Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

[diderot] View of /branches/charisee/src/compiler/ein/mkoperators.sml
 [diderot] / branches / charisee / src / compiler / ein / mkoperators.sml

# View of /branches/charisee/src/compiler/ein/mkoperators.sml

Wed Apr 30 16:05:25 2014 UTC (5 years, 4 months ago) by cchiw
File size: 14004 byte(s)
(* examples.sml
*
* COPYRIGHT (c) 2012 The Diderot Project (http://diderot-language.cs.uchicago.edu)
*)

structure mkOperators = struct

local

structure E = Ein
structure P=Printer
in

fun expIndex(n,inc)=List.tabulate(n, (fn(x)=>E.V (x+inc)))
fun expIndexP(n,inc)=List.tabulate(n, (fn(x)=> (x+inc)))

fun specialize(alpha,inc)=(alpha,expIndex(length(alpha),inc))
fun specializeP(alpha,inc)=(alpha,expIndexP(length(alpha),inc))

(*mkTensor functions*)
(* Adding tensors : < X{\alpha} + Y_{\alpha}>_{\alpha} *)
val (index', expindex')= specialize(alpha,0)
in
E.EIN{
params = [E.TEN(1,alpha), E.TEN(1,alpha)], index = index',
body = E.Add[E.Tensor(0, expindex'), E.Tensor(1, expindex')]
}
end

fun createVec(dim)=E.EIN{
params = [E.TEN(1,[dim])], index = [dim],
body = E.Tensor(0, [E.V 0])
}

val zero=E.EIN{
params = [], index = [],
body = E.Const(0)
}

(* Subtracting tensors *)
fun subTen(alpha)=let
val (index', expindex')= specialize(alpha,0)
in
E.EIN{
params = [E.TEN(1,alpha), E.TEN(1,alpha)], index = index',
body = E.Sub(E.Tensor(0, expindex'), E.Tensor(1, expindex'))}
end

fun divTen(alpha) =let
val (index', expindex')= specialize(alpha,0)
in  E.EIN{
params = [E.TEN(1,alpha), E.TEN(1,[])], index = index',
body = E.Div(E.Tensor(0, expindex'), E.Tensor(1,[]))
}
end

(* Trace: <M_{i, i}>  This one Sx represents both i's*)
fun trace(dim) = E.EIN{
params = [E.TEN(1,[dim,dim])],         (* M *)
index = [],           (* i *)
body = E.Sum([(E.V 0,0,dim-1)],E.Tensor(0, [E.V 0, E.V 0]))
}

fun negTen(alpha)=let
val (index', expindex')= specialize(alpha,0)
in E.EIN{
params = [E.TEN(1,alpha)],
index = index',
body = E.Neg(E.Tensor(0, expindex'))
}
end

(* scalar times tensor product: <s * T_{\alpha}>_{\alpha} *)
fun scaleTen(alpha) = let
val (index', expindex')= specialize(alpha,0)
in E.EIN{
params = [E.TEN(1,[]), E.TEN(1,alpha)],    (* s and T *)
index = index',           (* \alpha *)
body = E.Prod[ E.Tensor(0, []),  E.Tensor(1, expindex')]
}
end

(* generic inner product: <T_{\alpha i} * T_{i \beta}>_{\alpha \beta} *)
fun innerProduct(shape1,i::beta) = let
val alpha= List.take(shape1,length(shape1)-1)
val (indexA, expindexA)= specialize(alpha,0)
val (indexB, expindexB)= specialize(beta,(length(alpha)))
val s'=E.V(length(alpha)+ length(beta))
val s''=[(s',0,i-1)]
in E.EIN{
params = [E.TEN(1,shape1) ,E.TEN(1,i::beta)],              (* T and T' *)
index = indexA@indexB,   (* \alpha \beta, i *)
body = E.Sum(s'', E.Prod[
E.Tensor(0, expindexA@[s']),   (* T_{\alpha i} *)
E.Tensor(1, [s']@expindexB )  (* T'_{i \beta} *)
])
}
end
| innerProduct _ = raise Fail "Wrong shape for inner product"

(*<T_{\alpha i j} * B{i j \beta }>_\alpha \beta*)
fun doubleDot(shape1,i::j::beta) = let
val alpha= List.take(shape1,length(shape1)-2)
val (indexA, expindexA)= specialize(alpha,0)
val (indexB, expindexB)= specialize(beta,(length(alpha)))
val sumi=length(alpha)+ length(beta)
val s'=[E.V sumi,E.V(sumi+1)]
val s''=[(E.V sumi,0,i-1),(E.V(sumi+1),0,j-1)]
in E.EIN{
params = [E.TEN(1,shape1),E.TEN(1,i::j::beta)],
index = indexA@indexB,
body = E.Sum(s'',E.Prod[
E.Tensor(0, expindexA@s'),
E.Tensor(1,s'@expindexB)
])
}
end
| doubleDot _ = raise Fail "Wrong shape for double dot "

(*Vector Examples : <T_i * T_j>_ij..t0⊗t1*)
fun outerProduct(dimA,dimB) =E.EIN{
params = [E.TEN(1,[dimA]), E.TEN(1,[dimB])],
index= [dimA,dimB],
body= E.Prod[E.Tensor(0, [E.V 0]), E.Tensor(1, [E.V 1])]
}

fun transpose([i,j]) =E.EIN{
params = [E.TEN(1,[i,j])], index= [j,i],
body= E.Tensor(0, [E.V 1,E.V 0])
}
| transpose _= raise Fail "too many indices for transpose"

fun modulate(dim) =E.EIN{
params = [E.TEN(1,[dim]), E.TEN(1,[dim])],
index = [dim],
body = E.Prod[E.Tensor(0, [E.V 0]), E.Tensor(1, [E.V 0])]
}

(*crossProduct is on 3D vectors ..vec3 t8=t0 × t1; *)
val crossProduct = E.EIN{
params = [E.TEN(1,[3]), E.TEN(1,[3])],
index= [3],
body=E.Sum([(E. V 1,0,2),(E.V 2,0,2)],
E.Prod[ E.Epsilon(0, 1, 2), E.Tensor(0, [E.V 1]),  E.Tensor(1, [E.V 2 ]) ])
}

(* Identiy: <\delta_{i j}>_{i j}  *)
fun identity(dim) =E.EIN{
params = [],
index = [dim,dim],
body = E.Delta(E.V(0), E.V(1))
}

(*Tensor and Fields*)
params = [E.TEN(1,[]),E.FLD(dim)],
index = [],
}

fun subTenField(dim) = E.EIN{
params = [E.TEN(1,[]),E.FLD(dim)],
index = [],
}

fun subFieldTen(dim) = E.EIN{
params = [E.TEN(1,[]),E.FLD(dim)],
index = [],
body = E.Sub(E.Field(1, []),E.Lift(E.Tensor(0, [])))
}

(* mkField functions*)
(*Adding Fields : < F{\alpha} + G_{\alpha}>_{\alpha} *)
val (index', expindex')= specialize(shape,0)
in E.EIN{
params = [E.FLD(dim),E.FLD(dim)],
index = index',
}
end

fun subField(dim,shape) =let
val (index', expindex')= specialize(shape,0)
in E.EIN{
params = [E.FLD(dim),E.FLD(dim)],
index = index',
body = E.Sub(E.Field(0, expindex'),E.Field(1, expindex'))
}
end

fun scaleField(dim,shape) =let
val (index', expindex')= specialize(shape,0)
in E.EIN{
params = [E.TEN(1,[]),E.FLD(dim)],
index = index',
body = E.Prod[E.Lift( E.Tensor(0,[])), E.Field(1,expindex')]
}
end

fun divideField(dim,shape) = let
val (index', expindex')= specialize(shape,0)
in E.EIN{
params = [E.FLD(dim),E.TEN(1,[])],
index = index',
body = E.Div(E.Field(0, expindex'),E.Lift(  E.Tensor(1, [])))
}
end

fun negField(dim,shape) = let
val (index', expindex')= specialize(shape,0)
in E.EIN{
params = [E.FLD(dim)],
index = index',
body = E.Neg(E.Field(0, expindex'))
}
end

(*< d F /  d_i>_i  *)
val a=List.hd(alpha)

val (index', expindex')= specialize(alpha,0)
in E.EIN{
params = [E.FLD(a)],
index =index',
body = E.Apply(E.Partial(expindex'),E.Field(0,[]))
}
end

(*< Sigma d F_alpha /  d x_i>ALpha  i CHANGE HERE *)
fun dotimes(dim,alpha)= let
val n=length(alpha)
fun expIndex(n,inc)=List.tabulate(n, (fn(x)=>E.V (x+inc)))
val i'=expIndex(n,0)

in E.EIN{
params = [E.FLD(dim)], index =alpha@[dim],
body = E.Apply(E.Partial [E.V n] ,E.Field(0,i'))
}
end

(*  <d F_i /d_i> *)
(*Need to change here *)

fun fs i =Int.toString(length(i))
fun f i =Int.toString(i)

fun divergence(dim,alpha)=let

val (index', expindex')= specialize(alpha,0)
val sumI=length(alpha)
val _=print (String.concat["\n\n Divergence, length alpha", fs(alpha),"length expindex", fs(expindex'),"\n Dimension", f(dim),
"SumI", f(sumI)
])

val sumIndex=E.V(sumI)
val sumIndexL=[sumIndex]
val S=expindex'@sumIndexL

in E.EIN{
params = [E.FLD(dim)],
index = index',
body = E.Sum([(sumIndex,0,dim-1)],E.Apply(E.Partial(sumIndexL),E.Field(0,S)))
}
end

(*FLD here is bounded to image field, and dimension of h*)
fun conv(dim,shape) =let
val (index', expindex')= specialize(shape,0)
in E.EIN{
params = [E.IMG(dim),E.KRN],
index = index',
body= E.Conv(0,expindex',1,[])
}
end

(* Probe: <F(x)>_{\alpha}   *)
fun probe(alpha,dim) = let
val (indexT, expindexT)= specialize(alpha,0)

in E.EIN{
params = [E.FLD(dim),E.TEN(0,[])],
index= indexT,
body= E.Probe(E.Field(0, expindexT), E.Tensor(1,[]))
}
end

(*(F_y/dx - F_x/dy )k*)
val curl2d=E.EIN{
params = [E.FLD 2],
index = [],
body = E.Sub(E.Apply(E.Partial([E.C 0]), E.Field(0,[E.C 1])),
E.Apply(E.Partial([E.C 1]), E.Field(0,[E.C 0])))
}

val curl3d=E.EIN{
params = [E.TEN(1,[3])],
index = [3],
body = E.Sum([(E.V 1,0,2), (E.V 2,0,2)],E.Prod[E.Epsilon(0, 1, 2),E.Apply( E.Partial([E.V 1]), E.Field(0,[E.V 2]))])
}

(*Scalars*)
params = [E.TEN(1,[]), E.TEN(1,[])] ,
index = [],
body = E.Add[ E.Tensor(0, []), E.Tensor(1, [])]
}

(* Subtract Scalars*)
val subScalar = E.EIN{
params = [E.TEN(1,[]), E.TEN(1,[])],
index = [],
body = E.Sub( E.Tensor(0, []), E.Tensor(1, []))
}

(* Divide Scalars*)
val divScalar = E.EIN{
params = [E.TEN(1,[]), E.TEN(1,[])],
index = [],
body = E.Div( E.Tensor(0, []), E.Tensor(1, []))
}

(* Product Scalars*)
val prodScalar = E.EIN{
params =[E.TEN(1,[]), E.TEN(1,[])],
index = [],
body = E.Prod[ E.Tensor(0, []), E.Tensor(1, [])]
}

(*Transform M_ij x_j+T*)
fun transform(i, j) = E.EIN{
params = [E.TEN(1,[i,j]), E.TEN(1,[j]), E.TEN(1,[j])],
index = [i],
[E.Sum([(E.V 1, 0,j-1)],E.Prod[E.Tensor(0, [E.V 0, E.V 1]), E.Tensor(1, [E.V 1])]),
E.Tensor(1,[E.V 0])]
}

(*New OPs*)
fun mulFieldss dim = E.EIN{
params = [E.FLD(dim),E.FLD(dim)],
index = [],
body = E.Prod[E.Field(0, []),E.Field(1, [])]
}

fun mulFieldsf(dim,shape) =let
val (index', expindex')= specialize(shape,0)
in E.EIN{
params = [E.FLD(dim),E.FLD(dim)],
index = index',
body = E.Prod[E.Field(0, []),E.Field(1, expindex')]
}
end

(*
(*Outer Product  Fields : < F{i} + G_{j}>_{ij} *)
fun outerField(dim,i, j) =let
val (index', expindex')= specialize(i@j,0)
in
E.EIN{
params = [E.FLD(dim),E.FLD(dim)],
index = index',
body = E.Prod[E.Field(0, [E.V 0]),E.Field(1, [E.V 1])]
}
end

*)

(*Assumes same dimension vetcor field *)
fun outerField(dim) =
E.EIN{
params = [E.FLD(dim),E.FLD(dim)],
index = [dim, dim],
body = E.Prod[E.Field(0, [E.V 0]),E.Field(1, [E.V 1])]
}

fun fs x=Int.toString(x)
fun f x=fs(length(x))

(* generic inner product: <T_{\alpha i} * T_{i \beta}>_{\alpha \beta} *)

fun innerProductField(shape1,dim,i::beta) = let
val alpha= List.take(shape1,length(shape1)-1)
val (indexA, expindexA)= specialize(alpha,0)
val (indexB, expindexB)= specialize(beta,(length(alpha)))
val s'=E.V(length(alpha)+ length(beta))
val s''=[(s',0,i-1)]

val _=print(String.concat["Inner product Field. ",f(indexA)])
in E.EIN{
params = [E.FLD(dim) ,E.FLD(dim)],              (* T and T' *)
index = [],(*indexA@indexB,  *) (* \alpha \beta, i *)
body = E.Sum(s'', E.Prod[
E.Field(0, expindexA@[s']),   (* F_{\alpha i} *)
E.Field(1, [s']@expindexB )  (* F'_{i \beta} *)
])}
end
| innerProductField _ = raise Fail "Wrong shape for innerProductField"

(*Field Cross Product*)
val crossProductField = E.EIN{
params = [E.FLD(3), E.FLD(3)],
index= [3],
body=E.Sum([(E. V 1,0,2),(E.V 2,0,2)],
E.Prod[ E.Epsilon(0, 1, 2), E.Field(0, [E.V 1]),  E.Field(1, [E.V 2 ]) ])
}

(* Trace: <Sigma_i F_{\alpha i, i}>  This one Sx represents both i's*)
fun traceField(dim,alpha) =let
val (indexA, expindexA)= specialize(alpha,0)
val s=E.V(length(alpha))
in
E.EIN{
params = [E.FLD(dim)],
index = indexA,
body = E.Sum([(s,0,dim-1)],E.Field(0, expindexA@[s,s]))
}
end

(*Transpose Field F_{ji}*)
fun transposeField(dim,i,j) =E.EIN{
params = [E.FLD(dim)], index= [i,j],
body= E.Field(0, [E.V 1,E.V 0])
}

end; (* local *)

end (* local *)