Prolog僅刪除獨特元素

Question

我想返回一個列表，刪除所有獨特的元素，例如

remUniqueVals([1,1,2,2,3,4,4,5,6,6,6],Q).   
Q = [1,1,2,2,4,4,6,6,6].  

我的問題是，目前我有返回的代碼

remUniqueVals([1,1,2,2,3,4,4,5,6,6,6],Q).  
Q = [1, 2, 4, 6, 6].

這樣只返回這些非唯一值的第一個實例。 這是我的代碼：

remUniqueVals([], []).  
remUniqueVals([Q1|RestQ],[Q1|Xs]) :-        
   member(Q1,RestQ),  
   remUniqueVals(RestQ,Xs).  
remUniqueVals([Q1|RestQ],Xs) :-  
   remove(Q1,[Q1|RestQ], NewQ),  
   remUniqueVals(NewQ,Xs).  

我可以看到member(Q1,RestQ)在第二次檢查1,2,4時失敗，因為它們現在不再在列表中，因此將它們刪除。 我想幫助解決這個問題，我的想法是檢查member(Q1, PreviousQ) ，這是最終Q已經存在的元素。 不知道如何實施，雖然任何幫助將不勝感激。

更新：

好的，謝謝你最終的結論：

remUniqueVals(_,[], []).  
remUniqueVals(_,[Q1|RestQ],[Q1|Xs]) :-        
   member(Q1,RestQ), 
   remUniqueVals(Q1,RestQ,Xs).  
remUniqueVals(PrevQ,[Q1|RestQ],[Q1|Xs]) :-        
   Q1 = PrevQ, 
   remUniqueVals(PrevQ,RestQ,Xs).  
remUniqueVals(PrevQ,[_|RestQ],Xs) :-  
   remUniqueVals(PrevQ,RestQ,Xs). 

remUniqueVals(0,[4,1,1,3,2,2,5,5],Q).
Q = [1, 1, 2, 2, 5, 5].

remUniqueVals(0, [A,B,C], [1,1]).
A = 1,
B = 1,
C = 1.

Answer 1

Prolog規則彼此獨立地讀取，因此對於元素是唯一的而不是元素的情況，需要一個規則。 如果元素的順序不相關，您可以使用：

?- remUniqueVals([A,B,C], [1,1]).
A = B, B = 1,
dif(C, 1) ;
A = C, C = 1,
dif(B, 1),
dif(B, 1) ;
B = C, C = 1,
dif(A, 1),
dif(A, 1) ;
false.

?- remUniqueVals([1,1,2,2,3,4,4,5,6,6,6],Q).
Q = [1, 1, 2, 2, 4, 4, 6, 6, 6] ;
false.

remUniqueVals([], []).
remUniqueVals([Q1|RestQ],[Q1|Xs0]) :-
   memberd(Q1, RestQ),
   phrase(delall(Q1, RestQ, NewQ), Xs0, Xs),
   remUniqueVals(NewQ, Xs).
remUniqueVals([Q1|RestQ],Xs) :-
   maplist(dif(Q1), RestQ),
   remUniqueVals(RestQ,Xs).

memberd(X, [X|_Xs]).
memberd(X, [Y|Xs]) :-
   dif(X,Y),
   memberd(X, Xs).

delall(_X, [], []) --> [].
delall(X, [X|Xs], Ys) -->
   [X],
   delall(X, Xs, Ys).
delall(X, [Y|Xs], [Y|Ys]) -->
   {dif(X,Y)},
   delall(X, Xs, Ys).

這是memberd/2的替代定義，使用if_/3可能更有效：

memberd(E, [X|Xs]) :-
   if_(E = X, true, memberd(E, Xs) ).

Answer 2

這與原始解決方案類似，但它會在輔助列表中收集非唯一值並檢查它以避免從原始列表中刪除最后一個：

remove_uniq_vals(L, R) :-
    remove_uniq_vals(L, [], R).

remove_uniq_vals([], _, []).
remove_uniq_vals([X|T], A, R) :-
    (   member(X, A)
    ->  R = [X|T1], A1 = A
    ;   member(X, T)
    ->  R = [X|T1], A1 = [X|A]
    ;   R = T1, A1 = A
    ),
    remove_uniq_vals(T, A1, T1).

測試...

| ?- remove_uniq_vals([1,2,3,1,2,3,1,2,3,4,3], Q).

Q = [1,2,3,1,2,3,1,2,3,3]

(1 ms) yes
| ?- remove_uniq_vals([1,1,2,2,3,4,4,5,6,6,6], Q).

Q = [1,1,2,2,4,4,6,6,6]

yes

因此，如果第一個參數是輸入，則謂詞的效果很好，並且它保持列表中其余元素的原始順序。

然而，該謂詞不是完全關系的 ，因為它將使第一個參數是已知數量的元素的未實例化列表並且第二個參數是不同固定數量的元素的列表的情況失敗。 所以像這樣的東西會起作用：

| ?- remove_uniq_vals([A,B,C], L).

B = A
C = A
L = [A,A,A]

(1 ms) yes

但是類似下面的事情失敗了：

| ?- remove_uniq_vals([A,B,C], [1,1]).

no

Answer 3

這是另一個純粹的關系解決方案，受到@ CapelliC解決方案的啟發。 現在這個保留了重復的順序。 有趣的是，現在必須明確地完成@CapelliC解決方案中發生的隱式量化。

