以最小的成本使列表中的所有元素相等

make all elements in list equal with minimal cost

我正在尝试创建一个 prolog 程序,该程序允许将列表转换为具有相同长度的列表,该列表仅由原始列表中的 1 个元素组成。必须以这样的方式选择此元素,即需要更改原始列表中的元素数量最少,并且所有解决方案都通过回溯提供,例如[a,b] 可以变成 [a,a][b,b][a,b,a] 应该变成 [a,a,a].

您可能已经注意到,这与查找出现次数最多的元素并创建一个与仅包含该元素的原始列表长度相同的新列表是同一个问题。这导致了以下代码:

make_all_equal(List, Cost, Result):-
    sort(0, @=<, List, Sorted),
    occurs_most(Sorted, X, Nr),
    length(List, N),
    Cost is N - Nr,
    repeat(X, N, Result).

occurs_most([], _, 0).
occurs_most([E|List], X, Nr):-
    count(E, List, 1, N, Left),
    occurs_most(Left, Y, Nr1),
    (Nr1 =:= N ->
        (X = Y, Nr = Nr1
        ; X = E, Nr = N)                % I would like some backtracking here
    ;
        (Nr1 > N ->
            X = Y, Nr = Nr1
        ;
            X = E, Nr = N
        )
    ).

count(_, [], Acc, Acc, []).
count(X, [X|T], Acc, N, Tail):-
    Acc1 is Acc + 1,
    count(X, T, Acc1, N, Tail).
count(X, [Y|T], Acc, Acc, [Y|T]):- 
    X \= Y.

repeat(_, 0, []):- !.                   % There is no existing predicate, is there?
repeat(X, N, [X|T]):- 
    N > 0, 
    N1 is N - 1, 
    repeat(X, N1, T).

此代码有效,但您可能已经注意到,occurs_most/3 的定义对于所有这些 if 语句来说看起来很糟糕。我也希望能够像我一样通过回溯得到所有解

如果有人能帮助我解决这个看似简单的问题的 occurs_most/3 谓词或更好的解决策略,我将不胜感激。恐怕我已经尝试了太久了。

PS:这不是作业,而是类似于第 100 个序言问题...

确定性变体

首先是一种更有效但确定性的方法:

occurs_most([],_,0).
occurs_most(List,X,Nr) :-
    msort(List,[H|T]),
    most_sort(T,H,1,H,1,X,Nr).

most_sort([Hb|T],Ha,Na,Hb,Nb,Hr,Nr) :-
    !,
    Nb1 is Nb+1,
    most_sort(T,Ha,Na,Hb,Nb1,Hr,Nr).
most_sort([Hc|T],_,Na,Hb,Nb,Hr,Nr) :-
    Nb > Na,
    !,
    most_sort(T,Hb,Nb,Hc,1,Hr,Nr).
most_sort([Hc|T],Ha,Na,_,_,Hr,Nr) :-
    most_sort(T,Ha,Na,Hc,1,Hr,Nr).
most_sort([],Ha,Na,_,Nb,Ha,Na) :-
    Na >= Nb,
    !.
most_sort([],_,_,Hb,Nb,Hb,Nb).

首先,您使用 msort/2 对列表进行排序。然后你遍历列表。每次您跟踪当前最常发生的事件。从新头 Hc 与前一个头 (Hb) 不同的那一刻起,您就知道您将永远不会再次访问 Hb(因为顺序关系的传递性)。所以你一直在计算当前序列中的次数。如果序列结束,则将其与前一个序列进行比较。如果它更大,你接受那个。

非确定性变体

现在我们可以把谓词变成non-determinstic一个:

occurs_most([],_,0).
occurs_most(List,X,Nr) :-
    msort(List,[H|T]),
    most_sort(T,H,1,X,Nr).

most_sort([Ha|T],Ha,Na,Hr,Nr) :-
    !,
    Na1 is Na+1,
    most_sort(T,Ha,Na1,Hr,Nr).
most_sort([Hb|T],Ha,Na,Hr,Nr) :-
    most_sort(T,Hb,1,Hc,Nc),
    (Nc =< Na -> 
        ((Hr = Ha,Nr = Na);
            (Nc = Na ->
                (Hr = Hc,Nr = Nc)
            )
        );
        (Hr = Hc,Nr = Nc)
    ).
most_sort([],Ha,Na,Ha,Na).

这种方法的一个问题是,如果有多个击球点比右边少,我们将重复我们当前的击球点几次(我们稍后会解决这个问题)。例如 (occurs_most([a,b,b,c,d],X,C)) 将给出两次 L=b,C=2 只是因为 cd 一样传播回来;对于两者,我们将通过 b.

