4 people like it.

RSK algorithm

Implements a bijective mapping between permutations and pairs of standard Young tableaux, both having the same shape. http://en.wikipedia.org/wiki/Robinson%E2%80%93Schensted_correspondence

 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: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
let snoc p ls = ls @ [p]

let bump q L = 
    let rec loop P i = function
        | [] -> (None, snoc q P,i)
        | p::tail -> if (p<q) then loop (snoc p P) (i+1) tail
                              else (Some(p), P @ (q::tail),1) 
    loop [] 1 L;;

// Schensted insertion procedure
let insert q T =
    let rec loop q P i = function
        |[] -> snoc [q] P,(i,1)
        |p::tail -> let t = bump q p
                    match t with 
                    |None   ,L,x  -> (snoc L P) @ tail,(i,x)
                    |Some(r),L,_  -> loop r (snoc L P) (i+1) tail
    loop q [] 1 T ;;

let convert p =
    Seq.groupBy (fun ((x,_),_) -> x) p 
    |> Seq.toList
    |> List.sortBy (fun (a,_) -> a)
    |> List.map (fun (_,b) -> Seq.sortBy (fun ((_,y),_) -> y) b
                              |> Seq.toList 
                              |> List.map (fun (_,v) -> v))

let rsk L = 
    let rec loop Q P i = function
        |[] -> Q,P
        |p::tail -> 
                    let u,pos = insert p Q
                    loop u (snoc (pos,i) P) (i+1) tail
    let a,b = loop [] [] 1 L in a, convert b;;

let P1,Q1  = rsk [4;2;7;3;6;1;5];
let P2,Q2 = rsk [7;2;8;1;3;4;10;6;9;5];  

// The lenght of the longest rising subsequence in a permutation is equal
//to the lenght of the first row of its RSK-corresponding Young tableaux

let shape_of tableaux  = 
    let rec loop S = function
        |[] -> S
        |p::tail -> loop (snoc (List.length p) S) tail
    loop [] tableaux;;

let len = List.head (shape_of P2)
val snoc : p:'a -> ls:'a list -> 'a list

Full name: Script.snoc
val p : 'a
val ls : 'a list
val bump : q:'a -> L:'a list -> 'a option * 'a list * int (requires comparison)

Full name: Script.bump
val q : 'a (requires comparison)
val L : 'a list (requires comparison)
val loop : ('a list -> int -> 'a list -> 'a option * 'a list * int) (requires comparison)
val P : 'a list (requires comparison)
val i : int
union case Option.None: Option<'T>
val p : 'a (requires comparison)
val tail : 'a list (requires comparison)
union case Option.Some: Value: 'T -> Option<'T>
val insert : q:'a -> T:'a list list -> 'a list list * (int * int) (requires comparison)

Full name: Script.insert
val T : 'a list list (requires comparison)
val loop : ('b -> 'b list list -> int -> 'b list list -> 'b list list * (int * int)) (requires comparison)
val q : 'b (requires comparison)
val P : 'b list list (requires comparison)
val p : 'b list (requires comparison)
val tail : 'b list list (requires comparison)
val t : 'b option * 'b list * int (requires comparison)
val L : 'b list (requires comparison)
val x : int
val r : 'b (requires comparison)
val convert : p:seq<('a * 'b) * 'c> -> 'c list list (requires comparison and comparison)

Full name: Script.convert
val p : seq<('a * 'b) * 'c> (requires comparison and comparison)
module Seq

from Microsoft.FSharp.Collections
val groupBy : projection:('T -> 'Key) -> source:seq<'T> -> seq<'Key * seq<'T>> (requires equality)

Full name: Microsoft.FSharp.Collections.Seq.groupBy
val x : 'a (requires comparison)
val toList : source:seq<'T> -> 'T list

Full name: Microsoft.FSharp.Collections.Seq.toList
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  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 sortBy : projection:('T -> 'Key) -> list:'T list -> 'T list (requires comparison)

Full name: Microsoft.FSharp.Collections.List.sortBy
val a : 'a (requires comparison)
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val b : seq<('a * 'b) * 'c> (requires comparison and comparison)
val sortBy : projection:('T -> 'Key) -> source:seq<'T> -> seq<'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Seq.sortBy
val y : 'b (requires comparison)
val v : 'c
val rsk : L:'a list -> 'a list list * int list list (requires comparison)

Full name: Script.rsk
val loop : ('b list list -> ((int * int) * int) list -> int -> 'b list -> 'b list list * ((int * int) * int) list) (requires comparison)
val Q : 'b list list (requires comparison)
val P : ((int * int) * int) list
val p : 'b (requires comparison)
val tail : 'b list (requires comparison)
val u : 'b list list (requires comparison)
val pos : int * int
val a : 'a list list (requires comparison)
val b : ((int * int) * int) list
val P1 : int list list

Full name: Script.P1
val Q1 : int list list

Full name: Script.Q1
val P2 : int list list

Full name: Script.P2
val Q2 : int list list

Full name: Script.Q2
val shape_of : tableaux:'a list list -> int list

Full name: Script.shape_of
val tableaux : 'a list list
val loop : (int list -> 'b list list -> int list)
val S : int list
val p : 'b list
val tail : 'b list list
val length : list:'T list -> int

Full name: Microsoft.FSharp.Collections.List.length
val len : int

Full name: Script.len
val head : list:'T list -> 'T

Full name: Microsoft.FSharp.Collections.List.head
Raw view Test code New version

More information

Link:http://fssnip.net/8k
Posted:12 years ago
Author:Ademar Gonzalez
Tags: math , mathematics , algorithm , young tableaux , rsk , combinatorics