############################################################################# # # qAlGO package (q-Aleatoire et Grammaires d'Objets) # # Author : Isabelle Dutour # e-mail : # Created : December 1995 # # Description : draws combinatorial objects at random, uniformly with # object grammars and linear and q-linear valuations # # Last modified : September 1997 ############################################################################# ############################################################# # table names ############################################################# macro( tCount = `qalgo/Count`, # holds the main counting procedures tDraw = `qalgo/Draw`, # holds the principal drawing procedures tValtmp = `qalgo/Val` # holds temporarily valuations ): ############################################################# # some names ############################################################# alias( compile = qalgo[compile], Countgo = qalgo[countgo], Drawgo = qalgo[drawgo], Drawgoall = qalgo[drawgoall] ): macro( Prod = `qalgo/Prod`, # usefull for "cuting" operations Indentity = `qalgo/Indentity`, Double = `qalgo/Double`, Plusone = `qalgo/Plusone` ): ############################################################# # something will always be subs into these names ############################################################# macro( A_NONTERM=`qalgo/placeholder/nontermA`, B_NONTERM=`qalgo/placeholder/nontermB`, T_NONTERM=`qalgo/placeholder/nontermT`, vTx=`qalgo/placeholder/valTx`, vTy=`qalgo/placeholder/valTy`, vTq=`qalgo/placeholder/valTq`, pTx=`qalgo/placeholder/polTx`, pTy=`qalgo/placeholder/polTy`, pTq=`qalgo/placeholder/polTq`, mT1=`qalgo/placeholder/matT1`, mT2=`qalgo/placeholder/matT2`, Count=`qalgo/placeholder/count`, Draw=`qalgo/placeholder/draw`, BODY=`qalgo/placeholder/body` ): ############################################################# # types ############################################################# `type/object` := proc(x) type(x,name); end: `type/operation` := proc(x) type(x,function); end: ############################################################# # general system functions ############################################################# infolevel[qalgo] := 1: # userinfo de niv 1 affiches readlib(forget): `qalgo/nb` := -1: newname := proc() global `qalgo/nb`; `qalgo/nb` := `qalgo/nb`+1; F.`qalgo/nb`; end: nameof := proc(expr) local n,r; n := op(4,op(procname))[expr]; if type(n,string) then n; elif nargs>=2 then procname(expr) := args[2]; else r := newname(); procname(expr) := r; fi; end: compile := proc(Go,Val,typ) local go,valmin; global tValtmp, `qalgo/typ`; options remember; `qalgo/typ` := typ; tValtmp := readval(Go,Val,typ); go := form12(Go,Val); valmin := `qalgo/is_well_founded`(go); if valmin=false then ERROR(`(object grammar,valuation) is not well founded`); fi; if typ='qlinear' then count_F12(Go,Val,valmin,args[4]); else count_F12(Go,Val,valmin); fi; draw_F12(Go,Val,valmin); end: readval := proc(Go,Val,typ) local tval; map(proc(v,t) t[op(1,v)]:=[op(2..nops(v),v)] end,Val,tval); op(tval); end: ############################################################# # form 12 ############################################################# form12 := proc(Go,Val) local eq,resgo,m,plus; options remember; forget(nameof); resgo := {}; for eq in Go do `type/object`(op(1,eq)) := false; if nops(op(2,eq))=1 then m := [op(2,eq)]; else m := convert(op(2,eq),list); fi; # decoupe les operations d'arite > 2 m := map(`qalgo/form12/split`,m); # cree des non-terminaux pour chaque operation # et fait suivre les valuations m := map(`qalgo/form12/nouv`,m); resgo := resgo union {op(1,eq) = convert(m,`+`)}; od; plus := op(4,eval(nameof)); if plus <> NULL then resgo := resgo union convert( map(x->op(2,x)=op(1,x), op(op(plus))) ,set); fi; resgo; end: `qalgo/form12/split` := proc(f) if not type(f,operation) or nops(f) < 3 then RETURN(f); else op(0,f) ( op(1,f) , procname( Prod(op(2..nops(f),f)) ) ); fi; end: `qalgo/form12/nouv` := proc(f) local n; global tValtmp; if type(f,object) then n := nameof(f); tValtmp[n] := tValtmp[f]; tValtmp[f] := evaln(tValtmp[f]); `type/object`(n) := true; else n := `qalgo/form12/nouvrec`[`qalgo/typ`](f); `type/object`(n) := false; fi; n; end: `qalgo/form12/nouvrec`[linear] := proc(f) local n; global tValtmp; if not type(f,operation) then n := f; elif nops(f) < 2 then n := nameof(f); tValtmp[n] := tValtmp[op(0,f)]; tValtmp[op(0,f)] := evaln(tValtmp[op(0,f)]); else n := newname(); if op(0,f)='Prod' then tValtmp[n] := [0]; else tValtmp[n] := tValtmp[op(0,f)]; tValtmp[op(0,f)] := evaln(tValtmp[op(0,f)]); fi; n := nameof( op(0,f) ( op(1,f) , procname(op(2,f)) ), n ); fi; `type/object`(n) := false; n; end: `qalgo/form12/nouvrec`[linear2] := subs('[0]'=[0,0], eval(`qalgo/form12/nouvrec`[linear])): `qalgo/form12/nouvrec`[qlinear] := proc(f) local n,m; global tValtmp; if not type(f,operation) then n := f; elif nops(f) < 2 then n := nameof(f); tValtmp[n] := tValtmp[op(0,f)]; tValtmp[op(0,f)] := evaln(tValtmp[op(0,f)]); else # n := newname(); if op(0,f)='Prod' then m := args[2]; if nops(m)=2 then tValtmp[n] := [0,0,m]; else tValtmp[n] := [0,0,[op(1,m),0]]; fi; else m := op(3,tValtmp[op(0,f)]); if nops(m)=2 then tValtmp[n] := [op(1..2,tValtmp[op(0,f)]),m]; else tValtmp[n] := [op(1..2,tValtmp[op(0,f)]),[op(1,m),0]]; fi; tValtmp[op(0,f)] := evaln(tValtmp[op(0,f)]); fi; n := nameof( op(0,f) ( op(1,f) , procname(op(2,f),[op(2..nops(m),m)]) ), n ); fi; `type/object`(n) := false; n; end: ############################################################# # minimum valuations ############################################################# Coeff_Pol := proc(T,var) global tValtmp; if var='x' then op(1,tValtmp[T]) elif var='y' or var='q' then op(2,tValtmp[T]) else ERROR(`bad variable`,var) fi end: Coeff_Mat := proc(T,ar) global tValtmp; if ar=1 then op(1,op(3,tValtmp[T])) elif ar=2 then op(2,op(3,tValtmp[T])) else ERROR(`bad arite`,ar) fi end: valuation_min[linear] := proc(go) # go en forme12 local eq,vmin,go_minus_obj,changed,T,f,R,rx; options remember; # initialization for eq in go do T := op(1,eq); if type(T,object) then vmin[T]['x'] := Coeff_Pol(T,'x'); else vmin[T]['x'] := infinity; fi; od; # calcul go_minus_obj := map(proc(eq) if not type(op(1,eq),object) then eq fi end,go); changed := true; while changed do changed := false; for eq in go_minus_obj do T := op(1,eq); f := op(2,eq); if not type(f,operation) then rx := min(seq(vmin[R]['x'],R=f)); elif nops(f)=1 then rx := Coeff_Pol(T,'x') + vmin[op(f)]['x']; else rx := Coeff_Pol(T,'x') + vmin[op(1,f)]['x'] + vmin[op(2,f)]['x']; fi; if rx<>vmin[T]['x'] then vmin[T]['x'] := rx; changed := true; fi; od; od; op(vmin); end: valuation_min[linear2] := proc(go) # go en forme12 local eq,vmin,go_minus_obj,changed,T,f,R,rx,ry; options remember; # initialization for eq in go do T := op(1,eq); if type(T,object) then vmin[T]['x'] := Coeff_Pol(T,'x'); vmin[T]['y'] := Coeff_Pol(T,'y'); else vmin[T]['x'] := infinity; vmin[T]['y'] := infinity; fi; od; # calcul go_minus_obj := map(proc(eq) if not type(op(1,eq),object) then eq fi end,go); changed := true; while changed do changed := false; for eq in go_minus_obj do T := op(1,eq); f := op(2,eq); if not type(f,operation) then rx := min(seq(vmin[R]['x'],R=f)); ry := min(seq(vmin[R]['y'],R=f)); elif nops(f)=1 then rx := Coeff_Pol(T,'x') + vmin[op(f)]['x']; ry := Coeff_Pol(T,'y') + vmin[op(f)]['y']; else rx := Coeff_Pol(T,'x') + vmin[op(1,f)]['x'] + vmin[op(2,f)]['x']; ry := Coeff_Pol(T,'y') + vmin[op(1,f)]['y'] + vmin[op(2,f)]['y']; fi; if rx<>vmin[T]['x'] then vmin[T]['x'] := rx; changed := true; fi; if ry<>vmin[T]['y'] then vmin[T]['y'] := ry; changed := true; fi; od; od; op(vmin); end: valuation_min[qlinear] := proc(go) # go en forme12 local obj,eq,vmin,go_minus_obj,changed,T,f,R,rx,rq; options remember; # initialization for eq in go do T := op(1,eq); if type(T,object) then vmin[T]['x'] := Coeff_Pol(T,'x'); vmin[T]['q'] := Coeff_Pol(T,'q'); else vmin[T]['x'] := infinity; vmin[T]['q'] := infinity; fi; od; # calcul go_minus_obj := map(proc(eq) if not type(op(1,eq),object) then eq fi end,go); changed := true; while changed do changed := false; for eq in go_minus_obj do T := op(1,eq); f := op(2,eq); if not type(f,operation) then rx := min(seq(vmin[R]['x'],R=f)); rq := min(seq(vmin[R]['q'],R=f)); elif nops(f)=1 then rx := Coeff_Pol(T,'x') + vmin[op(f)]['x']; rq := Coeff_Pol(T,'q') + vmin[op(f)]['q'] + Coeff_Mat(T,1) * vmin[op(f)]['x']; else rx := Coeff_Pol(T,'x') + vmin[op(1,f)]['x'] + vmin[op(2,f)]['x']; rq := Coeff_Pol(T,'q') + vmin[op(1,f)]['q'] + vmin[op(2,f)]['q'] + Coeff_Mat(T,1) * vmin[op(1,f)]['x'] + Coeff_Mat(T,2) * vmin[op(2,f)]['x']; fi; if rx<>vmin[T]['x'] then vmin[T]['x'] := rx; changed := true; fi; if rq<>vmin[T]['q'] then vmin[T]['q'] := rq; changed := true; fi; od; od; op(vmin); end: ############################################################# # well-founded functions ############################################################# # given the object grammar in form12, determine which non-terminals # can produce objects of valuation 1. `qalgo/wellfounded/has_valuation_one` := proc(go) local eq,val1,T,go_minus_obj,rhs,oldval,changed; global tValtmp; # initialization for eq in go do T := op(1,eq); if (type(T,object) and convert(tValtmp[T],set)={0}) then val1[T] := true else val1[T] := false; fi; od; # use a fixed-point algorithm go_minus_obj := map(proc(eq) if not type(op(1,eq),object) then eq fi end,go); changed := true; while changed=true do changed := false; for eq in go_minus_obj do T := op(1,eq); rhs := op(2,eq); oldval := val1[T]; val1[T] := `qalgo/wellfounded/has_one`(rhs,val1); if val1[T] <> oldval then changed := true fi; od; od; eval(val1); end: # subfunction - given rhs of a production, determine if it can produce # elements of valuation 1 `qalgo/wellfounded/has_one` := proc(rhs,val1) local r,T,m; global tValtmp; if type(rhs,name) then r := val1[rhs]; elif not type(rhs,operation) then r := convert(map(procname,[op(rhs)],val1),`or`); elif type(rhs,operation) then T := nameof(rhs); # linear : m=1, linear2 ou qlinear : m=2 m := min(2,nops(tValtmp[T])); if nops(rhs)=1 then r := val1[op(rhs)] and ({op(1..m,tValtmp[T])}={0}); else r := convert(map(procname,[op(rhs)],val1),`and`) and ({op(1..m,tValtmp[T])}={0}); fi; fi; r; end: `qalgo/wellfounded/dependency_graph` := proc(go,val1) # go in form12 local mat,g,eq,rhs,T,m,V,U; global tValtmp; if `qalgo/typ`=linear or `qalgo/typ`=linear2 then mat := proc() 0; end; else mat := Coeff_Mat; fi; g := NULL; for eq in go do T := op(1,eq); rhs := op(2,eq); if not type(rhs,operation) then g := g, seq(U args[4] = function for eq in go do T := op(1,eq); if not type(T,object) then tCount[Go,Val][1][fun][T] := eval(args[4]); tCount[Go,Val][1][aux][T] := subs(vTx=val[T]['x'], Count=tCount[Go,Val][0], makecount1_aux(T)); tCount[Go,Val][1][gen][T] := subs(Count=tCount[Go,Val][1][aux], Fun=tCount[Go,Val][1][fun], makecount1(T)); fi; od; fi; end: # count_F12 makecount1 := proc(T) subs(T_NONTERM=T, proc(m) option remember; Count[T_NONTERM](Fun[T_NONTERM](m),m); end ) end: makecount1_aux := proc(T) subs(T_NONTERM=T, proc(n,m) option remember; if n