Back to Questions
5.1k
views8
comments
split a list in sublist ?
f#

suppose I have a list

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; ... ]

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

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

1
2
3
4
5

  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:

1

   [ A; B; A; C; D; C; A; D; D; A; E; ... ]

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

.
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

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]
By on 9/2/2008 6:50 AM ()

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

 
/// 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.

1
2
3
4
5
6
7
8
9

 

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:

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

 

/// 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

1
2
3
4
5
6
7
8
9

 

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.SubsequenceForName 'A'
By on 9/5/2008 6:54 AM ()

Hi Don,

how should your previous code be modified in order to use the Equality and Comparison Constraints?

thanks!

By on 12/24/2009 9:11 AM ()

I came up with the following code,

1
2
3
4
5
6
7
8

>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']

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

By on 7/6/2008 4:19 PM ()

Thank you (aChrisSmith, gneverov and code17)

I think the functional programming is not really obvious.

My impression is that whenever we have to find a trick.
But once found, the code is short and elegant.

The imperative programming seems easier to understand.
But in this case, it seems to me that this would be very difficult to do in C++ or C#.

By on 7/6/2008 4:51 PM ()

Hi jonaas,

A similar problem was discussed in this thread [link:cs.hubfs.net]. A solution to your problem build upon the solution from this thread is.

1
2
3
4
5
6
7

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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 []
By on 7/6/2008 7:13 AM ()

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 :)

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

#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 :)

By on 7/4/2008 9:19 PM ()

Thank you

Finally it does not seem obvious.
But I began to functional programming (F#)

I thought a code without "if ... then .. else ...".
I look at everything.

The "reduceList" is ... (euh!) ... mysterious
Again thank you.

By on 7/4/2008 10:08 PM ()

    Topic tags

    IntelliFactory Offices Copyright (c) 2011-2012 IntelliFactory. All rights reserved.
    Home | Products | Consulting | Trainings | Blogs | Jobs | Contact Us | Terms of Use | Privacy Policy | Cookie Policy     		Built with WebSharper