使列表中的所有元素等于最低成本

时间:2015-06-17 14:51:34

标签: list optimization prolog

我正在尝试创建一个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个prolog问题......

2 个答案:

答案 0 :(得分:1)

确定性变体

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

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(因为订单关系具有传递性)。因此,您要继续计算当前序列中的次数。如果序列结束,则将其与之前的序列进行比较。如果它更大,你接受那个。

非确定性变体

现在我们可以将谓词转换为非确定性谓词:

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,因为c会传播回d;对于两者,我们将通过b

在此版本中,我们无需跟踪当前找到的最大值。我们只研究当前的焦点。从我们到达列表末尾的那一刻起,我们返回当前罢工的长度。此外,如果我们开始新的罢工,我们首先会看到右边的罢工。比起我们将它与当前的比较。如果当前的一个小于,我们只让右边的那些通过。如果它们相等,我们都会通过右边和当前的攻击。如果我们自己的罢工大于右边的罢工,我们只允许当前罢工通过。

此算法在 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).

答案 1 :(得分:0)

我的方法是这样的:

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!