* List * N
114 |
115 | let sum rs =
116 | match rs with
117 | | [] -> Immed(Scalar 0.0)
118 | | _ -> List.reduce (fun r1 r2 -> Sum(r1,r2)) rs
119 |
120 | let cond r us = List.foldBack (fun u r -> Cond(r,u)) r us
121 | let res alphas r = List.foldBack (fun alpha r -> Res(alpha,r)) alphas r
122 |
123 | let emptyT t =
124 | match t with
125 | | Noise [] -> true
126 | | Det [] -> true
127 | | _ -> false
128 |
129 | let r_of_N ns:r = ns |> List.map Draw |> sum
130 | let r_of_Top t :r =
131 | match t with
132 | | Noise n -> r_of_N n
133 | | Det vs -> vs |> List.map Immed |> sum
134 |
135 | let r_of_P (Coeff_Cond (v1, alpha, t, us)) =
136 | let r = if emptyT t
137 | then Immed(Scalar 0.0)
138 | else r_of_Top t
139 | cond us (Coeff(v1, alpha, r))
140 |
141 | let cond_of_P v (Coeff_Cond (v1, alpha, vs, us)) =
142 | Coeff_Cond (v1, alpha, vs, v :: us)
143 |
144 | let r_of_R (ResSum(alphas, ps, ns)) =
145 | (match (ps,ns) with
146 | | ([],_) -> [r_of_N ns]
147 | | (_,[]) -> List.map r_of_P ps
148 | | (_, _) -> (List.map r_of_P ps)@[r_of_N ns])
149 | |> sum |> res alphas
150 |
151 | let path_comp ws us = List.map (fun u -> Path(ws,u)) us
152 |
153 | let norm_coeff ws v0 (Coeff_Cond (v1, beta, vs, us)) =
154 | // v0{alpha ~ (v1{beta ~ Sigma ^vs} | us)} | ws
155 | // == v0:(ws.v1) {beta ~ Sigma ^vs} | ws.us)
156 | // + (0{alpha~^(v1:us.beta)} | ws)
157 | (Coeff_Cond(simplify(Interaction(v0,Path(ws,v1))),beta,vs,path_comp ws us),
158 | simplify(Interaction(v1,Path(us,Var beta))))
159 |
160 | // assuming that restricted names are distinct throughout
161 | let rec normalize ws r =
162 | match r with
163 | | Immed(v) ->
164 | let alpha = fresh "imm" in
165 | ResSum([alpha], [Coeff_Cond(v,alpha,Det([Scalar(1.0)]),[])],[])
166 | | Draw(alpha,vs) ->
167 | ResSum([], [],[(alpha,vs)])
168 | | Res(alpha,r) ->
169 | match normalize ws r with ResSum(alphas,Ps,N) -> ResSum(alpha::alphas,Ps,N)
170 | | Sum(r1,r2) ->
171 | match normalize ws r1, normalize ws r2 with
172 | | ResSum(alphas1,ps1,n1),ResSum(alphas2,ps2,n2) -> ResSum(alphas1@alphas2, ps1@ps2, n1@n2)
173 | | Cond(r0,w) ->
174 | normalize (ws @ [w]) r0
175 | | Coeff(v0,alpha,r0) ->
176 | match normalize [] r0 with
177 | | ResSum(alphas,[], N) -> // this case is an optimization, avoiding introducing a new name
178 | ResSum(alphas, [Coeff_Cond(v0, alpha, Noise N,ws)],[])
179 | | ResSum(alphas,ps,[]) -> // this case is an optimization, avoiding introducing a new name
180 | let pss,coeffs = ps |> List.map (norm_coeff ws v0) |> List.unzip
181 | let r' = Coeff_Cond(Scalar(0.0), alpha, Det coeffs,ws)
182 | in ResSum(alphas, pss @ [r'],[])
183 | | ResSum(alphas,ps,N) ->
184 | let pss,coeffs = ps |> List.map (norm_coeff ws v0) |> List.unzip
185 | let beta = fresh "noise"
186 | let n' = Coeff_Cond(v0, beta, Noise N,ws)
187 | let r' = Coeff_Cond(Scalar(0.0), alpha, Det(coeffs@[Var beta]),ws)
188 | in ResSum(alphas@[beta], pss @ [n';r'],[])
189 |
190 | // testing
191 |
192 | let test r1 =
193 | let r2 = r_of_R (normalize [] r1) in
194 | sprintf "\nBefore: %s\nAfter: %s\n" (pretty_regression r1) (pretty_regression r2)
195 |
196 | let r7 = res ["a";"b";"c"] (Sum (Immed (Scalar 1.0), Immed (Scalar 1.0)))
197 | let r8 = cond [Var "f1"; Var "f2"; Var"f3"] (Immed (Scalar 1.0))
198 |
199 | let r10 = Cond(Cond(Coeff (Scalar 1.0, "alpha", uninf_Coeff (Var "u") "b"), Var "s"), Var "t")
200 |
201 | test r10
202 |
203 |
--------------------------------------------------------------------------------
/Tabular/Erase.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | module Erase =
4 | open Syntax
5 | let rec
6 | model (m:Model) =
7 | match m with
8 | | MEmpty -> MEmpty
9 | | MExp e -> MExp(expr e)
10 | | MIndexed(m,e1,e2) ->
11 | MIndexed(model m,expr e1,expr e2)
12 | | MCall(f,args) -> MCall(f,flds args)
13 | | MRegn r -> MRegn (regr r)
14 | | TypedModel(m,_) -> model m
15 |
16 | and predictor p =
17 | match p with
18 | | Scalar _ -> p
19 | | Variable _ -> p
20 | | Interaction (p1,p2) -> Interaction(predictor p1, predictor p2)
21 | | Path(ps,p) -> Path (List.map predictor ps, predictor p)
22 | | TypedPredictor (p,t,lift) -> predictor p
23 |
24 | and regr r =
25 | match r with
26 | | Immed p -> Immed (predictor p)
27 | | Sum (r1,r2) -> Sum (regr r1, regr r2)
28 | | Coeff (p,alpha,r) -> Coeff (predictor p, alpha, regr r)
29 | | Cond (r,p,t) -> Cond (regr r,predictor p,ty t)
30 | | Noise (d,ps) -> Noise(d,List.map predictor ps)
31 | | Res(v,r) -> Res(v,regr r)
32 |
33 |
34 |
35 | and expr (e:Exp):Exp =
36 | match e with
37 | | Var _ -> e
38 | | Const _ -> e
39 | | Prim (p,es) -> Prim(p,List.map expr es)
40 | | Dist(d,es) -> Dist(d,List.map expr es)
41 | | SizeOf(t) -> e
42 | | DeRef(e1,tn,cn) -> DeRef(expr e1,tn,cn)
43 | | Ref(tn,cn) ->Ref(tn,cn)
44 | | If(e1,e2,e3) -> If(expr e1,expr e2, expr e3)
45 | | ForLoop(x,e1,e2) -> ForLoop(x,expr e1,expr e2)
46 | | Array(es) -> Array (List.map expr es)
47 | | Subscript(e1,e2) -> Subscript(expr e1,expr e2)
48 | | Constraint(e1,t1) -> Constraint(expr e1,ty t1)
49 | | Let(x,e1,e2) -> Let(x,expr e1, expr e2)
50 | | Scan(s,x,e1,e2,e3) -> Scan(s,x,expr e1, expr e2, expr e3)
51 | | Infer(d,es,x,e1) -> Infer(d,List.map expr es,x,expr e1)
52 | | TypedExp(e,ty) -> expr e
53 |
54 |
55 | and flds es = List.map (fun (f,e) -> (f,expr e)) es
56 |
57 | and recordTy fts = List.map (fun (f,t) -> (f,ty t)) fts
58 |
59 | and base_ b =
60 | match b with
61 | | B_Upto(e) -> B_Upto(expr e)
62 | | b -> b
63 |
64 | and ty t =
65 | match t with
66 | | T_Array(t,e) -> T_Array(ty t, expr e)
67 | | T_Record(ts) -> T_Record (recordTy ts)
68 | | T_Det(b,d) -> T_Det(base_ b,d)
69 |
70 | let markup (level,vis,M) :Markup = (level,vis,model M)
71 |
72 | let table (T:Table) =
73 | (List.map (fun(nme,col:Column) -> (nme,{Type = ty col.Type; Markup= markup col.Markup})) T)
74 |
75 | let decl ((Declaration (decl, T)):Declaration) =
76 | match decl with
77 | | Table(nme,oId) -> Declaration(Table(nme,oId),table T)
78 | | Fun(nme) -> Declaration(Fun(nme),table T)
79 |
80 | let schema (S:Schema) = (List.map decl S)
81 |
82 |
83 |
--------------------------------------------------------------------------------
/Tabular/Help.fs:
--------------------------------------------------------------------------------
1 | module Help
2 |
3 | //TODO construct from code as far as possible
4 | let help =
5 | """
6 | Syntax:
7 | ----------------------------------------------
8 | Identifiers (alphanumeric):
9 | Attributes c,x,...
10 | Tables t,...
11 | Functions f,...
12 |
13 | (Escaped identifiers: #"some string")
14 |
15 | literals: true,false, 0.0, 0, "a string"
16 | comments: (* a comment *)
17 |
18 | Types:
19 | T = int
20 | | bool
21 | | real
22 | | upto(n) (* integers in [0,n) *)
23 | | mod(n) (* same as upto(n) *)
24 | | vector (* vector of reals *)
25 | | PositiveDefiniteMatrix
26 | (* a positive definite matrix *)
27 | | T[e] (* T array of length e *)
28 | | link(t) (* abbreviates upto(SizeOf(t)) *)
29 | | T ! spc (* type in space spc *)
30 |
31 | spc := det | rnd | qry (* spaces *)
32 |
33 | Primitives:
34 | P :=
35 | | Logistic (* (real) -> real *)
36 | | Probit (* (real,real) -> real *)
37 | | Sum (* (real[n]) -> real *)
38 | | Softmax (* (real[n]) -> vector *)
39 | | DiagonalPDMatrix (* (real[n]) -> PositiveDefiniteMatrix *)
40 | | IdentityScaledBy (* (int,real[n]) -> PositiveDefiniteMatrix *)
41 | | InnerProduct (* (vector,vector) -> real *)
42 | | Log (* (real) -> real *)
43 | | VectorFromArray (* (real[n]) -> vector *)
44 | | Exp (* (real) -> real *)
45 | | ArgMin (* (real[n]) -> upto(n) *)
46 | | ArgMax (* (real[n]) -> upto(n) *)
47 | | BreakSymmetry (* (T) -> T *)
48 | | DampBackward (* (real,real) -> real *)
49 | | #ident (* (T1,..,TN) -> T *)
50 | (* #ident is an unchecked, trusted call to Infer.NET
51 | Variable.ident() *)
52 | Index Expressions:
53 | e :=
54 | | c (* attribute (ie. variable) name *)
55 | | i (* integer literal i > 0 *)
56 | | SizeOf(t) (* SizeOf (previously declared) table t *)
57 |
58 | Expressions:
59 | E :=
60 | | e (* index expression e *)
61 | | l (* literal *)
62 | | t.c (* parameter c of table t)
63 | | E.c (* attribute of key E *)
64 | | [E1,...,EN] (* array literal *)
65 | | [for c < e -> E] (* array construction, c bound in E *)
66 | | E1.[E2] (* index array E1 by index E2 *)
67 | | if E then E1 else E2 (* conditional expression *)
68 | | E1 op E2 (* operation: op is +,-,*,/, mod, max *)
69 | | - E1 (* unary minus *)
70 | | ! E1 (* boolean negation *)
71 | | E1 rel E2 (* comparison: rel in =,<>,<,<=,>,>= *)
72 | | D(e1,en,E1,...,EM) (* random draw from distribution D *)
73 | | P(E1,...,EN) (* primitive function *)
74 | | E : T (* type constraint *)
75 | | let c = E1 in E2 (* local definition, c bound in E2)
76 | | infer.D.p(c)
77 | | infer.D[e1,...,en].p(c)
78 | (* Property p of D / D[e1,...,en] distribution
79 | inferred for attribute c
80 | eg. infer.Bernoulli.Bias(coin)
81 | and inder.Discrete[6].Probs(die) *)
82 | | ( E ) (* parenthesized expression *)
83 |
84 | Properties (of Distributions):
85 | p := Mean|Variance|Precision|StdDeviation|Rate|Scale|Shape|alpha|beta|probTrue|Bias|trueCount|falseCount|Mode|Median|...
86 |
87 |
88 | Models:
89 | M :=
90 | | E (* expression *)
91 | | M[E] (* indexed model with implicit bound *)
92 | | M[E < e] (* indexed model with explicit bound *)
93 | | f(c1=E1,...,cn=En) (* function call *)
94 | | ~ r (* regression *)
95 |
96 | Predictors:
97 | p :=
98 | | c (* attribute name *)
99 | | l (* scalar literal, integer or float typed as real*)
100 | | p1 : p2 (* multiplicative interaction *)
101 | | ( p1,...,pn).p (* path *)
102 |
103 | Regressions:
104 | r :=
105 | (alpha and pi additionally range over attribute names c denoting parameters *)
106 | | r1 + r2 (* sum of regressions *)
107 | | p (* sugar: predictor with implicit coefficent with default prior *)
108 | | p{alpha} (* sugar: predictor with explicit coefficent named alpha with default prior *)
109 | | p{alpha~r} (* predictor with explicit coefficent named alpha given by nested regression *)
110 | | 'p (* coefficent-less, immediate predictor *)
111 | | (r | p) (* regression grouped by (discrete) predictor p *)
112 | | D(p1,...,pn) (* draw / explicit noise *)
113 | | ? (* sugar: default noise *)
114 | | ?{pi} (* sugar: named noise *)
115 | | ?{pi~r} (* sugar: named noise with precision r *)
116 | | new pi . r (* restriction *)
117 | | (r) (* parenthesized regression *)
118 |
119 | Columns:
120 | col := c T input (* concrete input or
121 | mandatory function parameter *)
122 | | c T hyper E (* shared attribute or
123 | optional function parameter
124 | with default, deterministic value E *)
125 | | c T param M (* shared attribute of table M *)
126 | | c T latent M (* latent attributes of table M *)
127 | | c T output M (* observable attributes of table M *)
128 |
129 | Tables:
130 | Table :=
131 | col1 (* vertical columns *)
132 | ...
133 | coln
134 |
135 | Declarations:
136 | Declaration :=
137 | | t (* table with infered key attribute *)
138 | Table
139 | | t[c] (* table with specified key attribute c *)
140 | Table
141 | | function f (* definition of function f *)
142 | Table
143 |
144 | Schema :=
145 | Declaration1
146 | ...
147 | DeclarationN
148 | """
149 |
150 |
151 |
--------------------------------------------------------------------------------
/Tabular/Plates.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Plates
2 |
3 | open MicrosoftResearch.Infer.Tabular.Syntax
4 | open MicrosoftResearch.Infer.Tabular.Pretty
5 | module P = MicrosoftResearch.Infer.Tabular.Pretty
6 |
7 | // graphviz-2.34\release\bin\dot.exe -Tgif Tabular.dot -O
8 | open System.IO
9 |
10 |
11 | let getGraphvizLocation () =
12 | let keys = System.Environment.GetEnvironmentVariables().Keys
13 | let graphivzDotKey = keys |> Seq.cast |> Seq.tryFind (fun s -> s.ToLower().Equals "graphvizdot")
14 | if graphivzDotKey.IsSome then
15 | Some <| System.Environment.GetEnvironmentVariable(graphivzDotKey.Value)
16 | else
17 | let path = System.Environment.GetEnvironmentVariable("Path");
18 | let potentialPlace = [ for folder in path.Split(';') -> Path.Combine(folder, "dot.exe") ] |> List.tryFind File.Exists
19 | if potentialPlace.IsSome then
20 | potentialPlace
21 | else
22 | let s = System.Environment.GetEnvironmentVariable("programfiles(x86)") + @"\Graphviz2.34\bin\dot.exe"
23 | if File.Exists s then
24 | Some s
25 | else None
26 |
27 | let runDot dotexePath workingFolder inputFolder filename =
28 |
29 | let pInfo = new System.Diagnostics.ProcessStartInfo();
30 | pInfo.FileName <- dotexePath ;
31 | pInfo.WorkingDirectory <- workingFolder;
32 | pInfo.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden
33 | pInfo.CreateNoWindow <- true
34 | pInfo.Arguments <- sprintf "-Tgif %s -O" (inputFolder + @"\" + filename);
35 | pInfo.LoadUserProfile <- true;
36 | pInfo.UseShellExecute <- false;
37 | let proc = System.Diagnostics.Process.Start(pInfo)
38 | proc.WaitForExit()
39 |
40 | // semantics of core Tabular
41 |
42 | type ID = string
43 | type Item =
44 | | Node of ID * string
45 | | Edge of ID * Option * ID
46 | | Cluster of ID * string * List-
47 |
48 | // bring all edges to the top-level, so that the nodes alone constrain layout of graph
49 | let rec normal2(items:List
- ): List
- *List
- =
50 | match items with
51 | | [] -> [],[]
52 | | item::items' ->
53 | let nodes,edges = normal2 items'
54 | match item with
55 | | Node(id,label) -> item::nodes,edges
56 | | Edge(id1,opt,id2) -> nodes,item::edges
57 | | Cluster(id,style,items'') ->
58 | let nodes',edges' = normal2 items''
59 | Cluster(id,style,nodes')::nodes, edges'@edges
60 |
61 | let gensym =
62 | let anon = ref 0
63 | fun() -> (anon := !anon+1; sprintf "%d" (!anon))
64 |
65 | let rec render items =
66 | let rec f item =
67 | match item with
68 | | Node(id,label) -> sprintf "\"%s\" [%s];" id label
69 | | Edge(i1,None,i2) -> sprintf "\"%s\" -> \"%s\";" i1 i2
70 | | Edge(i1,Some(label),i2) -> sprintf "\"%s\" -> \"%s\" [label=\"%s\"];" i1 i2 label
71 | | Cluster("",style,items') -> sprintf "subgraph \"cluster%s\" { label=\"\"; %s %s }" (gensym()) style (render items')
72 | | Cluster(nme,style,items') -> sprintf "subgraph \"cluster%s\" { labeljust=\"l\"; label=\"%s\"; %s %s }" nme nme style (render items')
73 |
74 | String.concat "\n" (List.map f items)
75 |
76 | let dot items = sprintf "strict digraph Tabular { %s }" (render items) // strict suppresses multiple edges
77 |
78 | let TypedId ty nme = sprintf "%s %s" (columnTypeToStr ty) nme
79 | let VariableId tabnme nme = sprintf "Variable.%s.%s" tabnme nme
80 | let FactorId tabnme nme = sprintf "Factor.%s.%s" tabnme nme
81 |
82 | let deps (tabnme:TableName) factor e =
83 | let rec f rho e =
84 | match e with
85 | | Var v -> if Set.contains(v) rho then [] else [Edge(VariableId tabnme v,None,factor)]
86 | | Const (_) -> []
87 | | Prim(_,es) -> List.collect (f rho) es
88 | | Dist(_,es) -> List.collect (f rho) es
89 | | SizeOf(t) -> []
90 | | DeRef(e1,tn,cn) -> //let label = sprintf "%s.ID=%s" tn (exprToStr e1)
91 | [Edge(VariableId tn cn,None,factor)] @ f rho e1
92 | | Ref(tn,cn) -> [Edge(VariableId tn cn,None,factor)] //TBR
93 | | If(e1,e2,e3) -> List.concat [f rho e1; f rho e2; f rho e3]
94 | | ForLoop(x,e1,e2) -> let rho' = Set.add x rho in List.concat [f rho e1; f rho' e2]
95 | | Array(es) -> List.collect (f rho) es
96 | | Subscript(Var x,e1) -> //let label=sprintf "%s" (exprToStr e1)
97 | [Edge(VariableId tabnme x,None,factor)] @ f rho e1
98 | | Subscript(e1,e2) -> List.concat [f rho e1; f rho e2] // TODO: do the general case
99 | | Constraint(e1,t1) -> f rho e1
100 | | Let(x,e1,e2) -> let rho' = Set.add x rho in List.concat [f rho e1; f rho' e2]
101 | | Infer(d,es,x,e1) -> List.collect (f rho) (e1::es)
102 | | TypedExp(e,ty) -> f rho e
103 | | _ -> failwith (sprintf "deps: %s unexpected expression" (exprToStr e))
104 |
105 | in f (Set.empty) e
106 |
107 | let ExprNode0 (tabnme:TableName, nme:ColumnName, ty:ColumnType, e:Exp,style:string): List
- =
108 | let node = VariableId tabnme nme
109 | let label = TypedId ty nme
110 | let factor = FactorId tabnme nme
111 | [Node(factor, sprintf "label=\"%s\",shape=box,style=unfilled,fillcolor=black,height=0.1,width=0.1" (exprToStr e));
112 | Edge(factor,None,node);
113 | Node(node, sprintf "label=\"%s\",%s" label style)]
114 | @ deps tabnme factor e
115 |
116 | // deconstruct a possibly typed MExp
117 | let rec private (|TypedForLoop|_|) M = match M with (TypedExp (TypedForLoop e,_)) -> Some e | ForLoop(x,e1,e2) -> Some (x,e1,e2) | _ -> None
118 |
119 |
120 | let rec ExprNode (tabnme:TableName, nme:ColumnName, ty:ColumnType, e:Exp,style:string) =
121 | match e,ty with
122 | | TypedForLoop(x,e1,e2),T_Array(ty,_) -> [Cluster(sprintf "%s<%s" x (exprToStr e1),"style=unfilled;color=black;",ExprNode(tabnme,nme,ty,e2,style))]
123 | | _,_ -> ExprNode0 (tabnme,nme,ty,e,style)
124 |
125 | // deconstruct a possibly typed MExp
126 | let rec private (|TypedMExp|_|) M = match M with (TypedModel (TypedMExp e,_)) -> Some e | MExp(e) -> Some e | _ -> None
127 |
128 | let color red green blue = sprintf "\"#%02x%02x%02x\"" red green blue
129 | let office2013blue = color 91 155 213
130 | let office2013orange = color 237 125 49
131 | let office2013gray = color 165 165 165
132 |
133 | let Column1 (tabnme:TableName) (nme:ColumnName, col:Column): List
- =
134 | match col.Markup with
135 | | Hyper(e) -> [Node(VariableId tabnme nme, sprintf "style=unfilled,color=black,label=\"%s\"" (sprintf "%s=%s" (TypedId (col.Type) nme) (exprToStr e)))]
136 | | Param(TypedMExp(e)) -> ExprNode (tabnme,nme, col.Type, e, "style=filled,color="+office2013gray)
137 | | Input -> []
138 | | Latent(M) -> []
139 | | Observable(M) -> []
140 | | Param(_) -> failwith "Column1: not core Tabular"
141 |
142 | let Column2 (tabnme:TableName) (nme:ColumnName, col:Column): List
- =
143 | match col.Markup with
144 | | Hyper(e) -> []
145 | | Param(M) -> []
146 | | Input -> [Node(VariableId tabnme nme, sprintf "label=\"%s\", style=filled,color=%s" (TypedId (col.Type) nme) office2013blue)]
147 | | Latent(TypedMExp(e)) -> ExprNode (tabnme, nme, col.Type, e, "style=filled,color="+office2013gray)
148 | | Observable(TypedMExp(e)) -> ExprNode (tabnme, nme, col.Type, e, "style=filled,color="+office2013orange)
149 | | _ -> failwith (sprintf "Column2: %s not core Tabular" (markupToStr col.Markup))
150 |
151 | let platesDecl (S:Schema) ((Declaration (decl, T)):Declaration) =
152 | match decl with
153 | | Table(tabnme,oId) ->
154 | let text = sprintf "labeljust=l;nojustify=true;style=filled;color=gray95" // ;label=\"%s\" (P.declToStr decl)
155 | let T' = T //coreT S T
156 | let step1 = List.collect (Column1 tabnme) T'
157 | let step2 = List.collect (Column2 tabnme) T'
158 | let label = sprintf "ID<%s" (exprToStr (SizeOf(tabnme)))
159 | [Cluster("", text, [Cluster("","",step1)] @ [Cluster(label, "style=unfilled;color=black;", step2)])]
160 | | Fun(_) -> []
161 |
162 |
163 | let plates nme tmpPath outPath (S:Schema) =
164 | let S = coreS S
165 | let fileName = sprintf @"%s.dot" nme
166 | let nodes,edges = normal2 (List.collect (platesDecl S) S)
167 | let x = System.IO.File.WriteAllText(tmpPath + @"\"+ fileName, dot (nodes@edges))
168 | runDot (Option.get <| getGraphvizLocation ()) outPath tmpPath fileName
169 |
170 |
171 | let platesCrusso nme (S:Schema) =
172 | plates nme @"C:\Users\crusso\Desktop\" @"C:\Users\crusso\Desktop" S
173 |
174 | let platesAdg nme (S:Schema) =
175 | plates nme @"C:\Users\adg\Desktop\" @"C:\Users\adg\Desktop" S
176 |
--------------------------------------------------------------------------------
/Tabular/SchemaGraph.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 |
4 | module SchemaGraph =
5 |
6 | let ItemsTS getTableByName getDependencies projection x =
7 | let visited = ref Set.empty
8 | let rec dfs (tableName:string) (visited:Set<_> ref) = [
9 | if not ((!visited).Contains tableName) then
10 | visited := (!visited).Add tableName
11 | let table = getTableByName tableName
12 | for t in getDependencies(table) do
13 | yield! dfs t visited
14 | yield projection tableName ]
15 |
16 | x |> List.fold(fun (visited, previousseq) (tname) -> (visited, (dfs tname visited)@previousseq)) (visited, List.empty) |> snd |> List.rev
17 |
18 |
--------------------------------------------------------------------------------
/Tabular/Tabular.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | cdfb169a-3ca6-4e26-b61e-0a910f4bcd5d
9 | Library
10 | Tabular
11 | Tabular
12 | v4.5
13 | Tabular
14 | SAK
15 | SAK
16 | SAK
17 | SAK
18 | 4.7.0.0
19 | ..\
20 | true
21 |
22 |
23 | true
24 | full
25 | false
26 | true
27 | bin\Debug\
28 | DEBUG;TRACE
29 | 3
30 | bin\Debug\Tabular.XML
31 | AnyCPU
32 |
33 |
34 | pdbonly
35 | true
36 | true
37 | bin\Release\
38 | TRACE
39 | 3
40 | bin\Release\Tabular.XML
41 |
42 |
43 | 11
44 |
45 |
46 |
47 |
48 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
49 |
50 |
51 |
52 |
53 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 | ..\packages\FSharp.Core.4.7.2\lib\net45\FSharp.Core.dll
72 |
73 |
74 | True
75 |
76 |
77 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Compiler.dll
78 | True
79 |
80 |
81 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Runtime.dll
82 | True
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
98 |
--------------------------------------------------------------------------------
/Tabular/Tabular.fsproj.vspscc:
--------------------------------------------------------------------------------
1 | ""
2 | {
3 | "FILE_VERSION" = "9237"
4 | "ENLISTMENT_CHOICE" = "NEVER"
5 | "PROJECT_FILE_RELATIVE_PATH" = ""
6 | "NUMBER_OF_EXCLUDED_FILES" = "0"
7 | "ORIGINAL_PROJECT_FILE_PATH" = ""
8 | "NUMBER_OF_NESTED_PROJECTS" = "0"
9 | "SOURCE_CONTROL_SETTINGS_PROVIDER" = "PROVIDER"
10 | }
11 |
--------------------------------------------------------------------------------
/Tabular/Tex.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | module Tex =
4 | module S = MicrosoftResearch.Infer.Tabular.Syntax
5 |
6 | let rec private isAtomic e =
7 | match e with
8 | //TBR this look wrong
9 | | S.Var _ | S.Const _ | S.SizeOf _ | S.ForLoop _ | S.Array _ | S.DeRef _ | S.Ref _ | S.Prim (S.Factor _,_)| S.Dist _ | S.Subscript _ -> true
10 | | S.TypedExp(e,t) -> isAtomic e
11 | | _ -> false
12 |
13 | let ident (x:string) = x.Replace("_","\\_")
14 |
15 | let detToStr d =
16 | match d with
17 | | Syntax.D -> "det"
18 | | Syntax.R -> "rnd"
19 | | Syntax.Qry -> "qry"
20 |
21 | let uptoAsMod = ref true
22 |
23 | let rec
24 | modelToStr (m:S.Model) : string =
25 | match m with
26 | | S.MExp e -> exprToStr e
27 | | S.MIndexed(m,e1,e2) ->
28 | sprintf "(%O)\\[%O<%O\\]" (modelToStr m) (exprToStr e1) (exprToStr e2)
29 | | S.MCall(f,args) -> sprintf "%O(%O)" f (fldsToStr args)
30 | | S.MRegn r -> "== "+(RtoString r)
31 | | S.TypedModel(m,_) -> (modelToStr m)
32 |
33 | and PredictorToString p =
34 | match p with
35 | | S.Scalar f -> sprintf "%A" f
36 | | S.Variable (v,_,_) -> ident v
37 | | S.Interaction (p1,p2) -> sprintf "%O:%O" (PredictorToString p1) (PredictorToString p2)
38 | | S.Path ([p1],p2) -> sprintf "%O.%O" (PredictorToString p1) (PredictorToString p2)
39 | | S.Path (ps,p) -> sprintf "(%O).%O" (String.concat "," (List.map PredictorToString ps)) (PredictorToString p)
40 |
41 |
42 | and RtoString r =
43 | match r with
44 | | S.Immed e -> sprintf "'%O" (PredictorToString e)
45 | | S.Sum (r1,r2) -> sprintf "%O + %O" (RtoString r1) (RtoString r2)
46 | | S.Coeff(e,alpha,r) -> sprintf "%O\\{%O==%O\\}" (PredictorToString e) alpha (RtoString r)
47 | | S.Cond(r,p,_) -> sprintf "(%O\|%O)" (RtoString r) (PredictorToString p)
48 | | S.Noise(d,ps) ->sprintf "%O(%O)" (Pretty.distToStr d) (String.concat "," (List.map PredictorToString ps))
49 | | S.Res(v,r) -> sprintf "(new %O)(%O)" v (RtoString r)
50 |
51 | and exprToStr (e:S.Exp) =
52 | let nestedExprToStr e =
53 | if isAtomic e
54 | then exprToStr e
55 | else sprintf "(%O)" (exprToStr e)
56 |
57 | // todo: exploit precedences
58 | match e with
59 | | S.Var v -> ident v
60 | | S.Const (S.IntConst v) -> sprintf "%A" v
61 | | S.Const (S.BoolConst v) -> sprintf "%A" v
62 | | S.Const (S.RealConst v) -> sprintf "%A" v
63 | | S.Const (S.StringConst v) -> sprintf "%A" v
64 | | S.Prim (S.Negate,[e]) -> sprintf "-%O" (nestedExprToStr e)
65 | | S.Prim (S.Not, [e]) -> sprintf "!%O" (nestedExprToStr e)
66 | | S.Prim(S.Plus,[e1;e2]) -> sprintf "%O + %O" (nestedExprToStr e1) (nestedExprToStr e2)
67 | | S.Prim(S.Minus,[e1;e2]) -> sprintf "%O - %O" (nestedExprToStr e1) (nestedExprToStr e2)
68 | | S.Prim(S.Mult,[e1;e2]) -> sprintf "%O * %O" (nestedExprToStr e1) (nestedExprToStr e2)
69 | | S.Prim(S.Div,[e1;e2]) -> sprintf "%O / %O" (nestedExprToStr e1) (nestedExprToStr e2)
70 | | S.Prim(S.Max,[e1;e2]) -> sprintf "max(%O,%O)" (nestedExprToStr e1) (nestedExprToStr e2)
71 | | S.Prim(S.Mod,[e1;e2]) -> sprintf "mod(%O,%O)" (nestedExprToStr e1) (nestedExprToStr e2)
72 | | S.Prim(S.Or,[e1;e2]) -> sprintf "%O \\| %O" (nestedExprToStr e1) (nestedExprToStr e2)
73 | | S.Prim(S.And,[e1;e2]) -> sprintf "%O \\& %O" (nestedExprToStr e1) (nestedExprToStr e2)
74 | | S.Prim(S.Eq,[e1;e2]) -> sprintf "%O = %O" (nestedExprToStr e1) (nestedExprToStr e2)
75 | | S.Prim(S.Neq,[e1;e2]) -> sprintf "%O != %O" (nestedExprToStr e1) (nestedExprToStr e2)
76 | | S.Prim(S.Lt,[e1;e2]) -> sprintf "%O < %O" (nestedExprToStr e1) (nestedExprToStr e2)
77 | | S.Prim(S.Gt,[e1;e2]) -> sprintf "%O > %O" (nestedExprToStr e1) (nestedExprToStr e2)
78 | | S.Prim(S.LtEq,[e1;e2]) -> sprintf "%O <= %O" (nestedExprToStr e1) (nestedExprToStr e2)
79 | | S.Prim(S.GtEq,[e1;e2]) -> sprintf "%O >= %O" (nestedExprToStr e1) (nestedExprToStr e2)
80 | | S.Prim(S.Factor(S.FactorName p),es) -> sprintf "%O(%O)" p (expsToStr es)
81 | | S.Dist(S.GaussianFromMeanAndVariance,es) -> sprintf "Gaussian(%O)" (expsToStr es)
82 | | S.Dist(d,es) -> sprintf "%A(%O)" d (expsToStr es)
83 | | S.SizeOf(t) -> sprintf "SizeOf(%O)" t
84 | | S.DeRef(e1,_,cn) -> sprintf "%O.%O" (nestedExprToStr e1) cn // suppress link
85 | | S.DeRef(e1,tn,cn) -> sprintf "(%O :> Link(%O)).%O" (nestedExprToStr (e1)) tn cn
86 | | S.Ref(tn,cn) -> sprintf "%O.%O" tn cn
87 | | S.If(e1,e2,e3) -> sprintf "if %O then %O else %O" (exprToStr e1) (exprToStr e2) (exprToStr e3)
88 | | S.ForLoop(x,e1,e2) -> sprintf "\\[for %O < %O -> %O\\]" (ident x) (nestedExprToStr e1) (exprToStr e2)
89 | | S.Array(es) -> sprintf "\\[%O\\]" (elemsToStr es)
90 | | S.Subscript(e1,e2) -> sprintf "%O\\[%O\\]" (nestedExprToStr ( e1)) (exprToStr ( e2))
91 | | S.Constraint(e1,t1) -> sprintf "%O : %O" (nestedExprToStr ( e1)) (columnTypeToStr ( t1))
92 | | S.Let(x,e1,e2) -> sprintf "let %O = %O in %O" (ident x) (exprToStr ( e1)) (exprToStr ( e2))
93 | | S.Scan(s,x,e1,e2,e3) -> sprintf "Scan((%O,%O)->%O,%O,%O)" s (ident x) (nestedExprToStr ( e1)) (nestedExprToStr ( e2)) (nestedExprToStr ( e3))
94 | | S.Infer(d,es,x,e) -> sprintf "infer.%A\\[%O\\].%O(%O)" d (expsToStr es) x (exprToStr e)
95 | | S.TypedExp(e,ty) -> exprToStr e
96 | | _ -> sprintf "?%A" e
97 |
98 | and fldsToStr es =
99 | match es with
100 | | [] -> ""
101 | | [(f,e)] -> sprintf "%O=%O" (ident f) (exprToStr ( e))
102 | | (f,e)::es -> sprintf "%O=%O,%O" (ident f) (exprToStr ( e)) (fldsToStr es)
103 | and elemsToStr es =
104 | match es with
105 | | [] -> ""
106 | | [e] -> exprToStr e
107 | | e::es -> sprintf "%O;%O" (exprToStr ( e)) (elemsToStr es)
108 | and expsToStr es =
109 | match es with
110 | | [] -> ""
111 | | [e] -> exprToStr e
112 | | e::es -> sprintf "%O,%O" (exprToStr ( e)) (expsToStr es)
113 | and recordTyToStr ts =
114 | match ts with
115 | | [] -> ""
116 | | [(f,t)] -> sprintf "%O:%O" (ident f) (columnTypeToStr ( t))
117 | | (f,t)::ts -> sprintf "%O:%O;%O" (ident f) (columnTypeToStr ( t)) (recordTyToStr ts)
118 | and columnTypeToStr ty =
119 | match ty with
120 | | S.T_Real -> "real"
121 | | S.T_Int -> "int"
122 | | S.T_Bool -> "bool"
123 | | S.T_String -> "string"
124 | | S.T_Upto(S.TypedExp(S.SizeOf t,_))
125 | | S.T_Upto(S.SizeOf t)
126 | | S.T_Link t -> sprintf "link(%O)" (ident t)
127 | | S.T_Array (ty,e) -> sprintf "%O\\[%O\\]" (columnTypeToStr ty) (exprToStr e)
128 | | S.T_Upto e -> if !uptoAsMod then sprintf "mod(%O)" (exprToStr e)
129 | else sprintf "upto(%O)" (exprToStr e)
130 | | S.T_Record flds -> sprintf "{%O}" (recordTyToStr flds)
131 | | S.T_Vector -> "vector"
132 | | S.T_PositiveDefiniteMatrix -> "PositiveDefiniteMatrix"
133 |
134 | let markupToFmt (A:S.Markup) =
135 | match A with
136 | | S.Hyper(e) -> sprintf "\\StaticIn{%s}{%s}\\\\ %%{%s}" //?
137 | | S.Param(M) -> sprintf "\\StaticOut{%s}{%s}{%s}\\\\"
138 | | S.Input -> sprintf "\\InstIn{%s}{%s}{%s}\\\\"
139 | | S.Latent(M) -> sprintf "\\InstOut{%s}{%s}{%s}\\\\"
140 | | S.Observable(M) -> sprintf "\\InstOut{%s}{%s}{%s}\\\\"
141 | | (l,v,M) -> sprintf "\\%A%A{%s}{%s}{%s}\\\\" (Pretty.levelToStr l) (Pretty.visibilityToStr v)
142 | open Syntax
143 |
144 |
145 |
146 | let TypeToStr ty =
147 | let d = detToStr (det ty)
148 | let ty = columnTypeToStr ty
149 | //sprintf "%O!%O" ty d
150 | ty
151 |
152 |
153 | let markupToStr (A:S.Markup) : string =
154 | match A with
155 | | S.Hyper(e) -> (exprToStr e)
156 | | S.Param(M) -> (modelToStr M)
157 | | S.Input -> ""
158 | | S.Latent(M) -> (modelToStr M)
159 | | S.Observable(M) -> (modelToStr M)
160 |
161 |
162 |
163 |
164 | let tableToStr (T:S.Table) : string =
165 | (List.map (fun(nme,col:S.Column) -> markupToFmt col.Markup (ident nme) (TypeToStr col.Type) (markupToStr col.Markup)) T)
166 | |> String.concat "\n "
167 | let declToStr ((S.Declaration (decl, T)):S.Declaration): string =
168 | match decl with
169 | | S.Table(nme,_) -> sprintf "\\TABLE{%s}\\\\\n%s\\\\" (ident nme) (tableToStr T)
170 | | S.Fun(nme) -> sprintf "\\FUN{%s}\\\\\n%s\\\\" (ident nme) (tableToStr T)
171 |
172 | let schemaToStr (S:S.Schema) = String.concat "\n " ("\\begin{Tabular}"::(List.map declToStr S)@["\\end{Tabular}"])
173 |
--------------------------------------------------------------------------------
/Tabular/app.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
--------------------------------------------------------------------------------
/Tabular/packages.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
--------------------------------------------------------------------------------
/TabularCSVCLI.Tests/App.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
--------------------------------------------------------------------------------
/TabularCSVCLI.Tests/Program.fs:
--------------------------------------------------------------------------------
1 |
2 | open NUnit.Framework
3 | open MicrosoftResearch.Infer.Tabular.CLI
4 |
5 | let runTest modelFileName breakSym =
6 | let modelFileName = System.IO.Path.GetFullPath(modelFileName)
7 | let exeDir = System.IO.Path.GetDirectoryName(modelFileName)
8 | System.Environment.CurrentDirectory <- exeDir
9 | runCLI "." None modelFileName "." false None None (Reuse "verified") true true breakSym true
10 |
11 | []
12 | let TrueSkill() =
13 | runTest (System.IO.Path.Combine("..","..","..","Samples","TrueSkill","TrueSkill.csv")) false
14 | Assert.True(true)
15 |
16 |
17 | []
18 | let FaithfulCsv() =
19 | runTest (System.IO.Path.Combine("..","..","..","Samples","Faithful","Model.csv")) true
20 | Assert.True(true)
21 |
22 | []
23 | let FaithfulTxt() =
24 | runTest (System.IO.Path.Combine("..","..","..","Samples","Faithful","Model.txt")) true
25 | Assert.True(true)
26 |
27 | []
28 | let OutliersTxt() =
29 | runTest (System.IO.Path.Combine("..","..","..","Samples","Outliers","Outliers.txt")) true
30 | Assert.True(true)
31 |
32 | []
33 | let MixedLinearRegressionTxt() =
34 | runTest (System.IO.Path.Combine("..","..","..","Samples","MixedLinearRegression","Paper.txt")) true
35 | Assert.True(true)
36 |
37 |
38 | []
39 | let main argv =
40 | FaithfulTxt()
41 | printfn "%A" argv
42 | 0 // return an integer exit code
43 |
--------------------------------------------------------------------------------
/TabularCSVCLI.Tests/TabularCSVCLI.Tests.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | a10a61c0-60ce-44dd-bb4b-9ac23f81c0ca
9 | Exe
10 | TabularCSVCLI.Tests
11 | TabularCSVCLI.Tests
12 | v4.5
13 | true
14 | 4.7.0.0
15 | TabularCSVCLI.Tests
16 | SAK
17 | SAK
18 | SAK
19 | SAK
20 | ..\
21 | true
22 |
23 |
24 | true
25 | full
26 | false
27 | false
28 | bin\Debug\
29 | DEBUG;TRACE
30 | 3
31 | AnyCPU
32 | bin\Debug\TabularCSVCLI.Tests.XML
33 | false
34 |
35 |
36 |
37 |
38 |
39 | pdbonly
40 | true
41 | true
42 | bin\Release\
43 | TRACE
44 | 3
45 | AnyCPU
46 | bin\Release\TabularCSVCLI.Tests.XML
47 | true
48 |
49 |
50 |
51 | ..\packages\FSharp.Core.4.7.2\lib\net45\FSharp.Core.dll
52 |
53 |
54 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Compiler.dll
55 | True
56 |
57 |
58 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Runtime.dll
59 | True
60 |
61 |
62 |
63 | True
64 |
65 |
66 | ..\packages\NUnitTestAdapter.2.0.0\lib\nunit.core.dll
67 | False
68 |
69 |
70 | ..\packages\NUnitTestAdapter.2.0.0\lib\nunit.core.interfaces.dll
71 | False
72 |
73 |
74 | ..\packages\NUnit.2.6.4\lib\nunit.framework.dll
75 | True
76 |
77 |
78 | ..\packages\NUnitTestAdapter.2.0.0\lib\nunit.util.dll
79 | False
80 |
81 |
82 | ..\packages\NUnitTestAdapter.2.0.0\lib\NUnit.VisualStudio.TestAdapter.dll
83 | False
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 | TabularCSVCLI
97 | {dbf75f1d-6a77-4007-a33b-498abafa4cd5}
98 | True
99 |
100 |
101 |
102 | 11
103 |
104 |
105 |
106 |
107 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
108 |
109 |
110 |
111 |
112 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
113 |
114 |
115 |
116 |
117 |
124 |
--------------------------------------------------------------------------------
/TabularCSVCLI.Tests/TabularCSVCLI.Tests.fsproj.vspscc:
--------------------------------------------------------------------------------
1 | ""
2 | {
3 | "FILE_VERSION" = "9237"
4 | "ENLISTMENT_CHOICE" = "NEVER"
5 | "PROJECT_FILE_RELATIVE_PATH" = ""
6 | "NUMBER_OF_EXCLUDED_FILES" = "0"
7 | "ORIGINAL_PROJECT_FILE_PATH" = ""
8 | "NUMBER_OF_NESTED_PROJECTS" = "0"
9 | "SOURCE_CONTROL_SETTINGS_PROVIDER" = "PROVIDER"
10 | }
11 |
--------------------------------------------------------------------------------
/TabularCSVCLI.Tests/packages.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
--------------------------------------------------------------------------------
/TabularCSVCLI/App.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
--------------------------------------------------------------------------------
/TabularCSVCLI/CSVTabular.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | module CSVTabular =
4 | open Syntax
5 | open System.IO
6 | open System.Text.RegularExpressions
7 | open MicrosoftResearch.Infer
8 | open Microsoft.VisualBasic.FileIO
9 |
10 | let getFreshName fExists outname =
11 | let rec go optNum =
12 | let name = outname + (match optNum with | Some i -> i.ToString() | _ -> "")
13 | match fExists (name) with
14 | | true -> go (optNum |> Option.fold(fun _ i -> Some (i + 1)) (Some 1) )
15 | | false -> name
16 | go None
17 | let getFreshOutputDirName = getFreshName System.IO.Directory.Exists
18 | let getFreshFileName = getFreshName System.IO.File.Exists
19 |
20 |
21 | let getSchema separator (modelFilePath : string) =
22 | use tfp = new TextFieldParser(modelFilePath)
23 | tfp.TextFieldType <- FieldType.Delimited
24 | tfp.TrimWhiteSpace <- false
25 | tfp.Delimiters <- [| separator |]
26 | tfp.HasFieldsEnclosedInQuotes <- true
27 | let acc = new System.Collections.Generic.List()
28 | let col (line:string[]) i = if i < line.Length then line.[i] else ""
29 | let addEmptyLines (cl:System.Int64) (nl:System.Int64) cols =
30 | if nl = -1L then cols
31 | else let rec addEmpty n cols = if n <= 1L then cols else addEmpty (n-1L) (("","","","",None)::cols)
32 | addEmpty (nl - cl) cols
33 | let rec loop cl cols =
34 | if tfp.EndOfData then
35 | tfp.Close()
36 | List.rev (("","","","",None)::cols)
37 | else
38 | let line = tfp.ReadFields() in
39 | let nl = tfp.LineNumber in
40 | loop nl ((col line 0,col line 1,col line 2, col line 3, None)::(addEmptyLines cl nl cols))
41 | let cols = loop tfp.LineNumber []
42 | SchemaParser.readSchema cols
43 |
44 |
45 | open System.Collections
46 | open System.Linq
47 | open System.Collections.Generic
48 | open SchemaConstants
49 |
50 | let approxEq (s1:string) (s2:string) =
51 | let eq1 (s1:string) (s2:string) = s1.ToLowerInvariant().Equals(s2.ToLowerInvariant())
52 | eq1 s1 s2 || eq1 (s1.Replace(" ", "")) (s2.Replace(" ", ""))
53 | let coerce (v:'a) = System.Convert.ChangeType(v, (typeof<'b>)) :?> 'b
54 |
55 | let AvailableDefaultAlgo = [new ExpectationPropagation() :> IAlgorithm
56 | new VariationalMessagePassing():> IAlgorithm
57 | new GibbsSampling():> IAlgorithm]
58 |
59 | let tryFindAlgo algorithmLabel= algorithmLabel |> (fun algo -> try AvailableDefaultAlgo |> List.find(fun a -> approxEq a.Name (algorithmLabel |> string))
60 | with |e -> failwith (sprintf "can not find algo '%A' specified in the settings" algorithmLabel))
61 |
62 | let getAdHocOptions (settings:Map) =
63 | let settings = settings.AsEnumerable()
64 | let tryFind name = settings |> Seq.tryFind(fun kv -> approxEq name kv.Key) |> Option.map(fun kv -> kv.Value)
65 | let oAlgo = tryFind algorithmLabel
66 | |> Option.map tryFindAlgo
67 | let oIterations = tryFind iterationsLabel
68 | |> Option.map(fun iterations -> try coerce iterations : int
69 | with |e -> failwith (sprintf "can not convert the setting '%A' of value %A to int" iterationsLabel iterations))
70 | let oSaveInput = tryFind saveinpuLabel
71 | |> Option.map (fun saveInput -> try coerce saveInput : bool
72 | with |e -> failwith (sprintf "can not convert the setting '%A' of value %A to bool" saveinpuLabel saveInput))
73 | oAlgo, oIterations, oSaveInput
74 |
75 |
76 | open TypedDTO
77 | let readCSVData typedCoreSchema (dirPath: string) =
78 | read typedCoreSchema (CSVConverter()) (CSVSource.read dirPath)
79 |
80 | let saveModeToCSV outputDir filename schema =
81 | let res = Pretty.toPositional2DStr schema |> List.toArray
82 | let ares : obj [,] = Array2D.init (res.Length) 4 (fun i j -> let (a,b,c,d) = res.[i] in (match j with | 0 -> a | 1 -> b | 2 -> c | 3 -> d) |> box)
83 | TypedDTO.write2DArrayToCSV outputDir filename ares
84 |
--------------------------------------------------------------------------------
/TabularCSVCLI/TabularCSVCLI.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | dbf75f1d-6a77-4007-a33b-498abafa4cd5
9 | Exe
10 | TabularCSVCLI
11 | tc
12 | v4.5
13 | true
14 | 4.7.0.0
15 | TabularCSVCLI
16 | SAK
17 | SAK
18 | SAK
19 | SAK
20 | ..\
21 | true
22 |
23 |
24 | true
25 | full
26 | false
27 | false
28 | bin\Debug\
29 | DEBUG;TRACE
30 | 3
31 | AnyCPU
32 | bin\Debug\TabularCSVCLI.XML
33 | false
34 | --verbose --model "Model.txt" --savemodels
35 | D:\tfs\mlp\pp\CoreTabular\Samples\Faithful\
36 |
37 |
38 | pdbonly
39 | true
40 | true
41 | bin\Release\
42 | TRACE
43 | 3
44 | AnyCPU
45 | bin\Release\TabularCSVCLI.XML
46 | true
47 |
48 |
49 |
50 | ..\packages\FSharp.Core.4.7.2\lib\net45\FSharp.Core.dll
51 |
52 |
53 | True
54 |
55 |
56 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Compiler.dll
57 | True
58 |
59 |
60 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Runtime.dll
61 | True
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 | Parsing
78 | {4d13b34e-2527-4295-a8b3-7770595147e7}
79 | True
80 |
81 |
82 | TabularChecker
83 | {0d2aac5f-656f-48d6-8d8e-5401e031a94b}
84 | True
85 |
86 |
87 | TabularCompiler
88 | {5f6ce5c9-3657-497d-b128-2076fb8fbd9c}
89 | True
90 |
91 |
92 | Tabular
93 | {cdfb169a-3ca6-4e26-b61e-0a910f4bcd5d}
94 | True
95 |
96 |
97 |
98 | 11
99 |
100 |
101 |
102 |
103 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
104 |
105 |
106 |
107 |
108 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
109 |
110 |
111 |
112 |
113 |
120 |
--------------------------------------------------------------------------------
/TabularCSVCLI/TabularCSVCLI.fsproj.vspscc:
--------------------------------------------------------------------------------
1 | ""
2 | {
3 | "FILE_VERSION" = "9237"
4 | "ENLISTMENT_CHOICE" = "NEVER"
5 | "PROJECT_FILE_RELATIVE_PATH" = ""
6 | "NUMBER_OF_EXCLUDED_FILES" = "0"
7 | "ORIGINAL_PROJECT_FILE_PATH" = ""
8 | "NUMBER_OF_NESTED_PROJECTS" = "0"
9 | "SOURCE_CONTROL_SETTINGS_PROVIDER" = "PROVIDER"
10 | }
11 |
--------------------------------------------------------------------------------
/TabularCSVCLI/packages.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
--------------------------------------------------------------------------------
/TabularChecker/AssemblyInfo.fs:
--------------------------------------------------------------------------------
1 | namespace System
2 | open System.Reflection
3 |
4 | []
5 | []
6 | []
7 | []
8 | []
9 | do ()
10 |
11 | module internal AssemblyVersionInformation =
12 | let [] Version = "0.1.0"
13 |
--------------------------------------------------------------------------------
/TabularChecker/Elaborator.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Elaborator
2 |
3 | open Syntax
4 | open Types
5 | open Checker
6 | open Model
7 | open Table
8 | open System.Collections.Generic
9 | type Log = Map
10 |
11 |
12 | let logToString log =
13 | Map.fold (fun s tb log ->
14 | Map.fold (fun s col v ->
15 | match v with
16 | | (Table.Err msg) -> s+(sprintf "\nTable %A, column %A:\n %A" (Pretty.ident tb) (Pretty.ident col) msg)
17 | | _ -> s) s log) "" log
18 |
19 | let elaborate(fullSchema:Schema) =
20 | // reset fresh variable counter
21 | Syntax.counter <- 0
22 | // type Schema, adding Prelude, annotating derefs and bounds of indexed models
23 | let (log,err,(typedFullSchema,schemaType)) = Schema.typeSchema fullSchema
24 | if err
25 | then (log,err,(typedFullSchema,schemaType))
26 | else
27 | // erase type annotations
28 | let fullSchema = Erase.schema typedFullSchema
29 | // reduce
30 | // System.Console.WriteLine(Pretty.schemaToStr fullSchema)
31 | let coreSchema = coreS fullSchema
32 | System.Console.WriteLine("-----------")
33 | System.Console.WriteLine(Pretty.schemaToStr coreSchema)
34 | // retypecheck
35 | Schema.synthSchema Types.G_Empty coreSchema
36 |
37 |
38 |
39 |
40 |
--------------------------------------------------------------------------------
/TabularChecker/Library.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Library
2 |
3 |
4 | open Syntax
5 |
6 |
7 |
8 | let prelude : Schema =
9 | [
10 | Declaration(Fun "CDiscrete",
11 | ["N", {Type=T_Int; Markup=Hyper(Const (IntConst 2))};
12 | "Alpha", {Type=T_Real; Markup=Hyper(Const (RealConst 1.0))};
13 | "V", {Type=makeDet T_Vector R;
14 | Markup=Param(MExp(Prim(Factor(FactorName "BreakSymmetry"),[Dist(DirichletSymmetric,[Var "N"; Var "Alpha"])])))};
15 | "ret", {Type=makeDet (T_Upto (Exp.Var "N")) R;
16 | Markup=Observable(MExp(Dist(Discrete,[Var "N"; Var "V"])))} ])
17 | Declaration(Fun "CBernoulli",
18 | [ "alpha", {Type=T_Real; Markup=Hyper (Const (RealConst 1.0))};
19 | "beta", {Type=T_Real; Markup=Hyper (Const (RealConst 1.0))};
20 | "Bias", {Type=makeDet T_Real R; Markup=Param (MExp (Prim(Factor(FactorName "BreakSymmetry"),[Dist (Beta, [Var "alpha"; Var "beta"])])))};
21 | "ret", {Type=makeDet T_Bool R; Markup=Observable (MExp (Dist (Bernoulli, [Var "Bias"])))}])
22 |
23 | Declaration(Fun "CGaussian",
24 | ["MeanMean", {Type=T_Real; Markup= Hyper(Const (RealConst 0.0))};
25 | "MeanPrec", {Type=T_Real; Markup=Hyper(Const (RealConst 1.0))};
26 | "Shape", {Type=T_Real; Markup=Hyper(Const (RealConst 1.0))};
27 | "Scale", {Type=T_Real; Markup=Hyper(Const (RealConst 1.0))};
28 | "Mean", {Type=makeDet T_Real R; Markup=Param(MExp(Dist(GaussianFromMeanAndPrecision,[Var "MeanMean"; Var "MeanPrec"])))};
29 | "Prec", {Type=makeDet T_Real R; Markup=Param(MExp(Dist(GammaFromShapeAndScale,[Var "Shape"; Var "Scale"])))};
30 | "ret", {Type=makeDet T_Real R; Markup=Observable(MExp(Dist(GaussianFromMeanAndPrecision,[Var "Mean"; Var "Prec"])))} ]);
31 | Declaration(Fun "Error",
32 | ["Scale", {Type=T_Real; Markup= Hyper(Const (RealConst 10000.0))};
33 | "Noise", {Type=makeDet T_Real R; Markup=Param(MExp(Dist(GammaFromShapeAndScale,[Const(RealConst 1.0); Var "Scale"])))};
34 | "ret", {Type=makeDet T_Real R; Markup=Observable(MExp(Dist(GaussianFromMeanAndPrecision,[Const(RealConst 0.0); Var "Noise"])))} ]);
35 |
36 | ]
37 |
38 |
--------------------------------------------------------------------------------
/TabularChecker/Model.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Model
2 |
3 | open Syntax
4 | open Types
5 | open Checker
6 |
7 |
8 | let rec checkModel (pc:B) (g:Env) (m:Model) (y:TargetType) : ModelTyped =
9 | match m with
10 | | MRegn r ->
11 | let (rt,Q) = Regression.check g r y
12 |
13 | (TypedModel (MRegn rt,
14 | ((T_Record Q,T_Record ERT), y)))
15 | | MEmpty ->
16 | failwith "only inputs may have empty models"
17 | | MExp (e) ->
18 | let (TypedExp(e',y) as et) = checkExpr pc g e y
19 | (TypedModel (MExp (et), ((T_Record ERT,T_Record ERT), y)))
20 | // this is for backwards compatibility with OldTabular, which inserts dummy -1 bounds
21 | | MIndexed (n, e, Const (IntConst -1)) ->
22 | // here, we are ignoring -1 and insert e'' based on the type of e.
23 | let n' = checkModel pc g n y
24 | let (TypedModel(_, t)) = n'
25 | let ((T_Record w,zs),y) = t
26 | //let (e',l2) = checkExpr g e T_Int //upto?
27 | //((Indexed (n', e', c), (h, T_Array (w, (Const c, T_Int)), ERT, y)), sup l1 l2)
28 | let (TypedExp(e',t') as et') = synthExpr pc g e
29 | // if det t' > D then failwith (sprintf "expected deterministic bound for %O; found random bound" (Pretty.modelToStr m))
30 | match t' with
31 | | T_Upto e'' ->
32 | (TypedModel(MIndexed (n', et', e''), ((T_Record [ for (wi,wti) in w -> (wi,T_Array (wti, e''))],
33 | zs),
34 | y)))
35 | | _ -> failwithf "index must have upto type"
36 | | MIndexed (n, e1, e2) ->
37 | let n' = checkModel pc g n y
38 | let (TypedModel(_, t)) = n'
39 | let ((T_Record w,zs),y) = t
40 | let (TypedExp(_,t2) as et2) = checkExpr H g e2 T_Int
41 | if det t2 > D then failwith (sprintf "expected deterministic bound in %O; found rnd or qry bound" (Pretty.modelToStr m))
42 | //((Indexed (n', e', c), (h, T_Array (w, (Const c, T_Int)), ERT, y)), sup l1 l2)
43 | let (TypedExp(_,t1) as et1) = checkExpr pc g e1 (T_Upto(et2))
44 | match t1 with
45 | | T_Upto et3 ->
46 | (TypedModel(MIndexed (n', et1, et3), ((T_Record [ for (wi,wti) in w -> (wi,T_Array (wti, et3))],
47 | zs),
48 | y)))
49 | | _ -> failwithf "index must have upto type"
50 | | MCall(f,es) ->
51 | let ((rh,rw,rx,[(co,t)],rz),defaults,b) = getModelType g f
52 |
53 | let rec checkHypers ets rh rw rx rz defaults es t =
54 | match rh,defaults,es with
55 | | [],[],es -> checkInputs ets rw rx rz es t
56 | | ((n,nt)::rh),(_,_)::ds,(n',e)::es when n = n' ->
57 | let et = checkExpr H g e nt
58 | let S = (e,n)
59 | let rS = List.map (fun (n',t') -> (n',substT S t'))
60 | let rh = rS rh
61 | let rw = rS rw
62 | let rx = rS rx
63 | let rz = rS rz
64 | let t = substT S t
65 | checkHypers ((n,et)::ets) rh rw rx rz ds es t
66 | | ((n,nt)::rh),(_,d)::ds,es ->
67 | let et = checkExpr H g d nt
68 | let S = (d,n)
69 | let rS = List.map (fun (n',t') -> (n',substT S t'))
70 | let rh = rS rh
71 | let rw = rS rw
72 | let rx = rS rx
73 | let rz = rS rz
74 | let t = substT S t
75 | checkHypers ((n,et)::ets) rh rw rx rz ds es t
76 | and checkInputs ets rw rx rz es t =
77 | match rx,es with
78 | | [],[] -> (List.rev ets),((rw,rz),t)
79 | | [],(n,_)::es -> failwithf "unexpected argument '%O' to function %O \n possible choices %O " n f (Pretty.recordTyToStr (rh@rx))
80 | | ((n,nt)::rx),(n',e)::es when n = n' ->
81 | let et = checkExpr pc g e nt
82 | checkInputs ((n,et)::ets) rw rx rz es t
83 | | ((n,nt)::rh),es ->
84 | failwithf "call to %O is missing argument %O of type %O" f n (Pretty.columnTypeToStr nt)
85 | let (ets,((rw,rz),t)) = checkHypers [] rh rw rx rz defaults es t
86 | if not (areTypesEquivalent g y t) then
87 | failwith (sprintf "expecting function with output type %O but found output type %O" (Pretty.columnTypeToStr y) (Pretty.columnTypeToStr t))
88 | (TypedModel(MCall(f,ets), ((T_Record rw,T_Record rz),t)))
89 |
90 | | _ -> failwithf "NYI: checkModel %A" m
91 |
92 |
--------------------------------------------------------------------------------
/TabularChecker/Regression.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Regression
2 |
3 | open Syntax
4 | open Types
5 | open Checker
6 |
7 |
8 | open Regressions.Semantics
9 |
10 |
11 | let R_Real = T_Det(B_Real,D.R)
12 |
13 | let GammaOfEnv g =
14 | let rec GammaOfEnv G g =
15 | match g with
16 | G_Empty -> Map.empty
17 | | G_Var ((y, (t,B)), g)->
18 | let G = GammaOfEnv G g
19 | Map.add y (t,None) G
20 | | G_Table ((t, (h,w,x,y,z)), g) ->
21 | let sizeOf = TypedExp(SizeOf t,T_Int)
22 | let add G (x,T) = Map. add x (T,Some (Static,t)) G //TBR
23 | let lift G (x, T) = Map.add x (T_Array(T,sizeOf),Some (Instance,t)) G
24 | let G = GammaOfEnv G g
25 | let G = List.fold add G h
26 | let G = List.fold add G w
27 | let G = List.fold lift G x
28 | let G = List.fold lift G y
29 | let G = List.fold lift G z
30 | G
31 | | G_Model ((y, t), tail) ->
32 | GammaOfEnv G tail
33 | GammaOfEnv Map.empty g
34 |
35 |
36 | // check argument type t is array of form t'[es] (ie nb: t'[en]...[e0] where es = [e0,...,en] )
37 | // returning u where pat t' = Some u.
38 | // NB: passing Some for pat just returns t'.
39 | let rec (| Arrays|_|) pat es t =
40 | match es,t with
41 | | [],_ -> pat t
42 | | e::es, T_Array(Arrays pat es.Tail t',e')
43 | when areTermsEquivalent G_Empty e e' T_Int -> // it's ok to pass G_Empty, better would be to fix g
44 | Some t'
45 | | _,_ -> None
46 |
47 | let arrays Q es =
48 | List.map (fun (c,ty) -> (c,Arrays ty es)) Q
49 |
50 | let rec checkPredictor dim G es e =
51 | match e with
52 | | Scalar r -> TypedPredictor(e,Dim dim T_Real, dim <> Id)
53 | | Variable (c,_,_) ->
54 | match Map.tryFind c G with
55 | | Some (Arrays (Some) es u,sort) ->
56 | if (Types.det u = Qry)
57 | then failwithf "Predictor %s has unexpected space %s, expecting %s or %s" (Pretty.PredictorToString e) (Pretty.detToStr Qry) (Pretty.detToStr D.D) (Pretty.detToStr D.R)
58 | else match u with
59 | | Dim dim u' ->
60 | TypedPredictor(Variable(c,sort,0),Dim dim u',false) // we annotate with sort for correct elaboration; don't lift
61 | | _ ->
62 | match dim with
63 | | Vector e ->
64 | TypedPredictor(Variable(c,sort,0),Dim dim u,true) // need to lift
65 | | _ -> failwithf "Variable %s has type %s, expecting dimensionality %s" (Pretty.PredictorToString e) (Pretty.columnTypeToStr u) (dimToString dim)
66 | | Some (u,sort) ->
67 | match u with
68 | | Dim dim u' ->
69 | TypedPredictor(Variable(c,sort,(List.length es) - (if dim = Id then 0 else 1)),Dim dim u',false) // we annotate with sort for correct elaboration; don't lift
70 | | _ ->
71 | match dim with
72 | | Vector e ->
73 | TypedPredictor(Variable(c,sort,List.length es),Dim dim u,true) // need to lift
74 | | _ -> failwithf "Variable %s has type %s, expecting dimensionality %s" (Pretty.PredictorToString e) (Pretty.columnTypeToStr u) (dimToString dim)
75 | // failwithf "Variable %s has type %s, expecting array type with dimensions %s" (Pretty.PredictorToString e) (Pretty.columnTypeToStr t) (String.concat "" (List.map (fun e -> "["+(Pretty.exprToStr e)+"]") es))
76 | | None -> failwithf "Ill-bound variable %s" (Pretty.PredictorToString e)
77 | | Interaction(p1,p2) ->
78 | match checkPredictor dim G es p1 ,checkPredictor dim G es p2 with
79 | | (TypedPredictor(e1,t1,_)) as pt1,(TypedPredictor(e2,t2,_) as pt2) when areTypesEquivalent G_Empty t1 (Dim dim T_Real) && areTypesEquivalent G_Empty t2 (Dim dim T_Real) ->
80 | TypedPredictor(Interaction(pt1,pt2),Dim dim T_Real,false)
81 | | _ -> failwithf "Ill-typed interaction %s" (Pretty.PredictorToString e)
82 | | Path(ps,p) ->
83 | let rec checkPaths ps pts fs =
84 | match ps with
85 | | [] ->
86 | match checkPredictor dim G (List.rev fs) p with
87 | | TypedPredictor(p,t,lift) as pt ->
88 | TypedPredictor(Path(List.rev pts,pt),t,lift)
89 | | (pi::ps) ->
90 | match checkPredictor dim G es pi with
91 | | (TypedPredictor(pi,Dim dim (T_Upto(fi)),li) as pit) ->
92 | checkPaths ps (pit::pts) (fi::fs)
93 | | (TypedPredictor(pi,ti,li) as pit) -> failwithf "Ill-typed path component %s; expecting predictor of 'mod(_)' type, found predictor of type %s " (Pretty.PredictorToString pi) (Pretty.columnTypeToStr ti)
94 | checkPaths ps [] []
95 | | TypedPredictor _ -> failwith "checkPredictor"
96 |
97 |
98 | let checkRealPredictor dim G es e =
99 | match checkPredictor dim G es e with
100 | | (TypedPredictor(e,t,_)) as et when areTypesEquivalent G_Empty t (Dim dim T_Real) ->
101 | et
102 | | (TypedPredictor(e,t,_)) -> failwithf "expected predictor type %s, found predictor of type %s" (Pretty.columnTypeToStr (Dim dim T_Real)) (Pretty.columnTypeToStr t)
103 |
104 | let rec checkRegrn (G:Map) es fs (r:Regression) (dim:Dim) : (Regression*RecordType) =
105 | match r with
106 | | Immed e ->
107 | let et = checkRealPredictor dim G es e
108 | (Immed et,[])
109 | | Cond (r,p,_) ->
110 | let (TypedPredictor(e,t,_) as pt) = checkPredictor dim G es p
111 | let f = match t with
112 | | Dim dim (T_Upto(f)) -> f
113 | | _ -> failwithf "attribute %s is expected to be discrete but has type %s" (Pretty.PredictorToString p) (Pretty.columnTypeToStr t)
114 | let (rt,Pi) = checkRegrn G es (f::fs) r dim
115 | (Cond(rt,pt,t),Pi)
116 | | Sum(r1,r2) ->
117 | let (rt1,Q1) = checkRegrn G es fs r1 dim
118 | let GQ1 = List.fold (fun G (alpha,T) -> Map.add alpha (T,None) G) G Q1
119 | let (rt2,Q2) = checkRegrn GQ1 es fs r2 dim
120 | let I = Set.intersect (Set.ofList (List.map fst Q1)) (Set.ofList (List.map fst Q2))
121 | if not (Set.isEmpty I) then failwithf "duplicate parameter names %s in regression" (String.concat " " (Set.toList I))
122 | (Sum(rt1,rt2),List.append Q1 Q2 )
123 | | Coeff(p,alpha,r) ->
124 | if G.ContainsKey(alpha) then failwithf "Illegal name, variable %s already bound in environment" alpha //TBR
125 | let et = checkRealPredictor dim G es p
126 | let (rt,Q) = checkRegrn G fs [] r dim
127 | if List.exists (fun (c,_) -> c = alpha) Q then failwithf "duplicate parameter name %s in regression" alpha
128 | (Coeff(et,alpha,rt),arrays ((alpha,Dim dim R_Real)::Q) fs)
129 | | Noise(d,ps) ->
130 | let pts = List.map (fun p -> checkPredictor dim G es p) ps
131 | let ets = List.mapi (fun (i:int) (TypedPredictor(p,Dim dim t,_)) -> TypedExp(Syntax.Var (i.ToString()), t)) pts
132 | let t = Checker.synthDist W G_Empty (d,ets)
133 | match t with
134 | | T_Real ->
135 | (Noise(d,pts),[])
136 | | _ -> failwithf "Noise term %s expected to have type real but has type %s" (Pretty.RtoString r) (Pretty.columnTypeToStr t)
137 | | Res(v,r) ->
138 | if G.ContainsKey(v) then failwithf "Illegal restriction, variable %s already bound in environment" v //TBR
139 | let (rt,Q) = checkRegrn G es fs r dim
140 | (Res(v,rt),List.filter (fun (pi,t) -> pi<>v) Q)
141 |
142 | let check g r t =
143 | let dim =
144 | match t with
145 | | RealDim dim -> dim
146 | | _ -> failwithf "regressions must be typed at type %s or %s" (Pretty.columnTypeToStr T_Real) (Pretty.columnTypeToStr (T_Array(T_Real,Syntax.Var "?")))
147 | checkRegrn (GammaOfEnv g) [] [] r dim
--------------------------------------------------------------------------------
/TabularChecker/Schema.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Schema
2 |
3 | open Syntax
4 | open Types
5 | open Checker
6 | open Model
7 | open Table
8 | open System.Collections.Generic
9 | type Log = Map
10 |
11 | module Tabular = Syntax
12 |
13 | let rec synthSchema (g:Env) (s:Schema) : (Log * Error * (Declaration list * SchemaType)) =
14 | match s with
15 | [] -> (Map.empty, false, ([], (ERT, ERT, ERT, ERT, ERT)))
16 | | (Declaration(Table (tName,oStratId),tb)) :: tl ->
17 | let (tlog,err,tb') = synthTable true g tb
18 | let (tb1, t) = tb'
19 | let (ht, wt, xt, yt, zt) = t
20 | let g1 = envInsertTable g tName t
21 | let (slog',err',s1') = synthSchema g1 tl
22 | let slog = slog'.Add(tName,tlog)
23 | let (s2, t1) = s1'
24 | let (h, w, x, y, z) = t1
25 | let h1 = ( (tName, T_Record ht) :: h)
26 | let w1 = ( (tName, T_Record wt) :: w)
27 | let x1 = ( (tName, T_Record xt) :: x)
28 | let y1 = ( (tName, T_Record yt) :: y)
29 | let z1 = ( (tName, T_Record zt) :: z)
30 | (slog,err||err',(((Declaration(Table(tName, oStratId),tb1) :: s2), (h1, w1, x1, y1, z1))))
31 | | (Declaration(Fun tName,tb)) :: tl ->
32 | let (tlog,err,tb') = synthTable false g tb
33 | let (tb1, t) = tb'
34 | let (ht, wt, xt, yt, zt) = t
35 | let (tlog,err) =
36 | match yt with
37 | | [(cn,e)] ->
38 | if cn = tName || cn = "ret" then (tlog,err)
39 | else (tlog.Add(cn,Table.Err (sprintf "function %O has observable column named %O, should be named %O" tName cn tName)), true)
40 | | _ ->
41 | (tlog.Add(tName,Table.Err (sprintf "function %O has zero or several output columns - only one expected" tName)), true)
42 | let rec checkRet cols =
43 | match cols with
44 | | [_,{Type=_; Markup=Observable _}] -> (tlog,err)
45 | | [_] | [] -> (tlog.Add(tName,Table.Err (sprintf "function %O must end in an output column named 'ret' or %O" tName tName)), true)
46 | | _ ::cols -> checkRet cols
47 | let (tlog,err) = checkRet tb
48 | let defaults = List.foldBack (fun col defaults ->
49 | match col with
50 | | (cn,{Type=_;Markup=Hyper e}) -> (cn,e)::defaults
51 | | _ -> defaults) tb []
52 | let g1 = if not err
53 | then envInsertModel g tName (t,defaults,Y)
54 | else g // what binding time should we use?
55 | let (slog',err',s1') = synthSchema g1 tl
56 | let slog = slog'.Add(tName,tlog)
57 | let (s2, t1) = s1'
58 | let (h, w, x, y, z) = t1
59 | let h1 = ( (tName, T_Record ht) :: h)
60 | let w1 = ( (tName, T_Record wt) :: w)
61 | let x1 = ( (tName, T_Record xt) :: x)
62 | let y1 = ( (tName, T_Record yt) :: y)
63 | let z1 = ( (tName, T_Record zt) :: z)
64 | (slog,err||err',(((Declaration(Fun tName, tb1) :: s2), (h1, w1, x1, y1, z1))))
65 |
66 | let typeSchema schema =
67 | synthSchema Types.G_Empty (Library.prelude@schema )
68 |
69 | let checkSchema schema =
70 | let (log,err,(typedFullSchema,_)) = typeSchema schema
71 | let errors = Map.fold (fun s tb log ->
72 | Map.fold (fun s col v -> match v with
73 | | (Table.Err msg) -> s+(sprintf "\nTable %A, column %A:\n %A" tb col msg)
74 | | _ -> s) s log) "" log
75 | if err then failwithf "type-checking error: %s" errors
76 |
--------------------------------------------------------------------------------
/TabularChecker/Table.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Table
2 |
3 | module Tabular = Syntax
4 | open Tabular
5 |
6 | open Types
7 | open Checker
8 | open Model
9 |
10 | type LogValue = ModelType of ModelType | Err of string
11 | type Log = Map
12 |
13 | let levelOf level = match level with Instance -> Y | Static -> W
14 |
15 |
16 | let rec synthTable isTable (g:Env) (tb:Table) : Log * Error * (Table * TableType) =
17 | let qualify m c w = match m with MRegn n -> w | _ -> qualify c w
18 | match tb with
19 | [] -> (Map.empty, false, ([], (ERT, ERT, ERT, ERT, ERT)))
20 | | hd :: tl ->
21 | let hd = Regressions.Sugar.desugar hd // desugar any regression
22 | let (c, col) = hd
23 | let tc = isWellFormed g col.Type
24 | let markup : Markup = col.Markup
25 | let (level,visibility,M) = markup
26 | if (hasVarOrTable g c) then failwith (sprintf "variable %O already in environment" c)
27 | match markup with
28 | | Tabular.Hyper (e) ->
29 | if isTable && det tc <> D then failwith (sprintf "hyper %O must be declared deterministic, but is not" c)
30 | let tb1:Table = tl
31 | let (logValue,err,e') =
32 | try
33 | let (TypedExp(e',tc') as et') = checkExpr H g e tc
34 | if isTable && det tc' > D then failwith (sprintf "hyper %O must be deterministic, but is random" c)
35 | (ModelType ((T_Record ERT,T_Record ERT),T_Record ERT),false,et')
36 | with Failure s ->
37 | let bogus = TypedExp(Tabular.Var "bogus",tc)
38 | (Err s,true,bogus)
39 | let (TypedExp(_, tc)) = e'
40 | let g1 = envInsertVar g c (tc,H)
41 | let (log',err',((tb1,ty1) as tb1'ty)) = synthTable isTable g1 tb1
42 | let tb1'ty = if isTable
43 | // substitute value after binding -- this is why we require det tc when isTable
44 | then let e'c = (e',c)
45 | List.map (fun (cn,col) -> (cn, substC (e',c) col)) tb1,
46 | let (h,w,x,y,z) = ty1
47 | (substRT e'c h, substRT e'c w, substRT e'c x, substRT e'c y, substRT e'c z)
48 | else tb1'ty
49 | let log = log'.Add(c,logValue)
50 | let (tb1, ty) = tb1'ty
51 | let (h, w, x, y, z) = ty
52 | let h1 = (c, tc) :: h
53 | let firstCol = {Type = tc; Markup = Hyper e'}
54 | (log,err||err',(((c, firstCol) :: tb1), (h1, w, x, y, z)))
55 | | Tabular.Param m ->
56 | let tb1:Table = tl
57 | let (logValue,err,m') =
58 | try
59 | let (TypedModel(_, rwy) as m') = checkModel (levelOf level) g m tc
60 | (ModelType rwy,false,m')
61 | with Failure s ->
62 | let bogus = TypedModel(MExp(TypedExp(Tabular.Var "bogus",tc)),((T_Record ERT,T_Record ERT),tc))
63 | (Err s,true,bogus)
64 | let (TypedModel(_, t)) = m'
65 | let ((T_Record ws,T_Record zs) as wc,tci) = t
66 | //use sup of inferred, not declared, type with det tc
67 | let (Some tc) = Syntax.supT tci (det tc)
68 | let g1 = List.fold (fun g (wi,twi) -> envInsertVar g (qualify m c wi) (twi,levelOf level)) g (ws@zs)
69 | let g2 = envInsertVar g1 c (tc, W)
70 | let (log',err',tb1') = synthTable isTable g2 tb1
71 | let log = log'.Add(c,logValue)
72 | let (tb2, t1) = tb1'
73 | let col' = (c,{Type = tc; Markup = Param m'})
74 | let tb' = col'::tb2
75 | let (h, w, x, y, z) = t1
76 | match visibility with
77 | | Local ->
78 | (log,err||err',(tb',(h, w, x, y, z)))
79 | | Output _ ->
80 | let w1 = (List.map (fun (wi,twi) -> (qualify m c wi,twi)) ws) @ (c, tc) :: w
81 | (log,err||err',(tb',(h, w1, x, y, z)))
82 | | In ->
83 | failwith "impossible"
84 | | Tabular.Input ->
85 | assert(if isTable then det tc = D else true)
86 | let tb1:Table = tl
87 | let g1 = envInsertVar g c (tc, levelOf level)
88 | let (log',err,tb1') = synthTable isTable g1 tb1
89 | let (tb2, t1) = tb1'
90 | let (h, w, x, y, z) = t1
91 | let x1 = (c, tc) :: x
92 | let firstCol = {Type = tc; Markup = (level,visibility,TypedModel(MEmpty,((T_Record ERT,T_Record ERT),tc )))}
93 | (log',err,(((c, firstCol) :: tb2), (h, w, x1, y, z)))
94 | | Tabular.Latent m
95 | | Tabular.Observable m ->
96 | //let tc = supT tc R
97 | let tb1:Table = tl
98 | let (logValue,err,m') =
99 | try
100 | let (TypedModel(_, rwy) as m') = checkModel (levelOf level) g m tc
101 | (ModelType rwy,false,m')
102 | with Failure s ->
103 | let bogus = TypedModel(MExp(TypedExp(Tabular.Var "bogus",tc)),((T_Record ERT,T_Record ERT),tc))
104 | (Err s,true,bogus)
105 | let (TypedModel(_, t)) = m'
106 | let ((T_Record ws as wc,T_Record zs as zc),tci) = t
107 | let (Some tc) = Syntax.supT tci (det tc) //use sup of inferred, not declared, type with det tc
108 | let g0 = List.fold (fun g (wi,twi) -> envInsertVar g (qualify m c wi) (twi,W)) g ws
109 | let g1 = List.fold (fun g (wi,twi) -> envInsertVar g (qualify m c wi) (twi,levelOf level)) g0 zs
110 | let g2 = envInsertVar g1 c (tc, levelOf level)
111 | let (log',err',tb1') = synthTable isTable g2 tb1
112 | let log = log'.Add(c,logValue)
113 | let (tb2, t1) = tb1'
114 | let (h, w, x, y, z) = t1
115 | let col' = (c,{Type = tc; Markup = (level,visibility,m')})
116 | let tb' = col'::tb2
117 | let err'' = err||err'
118 | match visibility with
119 | | In -> failwith "impossible"
120 | | Local ->
121 | (log,err'',(tb',(h,w,x,y,z)))
122 | | Output _ ->
123 | let w1 = (List.map (fun (wi,twi) -> (qualify m c wi,twi)) ws) @ (c, tc) :: w
124 | let qzs = (List.map (fun (wi,twi) -> (qualify m c wi,twi)) zs)
125 | match markup with
126 | | Latent _ ->
127 | let z1 = qzs @ (c, tc) :: z
128 | (log,err'',(tb', (h, w1, x, y, z1)))
129 | | Observable _ ->
130 | let z1 = qzs @ z
131 | let y1 = (c, tc) :: y
132 | (log,err'',(tb', (h, w1, x, y1, z1)))
133 | | _ ->
134 | let bogus = TypedModel(MExp(TypedExp(Tabular.Var "bogus",tc)),((T_Record ERT,T_Record ERT),tc))
135 | let g1 = envInsertVar g c (tc, levelOf level)
136 | let (log',err',(tb1',Q)) = synthTable isTable g1 tl
137 | (log'.Add(c,Err "cannot type model"),
138 | true,
139 | (((c,{Type = tc; Markup = (level,visibility,bogus) })::tb1'),Q))
140 |
141 |
--------------------------------------------------------------------------------
/TabularChecker/TabularChecker.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | 0d2aac5f-656f-48d6-8d8e-5401e031a94b
9 | Library
10 | NewTabular
11 | TabularChecker
12 | v4.5
13 | TabularChecker
14 | SAK
15 | SAK
16 | SAK
17 | SAK
18 | 4.7.0.0
19 |
20 |
21 | true
22 | full
23 | false
24 | true
25 | bin\Debug\
26 | TRACE;DEBUG;standalone
27 | 3
28 | AnyCPU
29 | bin\Debug\NewTabular.XML
30 | false
31 |
32 |
33 | pdbonly
34 | true
35 | true
36 | bin\Release\
37 | TRACE
38 | 3
39 | AnyCPU
40 | bin\Release\NewTabular.XML
41 | true
42 |
43 |
44 | 11
45 |
46 |
47 | AnyCPU
48 | bin\CoreTabular\
49 |
50 |
51 |
52 |
53 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
54 |
55 |
56 |
57 |
58 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 | ..\packages\FSharp.Core.4.7.2\lib\net45\FSharp.Core.dll
78 |
79 |
80 | True
81 |
82 |
83 |
84 |
85 |
86 |
87 | Tabular
88 | {cdfb169a-3ca6-4e26-b61e-0a910f4bcd5d}
89 | True
90 |
91 |
92 |
99 |
--------------------------------------------------------------------------------
/TabularChecker/TabularChecker.fsproj.vspscc:
--------------------------------------------------------------------------------
1 | ""
2 | {
3 | "FILE_VERSION" = "9237"
4 | "ENLISTMENT_CHOICE" = "NEVER"
5 | "PROJECT_FILE_RELATIVE_PATH" = ""
6 | "NUMBER_OF_EXCLUDED_FILES" = "0"
7 | "ORIGINAL_PROJECT_FILE_PATH" = ""
8 | "NUMBER_OF_NESTED_PROJECTS" = "0"
9 | "SOURCE_CONTROL_SETTINGS_PROVIDER" = "PROVIDER"
10 | }
11 |
--------------------------------------------------------------------------------
/TabularChecker/Types.fs:
--------------------------------------------------------------------------------
1 | module MicrosoftResearch.Infer.Tabular.Types
2 | open Syntax
3 |
4 |
5 | type Ident = string
6 |
7 |
8 | // check implicit ordering is as expected
9 | assert(D < R)
10 | assert(R < Qry)
11 | assert(H < W && W < Y)
12 |
13 | assert ((D
45 | type TableType = RecordType * RecordType * RecordType * RecordType * RecordType
46 |
47 | type SchemaType = RecordType * RecordType * RecordType * RecordType * RecordType
48 |
49 | let EmptyRecordType : RecordType = []
50 |
51 | //shorthands
52 | let ERT = EmptyRecordType
53 |
54 | type Env =
55 | G_Empty
56 | | G_Var of (Var * (TargetType * B)) * Env
57 | | G_Table of (Var * TableType) * Env
58 | | G_Model of (Var * (TableType * List * B)) * Env
59 |
60 | let envInsertVar (g:Env) (x:Var) (t:TargetType * B) : Env =
61 | G_Var ((x, t), g)
62 |
63 | let envInsertTable (g:Env) (x:Var) (t:TableType) : Env =
64 | G_Table ((x, t), g)
65 |
66 | let envInsertModel (g:Env) (x:Var) (t:TableType * List * B) : Env =
67 | G_Model ((x, t), g)
68 |
69 | let extractType (e:ExprTyped) : TargetType =
70 | let (TypedExp(_, t)) = e in t
71 |
72 | let rec getType (g:Env) (x:Ident) : (TargetType * B) =
73 | match g with
74 | G_Empty -> failwith (sprintf "Variable %O not in environment" x)
75 | | G_Var ((y, t), tail) -> if (x=y) then t else getType tail x
76 | | G_Table ((y, t), tail) -> getType tail x
77 | | G_Model ((y, t), tail) -> getType tail x
78 |
79 | let rec getTableType (g:Env) (x:Ident) : TableType =
80 | match g with
81 | G_Empty -> failwith (sprintf "Table %O not in environment" x)
82 | | G_Var ((y, t), tail) -> getTableType tail x
83 | | G_Table ((y, t), tail) -> if (x=y) then t else getTableType tail x
84 | | G_Model ((y, t), tail) -> getTableType tail x
85 |
86 | let rec getModelType (g:Env) (x:Ident) : (TableType * List * B) =
87 | match g with
88 | G_Empty -> failwith (sprintf "Function %O not in environment" x)
89 | | G_Var ((y, t), tail) -> getModelType tail x
90 | | G_Table ((y, t), tail) -> getModelType tail x
91 | | G_Model ((y, t), tail) -> if (x=y) then t else getModelType tail x
92 |
93 | let rec hasVar (g:Env) (x:Ident) : bool =
94 | match g with
95 | G_Empty -> false
96 | | G_Var ((y, t), tail) -> if (x=y) then true else hasVar tail x
97 | | G_Table ((y, t), tail) -> hasVar tail x
98 | | G_Model ((y, t), tail) -> hasVar tail x
99 |
100 | let rec hasTable (g:Env) (x:Ident) : bool =
101 | match g with
102 | G_Empty -> false
103 | | G_Var ((y, t), tail) -> hasTable tail x
104 | | G_Table ((y, t), tail) -> if (x=y) then true else hasTable tail x
105 | | G_Model ((y, t), tail) -> hasTable tail x
106 |
107 | let rec hasVarOrTable (g:Env) (x:Ident) : bool =
108 | match g with
109 | G_Empty -> false
110 | | G_Var ((y, t), tail) -> if (x=y) then true else hasVarOrTable tail x
111 | | G_Table ((y, t), tail) -> if (x=y) then true else hasVarOrTable tail x
112 | | G_Model ((y, t), tail) -> if (x=y) then true else hasVarOrTable tail x
113 |
114 | let rec lookupFieldType (record:List) (fIn:Var) : TargetType =
115 | match record with
116 | (f,t) :: tail ->
117 | if (f = fIn) then t else lookupFieldType tail fIn
118 | | [] -> failwith (sprintf "no such field: %O" (fIn))
119 |
120 |
121 | let rec printEnv (g:Env) =
122 | match g with
123 | G_Empty -> printf ";;\n"
124 | | G_Var ((y, t), tail) -> printf "v>%s\n" y;
125 | printEnv tail
126 | | G_Table ((y, t), tail) -> printf "t>%s\n" y
127 | printEnv tail
128 | | G_Model ((y, t), tail) -> printf "m>%s\n" y
129 | printEnv tail
130 |
131 |
--------------------------------------------------------------------------------
/TabularChecker/app.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
--------------------------------------------------------------------------------
/TabularChecker/packages.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
--------------------------------------------------------------------------------
/TabularCompiler/AssemblyInfo.fs:
--------------------------------------------------------------------------------
1 | namespace System
2 | open System.Reflection
3 |
4 | []
5 | []
6 | []
7 | []
8 | []
9 | do ()
10 |
11 | module internal AssemblyVersionInformation =
12 | let [] Version = "0.1.0"
13 |
--------------------------------------------------------------------------------
/TabularCompiler/LatentModel.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | open System.Threading
4 |
5 | open MicrosoftResearch.Infer
6 |
7 | []
8 | type LatentModel() =
9 | abstract member TrainAndPredictWithLogEvidence: DTO * IAlgorithm option * int option * CancellationToken option -> Syntax.Schema * float*( DistDTO * KnowDTO)
10 | member this.performInferenceGeneric (DTO dicDatas, algo, numberOfIterations, cts) =
11 | async {
12 | let! (schema, le, predictedPZ, knowledgeDW) = async {
13 | let ctx = SynchronizationContext.Current
14 | do! Async.SwitchToThreadPool()
15 | let! tok= Async.StartChild(async { let schema,le,(predictedPZ, knowledgeDW) = this.TrainAndPredictWithLogEvidence(DTO dicDatas,algo, numberOfIterations, cts)
16 | return schema, le,(predictedPZ, knowledgeDW) })
17 | let! schema, le,(predictedPZ, knowledgeDW) = tok
18 | do! Async.SwitchToContext(ctx)
19 | return schema, le, predictedPZ, knowledgeDW
20 | }
21 | return schema,le, None, predictedPZ, knowledgeDW, Option.None
22 | }
23 |
--------------------------------------------------------------------------------
/TabularCompiler/Pretty.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | module Pretty =
4 | module T = Syntax
5 | open T
6 | open Target
7 |
8 | let rec EtoString e : string =
9 | let EsToString (es:E list) = (System.String.Join (",",[| for e in es -> EtoString e |]))
10 | match e with
11 | | Var v -> v
12 | | Rng r -> r + "/*range*/"
13 | | Const (IntConst i) -> sprintf "Variable.Constant(%O)" i
14 | | Const (RealConst r) -> sprintf "Variable.Constant(%O)" (r.ToString())
15 | | Const (BoolConst b) -> sprintf "Variable.Constant(%O)" (b.ToString())
16 | | Const (StringConst s) -> sprintf "Variable.Constant(%O)" (sprintf "\"%A\"" (s.ToString()))
17 | | IndexRng (e1,e2) -> sprintf "%O[ %O]" (EtoString e1) e2
18 | | Index (e1,e2) -> sprintf "%O[ %O]" (EtoString e1) (EtoString e2)
19 | | Prim(Prim.Gt,[e1;e2]) -> sprintf "%O > %O" (EtoString e1) (EtoString e2)
20 | | Prim(Prim.GtEq,[e1;e2]) -> sprintf "%O >= %O" (EtoString e1) (EtoString e2)
21 | | Prim(Prim.Lt,[e1;e2]) -> sprintf "%O < %O" (EtoString e1) (EtoString e2)
22 | | Prim(Prim.LtEq,[e1;e2]) -> sprintf "%O <= %O" (EtoString e1) (EtoString e2)
23 | | Prim(Prim.Eq,[e1;e2]) ->
24 | sprintf "(%O = %O)" (EtoString e1) (EtoString e2)
25 | | Prim(Prim.Minus,[e1;e2]) ->
26 | sprintf "(%O - %O)" (EtoString e1) (EtoString e2)
27 | | Prim(Prim.And, [e1;e2]) -> sprintf "(%O & %O)" (EtoString e1) (EtoString e2)
28 | | Prim(Prim.Or, [e1;e2]) -> sprintf "(%O | %O)" (EtoString e1) (EtoString e2)
29 | | Prim(Prim.Mult, [e1;e2]) -> sprintf "(%O * %O)" (EtoString e1) (EtoString e2)
30 | | Prim(Prim.Factor (FactorName s), es) ->
31 | sprintf "Factor.%O(%O)" s (EsToString es)
32 | | Prim(p, es) ->
33 | sprintf "Prim.%A(%O)" p (EsToString es)
34 | | Dist(d,es) -> sprintf "Variable.%A(%O)" d (EsToString es)
35 | | _ -> sprintf "??%A??" e
36 |
37 | let rec tyToString ty =
38 | match ty with
39 | | T_Int -> "int"
40 | | T_Real -> "double"
41 | | T_Bool -> "bool"
42 | | T_String -> "string"
43 | | T_Array (ty,e) -> tyToString ty + sprintf "[/*%A*/]" (Pretty.exprToStr e)
44 | | T_Upto e -> sprintf "int /*upto(%A)*/" (Pretty.exprToStr e)
45 | | T_Link t -> sprintf "int /*upto(SizeOf(%s))*/" t
46 | | T_Vector -> "Maths.Vector"
47 | | T_PositiveDefiniteMatrix -> "PositiveDefiniteMatrix"
48 | | T_Record flds -> sprintf "{%O}" (System.String.Join(",",[|for (n,ty) in flds -> sprintf "%O = %O" n (tyToString ty)|]))
49 | | t -> sprintf "??%A??" t
50 |
51 | let rec objToString ty (obj:obj) =
52 | match ty with
53 | | T_Int
54 | | T_Real
55 | | T_Bool
56 | | T_String
57 | | T_Upto _
58 | | T_Link _
59 | | T_Vector
60 | | T_PositiveDefiniteMatrix -> obj.ToString()
61 | | T_Array (ty,e) -> sprintf "new %O []{%O}" (tyToString ty) (System.String.Join(",", [| for o in (obj :?> System.Array) -> objToString ty o |]))
62 | | t -> sprintf "??%A??" t
63 |
64 | let rec StoString tab s =
65 | //let sprintf fmt k = "\n"+tab+(sprintf fmt k)
66 | match s with
67 | | CloneRng (s,r) -> tab+sprintf "var %O = %O.Clone();" s r
68 | | LetRng (r,i) -> tab+sprintf "var %O = new Range(%O);" r i
69 | | LetVar (v,e) -> tab+sprintf "var %O = %O;" v (EtoString e)
70 | | LetNew (v,t) -> tab+sprintf "var %O = Variable.New<%O>();" v (tyToString t)
71 | | LetArray (v,r,t) ->
72 | tab+(sprintf "var %O = Variable.Array<%O>(%O);" v (tyToString t) r)
73 | | ObserveValue(v,t,obj) ->
74 | tab+(sprintf "%O.ObservedValue=%O;" v (objToString t obj))
75 | | Assign (v,r,E) ->
76 | tab+(sprintf "%O[%O] = %O;" v r (EtoString E))
77 | | AssignIndex (v,Ei,E) ->
78 | tab+(sprintf "%O[%O] = %O;" v (EtoString Ei) (EtoString E))
79 | | SetTo(v,E) ->
80 | tab+(sprintf "%O.SetTo(%O);" v (EtoString E))
81 | | Seq (S1,S2) ->
82 | (sprintf "%O%O" (StoString tab S1) (StoString tab S2))
83 | | ForEach(r,S) ->
84 | tab + (sprintf "using(Variable.ForEach(%O)) {%O" r (StoString (tab+" ") S)) + tab + "}"
85 | | ForLoop(r,x,S) ->
86 | tab + (sprintf "using(var %OBlock = Variable.ForEach(%O)) { var %O= %OBlock.Index; %O" r r x r (StoString (tab+" ") S)) + tab + "}"
87 | | IfNot(v,S) ->
88 | tab + (sprintf "using(Variable.IfNot(%O)) {%O" v (StoString (tab+" ") S)) + tab + "}"
89 | | If(v,S) ->
90 | tab + (sprintf "using(Variable.If(%O)) {%O" v (StoString (tab+" ") S)) + tab + "}"
91 | | Skip -> ""
92 | | Switch(v,S) ->
93 | tab + (sprintf "using(Variable.Switch(%O)) {%O" v (StoString (tab+" ") S)) + tab + "}"
94 | | SetValueRange(v,r) ->
95 | tab + (sprintf "%O.SetValueRange(%O);" v r)
96 | | LetCopy(v,E) ->
97 | tab + (sprintf "var %O = Variable.Copy(%O);" v (EtoString E))
98 |
99 | let rangeindex r = r+"_i"
100 |
101 | let rec EToCSoft e : string =
102 | let EsToString (es:E list) = (System.String.Join (",",[| for e in es -> EToCSoft e |]))
103 | match e with
104 | | Var v -> v
105 | | Rng r -> r + "/*range*/"
106 | | Const (IntConst i) -> i.ToString()
107 | | Const (RealConst r) -> r.ToString()
108 | | Const (BoolConst b) -> b.ToString()
109 | | Const (StringConst b) -> sprintf "\"%A\"" (b.ToString())
110 | | IndexRng (e1,r) -> sprintf "%O[ %O]" (EToCSoft e1) (rangeindex r)
111 | | Index (e1,e2) -> sprintf "%O[ %O]" (EToCSoft e1) (EToCSoft e2)
112 | | Prim(Prim.Gt,[e1;e2]) -> sprintf "%O > %O" (EToCSoft e1) (EToCSoft e2)
113 | | Prim(Prim.GtEq,[e1;e2]) -> sprintf "%O >= %O" (EToCSoft e1) (EToCSoft e2)
114 | | Prim(Prim.Lt,[e1;e2]) -> sprintf "%O < %O" (EToCSoft e1) (EToCSoft e2)
115 | | Prim(Prim.LtEq,[e1;e2]) -> sprintf "%O <= %O" (EToCSoft e1) (EToCSoft e2)
116 | | Prim(Prim.Eq,[e1;e2]) ->
117 | sprintf "(%O = %O)" (EToCSoft e1) (EToCSoft e2)
118 | | Prim(Prim.Minus,[e1;e2]) ->
119 | sprintf "(%O - %O)" (EToCSoft e1) (EToCSoft e2)
120 | | Prim(Prim.And, [e1;e2]) -> sprintf "(%O & %O)" (EToCSoft e1) (EToCSoft e2)
121 | | Prim(Prim.Or, [e1;e2]) -> sprintf "(%O | %O)" (EToCSoft e1) (EToCSoft e2)
122 | | Prim(Prim.Mult, [e1;e2]) -> sprintf "(%O * %O)" (EToCSoft e1) (EToCSoft e2)
123 | | Prim(Prim.Factor (FactorName s), es) ->
124 | sprintf "Factor.%O(%O)" s (EsToString es)
125 | | Prim(p, es) ->
126 | sprintf "Prim.%A(%O)" p (EsToString es)
127 | | Dist(d,es) -> sprintf "Variable.%A(%O)" d (EsToString es)
128 | | _ -> sprintf "??%A??" e
129 |
130 | let rec tyToCSoft ty =
131 | match ty with
132 | | T_Int -> "int"
133 | | T_Real -> "double"
134 | | T_Bool -> "bool"
135 | | T_String -> "string"
136 | | T_Array (ty,e) -> tyToCSoft ty + sprintf "[(*%A*)]" e
137 | | T_Upto e -> sprintf "int"
138 | | T_Link _ -> "int"
139 | | T_Vector -> "Maths.Vector"
140 | | T_PositiveDefiniteMatrix -> "PositiveDefiniteMatrix"
141 | | T_Record flds -> sprintf "{%O}" (System.String.Join(",",[|for (n,ty) in flds -> sprintf "%O = %O" n (tyToCSoft ty)|]))
142 | | t -> sprintf "??%A??" t
143 |
144 | let rec StoCSoft tab s : string =
145 | //let sprintf fmt k = "\n"+tab+(sprintf fmt k)
146 | match s with
147 | | CloneRng (s,r) -> tab+sprintf "var %O = %O.Clone();" s r
148 | | LetRng (r,i) -> tab+sprintf "var %O = %O;" r i
149 | | LetVar (v,e) -> tab+sprintf "var %O = %O;" v (EToCSoft e)
150 | | LetNew (v,t) -> tab+sprintf "%O %O;" (tyToCSoft t) v
151 | | LetArray (v,r,t) ->
152 | tab+(sprintf "var %O = new %O[%O];" v (tyToCSoft t) r )
153 | | ObserveValue(v,t,obj) ->
154 | tab+(sprintf "%O.ObservedValue=%O;" v (objToString t obj))
155 | | Assign (v,r,E) ->
156 | tab+(sprintf "%O[%O] = %O;" v (rangeindex r) (EToCSoft E))
157 | | AssignIndex (v,Ei,E) ->
158 | tab+(sprintf "%O[%O] = %O;" v (EToCSoft Ei) (EToCSoft E))
159 | | SetTo(v,E) ->
160 | tab+(sprintf "%O = %O;" v (EToCSoft E))
161 | | Seq (S1,S2) ->
162 | (sprintf "%O%O" (StoCSoft tab S1) (StoCSoft tab S2))
163 | | LetCopy(v,E) ->
164 | tab + (sprintf "var %O = Copy(%O);" v (EToCSoft E))
165 | | SetValueRange(v,r) ->
166 | tab + (sprintf "/* %O.SetValueRange(%O); */" v r)
167 | | ForEach(r,S) ->
168 | let ri = rangeindex r
169 | tab + (sprintf "for(int %O = 0; %O < %O; %O++) {%O" ri ri r ri (StoCSoft (tab+" ") S)) + tab + "}"
170 | | ForLoop(r,x,S) ->
171 | let ri = x
172 | tab + (sprintf "for(int %O = 0; %O < %O; %O++) {%O" ri ri r ri (StoCSoft (tab+" ") S)) + tab + "}"
173 | | IfNot(v,S) ->
174 | tab + (sprintf "if (!%O) {%O" v (StoCSoft (tab+" ") S)) + tab + "}"
175 | | If(v,S) ->
176 | tab + (sprintf "if (%O) {%O" v (StoCSoft (tab+" ") S)) + tab + "}"
177 | | Skip -> ""
178 | | Switch(v,S) ->
179 | tab + (sprintf "using(Variable.Switch(%O)) {%O" v (StoCSoft (tab+" ") S)) + tab + "}"
180 |
--------------------------------------------------------------------------------
/TabularCompiler/Ranges.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | module Ranges =
4 | module T = Syntax
5 | open Target
6 | type R = RSizeOf of T.TableName | RConst of int
7 | let ranges = new System.Collections.Generic.Dictionary()
8 | let rangeCtxt = ref (fun S -> S)
9 |
10 |
11 | let rec rangeOf (R,depth) =
12 | match R with
13 | | RConst i ->
14 | if ranges.ContainsKey((R,depth)) then ranges.[(R,depth)]
15 | else
16 | if depth <= 0
17 | then
18 | let s = fresh()
19 | let r = fresh()
20 | rangeCtxt :=
21 | (let ctxt = !rangeCtxt
22 | fun S ->
23 | ctxt ( Seq(LetVar(s,Const (T.IntConst(i))),
24 | Seq(LetRng(r, s),S))))
25 | ranges.Add((R,depth),r)
26 | r
27 | else
28 | let r0 = rangeOf (R,0)
29 | let r = r0+"_"+depth.ToString()
30 | rangeCtxt :=
31 | (let ctxt = !rangeCtxt
32 | fun S ->
33 | ctxt (Seq(CloneRng(r, r0),S)))
34 | ranges.Add((R,depth),r)
35 | r
36 | | RSizeOf tn ->
37 | if ranges.ContainsKey((R,depth)) then ranges.[(R,depth)]
38 | else
39 | if depth <= 0
40 | then
41 | let s = Target.size tn
42 | let r = Target.range tn
43 | rangeCtxt :=
44 | (let ctxt = !rangeCtxt
45 | fun S ->
46 | ctxt ( Seq(LetNew(s,T.T_Int), // To be observed
47 | Seq(LetRng(r, s),S))))
48 | ranges.Add((R,depth),r)
49 | r
50 | else
51 | let r0 = rangeOf (R,0)
52 | let r = r0+"_"+depth.ToString()
53 | rangeCtxt :=
54 | (let ctxt = !rangeCtxt
55 | fun S ->
56 | ctxt (Seq(CloneRng(r, r0),S)))
57 | ranges.Add((R,depth),r)
58 | r
59 |
60 |
61 | // decRangesXXX - collect all constant ranges via rangeOf
62 | let rec decRangesExp e =
63 | match e with
64 | | T.Var v -> ()
65 | | T.Const c -> ()
66 | | T.Prim (p,es) -> List.iter decRangesExp es
67 | | T.Dist(d,es) -> List.iter decRangesExp es
68 | | T.SizeOf(t) -> ()
69 | | T.DeRef(e1,tn,cn) -> decRangesExp e1
70 | | T.Ref(tn,cn) -> ()
71 | | T.If(e1,e2,e3) -> decRangesExp e1; decRangesExp e2; decRangesExp e3
72 | | T.ForLoop(x,e1,e2) -> decRangesExp e1; decRangesExp e2
73 | | T.Array(es) -> List.iter decRangesExp es
74 | | T.Subscript(e1,e2) -> decRangesExp e1; decRangesExp e2
75 | | T.Constraint(e1,t1) -> decRangesExp e1; decRangesColumnType t1
76 | | T.Let(x,e1,e2) -> decRangesExp e1; decRangesExp e2
77 | | T.Scan(s,x,e1,e2,e3) -> decRangesExp e1; decRangesExp e2; decRangesExp e3
78 | | T.Infer(d,es,x,y) -> List.iter decRangesExp es // shouldn't really occur
79 | | T.TypedExp(e,t) -> decRangesExp e;decRangesColumnType t
80 |
81 | and decRangesModel m =
82 | match m with
83 | | T.MExp e -> decRangesExp e
84 | | T.TypedModel (m,((t1,t2),t3)) -> decRangesModel m; decRangesColumnType t1; decRangesColumnType t2; decRangesColumnType t3
85 | | _ -> failwithf "decRanges: unexpected non-core model"
86 |
87 | and depth t =
88 | match t with
89 | | T.T_Array (t,e) -> 1+depth t
90 | | _ -> 0
91 | and decRangesColumnType t =
92 | match t with
93 | | T.T_Link tn -> ignore(rangeOf (RSizeOf tn,0))
94 | | T.T_Real
95 | | T.T_Bool
96 | | T.T_String
97 | | T.T_Int
98 | | T.T_PositiveDefiniteMatrix-> ()
99 | | T.T_Upto (T.TypedExp (T.Const (T.IntConst i),_)) -> ignore(rangeOf (RConst i,0))
100 | | T.T_Upto (T.TypedExp (T.SizeOf tn,_)) -> ignore()
101 | | T.T_Array (ct,(T.TypedExp (T.Const (T.IntConst i),_))) ->
102 | ignore(rangeOf (RConst i,(depth t))); decRangesColumnType ct;
103 | | T.T_Array (ct,(T.TypedExp (T.SizeOf tn,_))) ->
104 | ignore(rangeOf (RSizeOf tn,(depth t))); decRangesColumnType ct;
105 | | T.T_Array (ct,_) ->
106 | decRangesColumnType ct
107 | | T.T_Record flds -> List.iter (fun (v,ty) -> decRangesColumnType ty) flds
108 | | T.T_Vector -> ()
109 | and decRangesMarkup m =
110 | match m with
111 | T.Input -> ()
112 | | T.Latent m -> decRangesModel m
113 | | T.Observable m -> decRangesModel m
114 | | T.Hyper e -> decRangesExp e
115 | | T.Param m -> decRangesModel m
116 | let rec decRangesColumns cs = List.iter (fun (cn,col:T.Column) -> decRangesColumnType col.Type;
117 | decRangesMarkup col.Markup) cs
118 | let rec decRangesTable cs = decRangesColumns cs
119 | let rec decRangesTables decs =
120 | match decs with
121 | | [] -> ()
122 | | (T.Declaration(T.Table(tn,_),tbl))::decs ->
123 | ignore(rangeOf (RSizeOf tn,0));
124 | decRangesTable tbl;
125 | decRangesTables decs;
126 | | dec::decs' -> decRangesTables decs' // skip non-core functions if present
127 | let rec decRangesSchema decs = decRangesTables decs
128 |
--------------------------------------------------------------------------------
/TabularCompiler/Ranks.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | // A TypeIndex representation of array types that (hopefully) makes it easy to generate Infer.NET's array declarations.
4 | module Ranks =
5 | open Syntax
6 | open MicrosoftResearch.Infer.Models
7 | open MicrosoftResearch.Infer.Maths
8 |
9 |
10 |
11 | type IRankVisitor<'Result> =
12 | abstract CaseBase<'T> : Base<'T> -> 'Result
13 | abstract CaseArr<'V,'R when 'V:>Variable
14 | and 'V:> System.ICloneable
15 | and 'V:> SettableTo<'V>> : Arr<'V,'R> -> 'Result
16 |
17 | and []
18 | Rank() =
19 | inherit obj()
20 | abstract member Visit<'Result> : IRankVisitor<'Result> -> 'Result
21 | abstract member AddRange: Exp -> Rank
22 | abstract member ValueRange : Exp option
23 | abstract member NewAbstractVariable : (int -> Exp -> Range) -> Variable
24 | abstract member depth: int
25 |
26 | and []
27 | Rank<'R>() =
28 | inherit Rank()
29 | abstract member NewVariable : (int -> Exp -> Range) -> Variable<'R>
30 | override this.NewAbstractVariable(eToRange) = this.NewVariable(eToRange) :> Variable
31 |
32 | and []
33 | Rank<'V ,'R when 'V:>Variable
34 | and 'V:> System.ICloneable
35 | and 'V:> SettableTo<'V>>() =
36 | inherit Rank<'R>()
37 |
38 | override this.NewVariable(eToRange) = this.NewVariableArray(eToRange) :> Variable<'R>
39 | abstract member NewVariableArray: (int -> Exp -> Range) -> VariableArray<'V,'R>
40 |
41 |
42 | and Base<'T>(range:Exp,valueRangeOpt:Exp option) =
43 | inherit Rank,'T[]>()
44 | member this.Range = range
45 | override this.ValueRange = valueRangeOpt
46 | override this.Visit<'Result>(v : IRankVisitor<'Result>) = v.CaseBase(this)
47 |
48 | override this.AddRange(range) =
49 | let arr = Arr(this,range)
50 | arr :> Rank
51 | override this.NewVariableArray(eToRange:int -> Exp -> Range) =
52 | let a = Variable.Array<'T>(eToRange this.depth range) :> VariableArray,'T[]>
53 | if valueRangeOpt.IsSome then a.SetValueRange(eToRange 0 (valueRangeOpt.Value))
54 | a
55 | override this.depth = 1
56 |
57 | and Arr<'V,'R when 'V:>Variable
58 | and 'V:> System.ICloneable
59 | and 'V:> SettableTo<'V>>(rank:Rank<'V,'R>,range:Exp) =
60 | inherit Rank,'R[]>()
61 | member this.Rank = rank
62 | member this.Range = range
63 | override this.ValueRange = rank.ValueRange
64 | override this.Visit<'Result>(v : IRankVisitor<'Result>) = v.CaseArr(this)
65 |
66 | override this.AddRange(r) =
67 | let arr = Arr(this:>Rank,'R[]>,r)
68 | arr :> Rank
69 | override this.NewVariableArray(eToRange) =
70 | // Variable.Array,'R[]>(itemPrototype=r.NewVariableArray(),r=range)
71 | let array = rank.NewVariableArray(eToRange)
72 | let va = Variable.Array<'V,'R>(array=array,r=eToRange this.depth range)
73 | let vr = array.GetValueRange(false)
74 | if vr <> null then va.SetValueRange(vr)
75 | va
76 | override this.depth = rank.depth + 1
77 |
78 | let test =
79 | let eToRange n e = match e with (Const (IntConst i)) -> new Range(i)
80 | Arr(Base(Const (IntConst 1),None), Const(IntConst 2)).NewVariableArray(eToRange) :> Variable
81 |
82 | open System.CodeDom
83 |
84 |
85 |
86 | let rec TToRank ty E =
87 | match ty with
88 | | T_Int -> Base(E,None) :> Rank
89 | | T_Bool -> Base(E,None) :> Rank
90 | | T_Real -> Base(E,None) :> Rank
91 | | T_String -> Base(E,None) :> Rank
92 | | T_Upto E' -> Base(E,Some E') :> Rank
93 | | T_Link t -> Base(E,Some (TypedExp(SizeOf(t),T_Int))) :> Rank
94 | | T_Vector -> Base(E,None) :> Rank
95 | | T_PositiveDefiniteMatrix -> Base(E,None) :> Rank
96 | | T_Record _ -> failwithf "TToRank"
97 | | T_Array(ty,E') -> (TToRank ty E').AddRange( E)
98 |
99 |
--------------------------------------------------------------------------------
/TabularCompiler/SymmetryBreaking.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 | module SymmetryBreaking =
4 |
5 | module T = Syntax
6 | open Syntax
7 | open Target
8 | open Ranges
9 | open Translate
10 | open Compiler
11 |
12 | open MicrosoftResearch.Infer
13 | open MicrosoftResearch.Infer.Factors
14 | open MicrosoftResearch.Infer.Maths
15 | open MicrosoftResearch.Infer.Distributions
16 | open MicrosoftResearch.Infer.Models
17 |
18 | type IDist<'T> = IDistribution<'T>
19 |
20 | []
21 | type AbsDist() =
22 | abstract member singleton: unit -> obj
23 | abstract member array: int -> AbsDist
24 |
25 | type MkStructDist<'T,'U when
26 | 'T:> IDist<'U> and
27 | 'T:(new:unit->'T) and
28 | 'T:> System.ValueType and
29 | 'T:> Sampleable<'U> and
30 | 'T:struct and 'T:> SettableToProduct<'T> and 'T:> SettableToRatio<'T> and 'T:> SettableToPower<'T> and 'T:>SettableToWeightedSum<'T> and 'T:>CanGetLogAverageOf<'T> and 'T:>CanGetLogAverageOfPower<'T> and 'T:>CanGetAverageLog<'T> > (gen: unit -> 'T) =
31 | inherit AbsDist()
32 | override this.singleton() = gen() :> obj
33 | override this.array(n:int) = MkRefDist(fun () -> Distribution<'U>.Array<'T>( [| for i in 1..n-> gen() |]) :?> DistributionStructArray<'T,'U> ):> AbsDist
34 |
35 | and MkRefDist<'T,'U when
36 | 'T:> IDist<'U> and
37 | 'T:> Sampleable<'U> and
38 | 'T: not struct and
39 | 'T:> SettableTo<'T> and
40 | 'T:> SettableToProduct<'T> and 'T:> SettableToRatio<'T> and 'T:> SettableToPower<'T> and 'T:>SettableToWeightedSum<'T> and 'T:>CanGetLogAverageOf<'T> and 'T:>CanGetLogAverageOfPower<'T> and 'T:>CanGetAverageLog<'T> > (gen: unit -> 'T) =
41 | inherit AbsDist()
42 | override this.singleton() = gen() :> obj
43 | override this.array(n:int) = MkRefDist(fun () -> Distribution<'U>.Array<'T>( [| for i in 1..n-> gen() |]) :?> DistributionRefArray<'T,'U>) :> AbsDist
44 |
45 | let dirichletInit n =
46 | Distributions.Dirichlet([| for i in 1 .. n -> 1.0 + Rand.Double()*0.01|])
47 |
48 | let rec breakExpressionSymmetry (sizeOf:Map) (TypedExp(e,t)) : AbsDist option =
49 | match e with
50 | | T.ForLoop(v,TypedExp(e1,t1),e2) ->
51 | match e1 with
52 | | T.Const(IntConst n) ->
53 | match breakExpressionSymmetry sizeOf e2 with
54 | | Some d -> Some (d.array n)
55 | | None -> None
56 | | T.SizeOf(tn) ->
57 | match breakExpressionSymmetry sizeOf e2 with
58 | | Some d -> Some (d.array (sizeOf.[tn]))
59 | | None -> None
60 | | _ -> None
61 | | T.Prim(T.Factor(T.FactorName("BreakSymmetry")),[T.TypedExp(T.Dist(d,es),_)]) ->
62 | match d,es with
63 | | (Bernoulli,[TypedExp(e0,_)]) ->
64 | match e0 with
65 | | T.Const(T.RealConst(p)) ->
66 | Some (MkStructDist (fun () ->
67 | let b = MicrosoftResearch.Infer.Maths.Rand.Double() < p
68 | Distributions.Bernoulli.PointMass(b)
69 | ):>AbsDist)
70 | | T.Dist(Beta,[TypedExp(T.Const(T.RealConst(a)),_);TypedExp(T.Const(T.RealConst(b)),_)]) ->
71 | Some (MkStructDist(fun () ->
72 | let p = a / (a+b)
73 | let b = MicrosoftResearch.Infer.Maths.Rand.Double() < p
74 | Distributions.Bernoulli.PointMass(b)) :> AbsDist)
75 |
76 | | _ -> None //TBC
77 | | (Dirichlet | DirichletUniform |DirichletSymmetric), ((TypedExp(e0,_))::es) ->
78 | match e0 with
79 | | T.Const(IntConst n) ->
80 | Some (MkRefDist(fun () -> dirichletInit(n)):> AbsDist)
81 | | T.SizeOf(tn) ->
82 | let n = sizeOf.[tn]
83 | Some (MkRefDist(fun () -> dirichletInit(n)) :> AbsDist)
84 | | _ -> None //TBC
85 | | Discrete, ((TypedExp(e0,_))::es) ->
86 | match e0 with
87 | | T.Const(IntConst n) ->
88 | Some (MkRefDist(fun () -> Distributions.Discrete.PointMass(MicrosoftResearch.Infer.Maths.Rand.Int(n),n)):>AbsDist)
89 | | T.SizeOf(tn) ->
90 | let n = sizeOf.[tn]
91 | Some (MkRefDist(fun () ->Distributions.Discrete.PointMass(MicrosoftResearch.Infer.Maths.Rand.Int(n),n)):>AbsDist)
92 | | _ -> None
93 | | _,_ ->
94 | None
95 | | _ -> None
96 |
97 |
98 | let breakModelSymmetry (sizeOf:Map) (TypedModel(MExp e,_)) = breakExpressionSymmetry sizeOf e
99 |
100 |
101 | let breakSymmetries (sizeOf:Map) (RE,VE:Map,AE:Map) (typedCoreSchema:(*typed core*) Schema) =
102 | let rec trTables tables =
103 | match tables with
104 | | [] -> ()
105 | | (Declaration(Table(tn,_),table)::tables) ->
106 | let size = sizeOf.[tn]
107 | // let s = size tn
108 | let rec trColumns columns =
109 | match columns with
110 | | [] ->
111 | trTables tables
112 | | (cn,{Type=ty;Markup=m})::rest ->
113 | if Types.det ty = Qry
114 | then trColumns rest
115 | else
116 | let r = range(tn)
117 | match m with
118 | | Hyper _ ->
119 | trColumns rest
120 | | Param m ->
121 | let v = VE.[col(tn,cn)]
122 | match breakModelSymmetry sizeOf m with
123 | | Some f -> ignore( initializeTo (f.singleton()) v); trColumns rest
124 | | None -> trColumns rest
125 | | Input ->
126 | trColumns rest
127 | | Latent m ->
128 | let av = AE.[col(tn,cn)]
129 | match breakModelSymmetry sizeOf m with
130 | | Some f -> ignore( initializeTo (f.array(size).singleton()) av); trColumns rest
131 | | None -> trColumns rest
132 | | Observable m ->
133 | let av = AE.[col(tn,cn)]
134 | match breakModelSymmetry sizeOf m with
135 | | Some f -> ignore( initializeTo (f.array(size).singleton()) av); trColumns rest
136 | | None -> trColumns rest
137 | trColumns table
138 | trTables typedCoreSchema
139 |
140 |
--------------------------------------------------------------------------------
/TabularCompiler/TabularCompiler.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | 5f6ce5c9-3657-497d-b128-2076fb8fbd9c
9 | Library
10 | FSPlayGround
11 | TabularCompiler
12 | v4.5
13 | TabularCompiler
14 | SAK
15 | SAK
16 | SAK
17 | SAK
18 | 4.7.0.0
19 | ..\
20 | true
21 | OnOutputUpdated
22 |
23 |
24 | true
25 | full
26 | false
27 | true
28 | bin\Debug\
29 | DEBUG;TRACE
30 | 3
31 | AnyCPU
32 | bin\Debug\FSPlayGround.XML
33 | false
34 |
35 |
36 | pdbonly
37 | true
38 | true
39 | bin\Release\
40 | TRACE
41 | 3
42 | AnyCPU
43 | bin\Release\FSPlayGround.XML
44 | true
45 |
46 |
47 | 11
48 |
49 |
50 | true
51 | full
52 | false
53 | false
54 | bin\Debug\
55 | DEBUG;TRACE
56 | 3
57 | bin\Debug\FSPlayGround.XML
58 | true
59 | x64
60 |
61 |
62 | pdbonly
63 | true
64 | true
65 | bin\Release\
66 | TRACE
67 | 3
68 | bin\Release\FSPlayGround.XML
69 | true
70 | x64
71 |
72 |
73 |
74 |
75 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
76 |
77 |
78 |
79 |
80 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 | CSharpHelpers
109 | {5257638a-cc80-46eb-be75-db9ad91d8b02}
110 | True
111 |
112 |
113 | TabularChecker
114 | {0d2aac5f-656f-48d6-8d8e-5401e031a94b}
115 | True
116 |
117 |
118 | Tabular
119 | {cdfb169a-3ca6-4e26-b61e-0a910f4bcd5d}
120 | True
121 |
122 |
123 | ..\packages\FSharp.Core.4.7.2\lib\net45\FSharp.Core.dll
124 |
125 |
126 | True
127 |
128 |
129 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Compiler.dll
130 | True
131 |
132 |
133 | ..\packages\Microsoft.Research.InferNET.2.6.41114.1\lib\net45\Infer.Runtime.dll
134 | True
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
149 |
--------------------------------------------------------------------------------
/TabularCompiler/TabularCompiler.fsproj.vspscc:
--------------------------------------------------------------------------------
1 | ""
2 | {
3 | "FILE_VERSION" = "9237"
4 | "ENLISTMENT_CHOICE" = "NEVER"
5 | "PROJECT_FILE_RELATIVE_PATH" = ""
6 | "NUMBER_OF_EXCLUDED_FILES" = "0"
7 | "ORIGINAL_PROJECT_FILE_PATH" = ""
8 | "NUMBER_OF_NESTED_PROJECTS" = "0"
9 | "SOURCE_CONTROL_SETTINGS_PROVIDER" = "PROVIDER"
10 | }
11 |
--------------------------------------------------------------------------------
/TabularCompiler/Target.fs:
--------------------------------------------------------------------------------
1 | namespace MicrosoftResearch.Infer.Tabular
2 |
3 |
4 | module Target =
5 |
6 | module Tabular = Syntax
7 |
8 | type r = string
9 | type v = string
10 |
11 | type T = Tabular.ColumnType
12 |
13 | type C = Tabular.Constant
14 |
15 | type E =
16 | | Var of v
17 | | Rng of r
18 | | IndexRng of E * r
19 | | Const of C
20 | | Prim of (Tabular.Prim * E list) //TODO: restrict to v list
21 | | Dist of (Tabular.Dist * E list)
22 | | Index of E * E // array indexing
23 | // used for symmetry breaking
24 | | InitialiseTo of E * obj // obj must be a distribution
25 |
26 | type S =
27 | | CloneRng of r * r
28 | | LetRng of r * v
29 | | LetNew of v * T
30 | | LetVar of v * E
31 | | LetArray of v * r * T
32 | | ForEach of r * S
33 | | ForLoop of r * v * S
34 | | IfNot of v * S
35 | | If of v * S
36 | | SetTo of v * E
37 | | AssignIndex of v * E * E
38 | | Assign of v * r * E
39 | | Seq of S * S
40 | | ObserveValue of v * T * obj
41 | | Skip
42 | | Switch of v * S
43 | | SetValueRange of v * r
44 | | LetCopy of v * E
45 |
46 |
47 |
48 | let size(tn) = tn+"_"+"size"
49 | let col(tn:string,cn) = tn+"_"+cn
50 |
51 | let input(tn,cn) = col("in",col(tn,cn))
52 | let output(tn,cn) = col("out",col(tn,cn))
53 |
54 | let subarraysize(tn:string,cn) = tn+"_"+cn+"_"+"size"
55 | let subarrayrange(tn:string,cn) = tn+"_"+cn+"_"+"range"
56 | let subarrayindices(tn:string,cn) = tn+"_"+cn+"_"+"indices"
57 | let subarray(tn:string,cn) = tn+"_"+cn+"_"+"subarray"
58 | let colfield(tn:string,cn,fld) = tn+"_"+cn+"_"+fld
59 | let range(tn:string) = tn+"_range"
60 | let mutable i = 0
61 | let fresh() =
62 | i <- i + 1
63 | "v"+i.ToString()
64 |
65 |
--------------------------------------------------------------------------------
/TabularCompiler/packages.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
--------------------------------------------------------------------------------
/packages/repositories.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
--------------------------------------------------------------------------------