locked
Embedding an arithmetic DSL in F# RRS feed

  • Question

  •     Hello,
    I have to embed a DSL for linear programming (MILP) in F# as close as possible to the following example (dedicated language).
    [Syntax example]
     {string} teams = {"ATL", "NYM", "PHI", "MON"};
     int distance [teams][teams] = [
       [0, 745, 665, 929],
       [745, 0, 80, 337],
       [665, 80, 0, 380],
       [929, 337, 380, 0]
     ];
    
     int nbTeams = card (teams);
     int firstDay = 1;
     int lastDay = 2 * nbTeams - 2 + 1;
     range days = firstDay..lastDay; 
    	
     //dvar float travels [teams][days][teams][teams];
     dvar int travels [teams][days][teams][teams] in 0..1;
    
     dexpr int cost [t in teams] = sum (i, j in teams, d in days) distance[i][j] * travels[t][d][i][j];
    
     minimize sum (t in teams) cost[t];
    
     constraints {
    
       // Teams follows a route
       forall (t in teams, d in days, j in teams : (d + 1) in days)
    	  sum (i in teams) travels[t][d][i][j] == sum (k in teams) travels[t][d + 1][j][k];
    
       // Each team plays each other other once home, once away
       forall (t, s in teams : t != s) sum (i in teams, d in days : i != s) travels[t][d][i][s] == 1;
    
       // If team A visits B then B plays at home
       forall (t in teams, d in days : d != lastDay)
           sum (j in teams) travels[t][d][j][t] == sum (s, j in teams : s != t) travels[s][d][j][t];
    
       // No repeaters
       forall (s, t in teams, d in days : s != t && (d + 1) in days)
         sum (j in teams) travels[s][d][j][t] + sum (j in teams) travels[t][d + 1][j][s] <= 1;
    }
    
    [End syntax example]
    I still have trouble with
    - multidimensional sparse arrays with .[] syntax
    - sum keyword and similar operators
    - message saying I shouldn't be redefining the comparison operator
    Till now I have used objects with operator overloading, I was thinking of combining that with quotes. However, because the quotes are typed I still need something that typechecks even with phony semantics before I can process the quote.
    Here is as far as I got
    type ExprA =
        | Var of string * int list
        | IntConstant of int
        | FloatConstant of float
        | Plus of ExprA * ExprA
        | Minus of ExprA * ExprA
        | Times of ExprA * ExprA
    
    type Comparison = Leq | Eq | Geq
    type ConstrA = ExprA * Comparison * ExprA
    type Constraint (c : ConstrA) = member v.content = c
    
    let inline (<=) x y = ((^a or ^b): (static member (<=) : ^a * ^b -> ^c) (x,y))
        
    type Expr (e : ExprA) =
        member v.content = e
        static member (+) (e1 : int, e2 : Expr) = Expr (Plus (IntConstant (e1), e2.content))
        static member (+) (e1 : Expr, e2 : Expr) = Expr (Plus (e1.content, e2.content))
        static member (-) (e1 : Expr, e2 : Expr) = Expr (Minus (e1.content, e2.content))
        static member (*) (e1 : int, e2 : Expr) = Expr (Times (IntConstant (e1), e2.content))       
        static member (*) (e1 : float, e2 : Expr) = Expr (Times (FloatConstant (e1), e2.content))       
        static member (*) (e1 : Expr, e2 : Expr) = Expr (Times (e1.content, e2.content))
        static member (<=) (e1 : Expr, e2 : int) = Constraint (e1.content, Leq, IntConstant(e2))
        static member (<=) (e1 : Expr, e2 : float) = Constraint (e1.content, Leq, FloatConstant(e2))
        static member (<=) (e1 : Expr, e2 : Expr) = Constraint (e1.content, Leq, e2.content)
        static member (==) (e1 : Expr, e2 : int) = Constraint (e1.content, Eq, IntConstant (e2))
        static member (==) (e1 : Expr, e2 : float) = Constraint (e1.content, Eq, FloatConstant (e2))
        static member (==) (e1 : Expr, e2 : Expr) = Constraint (e1.content, Eq, e2.content)
        
    let UIDcounter = ref 0
    
    type dvar<'T> (indexes : int seq) =
        let mutable name = incr UIDcounter; "Var" + string(!UIDcounter)
        let indexes = Set.ofSeq (indexes)
        member t.Item with get i = if indexes.Contains i then new Expr (Var (name, [i])) else failwith ("out of bounds " + name + " : " + string(i))
    
    // Testing
    let cities = [0..10]
    let teams = Set.ofSeq (seq { for x in 0..10 -> x }) // add workflow for sets : set { for x in 0..10 -> x }
    
    let y = dvar<float> [0..10] 
    let x = dvar<int> cities    
    let z = dvar<bool> teams
    
    x.[10] // add pretty printer for dvars
    y.[11]
    3 * x.[10]
    3 * x.[10] + 2 * x.[9]
    3.0 * y.[10]
    3 * y.[10]
    Seq.fold (fun total x -> total + x) x.[0] (seq {for i in 1..10 -> x.[i]})
    
    x.[10] == x.[9]
    x.[10] == 9
    3 * x.[10] + 2 * x.[9] == 9
    y.[10] == x.[9]
    y.[10] == 9.5
    y.[10] == 9
    3 * y.[10] + 2 * y.[9] == 9
    
    [for i in 0..10 -> i * x.[i] == 3]
    seq { for i in 0..10 do for j in 0..10 -> (i + j) * x.[i] == j }
    
    seq { 
            // Constraint A
            for i in 1..2 do yield i * x.[i] == i 
    
            // Constraint B
            for j in 3..4 -> j * x.[j] == j
        }
    
    x.[10] <= x.[5] 
    x.[10] <= 5
    x.[10] <= 5.5
    2 * x.[10] <= 5 * x.[5] 
    x.[10] <= y.[5]
    3 + 3 * x.[10] + 2.5 * x.[9] + 2 * y.[1] <= 9


    Friday, September 23, 2011 8:42 AM