擁有純粹的關系定義的最大優點是noes is noes。 並且ayes是ayes。 那就是：你不必擔心你得到的答案是否正確。 這是正確的（或不正確 - 但它不是部分正確）。 在方法失敗的情況下，通常可以通過生成instantiation_error來清除非關系解決方案。 但是你可以自己驗證，兩者都“忘記”了這樣的測試，從而為bug做好了准備。 對那些其他解決方案的安全測試可能是ground(Xs)或ground(Xs), acyclic_term(Xs)但這種情況經常被認為太受限制。

remUniqueVals2(Xs, Ys) :-
   tfilter(list_withduplicate_truth(Xs),Xs,Ys).

list_withduplicate_truth(L, E, Truth) :-
   phrase(
      (  all(dif(E)),
         (  {Truth = false}
         |  [E],
            all(dif(E)),
            (   {Truth = false}
            |   {Truth = true},
                [E],
                ...
            )
         )
      ),  L).

all(_) --> [].
all(P_1) -->
   [E],
   {call(P_1,E)},
   all(P_1).

... --> [] | [_], ... .

tfilter(     _, [], []).
tfilter(TFilter_2, [E|Es], Fs0) :-
   call(TFilter_2,E,Truth),
   (  Truth = false,
      Fs0 = Fs
   ;  Truth = true,
      Fs0 = [E|Fs]
   ),
   tfilter(TFilter_2, Es, Fs).

使用if_/3另一種更緊湊的方式

tfilter(   _, [], []).
tfilter(TFilter_2, [E|Es], Fs0) :-
   if_(call(TFilter_2,E), Fs0 = [E|Fs], Fs0 = Fs ),
   tfilter(TFilter_2, Es, Fs).

Answer 4

這是@ mbratch解決方案的純化版本。 它使用了member/2的reïfied版本，它沒有像member(X,[a,a])那樣的冗余答案。

memberd_truth_dcg(X, Xs, Truth) :-
   phrase(( all(dif(X)), ( [X], {Truth = true}, ... | {Truth = false} ) ), Xs).

一個略微概括的版本，只需要有一個列表前綴，但不是列表：

memberd_truth(_X, [], false).
memberd_truth(X, [X|_], true).
memberd_truth(X, [Y|Ys], Truth) :-
   dif(X,Y),
   memberd_truth(X, Ys, Truth).

變量的命名方式與@ mbratch的解決方案相同：

remove_uniq_valsBR(L, R) :-
   remove_uniq_valsBR(L, [], R).

remove_uniq_valsBR([], _, []).
remove_uniq_valsBR([X|T], A, R) :-
    memberd_truth(X, A, MemT1),
    (  MemT1 = true,
       R = [X|T1], A1 = A
    ;  MemT1 = false,
       memberd_truth(X, T, MemT2),
       (  MemT2 = true,
          R = [X|T1], A1 = [X|A]
       ;  MemT2 = false,
          R = T1, A1 = A
       )
    ),
    remove_uniq_valsBR(T, A1, T1).

使用if/3更緊湊：

remove_uniq_valsBR([], _, []).
remove_uniq_valsBR([X|T], A, R) :-
    if_( memberd_truth(X, A),
       ( R = [X|T1], A1 = A ),
       if_( memberd_truth(X, T),
          ( R = [X|T1], A1 = [X|A] ),
          ( R = T1, A1 = A ) ) )
    ),
    remove_uniq_valsBR(T, A1, T1).

我不喜歡的是許多冗余的dif/2約束。 我希望這個版本的版本更少：

| ?- length(L,_),remove_uniq_valsBR(L,L).
L = [] ? ;
L = [_A,_A] ? ;
L = [_A,_A,_A] ? ;
L = [_A,_A,_A,_A] ? ;
L = [_A,_A,_B,_B],
dif(_B,_A) ? ;
L = [_A,_B,_A,_B],
dif(_A,_B),
dif(_B,_A),
dif(_B,_A),
dif(_A,_B) ? ...

當然可以檢查是否已經存在dif/2 ，但是我更喜歡從一開始就發布的dif/2目標較少的版本。

Answer 5

保持邏輯純度 ！ 基於if_/3 ， (=)/3和meta-predicate tpartition/4我們定義：

remUniqueValues([], []).
remUniqueValues([X|Xs1], Ys1) :-
   tpartition(=(X), Xs1, Eqs, Xs0),
   if_(Eqs = [],
       Ys1 = Ys0,
       append([X|Eqs], Ys0, Ys1)),
   remUniqueValues(Xs0, Ys0).

讓我們看看它在行動！

?- remUniqueValues([A,B,C], [1,1]).
       A=1 ,     B=1 , dif(C,1)
;      A=1 , dif(B,1),     C=1
;  dif(A,1),     B=1 ,     C=1
;  false.

?- remUniqueValues([1,1,2,2,3,4,4,5,6,6,6], Vs).
Vs = [1,1,2,2,4,4,6,6,6].                   % succeeds deterministically

Answer 6

基於3個內置的解決方案：

remUniqueVals(Es, NUs) :-
    findall(E, (select(E, Es, R), memberchk(E, R)), NUs).

可以讀作

找到選中后仍然出現在列表中的所有元素