0 people like it.

Outer product (aka outer join) of n lists

I recently wrote a program to automatically solve a category of logic puzzles, alone the lines of 'four men walked into a bar, one who drinks Guinness never pays darts...' The objective is to find a unique combination of attributes - name, age, favorite drink, favorite pub activity etc. I decided on a brute force approach, in which I generate every combination of attributes, apply a set of rules, and then inspect for the one unique solution. My solution starts with producing a list of lists of attributes.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
(* fn is a function which specifies how to join an item from list a to an item from list b *)
let rec outerProduct fn a b =
    match b with 
    |[] -> []
    |h::t -> List.append (List.map (fn h) a) (outerProduct fn a t)

// And this is a sample of how I used this:

type Name = { FirstName:string; LastName:string; Age:int}

// makeName gets successively curried down the pipeline, until it finally generates the record at then end
let makeName a b c = { FirstName = a; LastName = b; Age = c}

let l1 = 
    ["bill"; "Fred"; "James"]  
    |> List.map (fun x -> makeName x) 
    |> outerProduct (fun f p -> f p) ["Smith"; "Jones"]
    |> outerProduct (fun f p -> f p) [21; 22]

(* This produces the output:
 [
    {FirstName = "bill"; LastName = "Smith"; Age = 21;}; 
    {FirstName = "bill"; LastName = "Smith"; Age = 22;}; 
    {FirstName = "bill"; LastName = "Jones"; Age = 21;}; 
    {FirstName = "bill"; LastName = "Jones"; Age = 22;}; 
    {FirstName = "Fred"; LastName = "Smith"; Age = 21;};
    {FirstName = "Fred";LastName = "Smith";Age = 22;}; 
    {FirstName = "Fred";LastName = "Jones";Age = 21;}; 
    {FirstName = "Fred"; LastName = "Jones"; Age = 22;}; 
    {FirstName = "James"; LastName = "Smith"; Age = 21;}; 
    {FirstName = "James"; LastName = "Smith"; Age = 22;};
    {FirstName = "James";LastName = "Jones";Age = 21;}; 
    {FirstName = "James";LastName = "Jones";Age = 22;}
 ]

*)
val outerProduct : fn:('a -> 'b -> 'c) -> a:'b list -> b:'a list -> 'c list

Full name: Script.outerProduct
val fn : ('a -> 'b -> 'c)
val a : 'b list
val b : 'a list
val h : 'a
val t : 'a list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val append : list1:'T list -> list2:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.append
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
type Name =
  {FirstName: string;
   LastName: string;
   Age: int;}

Full name: Script.Name
Name.FirstName: string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
Name.LastName: string
Name.Age: int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val makeName : a:string -> b:string -> c:int -> Name

Full name: Script.makeName
val a : string
val b : string
val c : int
val l1 : Name list

Full name: Script.l1
val x : string
val f : (string -> int -> Name)
val p : string
val f : (int -> Name)
val p : int

More information

Link:http://fssnip.net/7UN
Posted:4 months ago
Author:billhay
Tags: #crossproduct , #outerproduct , #currying