structure NormalizeEin = struct local structure E = Ein structure P=Printer structure F=Filter structure G=EpsHelpers in fun err str=raise Fail (String.concat["Ill-formed EIN Operator",str]) val testing=0 fun prodAppPartial(es,p1)=(case es of [] => raise Fail "Empty App Partial" | [e1] => E.Apply(E.Partial p1,e1) | (e1::e2) => let val l= prodAppPartial(e2,p1) val (_,e2')= F.mkProd[e1,l] val (_,e1')=F.mkProd(e2@ [E.Apply(E.Partial p1, e1)]) in E.Add[e1',e2'] end (* end case *)) (*rewritten Sum*) fun mkSum(c1,e1)=(case e1 of E.Conv _ => (0,E.Sum(c1,e1)) | E.Field _ => (0,E.Sum(c1,e1)) | E.Probe _ => (0,E.Sum(c1,e1)) | E.Apply _ => (0,E.Sum(c1,e1)) | E.Delta _ => (0,E.Sum(c1,e1)) | E.Epsilon _ => (0,E.Sum(c1,e1)) | E.Tensor _ => (0,E.Sum(c1,e1)) | E.Neg e2 => (1,E.Neg(E.Sum(c1,e2))) | E.Lift e => (1,E.Lift(E.Sum(c1,e))) | E.Sum(c2,e2)=> (1,E.Sum(c1@c2,e2)) | E.Sub (a,b) => (1,E.Sub(E.Sum(c1,a),E.Sum(c1,b))) | E.Div (a,b) => (1,E.Div(E.Sum(c1,a),E.Sum(c1,b))) | E.Add e => (1,E.Add (List.map (fn(a)=>E.Sum(c1,a)) e)) | E.Prod p =>F.filterSca(c1,p) | E.Const _ => err("Sum of Const") | E.Partial _ => err("Sum of Partial") | E.Krn _ => err("Krn used before expand") | E.Value _ => err("Value used before expand") | E.Img _ => err("Probe used before expand") (*end case*)) (*rewritten Apply*) fun mkapply(d1,e1)=(case e1 of E.Lift e => (1,E.Const 0) | E.Prod [] => err("Apply of empty product") | E.Add [] => err("Apply of empty Addition") | E.Conv(v, alpha, h, d2) =>let val E.Partial d3=d1 in (1,E.Conv(v,alpha,h,d2@d3)) end | E.Field _ => (0,E.Apply(d1,e1)) | E.Probe _ => (0,E.Apply(d1,e1)) | E.Apply(E.Partial d2,e2) => let val E.Partial d3=d1 in (1,E.Apply(E.Partial(d3@d2),e2)) end | E.Apply _ => raise Fail" Apply of non-Partial expression" | E.Neg e2 => (1,E.Neg(E.Apply(d1,e2))) | E.Sum(c2,e2)=> (1,E.Sum(c2,E.Apply(d1,e2))) | E.Add e => (1,E.Add (List.map (fn(a)=>E.Apply(d1,a)) e)) | E.Sub (a,b) => (1,E.Sub(E.Apply(d1,a),E.Apply(d1,b))) | E.Div (a,b) => (1,E.Div(E.Apply(d1,a),E.Apply(d1,b))) | E.Prod p =>let val (pre, post)= F.filterField p val E.Partial d3=d1 in F.mkProd(pre@[prodAppPartial(post,d3)]) end | E.Const _ => err("Const without Lift") | E.Tensor _ => err("Tensor without Lift") | E.Delta _ => err("Apply of Delta") | E.Epsilon _ => err("Apply of Eps") | E.Partial _ => err("Apply of Partial") | E.Krn _ => err("Krn used before expand") | E.Value _ => err("Value used before expand") | E.Img _ => err("Probe used before expand") (*end case*)) (*rewritten probe*) fun mkprobe(e1,x)=(case e1 of E.Lift e => (1,e) | E.Prod [] => err("Probe of empty product") | E.Prod p => (1,E.Prod (List.map (fn(a)=>E.Probe(a,x)) p)) | E.Apply _ => (0,E.Probe(e1,x)) | E.Conv _ => (0,E.Probe(e1,x)) | E.Field _ => (0,E.Probe(e1,x)) | E.Add e => (1,E.Add (List.map (fn(a)=>E.Probe(a,x)) e)) | E.Sum(c,e') => (1,E.Sum(c,E.Probe(e',x))) | E.Div (a,b) => (1,E.Div(E.Probe(a,x),E.Probe(b,x))) | E.Sub (a,b) => (1,E.Sub(E.Probe(a,x),E.Probe(b,x))) | E.Neg e' => (1,E.Neg(E.Probe(e',x))) | E.Const _ => err("Const without Lift") | E.Tensor _ => err("Tensor without Lift") | E.Delta _ => err("Probe of Delta") | E.Epsilon _ => err("Probe of Eps") | E.Partial _ => err("Probe Partial") | E.Probe _ => err("Probe of a Probe") | E.Krn _ => err("Krn used before expand") | E.Value _ => err("Value used before expand") | E.Img _ => err("Probe used before expand") (*end case*)) (*fun K gg=String.concatWith "," (List.map (fn (E.V e1,_,_)=> (Int.toString(e1))) gg)*) fun K _= " " fun Kt gg=List.map (fn e1=> print(String.concat["[", (K e1),"]"])) gg (*Apply normalize to each term in product list or Apply normalize to tail of each list*) fun normalize (Ein.EIN{params, index, body}) = let (* val _ = print(String.concat["\n IN NORMALIZE@", P.printbody(body),"@\n"])*) val changed = ref false val sumIndex=ref [] fun rewriteBody body =(case body of E.Const _ => body | E.Tensor _ => body | E.Field _ => body | E.Delta _ => body | E.Epsilon _ => body | E.Conv _ => body | E.Partial _ => body | E.Krn _ => raise Fail"Krn before Expand" | E.Img _ => raise Fail"Img before Expand" | E.Value _ => raise Fail"Value before Expand" (*************Algebraic Rewrites **************) | E.Neg(E.Neg e) => rewriteBody e | E.Neg e => E.Neg(rewriteBody e) | E.Lift e => E.Lift(rewriteBody e) | E.Add es => let val (change,body')= F.mkAdd(List.map rewriteBody es) in if (change=1) then ( changed:=true;body') else body' end | E.Sub(a, E.Field f)=> (changed:=true;E.Add[a, E.Neg(E.Field(f))]) | E.Sub(E.Sub(a,b),E.Sub(c,d)) => rewriteBody(E.Sub(E.Add[a,d],E.Add[b,c])) | E.Sub(E.Sub(a,b),e2) =>rewriteBody (E.Sub(a,E.Add[b,e2])) | E.Sub(e1,E.Sub(c,d)) =>rewriteBody(E.Add([E.Sub(e1,c),d])) | E.Sub (a,b) => E.Sub(rewriteBody a, rewriteBody b) | E.Div(E.Div(a,b),E.Div(c,d)) => rewriteBody(E.Div(E.Prod[a,d],E.Prod[b,c])) | E.Div(E.Div(a,b),c) => rewriteBody (E.Div(a, E.Prod[b,c])) | E.Div(a,E.Div(b,c)) => rewriteBody (E.Div(E.Prod[a,c],b)) | E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b) (**************Apply, Sum, Probe**************) | E.Apply(E.Partial [],e)=> e | E.Apply(E.Partial d1, e1)=>let val e2 = rewriteBody e1 val (c,e3)=mkapply(E.Partial d1,e2) in (case c of 1=>(changed:=true;e3)| _ =>e3 (*end case*)) end | E.Apply _=> raise Fail" Not well-formed Apply expression" | E.Sum([],e)=> (changed:=true;rewriteBody e) | E.Sum(c,e)=>let val ref x=sumIndex val c'=[c]@x val e'=(sumIndex:=c';rewriteBody e) val ref s=sumIndex val z=hd(s) val (cng,e2)=(sumIndex:=tl(s);mkSum(z,e')) in (case cng of 1=> (changed:=true;e2) |_=> e2 (*end case*)) end | E.Probe(u,v)=> let val (c',b')=mkprobe(rewriteBody u,rewriteBody v) in (case c' of 1=> (changed:=true;b') |_=> b' (*end case*)) end (*************Product**************) | E.Prod [] => raise Fail"missing elements in product" | E.Prod [e1] => rewriteBody e1 | E.Prod((E.Div(e2,e3))::e4)=> (changed :=true; E.Div(E.Prod([e2]@e4), e3 )) | E.Prod((E.Add(e2))::e3)=> (changed := true; E.Add(List.map (fn e=> E.Prod([e]@e3)) e2)) | E.Prod(e1::E.Add(e2)::e3)=> (changed := true; E.Add(List.map (fn e=> E.Prod([e1,e]@e3)) e2)) | E.Prod((E.Sub(e2,e3))::e4)=> (changed :=true; E.Sub(E.Prod([e2]@e4), E.Prod([e3]@e4 ))) | E.Prod(e1::E.Sub(e2,e3)::e4)=> (changed :=true; E.Sub(E.Prod([e1,e2]@e4), E.Prod([e1,e3]@e4 ))) (*************Product EPS **************) | E.Prod(E.Epsilon(i,j,k)::E.Apply(E.Partial d,e)::es)=>let val change= G.matchEps(0,d,[],[i,j,k]) in case (change,es) of (1,_) =>(changed:=true; E.Const 0) | (_,[]) =>E.Prod[E.Epsilon(i,j,k),rewriteBody (E.Apply(E.Partial d,e))] |(_,_)=> let val a=rewriteBody(E.Prod([E.Apply(E.Partial d,e)]@ es)) val (_,b)=F.mkProd [E.Epsilon(i,j,k),a] in b end end | E.Prod(E.Epsilon(i,j,k)::E.Conv(V,alpha, h, d)::es)=>let val change= G.matchEps(0,d,[],[i,j,k]) in case (change,es) of (1,_) =>(changed:=true; E.Const 0) | (_,[]) =>E.Prod[E.Epsilon(i,j,k),E.Conv(V,alpha, h, d)] | (_,_) =>let val a=rewriteBody(E.Prod([E.Conv(V,alpha, h, d)]@ es)) val (_,b) = F.mkProd [E.Epsilon(i,j,k),a] in b end end | E.Prod[(E.Epsilon(e1,e2,e3)), E.Tensor(_,[E.V i1,E.V i2])]=> if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0)) else body | E.Prod(E.Epsilon eps1::ps)=> let val ref x=sumIndex val (i,s',e,rest)=G.epsToDels(x,body) in (case (i, e,rest) of (1,[e1],_) =>(changed:=true;sumIndex:=s';e1) |(0,eps,[])=>body | _ => let val p'=rewriteBody(E.Prod rest) val p''= (case p' of E.Prod p=>p |e=>[e]) val(_,b)= F.mkProd (e@p'') in b end (*end case*)) end | E.Prod(E.Sum(c1,E.Prod(E.Epsilon e1::es1))::E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es)=>let val ref x=sumIndex val m= Kt x val c'= [c1@c2]@x val (i,s',e,rest)=G.epsToDels(c', E.Prod([E.Epsilon e1, E.Epsilon e2]@es1@es2@es)) val gsg=Kt s' in (case (i, e,rest) of (1,[e1],_)=> (changed:=true;sumIndex:=s';let val ss=List.nth(s',((length s')-2)) in E.Sum(ss,e1) end ) | _=>let val eA=rewriteBody(E.Sum(c1,E.Prod(E.Epsilon e1::es1))) val eB=rewriteBody(E.Prod(E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es)) val (_,e)=F.mkProd([eA,eB]) in e end (*end case*)) end | E.Prod(E.Delta d::es)=>let val (pre',eps, dels,post)= F.filterGreek(E.Delta d::es) val ref x=sumIndex val (change,i',a)=G.reduceDelta(x, eps, dels, post) in (case (change,a) of (0, _)=> E.Prod [E.Delta d,rewriteBody(E.Prod es)] | (_, E.Prod p)=>let val (_, p') = F.mkProd p in (changed:=true;sumIndex:=i';p') end | _ => (changed:=true;sumIndex:=i';a ) (*end case*)) end | E.Prod[e1,e2]=> let val (_,b)=F.mkProd[rewriteBody e1, rewriteBody e2] in b end | E.Prod(e::es)=>let val e'=rewriteBody e val e2=rewriteBody(E.Prod es) val(_,b)=(case e2 of E.Prod p'=> F.mkProd([e']@p') |_=>F.mkProd [e',e2]) in b end (*end case*)) fun loop(body ,count) = let val body' = rewriteBody body in if !changed then let val _= (case testing of 1=> (print(String.concat["\nN =>",Int.toString(count),"--",P.printbody(body')]);1) | _=> 1) in (changed := false ;sumIndex:=[];loop(body',count+1)) end else (body',count) end val (b,count) = loop(body,0) val _ =(case testing of 1 => (print(String.concat["\n out of normalize \n",P.printbody(b),"\n Final CounterXX:",Int.toString(count),"\n\n"]);1) | _=> 1 (*end case*)) in (Ein.EIN{params=params, index=index, body=b},count) end end end (* local *)
Click to toggle
does not end with </html> tag
does not end with </body> tag
The output has ended thus: (Ein.EIN{params=params, index=index, body=b},count) end end end (* local *)