structure NormalizeEin = struct local structure E = Ein structure P=Printer in (*Flattens Add constructor: change, expression *) fun mkAdd [e]=(1,e) | mkAdd(e)=let fun flatten((i, (E.Add l)::l'))= flatten(1,l@l') |flatten(i,((E.Const c):: l'))= if (c>0.0 orelse c<0.0) then let val(b,a)=flatten(i,l') in (b,[E.Const c]@a) end else flatten(1,l') | flatten(i,[])=(i,[]) | flatten (i,e::l') = let val(b,a)=flatten(i,l') in (b,[e]@a) end val (b,a)=flatten(0,e) in case a of [] => (1,E.Const(1.0)) | [e] => (1,e) | es => (b,E.Add es) (* end case *) end fun mkProd [e]=(1,e) | mkProd(e)=let fun flatten(i,((E.Prod l)::l'))= flatten(1,l@l') |flatten(i,((E.Const c)::l'))= if(c>0.0 orelse 0.0>c) then (3,[E.Const 0.0]) else flatten(i,l') | flatten(i,[])=(i,[]) | flatten (i,e::l') = let val(a,b)=flatten(i,l') in (a,[e]@b) end val (change,a)=flatten(0,e) in if(change=3) then (1,E.Const(0.0)) else case a of [] => (1,E.Const(0.0)) | [e] => (1,e) | es => (change, E.Prod es) (* end case *) end (* fun mkEps(e)= (case e of E.Apply(E.Partial [E.V a], E.Prod( e2::m ))=> (0,e) | E.Apply(E.Partial [E.V a,E.V b], E.Prod( (E.Epsilon(i,j,k))::m ))=> (if(a=i andalso b=j) then (1,E.Const(0.0)) else if(a=i andalso b=k) then (1,E.Const(0.0)) else if(a=j andalso b=i) then (1,E.Const(0.0)) else if(a=j andalso b=k) then (1,E.Const(0.0)) else if(a=k andalso b=j) then (1,E.Const(0.0)) else if(a=k andalso b=i) then (1,E.Const(0.0)) else (0,e)) |_=> (0,e) (*end case*)) fun mkSumApply(E.Sum(c,E.Apply(d, e))) = (case e of E.Tensor(a,[])=> (0,E.Const(0.0)) | E.Tensor _=> (0,E.Sum(c,E.Apply(d,e))) | E.Field _ =>(0, E.Sum(c, E.Apply(d,e))) | E.Const _=> (1,E.Const(0.0)) | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(d, e))) l)) | E.Sub(e2, e3) =>(1, E.Sub(E.Sum(c,E.Apply(d, e2)), E.Sum(c,E.Apply(d, e3)))) | E.Prod((E.Epsilon c)::e2)=> mkEps(E.Apply(d,e)) | E.Prod[E.Tensor(a,[]), e2]=> (0, E.Prod[ E.Tensor(a,[]), E.Sum(c,E.Apply(d, e2))] ) | E.Prod((E.Tensor(a,[]))::e2)=> (0, E.Prod[E.Tensor(a,[]), E.Sum(c,E.Apply(d, E.Prod e2))] ) | E.Prod es => (let fun prod [e] = (E.Apply(d, e)) | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l] val lr=e2 @[E.Apply(d,e1)] val(b,a) =mkProd lr in ( E.Add[ a, m] ) end) | prod _= (E.Const(1.0)) in (1, E.Sum(c,prod es)) end) | _=> (0,E.Sum(c,E.Apply(d,e))) (*end case*)) *) fun rmEpsIndex(_,_,[])=[] | rmEpsIndex([],[],cs)=cs | rmEpsIndex([],m ,e1::cs)=[e1]@rmEpsIndex(m,[],cs) | rmEpsIndex(i::ix,rest ,(E.V c)::cs)= if(i=c) then rmEpsIndex(rest@ix,[],cs) else rmEpsIndex(ix,rest@[i],(E.V c)::cs) (* Transform eps to deltas*) fun epsToDels(E.Sum(count,E.Prod e))= let fun doubleEps((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::es,eps,e3)= let (*Function is called when eps are being changed to deltas*) fun createDeltas(i,s,t,u,v, e3)= let (*remove index from original index list*) (*currrent, left, sumIndex*) val s'= rmEpsIndex([i,s,t,u,v],[],count) val s''=[E.V s, E.V t ,E.V u, E.V v] val deltas= E.Sub( E.Sum(s'',E.Prod([E.Delta(E.V s,E.V u), E.Delta(E.V t,E.V v)] @e3)), E.Sum(s'',E.Prod([E.Delta(E.V s,E.V v), E.Delta(E.V t,E.V u)]@e3))) in (case (eps,s') of ([],[]) =>(1,deltas) |([],_)=>(1,E.Sum(s',deltas)) |(_,[])=>(1,E.Prod(eps@[deltas])) |(_,_) =>(1, E.Sum(s', E.Prod(eps@[deltas]))) ) end in if(a=d) then createDeltas(a,b,c,e,f, e3) else if(a=e) then createDeltas(a,b,c,f,d, e3) else if(a=f) then createDeltas(a,b,c,d,e, e3) else if(b=d) then createDeltas(b,c,a,e,f, e3) else if(b=e) then createDeltas(b,c,a,f,d,e3) else if(b=f) then createDeltas(b,c,a,d,e,e3) else if(c=d) then createDeltas(c,a,b,e,f,e3) else if(c=e) then createDeltas(c,a,b,f,d,e3) else if(c=f) then createDeltas(c,a,b,d,e,e3) else (0,E.Const 0.0) end fun findeps(e,[])= (e,[]) | findeps(e,(E.Epsilon eps)::es)= findeps(e@[E.Epsilon eps],es) | findeps(e,es)= (e, es) fun dist([],eps,rest)=(0,eps,rest) | dist([e],eps,rest)=(0,eps@[e],rest) | dist(c1::current,eps,rest)=let val(i, exp)= doubleEps(c1::current,eps,rest) in (case i of 1=>(i,[exp],[E.Const 2.0]) |_=> dist(current, eps@[c1],rest)) end val (es,rest)=findeps([],e) in dist(es,[],rest) end fun rmIndex(_,_,[])=[] | rmIndex([],[],cs)=cs | rmIndex([],m ,e1::cs)=[e1]@rmIndex(m,[],cs) | rmIndex(i::ix,rest ,c::cs)= if(i=c) then rmIndex(rest@ix,[],cs) else rmIndex(ix,rest@[i],c::cs) (* Apply deltas to tensors/fields*) fun reduceDelta(E.Sum(c,E.Prod p))=let fun findDeltas(dels,rest,E.Delta d::es)= findDeltas(dels@[E.Delta d], rest, es) | findDeltas(dels,rest,E.Epsilon eps::es)=findDeltas(dels,rest@[E.Epsilon eps],es) | findDeltas(dels,rest,es)= (dels,rest,es) fun distribute(change,d,dels,[],done)=(change,dels@d,done) | distribute(change,[],[],e,done)=(change,[],done@e) | distribute(change,E.Delta(i,j)::ds,dels,E.Tensor(id,[tx])::es,done)= if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Tensor(id,[i])]) else distribute(change,ds,dels@[E.Delta(i,j)],E.Tensor(id,[tx])::es,done) | distribute(change,E.Delta(i,j)::ds,dels,E.Field(id,[tx])::es,done)= if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Field(id,[i])]) else distribute(change,ds,dels@[E.Delta(i,j)],E.Field(id,[tx])::es,done) | distribute(change,d,dels,e::es,done)=distribute(change,dels@d,[],es,done@[e]) val (dels,eps,es)=findDeltas([],[],p) val (change,dels',done)=distribute([],dels,[],es,[]) val index=rmIndex(change,[],c) in (change, E.Sum(index,E.Prod (eps@dels'@done))) end fun mkApply2(E.Apply(d,e))=(case e of E.Tensor(a,[])=>(1,E.Const 0.0) | E.Const _ =>(1,E.Const 0.0) | E.Add l => (1,E.Add(List.map (fn e => E.Apply(d, e)) l)) | E.Sub(e2, e3) =>(1, E.Sub(E.Apply(d, e2), E.Apply(d, e3))) | E.Prod(E.Tensor(a,[])::e2)=>(1,E.Prod[E.Tensor(a,[]),E.Apply(d,e)]) | E.Prod [e1]=>(1,E.Apply(d,e1)) | E.Prod es=> (let fun prod [e1] =E.Apply(d,e1) | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l] val lr=e2 @[E.Apply(d,e1)] val(b,a) =mkProd lr in E.Add[a,m] end) in (1,prod es) end) |_=>(0,E.Apply(d,e)) (* end case*)) fun mkSumApply2(E.Sum(c,E.Apply(E.Partial d,e)))=(case e of E.Const _=>(1,E.Const 0.0) | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(E.Partial d, e))) l)) | E.Sub(e2, e3) =>(1, E.Sub(E.Sum(c,E.Apply(E.Partial d, e2)), E.Sum(c,E.Apply(E.Partial d, e3)))) | E.Prod(E.Tensor(a,[])::e2)=>(1, E.Prod[E.Tensor(a,[]),E.Sum(c,E.Apply(E.Partial d,E.Prod e2))]) | E.Prod [e1]=>(1,E.Sum(c,E.Apply(E.Partial d,e1))) | E.Prod es =>(let fun prod (change,rest, sum,partial,[]) = (change,E.Sum(sum,E.Apply(E.Partial partial,E.Prod rest))) | prod (change,rest, sum,partial,E.Epsilon(i,j,k)::ps)= let fun matchprod(2,_,_,_)= 1 (*matched 2*) | matchprod(num,_,_,[])=0 | matchprod(0,_,_,[eps])=0 | matchprod(num,[],rest,eps::epsx)= matchprod(num,rest,[],epsx) | matchprod(num,E.V p::px,rest,eps::epsx)= if(p=eps) then matchprod(num+1,px,rest,epsx) else matchprod(num,px,rest@[E.V p], eps::epsx) | matchprod(num,p::px,rest,eps)= matchprod(num,px,rest,eps) val change'= matchprod(0,d,[],[i,j,k]) in (case change' of 1 => (1,E.Const 0.0) | _ =>prod(change,rest@[E.Epsilon(i,j,k)],sum,partial,ps)) end | prod (change,rest, sum,partial,E.Delta(i,j)::ps)=let fun applyDelPartial([],_)=(0,[]) | applyDelPartial(p::px,r)= if(j=p) then (1,r@[i]@px) else applyDelPartial(px,r@[p]) val (change',px)=applyDelPartial(d,[]) in (case change' of 1 => (let val index=rmIndex([j],[],sum) in prod(1,rest, index,px, ps) end ) | _ => prod(change,rest@[E.Delta(i,j)], sum,partial, ps) (*end case*)) end | prod (change,rest,sum, partial,e::es)= prod(change,rest@[e],sum,partial,es) val (change,exp) = prod(0,[],c, d, es) in (change,exp) end) | _=>(0,E.Sum(c,E.Apply(E.Partial d,e))) (* end case*)) (* E.Sum(c,Apply(d,e)) try E.Sum(c,e)=> E.Sum(c',e') ==> E.Sum(c',E.Apply(d,e')) E.Apply(d,e')=> E.Apply(d',e'') ==>E.Sum(c',E.Apply(d',e'') *) (*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 changed = ref false fun rewriteBody body = (case body of E.Const _=> body | E.Tensor _ =>body | E.Field _=> body | E.Kernel _ =>body | E.Delta _ => body | E.Value _ =>body | E.Epsilon _=>body | E.Neg e => E.Neg(rewriteBody e) | E.Add es => let val (change,body')= mkAdd(List.map rewriteBody es) in if (change=1) then ( changed:=true;body') else body' end | E.Sub (a,b)=> E.Sub(rewriteBody a, rewriteBody b) | E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b) | E.Partial _=>body | E.Conv (V, alpha)=> E.Conv(rewriteBody V, alpha) | E.Probe(u,v)=> E.Probe(rewriteBody u, rewriteBody v) | E.Image es => E.Image(List.map rewriteBody es) (*Product*) | E.Prod [e1] => rewriteBody e1 | E.Prod(e1::(E.Add(e2))::e3)=> (changed := true; E.Add(List.map (fn e=> E.Prod([e1, e]@e3)) e2)) | E.Prod(e1::(E.Sub(e2,e3))::e4)=> (changed :=true; E.Sub(E.Prod([e1, e2]@e4), E.Prod([e1,e3]@e4 ))) | E.Prod [E.Partial r1,E.Conv(f,deltas)]=> (changed :=true;E.Conv(f,deltas@r1)) | E.Prod (E.Partial r1::E.Conv(f,deltas)::ps)=> (changed:=true; let val (change,e)=mkProd([E.Conv(f,deltas@r1)]@ps) in e 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.0)) else body | E.Prod(E.Partial r1::E.Partial r2::p)=> (changed:=true;E.Prod([E.Partial(r1@r2)]@p)) | E.Prod(e::es)=>let val e'=rewriteBody e val e2=rewriteBody(E.Prod es) val(a,b)=(case e2 of E.Prod p'=> mkProd([e']@p') |_=>mkProd [e',e2]) in b end (*Apply*) | E.Apply(E.Partial [],e)=> e | E.Apply(E.Partial p, e)=>let val body'=E.Apply(E.Partial p, rewriteBody e) val (c, e')=mkApply2(body') in (case c of 1=>(changed:=true;e') | _ =>e') end | E.Apply(e1,e2)=>E.Apply(rewriteBody e1, rewriteBody e2) (* Sum *) | E.Sum([],e)=> (changed:=true;rewriteBody e) | E.Sum(_,E.Const c)=>(changed:=true;E.Const c) | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l)) | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=> let val (i,e,rest)=epsToDels(body) in (case (i, e,rest) of (1,[e1],_) =>(changed:=true;e1) |(0,eps,[])=>body |(0,eps,rest)=>(let val p'=rewriteBody(E.Prod rest) val p''= (case p' of E.Prod p=>p |e=>[e]) val(a,b)= mkProd (eps@p'') in E.Sum(c,b) end ) |_=>body) end | E.Sum(c, E.Prod(E.Delta d::es))=>let val (change,a)=reduceDelta(body) val (change',body')=(case a of E.Prod p=> mkProd p |_=> (0,a)) in (case change of []=>body'|_=>(changed:=true;body')) end | E.Sum(c,E.Apply(d,e))=>let val(c',e')=mkSumApply2(body) in (case c' of 1=>(changed:=true;e') |_=>e') end | E.Sum(c,e)=>E.Sum(c,rewriteBody e) (*end case*)) fun loop body = let val body' = rewriteBody body in if !changed then (changed := false; print " \n \t => \n \t ";print( P.printbody body');print "\n";loop body') else body' end val b = loop body in ((Ein.EIN{params=params, index=index, body=b})) end end end (* local *)
Click to toggle
does not end with </html> tag
does not end with </body> tag
The output has ended thus: loop body in ((Ein.EIN{params=params, index=index, body=b})) end end end (* local *)