在此版本中,我们不需要跟踪当前找到的最大值。我们只处理当前的罢工。从我们到达列表末尾的那一刻起,我们 return 当前罢工的长度。此外,如果我们开始新的罢工,我们首先会查看右侧的罢工。比我们将其与当前的进行比较。如果当前一个小于,我们只让右边的通过。如果这些相等,我们都通过右侧的击球和当前的击球。如果我们自己的罢工比右边的要大,我们只让当前罢工通过。

此算法在 O(n log n)(用于排序)和 O(n) 中运行以查找出现的值大多数。

去掉重复的答案

我们可以去掉重复的答案,只需先构造一袋尾巴罢工:

most_sort([Hb|T],Ha,Na,Hr,Nr) :-
    findall(Hx/Nx,most_sort(T,Hb,1,Hx,Nx),Bag),
    Bag = [_/Nc|_],
    (
        (Nc =< Na -> (Hr = Ha,Nr = Na); fail);
        (Nc >= Na -> member(Hr/Nr,Bag); fail)
    ).

我们知道包里肯定有东西,因为列表右边还有元素,会形成一个新的罢工。我们把这些收集在袋子里。我们还知道这些元素都具有相同的计数(否则它们不会通过其他计数测试)。所以我们从包中取出第一个元素。检查长度,如果长度小于或等于,我们首先回答自己的罢工。如果袋子中的罢工大于或等于,我们传递袋子中的所有成员。

进一步提升

因为你经常使用occurs_most,在同一个列表中,你可以稍微优化一下算法,在make_all_equal方法中只排序一次)。此外,您还可以将 length/2 放在前面,因为列表的长度是固定的,因此您不必在每次找到出现次数最多的值 时都计算长度 。最后你也可以提升repeat/2:只用一个变量构造一个列表,然后实例化单个变量会节省你很多工作(假设列表有数千个元素长,你可以在 O(1)).

中进行实例化
make_all_equal(List, Cost, Result):-
    length(List, N),
    msort(List,Sorted),
    repeat(X, N, Result),
    occurs_most(Sorted, X, Nr),
    Cost is N - Nr.


occurs_most([],_,0).
occurs_most([H|T],X,Nr) :-
    most_sort(T,H,1,X,Nr).

most_sort([Ha|T],Ha,Na,Hr,Nr) :-
    !,
    Na1 is Na+1,
    most_sort(T,Ha,Na1,Hr,Nr).
most_sort([Hb|T],Ha,Na,Hr,Nr) :-
    findall(Hx/Nx,most_sort(T,Hb,1,Hx,Nx),Bag),
    Bag = [_/Nc|_],
    (
        (Nc =< Na -> (Hr = Ha,Nr = Na); fail);
        (Nc >= Na -> member(Hr/Nr,Bag); fail)
    ).
most_sort([],Ha,Na,Ha,Na).

repeat(_, 0, []):-
    !.
repeat(X, N, [X|T]) :-
    N > 0, 
    N1 is N - 1, 
    repeat(X, N1, T).

我的方法是这样的:

make_all_equal( List , Cost , Result ) :-
  frequencies( List , Frequencies ) , % compute the frequency table ordered in descending frequency
  length(List,L) ,                    % get the length of the source list
  member( N:X , Frequencies ) ,       % get a frequency  table entry
  Cost is L-N ,                       % compute the cost
  repeat(X,L,Result)                  % generate the result by repeating the item the right number of times.
  .                                   % Easy!

%
% generate a list consisting of an item X repeated N times.
%
repeat( _ , 0 , []   ) .
repeat( X , N , [X|Xs] ) :- N > 0 , N1 is N-1 , repeat(N1,X,Xs) .

%
% compute a frequency table of pairs (N:X) ordered by descending frequency
%
frequencies( Xs , Fs ) :-
  msort( Xs , S )        , % sort the source list
  compute_freqs( S , R ) , % compute the [unordered] list of frequencies
  msort( Xs , T )        , % sort that by frequency
  reverse( T , Fs )        % reverse it to get descending sequence
  .                        % Easy!

compute_freqs( []     , [] ) .      % empty list? we're done!
compute_freqs( [X|Xs] , Fs ) :-     % otherwise...
  compute_freqs( Xs , X , 1 , Fs )  % - call the worker with the accumulators initialied properly
  .                                 % - Easy!

compute_freqs( []    , X , N , [N:X] ) .     % when the source list is exhausted, put the frequency pair on the result set.
compute_freqs( [H|T] , H , N , Fs ) :-       % otherwise, if we don't have a sequence break...
  N1 is N+1 ,                                % - increment the frequency count
  compute_freqs(T,H,N1,Fs)                   % - recurse down, passing the new frequency count
  .                                          %
compute_freqs( [H:T] , X , N , [N:X|Fs] ) :- % otherwise, put the frequency pair on the result set
  H \= X ,                                   % - assuming we have a sequence break,
  compute_freqs(T,H,1,Fs)                    % - then recurse down, starting a new sequence
  .                                          % Easy!