hubFS: THE place for F#

suppose I have a list

  [1; 6; 7; 8; 1; 8; 7; 4; 3; 2; 1; 6; 7; 8; 1; 6; 5; 1; 9; 1; 6; 5; 1; 6; 7; 8; 1; 9; 1; 9; 1; 6; 7; 8; 1; 3; ... ]

I would spliit this list in list where new list start with number 1

  [  [1; 6; 7; 8] ;  [1; 8; 7; 4; 3; 2] ; [1; 6; 7; 8] ;  [1; 6; 5] ; [1; 9] ; [1; 6; 5] ; [1; 6; 7; 8]; [1; 9]; [1; 9]; [1; 6; 7; 8]; [1; 3]  ... ]

and rename my sublist (I have no exact idea how to rename, but with this small exemple I can rename

  A = [1; 6; 7; 8]
  B = [1; 8; 7; 4; 3; 2]
  C = [1; 6; 5]
  D = [1; 9]
  E = [1; 3]

and original list is now:
   [ A; B; A; C; D; C; A; D; D; A; E; ... ]

this example is "manual" => possible write a small F# code ? hints? suggestion?

 

 

You can break this down into three different problems:

1. Converting the input into a set of sub lists each begining with the number 1
2. Itterating through the first list and describing it as a sequence of sub lists
3. Printing out the resutls

Here is a quick and dirty solution, I'm sure you can make it more efficent :)

 

#light

let input = [1; 6; 7; 8; 1; 8; 7; 4; 3; 2; 1; 6; 7; 8; 1; 6; 5; 1; 9; 1; 6; 5; 1; 6; 7; 8; 1; 9; 1; 9; 1; 6; 7; 8; 1; 3]
printfn "input = %A" input

let foldFunc i acc =
    if acc = [] then
        [ [ i ] ]
    elif List.hd (List.hd acc) = 1 then
        [ i ] :: acc
    else
        (i :: (List.hd acc)) :: (List.tl acc)

// Break it down into sub lists starting with 1
let orgSubLists = List.fold_right foldFunc input [] 
// Make them unique..
let subLists = orgSubLists |> Set.of_list |> Set.to_list

printfn "sub lists = %A" subLists

// Now reduce the origional 
let reduceList list subLists =
    let rec reduceListr list subLists seenSoFar resultsSoFar =
        if list = [] then
            resultsSoFar
        else
            let result = List.tryfind_index (fun subList -> subList = seenSoFar) subLists
            if Option.is_none result then
                reduceListr (List.tl list) subLists (seenSoFar @ [List.hd list]) resultsSoFar
            else
                reduceListr list subLists [] (resultsSoFar @ [Option.get result])
    reduceListr list subLists [] []

let reducedList = reduceList input subLists
printfn "reduced list (indexes) = %A" reducedList

// Now make the results meaningful...
List.iteri (fun i subList -> printfn "%c = %A" (char (65 + i)) subList) subLists

let letteredAnswer = List.map (fun i -> char (65 + i)) reducedList
printfn "Answer = %A" letteredAnswer

(* Output
input = [1; 6; 7; 8; 1; 8; 7; 4; 3; 2; 1; 6; 7; 8; 1; 6; 5; 1; 9; 1; 6; 5; 1; 6; 7; 8; 1;
 9; 1; 9; 1; 6; 7; 8; 1; 3]
sub lists = [[1; 3]; [1; 6; 5]; [1; 6; 7; 8]; [1; 8; 7; 4; 3; 2]; [1; 9]]
reduced list (indexes) = [2; 3; 2; 1; 4; 1; 2; 4; 4; 2]
A = [1; 3]
B = [1; 6; 5]
C = [1; 6; 7; 8]
D = [1; 8; 7; 4; 3; 2]
E = [1; 9]
Answer = ['C'; 'D'; 'C'; 'B'; 'E'; 'B'; 'C'; 'E'; 'E'; 'C']
Press any key to continue . . .
*)

I'll try to blog about this next week to explain how it all works. Nice problem :)

---

http://blogs.msdn.com/chrsmith

Hi jonaas,

A similar problem was discussed in this thread http://cs.hubfs.net/forums/thread/6031.aspx. A solution to your problem build upon the solution from this thread is.

let sublists = f ((=) 1) input

let unique xs = xs |> Set.of_list |> Set.to_list

let answer =
  let lookup = unique sublists
  List.map (fun x -> List.find_index ((=) x) lookup) sublists

Using a set to do the renaming of the sublists is convenient but not terribly efficient. If that's a problem you might want to do something like building a tree to perform list equality tests.

Here's the relevant code from the other thread.

let f p xs =
  let f xs =
    match xs with
    | [] -> None
    | x::xs' -> let ys, zs = break p xs'
                Some (x::ys, zs)
  unfold f xs

let unfold f x =
  let rec unfold' x acc =
    match f x with
    | None -> List.rev acc
    | Some (a, x') -> unfold' x' (a::acc)
  unfold' x []
   
let break p xs =
  let rec break' xs acc =
    match xs with
    | [] -> List.rev acc, []
    | x::_ when p x -> List.rev acc, xs
    | x::xs' -> break' xs' (x::acc)
  break' xs []

I came up with the following code,

[code language=''F#'']
>let trans l =
  let h = HashMultiMap.Create() and i = ref 64 in
  let _,l' = List.fold_right (fun x (tmp,acc) -> if x=1 then [],(x::tmp)::acc else (x::tmp),acc) l ([],[]) in
  List.map (fun x -> match h.TryFind x with Some v -> v | None -> incr i; let c = char_of_int !i in h.Add(x,c); c) l';;
val trans : int list -> char list

>trans [1; 6; 7; 8; 1; 8; 7; 4; 3; 2; 1; 6; 7; 8; 1; 6; 5; 1; 9; 1; 6; 5; 1; 6; 7; 8; 1; 9; 1; 9; 1; 6; 7; 8; 1; 3];;
val it : char list = ['A'; 'B'; 'A'; 'C'; 'D'; 'C'; 'A'; 'D'; 'D'; 'A'; 'E']
[/code]

which seems working. However, I don't know how to generate fresh names, but I guess reflection can do that.

---

Member of Babelnova

module List =
    /// A map function with additional state
    let mapp f state lst =
        let rec mapp_aux f state lst acc =
            if List.is_empty lst then
                List.rev acc
            else
                let elem, state = f (List.hd lst) state
                mapp_aux f state (List.tl lst) (elem :: acc)
        mapp_aux f state lst []

let split elem acc =
    match acc with
    | []        -> [[elem]]
    | (1::_)::_ -> [elem] :: acc
    | h::t      -> (elem :: h) :: t

let next_char c =
    char (int c + 1)

let rename elem (hash, ch) =
    if hash |> Map.mem elem then
        (hash.[elem], (hash, ch))
    else
        (ch, (hash |> Map.add elem ch, next_char ch))

let a = [1;6;7;8;1;8;7;4;3;2;1;6;7;8;1;6;5;1;9;1;6;5;1;6;7;8;1;9;1;9;1;6;7;8;1;3]
let b = List.fold_right split a [] |> List.mapp rename (Map.empty, 'A')
// b = [A; B; A; C; D; C; A; D; D; A; E]

Here is my solution.

First, use a standard sequence-expression with state to accumulate the partial subsequences. Note this portion of the algorithm is, I believe, just as clea in either imperative or functional programming. The key thing is to abstract and encapsulate the imperative programming into a lovely reusable functional programming sequence processor. The F# "Seq" library is full of lots of examples like this.

/// Return all the subsequences starting with a given character. Also return any initial
/// sequence not starting with that character. Do this by keeping an internal accumulator and publishing from it
let SequencesStartingWith n (s:seq<_>) =
    seq { use ie = s.GetEnumerator()
          let acc = new ResizeArray<_>()
          while ie.MoveNext() do
             let x = ie.Current
             if x = n && acc.Count > 0 then
                 yield ResizeArray.to_list acc
                 acc.Clear()
             acc.Add x
          if acc.Count > 0 then
              yield  ResizeArray.to_list acc }

Next, given an initial element "n" and a sequence "s", the analysis is straight forward. Note the use of Seq.distinct to ensure no repeats.

let analyze n s =
    let subsequences = SequencesStartingWith n s |> Seq.distinct |> Seq.to_list
    let subsequenceToName = subsequences |> List.mapi (fun i x -> x,char (int 'A' + i)) |> Map.of_list
    let result = subsequences |> List.map (fun x -> subsequenceToName.[x])
    result

This is OK, but loses information, e.g. what do A and B mean in the result??? This leads is a perfect example of F# object oriented programming to return multiple interesting results from an analysis and give those results good names:

/// Do the subsequence analysis on an input sequence and return an object revealing the
/// forward mapping table 'A' to [1;3;4], the backward mapping table '[1;3;4]' to 'A',
/// the overall result, and the actual unique subsequences found.
type SequenceMarkup<'a>(marker,s:seq<'a>) =
    let subsequences = SequencesStartingWith marker s |> Seq.distinct |> Seq.to_list
    let mapping = subsequences |> List.mapi (fun i x -> x,char (int 'A' + i))
    let subsequenceToName = mapping |> Map.of_list
    let result = subsequences |> List.map (fun x -> subsequenceToName.[x])
    let nameToSubsequence = mapping |> List.map (fun (x,y) -> (y,x)) |> Map.of_list

    /// Get the name corresponding to a particular subsequence
    member x.NameForSubsequence(subsequence) = subsequenceToName.TryFind(subsequence)
   
    /// Get the subsequence corresponding to a particular name
    member x.SubsequenceForName(name) = nameToSubsequence.TryFind(name)

    /// Get the subsequence corresponding to a particular name
    member x.Subsequences = subsequences

    /// Get the input list with subsequences replaced by names
    member x.Result = result

Now run

let markup = SequenceMarkup(1,[1; 6; 7; 8; 1; 8; 7; 4; 3; 2; 1; 6; 7; 8; 1; 6; 5; 1; 9; 1; 6; 5; 1; 6; 7; 8; 1; 9; 1; 9; 1; 6; 7; 8; 1; 3; ])

markup.Result
markup.Subsequences

markup.<FONT size=2>SubsequenceForName 'A'</FONT>