structure NormalizeEin = struct local structure G = GenericEin structure E = Ein structure S = Specialize structure R = Rewrite in (* If changed is true then I know the expression will run through the funciton again. However, if not, then I want to make sure that every expression in the Product is examined, and not just individually but as a group. Prod[t1,t2,(t3+t4)] indivually=> same Prod[t1] @ Prod[t2,(t3+t4)]=> Notice rule here Prod[t1] @ Add(Prod (t2, t3), Prod (t2, t4)) => Add( Prod[t1, Prod(t2,t3)]..) => Add (Prod[t1,t2,t3]) Flattened *) (*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 c<0.0) then if (c>1.0 orelse c<1.0) then let val(b,a)=flatten(i,l') in (b,[E.Const c]@a) end else flatten(1,l') else (3, [E.Const(0.0)]) | 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 if(b=3) then (1,E.Const(0.0)) else case a of [] => (1,E.Const(0.0)) | [e] => (1,e) | es => (b, E.Prod es) (* end case *) end fun mkEps(e)= (case e of E.Apply(E.Partial [a], E.Prod( e2::m ))=> (0,e) | E.Apply(E.Partial [a,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 mkApply(E.Apply(d, e)) = (case e of E.Tensor(a,[])=> (0,E.Const(0.0)) | E.Tensor _=> (0,E.Apply(d,e)) | 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.Epsilon c)::e2)=> mkEps(E.Apply(d,e)) | E.Prod[E.Tensor(a,[]), e2]=> (0, E.Prod[ E.Tensor(a,[]), E.Apply(d, e2)] ) | E.Prod((E.Tensor(a,[]))::e2)=> (0, E.Prod[E.Tensor(a,[]), 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,prod es) end) | _=> (0,E.Apply(d,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*)) (* Identity: (Epsilon ijk Epsilon ilm) e => (Delta jl Delta km - Delta jm Delta kl) e The epsToDels Function searches for Epsilons in the expression, checks for this identity in all adjacent Epsilons and if needed, does the transformation. The Function returns two separate list, 1 is the remaining list of Epsilons that have not be changed to deltas, and the second is the Product of the remaining expression. Ex:(Epsilon_ijk Epsilon_ilm) Epsilon_stu e =>([Epsilon_stu], [Delta_jl,Delta_km,e -Delta_jm Delta_kl, e] ) This is useful since we can normalize the second list without having to normalize the epsilons again.*) fun epsToDels(E.Sum(count,E.Prod e))= let fun doubleEps((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::es,e3)= let fun createDeltas(s,t,u,v, e3)= (1, E.Sub(E.Sum(2,E.Prod([E.Delta(s,u), E.Delta(t,v)] @e3)), E.Sum(2,E.Prod([E.Delta(s,v), E.Delta(t,u)]@e3)))) in if(a=d) then createDeltas(b,c,e,f, e3) else if(a=e) then createDeltas(b,c,f,d, e3) else if(a=f) then createDeltas(b,c,d,e, e3) else if(b=d) then createDeltas(c,a,e,f, e3) else if(b=e) then createDeltas(c,a,f,d,e3) else if(b=f) then createDeltas(c,a,d,e,e3) else if(c=d) then createDeltas(a,b,e,f,e3) else if(c=e) then createDeltas(a,b,f,d,e3) else if(c=f) then createDeltas(a,b,d,e,e3) else (0,(E.Prod((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::e3))) end fun findeps(e,[])= (e,[]) | findeps(e,(E.Epsilon eps)::es)= findeps(e@[E.Epsilon eps],es) | findeps(e,es)= (e, es) fun distribute([], s)=(0, [],s) | distribute([e1], s)=(0, [e1], s) | distribute(e1::es, s)= let val(i, exp)=doubleEps(e1::es, s) in if(i=1) then (1, tl(es), [exp]) else let val(a,b,c)= distribute(es, s) in (a, [e1]@b, c) end end val (change, eps,rest)= distribute(findeps([], e)) in (change, eps,rest) end (*The Deltas then need to be distributed over to the tensors in the expression e. Ex.:Delta ij ,Tensor_j, e=> Tensor_i,e. The mkDelts function compares every Delta in the expression to the tensors in the expressions while keeping the results in the correct order. This also returns a list of deltas and a list of the remaining expression. *) fun mkDel(e) = let fun Del(i, [],x)= (i,[],x) | Del(i, d,[])=(i, d,[]) | Del(i, (E.Delta(d1,d2))::d, (E.Tensor(id,[x]))::xs)= if(x=d2) then (let val(i',s,t)= Del(i+1,d, xs) in Del(i',s, [E.Tensor(id, [d1])] @t) end) else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs) val(i2,s2,t2)= Del(i',d,[E.Tensor(id,[x])]@t) in (i2,s@s2, t2) end ) | Del(i, (E.Delta(d1,d2))::d, (E.Field(id,[x]))::xs)= if(x=d2) then (let val(i',s,t)= Del(i+1,d, xs) in Del(i',s, [E.Field(id, [d1])] @t) end) else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs) val(i2,s2,t2)= Del(i',d,[E.Field(id,[x])]@t) in (i2,s@s2, t2) end ) | Del(i, d, t)= (i,d,t) fun findels(e,[])= (e,[]) | findels(e,es)= let val del1= hd(es) in (case del1 of E.Delta _=> findels(e@[del1],tl(es)) |_=> (e, es)) end val(a,b)= findels([], e) in Del(0, a, b) end (*The Deltas are distributed over to the tensors in the expression e. This function checks for instances of the dotProduct. Sum_2 (Delta_ij (A_i B_j D_k))=>Sum_1(A_i B_i) D_k *) fun checkDot(E.Sum(s,E.Prod e))= let fun dot(i,d,r, (E.Tensor(ida,[a]))::(E.Tensor(idb,[b]))::ts)= if (a=b) then dot(i-1,d@[E.Sum(1,E.Prod[(E.Tensor(ida,[a])), (E.Tensor(idb,[b]))])], [],r@ts) else dot(i,d, r@[E.Tensor(idb,[b])],(E.Tensor(ida,[a]))::ts) |dot(i, d,r, [t])=dot(i,d@[t], [], r) |dot(i,d, [],[])= (i,d, [],[]) |dot(i,d, r, [])= dot(i,d, [], r) |dot(i, d, r, (E.Prod p)::t)= dot (i, d, r, p@t) |dot(i,d, r, e)= (i,d@r@e, [], []) val(i,d,r,c)= dot(s,[],[], e) val soln= (case d of [d1]=>d1 |_=> E.Prod d) in E.Sum(i,soln) end |checkDot(e)= (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.Delta _ => body | E.Epsilon _=>body | E.Conv _=> body | E.Partial _=>body | E.Add es => let val (b,a)= mkAdd(List.map rewriteBody es) in if (b=1) then ( changed:=true;a) else a end | E.Pair es=> E.Pair(List.map rewriteBody es) | E.Value _ => body | E.Sub (a,b)=> E.Sub(rewriteBody a, rewriteBody b) | E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b) | E.Probe(u,v)=> ( E.Probe(rewriteBody u, v)) | E.Sum(0, e)=>e | E.Sum(_, (E.Const c))=> E.Const c | E.Sum(c,(E.Add l))=> E.Add(List.map (fn e => E.Sum(c,e)) l) | E.Sum(c,E.Prod((E.Delta d)::es))=>( let val (i,dels, e)= mkDel((E.Delta d)::es) val rest=(case e of [e1]=> rewriteBody e1 |_=> rewriteBody(E.Prod(e))) val soln= (case rest of E.Prod r=> E.Sum(c-i, E.Prod(dels@r)) |_=>E.Sum(c-i, E.Prod(dels@[rest]))) val q= checkDot(soln) in if (i=0) then q else (changed :=true;q) end ) | E.Sum(c,E.Prod((E.Epsilon e1 )::(E.Epsilon e2)::xs))=> let val (i,eps, e)= epsToDels(body) in if (i=0) then let val e'=rewriteBody(E.Prod(e)) in (case e' of E.Prod m=> let val (i2, p)= mkProd(eps @ m) in E.Sum(c, p) end |_=>E.Sum(c, E.Prod(eps@ [e']))) end else(let val [list]=e val ans=rewriteBody(list) val soln=(case ans of E.Sub (E.Sum(c1,(E.Prod s1)),E.Sum(c2,(E.Prod s2))) => E.Sum(c-3+c1, E.Sub(E.Prod(eps@s1),E.Prod(eps@s2))) | E.Sub (E.Sum(c1,s1),E.Sum(c2,s2)) => E.Sum(c-3+c1, E.Prod(eps@ [E.Sub(s1,s2)])) |_=> E.Prod(eps@ [ans])) in (changed :=true;soln) end ) end | E.Sum(c, E.Apply(E.Partial p, E.Prod((E.Delta(i,j))::e3 )))=> let fun part([], e2, counter)=([], e2, counter) | part(p1::ps, [E.Delta(i,j)],counter)=if (p1=j) then ([i]@ps,[],counter-1) else (let val (a,b,counter)=part(ps, [E.Delta(i,j)],counter) in ([p1]@a, b,counter ) end) val (e1,e2,counter)= part(p, [E.Delta(i,j)],c) in (E.Sum(counter, E.Apply(E.Partial e1, E.Prod(e2@e3)))) end | E.Sum(c, E.Apply(p, e))=>let val e'= rewriteBody(E.Sum(c, e)) val p'= rewriteBody p val (i, e2)= (case e' of E.Sum(c',exp)=> mkSumApply(E.Sum(c', E.Apply(p', exp))) |_=>mkApply( E.Apply(p', e'))) in if(i=1) then (changed :=true;e2) else e2 end | E.Sum(c, e)=> E.Sum(c, rewriteBody e) | 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(E.Field(id,[i]), deltas)]=> (changed:=true; ( let val j1= List.map (fn(x)=> (i,x)) r1 in E.Conv(E.Field(id,[i]), j1@deltas) end )) | E.Prod((E.Partial r1)::(E.Partial r2)::e) => (changed := true; E.Prod([E.Partial (r1@r2)] @ e) ) | E.Prod[(E.Epsilon(e1,e2,e3)), E.Tensor(_,[i1,i2])]=> if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0.0)) else body | E.Prod((E.Epsilon eps1)::es)=> (let val rest=(case es of [e1] => rewriteBody e1 |_=> rewriteBody(E.Prod(es))) val (i, solution)=(case rest of E.Prod m=> mkProd ([E.Epsilon eps1] @m ) |_=> mkProd([E.Epsilon eps1]@ [rest])) in if (i=1) then (changed:=true;solution) else solution end) | E.Prod (e::es) => (let val r=rewriteBody(E.Prod es) val (i,solution)= (case r of E.Prod m => mkProd([e]@m ) |_=> mkProd([e]@ [r])) in if (i=1) then (changed:=true;solution) else solution end) | E.Apply(E.Const _,_) => (E.Const(0.0)) | E.Apply(E.Partial p, E.Prod((E.Delta(i,j))::e3))=> let fun part([], e2)=([], e2) | part(p1::ps, [E.Delta(i,j)])=if (p1=j) then ([i]@ps,[]) else (let val (a,b)=part(ps, [E.Delta(i,j)]) in ([p1]@a, b ) end) val (e1,e2)= part(p, [E.Delta(i,j)]) in E.Apply(E.Partial e1, E.Prod(e2@e3)) end | E.Apply(d,e)=> ( let val (t1,t2)= mkApply(E.Apply(rewriteBody d, rewriteBody e)) in if (t1=1) then (changed :=true;t2) else t2 end ) |_=> body (*end case*)) fun loop body = let val body' = rewriteBody body in if !changed then (changed := false; 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: p body in ((Ein.EIN{params=params, index=index, body=b})) end end end (* local *)