Haskell 回溯

Question

两个朋友 P1 和 P2 向共同的朋友 P3 发送相同的消息 M。

但是由于网络问题，P3一次只能接收到一个字符不知道接收到的字符是属于P1还是P2

此外，P3 可能从 P1 接收 X 个字符，然后从 P2 接收 Y 个字符，反之亦然，但无论顺序如何，P3 都将接收 P1 和 P2 发送的 ALL 个字符。

给定 P3 收到的字符序列 S 帮助他确定仅由 0 和 1 组成的初始消息 M

请注意，问题的解决方案可能不止一种，但只有一种也可以。

示例：

1) S = [0,1,0,0,1,0] then M = "010"

2) S = [0,0,1,1,0,0,1,1,0,0] then M = "01010" or M = "00110"

明确每个字符的顺序和归属：

Say M = "cat" then S might be :
    
    1) [c1,c2,a2,t2,a1,t1]

    2) [c1,a1,t1,c2,a2,t2]
    
    3) [c1,c2,a1,a2,t2,t1]

其中xi代表：角色x属于第i个人

鉴于 P1 和 P2 发送相同的消息，那么：

P1 和 P2 可以发送固定数量的 0
P1和P2也可以发送固定数量的1
M的长度显然是偶数

起初我使用 Prolog 和 A 的 (0) 和 B 的 (1) 实现了上面的谓词，其中回溯相当容易并且我应用了一个修剪我的搜索树的约束，这样我的方法就不是蛮力方法了：

序言代码：

countCharacters([],A,B,A,B).

countCharacters([C|T],A,B,X,Y) :-                           % Count A's per person and B's per person
       (C == a -> A1 is A + 1,countCharacters(T,A1,B,X,Y);
        B1 is B + 1,countCharacters(T,A,B1,X,Y)).

countCharacters(L,A,B) :-
    countCharacters(L,0,0,X,Y),
    A is X / 2,
    B is Y / 2.

rightOrder([],_) :- !.

rightOrder(_,[]) :- !.

rightOrder([C1|_],[C2|_]) :- C1 \= C2,!,false.

rightOrder([C|T1],[C|T2]) :-                   % Constraint that checks if two lists have the same order
        rightOrder(T1,T2).

determine([],M1,M2,_,_,_,_,M1) :- M1 == M2,!.

determine(L,M1,M2,A1,B1,A2,B2,X) :-
            A1 == 0,
            B1 == 0,
            append(M2,L,NM2),
            rightOrder(M1,NM2),
            determine([],M1,NM2,A1,B1,A2,B2,X).

determine([a|T],M1,M2,A1,B1,A2,B2,X) :-
            A1 > 0,
            NA1 is A1 - 1,
            append(M1,[a],NM1),
            determine(T,NM1,M2,NA1,B1,A2,B2,X).

determine([b|T],M1,M2,A1,B1,A2,B2,X) :-
            B1 > 0,
            NB1 is B1 - 1,
            append(M1,[b],NM1),
            determine(T,NM1,M2,A1,NB1,A2,B2,X).

determine([a|T],M1,M2,A1,B1,A2,B2,X) :-
            A2 > 0,
            NA2 is A2 - 1,
            append(M2,[a],NM2),
            rightOrder(M1,NM2),
            determine(T,M1,NM2,A1,B1,NA2,B2,X).

determine([b|T],M1,M2,A1,B1,A2,B2,X) :-
            B2 > 0,
            NB2 is B2 - 1,
            append(M2,[b],NM2),
            rightOrder(M1,NM2),
            determine(T,M1,NM2,A1,B1,A2,NB2,X).

determine(L,M) :-
    countCharacters(L,AS,BS),
    determine(L,[],[],AS,BS,AS,BS,M).

上面的代码没有那么优化，因为我研究 Prolog 才几个星期，但是我需要一些帮助或了解如何在 Haskell 中实现相同的谓词，因为我没有关于如何回溯的线索。

如果您需要更多说明，请告诉我。

Answer 1

在 Haskell 中执行此操作的一种低效方法是使用模拟不确定性的列表 monad。

找到解决方案的一种方法是从相反的方向考虑问题：您将如何生成消息交错的可能方式？基本上对于输出中的每个元素，都可以选择从一个发送者或另一个发送者那里获取它，或者如果一个发送者有运行个元素，则所有剩余元素将来自同一发送者。字面表达：

-- Compute all the possible interleavings of a list with itself.
interleavings :: [a] -> [[a]]
interleavings xs0 = go xs0 xs0
  where

    -- If the first list has run out,
    -- return the remainder of the second.
    go [] rs = pure rs

    -- And vice versa.
    go ls [] = pure ls

    -- If both lists are nonempty:
    go ls@(l : ls') rs@(r : rs') = do

      -- Toss a coin;
      choice <- [False, True]

      case choice of

        -- If tails, take an element from the left sender
        -- and prepend it to all possible remaining interleavings.
        False -> fmap (l :) (go ls' rs)

        -- If heads, take from the right sender.
        True -> fmap (r :) (go ls rs')

请注意，这会生成许多重复条目，因为它不会回溯或 p运行e:

> interleavings "10"
["1010","1100","1100","1100","1100","1010"]

但是，它确实指明了解决方案的起点。您想运行反向执行上述过程：给定交错，生成一系列选择并假设每个元素都来自假设列表，跟踪去交错列表.如果最后它们相等，那么它们代表有效的去交错：

-- The possible deinterleavings of a list
-- whose elements can be compared for equality.
deinterleavings :: (Eq a) => [a] -> [[a]]

-- Begin searching assuming no elements have been sent by either sender.
deinterleavings xs0 = go [] [] xs0
  where

    -- If there is an element remaining:
    go ls rs (x : xs) = do

      -- Toss a coin;
      choice <- [False, True]

      case choice of

        -- If tails, assume it came from the left sender and proceed.
        -- (Note that this accumulates in reverse, adding to the head.)
        False -> go (x : ls) rs xs

        -- If heads, assume the right sender.
        True -> go ls (x : rs) xs

    -- If there are no elements remaining:
    go ls rs [] = do

      -- Require that the accumulated messages be identical.
      guard (ls == rs)

      -- Return the (de-reversed) message.
      pure (reverse ls)

同样，这是非常低效的：

> deinterleavings "0011001100"
["00110","00110","01100","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01100","01100","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01010","01100","00110","00110"]

但我希望它能说明您可以改进的解决方案的一般结构。

考虑如何更早地引入守卫，或者以不同的方式积累元素以进行搜索；运行或使用不同的 monad 进行回溯，如 Logic; or maintain a stateful set of results with State (or even IO) so that you can check during the computation which results you’ve already seen. Also consider how you could approach the problem from another angle entirely, based on the fact that the interleaved message contains the same string twice as subsequences，因为对于“最长公共子序列”和“最长重复子序列”有标准高效的记忆算法。

Haskell 回溯

Haskell backtracking

recursion

haskell

functional-programming

predicate

backtracking