Haskell 回溯

编程问答 2022-06-02

问题描述

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

但是由于一些网络损坏，P3 一次只能收到一个字符不知道收到的字符是属于 P1 还是 P2。

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

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

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

示例：

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

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

澄清每个字符的顺序和所有权：

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

    2) [c1,t1,t2]
    
    3) [c1,t1]

其中xi代表：字符x属于人i。

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

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

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

序言代码：

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

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

countCharacters(L,B) :-
    countCharacters(L,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,A2,B2,X) :-
            A1 == 0,B1 == 0,append(M2,L,NM2),rightOrder(M1,determine([],NM2,X).

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

determine([b|T],X) :-
            B1 > 0,NB1 is B1 - 1,[b],NB1,X) :-
            A2 > 0,NA2 is A2 - 1,NA2,X) :-
            B2 > 0,NB2 is B2 - 1,NB2,X).

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

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

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

解决方法

在 Haskell 中执行此操作的一种低效方法是使用 list 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')

请注意，这会生成许多重复条目，因为它不会回溯或修剪：

> interleavings "10"
["1010","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,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","00110"]

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

考虑如何更早地引入守卫，或以不同的方式累积元素以修剪搜索；或使用不同的 monad 进行回溯，如 Logic;或者使用 State（甚至 IO）维护一组有状态的结果，以便您可以在计算过程中检查您已经看到的结果。还要考虑如何从另一个角度完全解决问题，基于交错消息包含与 subsequences 相同的字符串两倍的事实，因为对于“最长公共子序列”和“最长公共子序列”有标准的高效记忆算法重复子序列”。

backtrackingfunctional-programminghaskellhaskellpredicaterecursion