Back to Questions
2.1k
views1
comment
Difficult recursive function problem
f#templates

Suppose I want to write a function like this:

let match (templates:string list) (words: word list) : string list list = ...

The function should work as follows:

templates is a list of strings, where each item in the string is an alphabetic sequence such as ABC, DAD, etc. words is a list of strings of the same format. The purpose of the function is such that if the length of templates is N, the function returns all sequences of N strings such that each string is in "words", each string is used at most once, and there is a direct subtitution of letters that can take you from templates -> result.

I know I'm not explaining this correctly, but it's easily illustrated with an example:

templates = ["ABC"; "DEF"; "BOB"]
words = ["JIM"; "JOE"; "EVE"; "NED"]

The result of the function should be [ ["NED"; "JIM"; "EVE"] ]
This result is possible by the substitution A->N, B->E, C->D, D->J, E->I, F->M, O->V

There are no other possibilities. For example ["JIM"; "EVE"; "JOE"] should not be included in the result set, because that would require B->E (the only way to match EVE), which would then require that whatever maps to JOE end with an B. The only such possibility is BOB, but that does not work because we already know that BOB -> EVE, and not JOE.

Below is a function I have written that does this for single strings against single template.

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

type UniDirectionalMap = (char*char) list
type BiDirectionalMap = UniDirectionalMap*UniDirectionalMap

let rec match_template (orig:BiDirectionalMap) template word (mappings:BiDirectionalMap) = 
    let (tmp_to_word_map,word_to_tmp_map) = mappings
    match (template,word) with
    | ([], _::_) | (_::_, []) -> (false,orig)  //Word and template have different number of letters -> false
    | ([], []) -> (true,mappings)                  //Word and template both empty -> true
    | (thd::ttl, whd::wtl) -> 
        //Get the mapping of this template char, and the inverse mapping of this word char
        let (t_to_w, w_to_t) = (List.try_assoc thd tmp_to_word_map, List.try_assoc whd word_to_tmp_map)
        match (t_to_w, w_to_t) with
        | (None, None) ->               //Good, neither is mapped to anything.  Map them to each other
            let new_fwd = (thd,whd)::tmp_to_word_map
            let new_bkwd = (whd,thd)::word_to_tmp_map
            match_template orig ttl wtl (new_fwd, new_bkwd)
        | (Some _, None) | (None, Some _) -> (false,orig)
        | (Some w, Some t) when (w <> whd || t <> thd) -> (false,orig)
        | (Some _, Some _) -> 
            match_template orig ttl wtl mappings

I believe this function is correct. It takes as input a partial mapping, a template, and a word, and returns two values. The first a boolean that specifies whether this word matches this template, and the second a new mapping which contains the original mapping as well all the new mappings that were determined during the course of the transformation. For example if the original mapping contained only B<->C, but during this transformation we additionally determined that K<->L, then the new mapping should contain B<->C and K<->L. If the match is unsuccessful the function returns the original mapping unmodified

The difficulty arises when trying to find combinations of strings. I feel like this should be possible to do with a recursive function inside another recursive function. But I've been wracking my brain over it for quite a while, and I don't seem to be making much progress. Here's what I have so far (maybe it's better to not even look at this lol, lest it lead you down the wrong path).

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

            
let match_template_wrap (template:string) (word:string) (mappings:BiDirectionalMap) = 
    match_template mappings (Seq.to_list template) (Seq.to_list word) mappings

let match_multi (templates:string list) (words:string list) : (string list list) = 
    let rec match_multi (state:BiDirectionalMap) templates words = 
        match templates with
        | [] -> []::[]           //No words can possibly match an empty template
        | [this_template] -> 
            //If there's only one template, just filter out everything that doesn't match it
            let result = words
                        |> List.map (fun word -> (word,match_template_wrap this_template word state))
                        |> List.filter (fun (s,(b,m)) -> b)
                        |> List.map (fun (s,(_,_)) -> s)
            result::[]
        | this_template::rest -> 
            //All entries in this list matched the template, and produced a new state map
            //For each entry in the list, remove those that do not match this template
            words
            //Match each word against the current template
            |> List.map (fun word -> (word,match_template_wrap this_template word state))
            //Remove those items that did not match this template
            |> List.filter (fun (s,(b,m)) -> b)
            //Get rid of the match boolean flag since they will always be true now
            //For each item that matched this template, take its new map and test
            //the rest of the templates against this new map
            |> List.map_concat (fun (word,(_,map)) -> 
                            let new_words = List.filter (fun w -> w <> word) words
                            match_multi map rest new_words)
            |> Set.of_list |> Set.to_list
    match_multi ([], []) templates words

Any help appreciated

.

Wow, somehow I actually got it. Funny that I'd been working on it for hours, and then like 30 minutes after posting I came up with a solution:

That being said, it's not terribly efficient. If someone could suggest any optimizations I'd appreciate it. I'm pretty sure it's correct

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

let match_multi (templates:string list) (words:string list) : (string list list) = 
    let rec match_multi (state:BiDirectionalMap) templates words builder = 
        match templates with
        | [] -> []::[]           //No words can possibly match an empty template
        | [this_template] -> 
            //If there's only one template, just filter out everything that doesn't match it
            let result = words
                        |> List.map (fun word -> (word,match_template_wrap this_template word state))
                        |> List.filter (fun (s,(b,m)) -> b)
                        |> List.map (fun (s,(_,_)) -> s)
            (List.map (fun x -> x::builder) result)
        | this_template::rest -> 
            //All entries in this list matched the template, and produced a new state map
            //For each entry in the list, remove those that do not match this template
            words
            //Match each word against the current template
            |> List.map (fun word -> (word,match_template_wrap this_template word state))
            //Remove those items that did not match this template
            |> List.filter (fun (s,(b,m)) -> b)
            //Get rid of the match boolean flag since they will always be true now
            //For each item that matched this template, take its new map and test
            //the rest of the templates against this new map
            |> List.map_concat (fun (word,(_,map)) -> 
                            let new_words = List.filter ((<>) word) words
                            match_multi map rest new_words (word::builder))
            |> Set.of_list |> Set.to_list
    match_multi ([], []) templates words []
By on 1/28/2009 6:26 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