Answers

  • A few thoughts:

     

    What exactly are your problems with multidimensional arrays? Note that you can implement the getter for the Item member to take more than 1 argument as a means to achieve the syntax in your example. That is:

    As far as quotations, there is an untyped variant using <@@ ... @@> which combined with the splicing operator may help depending on your particular problem.

    type T() =
        member this.Item with get(x,y) = 1
        member this.Item with get(x,y,z) = 2
    
    let x = T()
    x.[1,2]
    x.[1,2,3]

    Can you elaborate on the problem with comparison operators? Why not implement IComparable as the warnings suggest? Or else just make the operators traditional functions that take arguments of Expr/ExprA?

    Thursday, September 29, 2011 10:48 PM

All replies

  • A few thoughts:

     

    What exactly are your problems with multidimensional arrays? Note that you can implement the getter for the Item member to take more than 1 argument as a means to achieve the syntax in your example. That is:

    As far as quotations, there is an untyped variant using <@@ ... @@> which combined with the splicing operator may help depending on your particular problem.

    type T() =
        member this.Item with get(x,y) = 1
        member this.Item with get(x,y,z) = 2
    
    let x = T()
    x.[1,2]
    x.[1,2,3]

    Can you elaborate on the problem with comparison operators? Why not implement IComparable as the warnings suggest? Or else just make the operators traditional functions that take arguments of Expr/ExprA?

    Thursday, September 29, 2011 10:48 PM
  • I more or less fixed all the issues with the sparseArrays (mainly due to the fact that type constraints are a bit surprizing in F# in the sense that sometimes F# compiles and typechecks things that don't fully work). Still working on the quotes. I suggest closing this questions and adressing specific questions in separate threads.
    Thursday, October 6, 2011 8:25 AM