2

好的,所以我正在尝试编写一个回溯算法,它可以接受如下输入:

0 2 3 1 (top-right location, length, horizontal or vertical)
1 0 4 0
2 2 4 0
1 3 3 1
top (the actual words)
that
toga
cat

并吐出一个填字游戏,例如:

**c***
that**
**toga
***p**

到目前为止我的代码是:

//prints the puzzle
let printPuzzle (puzzle : char[,]) =
    printfn "%s" ""
    printfn "%A" puzzle
    printfn "%s" ""

//checks if the words fits
let rec doesItFit place (puzzle : char[,]) (word : seq<char>) =
    let (row, col, length, isVertical) = place
    if length <> (Seq.length word) then
        (puzzle, false)
    else
        match (Seq.toList word) with
        | [] -> (puzzle, true)
        | letter::rest ->
            printfn "%c" letter
            printPuzzle puzzle
            if isVertical = 0 then
                if puzzle.[row, col] = '*' || puzzle.[row, col] = letter then
                    puzzle.[row, col] <- letter
                    doesItFit (row, col+1, length-1, isVertical) puzzle rest 
                else
                    (puzzle, false)
            else
                if puzzle.[row, col] = '*' || puzzle.[row, col] = letter then
                    puzzle.[row, col] <- letter
                    doesItFit (row+1, col, length-1, isVertical) puzzle rest   
                else
                    (puzzle, false)

//the actual backtracking algorithm... goes through all places and all words
//trying to make stuff fit
let rec sort words places (puzzle : char[,]) =
    match places with
    | [] -> (puzzle, true)
    | place::rest ->
        let rec checkWords words place puzzle =
            match words with
            | [] ->
                printfn "%s" "failure, backtracking" 
                puzzle, false
            | word::otherWords ->
                let attempt = doesItFit place puzzle word
                if snd attempt then
                    printfn "%s" "success, entering if block"
                    let nextLevel = sort words rest (fst attempt)
                    if (snd nextLevel) then
                        nextLevel
                    else
                        checkWords otherWords place puzzle
                else
                    checkWords otherWords place puzzle
        checkWords words place puzzle

//line for testing
printPuzzle (fst (sort ["cat"; "that"; "toga"; "top"] [(0, 2, 3, 1); (1, 0, 4, 0); (2, 2, 4, 0); (1, 3, 3, 1)] (Array2D.create 6 6 '*')));;

这是运行测试行的输出:

c

[['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

a

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['*'; '*'; 'a'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

success, entering if block
t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['*'; '*'; 'a'; '*'; '*'; '*']
 ['*'; '*'; 't'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

h

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; '*'; 'a'; '*'; '*'; '*']
 ['*'; '*'; 't'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

a

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; '*'; '*'; '*']
 ['*'; '*'; 't'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; '*'; '*'; '*']
 ['*'; '*'; 't'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

success, entering if block
t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

h

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

a

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

success, entering if block
t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

o

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

failure, backtracking
t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

o

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

failure, backtracking
t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

o

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

failure, backtracking
t

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

failure, backtracking

[['*'; '*'; 'c'; '*'; '*'; '*']
 ['t'; 'h'; 'a'; 't'; '*'; '*']
 ['*'; '*'; 't'; 'h'; 'a'; 't']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']
 ['*'; '*'; '*'; '*'; '*'; '*']]

认为我的问题是我不确定 F# 中的不变性是如何工作的。从我的程序所做的看来,当拼图在尝试失败后传入时,拼图已被修改。这对我来说没有多大意义,因为我认为 F# 不会让它被修改。我想要解释为什么这段代码在回溯后测试单词时使用修改后的谜题,而不是原始的、未修改的谜题。

4

1 回答 1

5

您的代码使用可变数组char[,]来表示拼图,因此当您在doesItFit函数中对其进行变异(使用<-运算符)时,您实际上是在更改对象的状态。当代码从doesItFit函数返回时,数组已经改变。

解决问题的方法主要有以下三种:

  • 使用不可变类型来表示谜题 - 如果你使用 F# list(列表列表)来表示谜题,那么你不能改变它(因为列表是不可变的),所以你不会陷入这种情况

  • 根据需要克隆对象 - 您不必使用不可变类型来编写函数式代码。只需在将数组传递给可能对其进行变异的函数之前克隆数组。你可以使用Array.copy它。

  • 恢复回溯前的状态 - 当函数失败时,它应该撤消所有修改
    (这不是纯粹的函数方法,但它可能更有效 - 将其视为优化)

于 2012-05-06T23:33:07.920 回答