Пролог удаляет только уникальные элементы

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

Это похоже на исходное решение, но оно собирает неуникальные значения во вспомогательном списке и проверяет его, чтобы избежать удаления последнего из исходного:

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 2

Правила Пролога читаются независимо друг от друга, поэтому вам нужно одно правило для случая, когда элемент уникален, а другое - там, где его нет. При условии, что порядок элементов не имеет значения, вы можете использовать:

?- 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 3

Это еще одно чистое реляционное решение, вдохновленное решением @CapelliC. Теперь этот сохраняет порядок дубликатов. Интересно увидеть, как неявное количественное определение, происходящее в решении @CapelliC, теперь должно выполняться явно.

Самым большим преимуществом чистого реляционного определения является то, что нет - это нет. И да есть да. То есть: вам не нужно беспокоиться о том, является ли полученный вами ответ правильным или нет. Это правильно (или неправильно - но это не частично правильно). Нереляционные решения часто можно очистить, произведя instantiation_error в случае сбоя метода. Но, как вы можете убедиться сами, оба "забыли" такие тесты, тем самым подготовив хорошую среду обитания для ошибок. Безопасный тест для этих других решений был бы 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 который свободен от лишних ответов, как для 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 и мета-предикат 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, диф (C,1);      A=1, диф (B,1),     C=1; диф (A,1),     B=1,     C=1; ложный.?- remUniqueValues ​​([1,1,2,2,3,4,4,5,6,6,6], против).
Vs = [1,1,2,2,4,4,6,6,6].                   % преуспевает детерминистически

Answer 6

Решение на основе 3 встроенных компонентов:

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

можно читать как

найти все элементы, которые все еще появляются в списке после того, как были выбраны