Удалите как значение, так и все дубликаты этого значения в списке в прологе

У меня возникли проблемы с удалением значений из списка в прологе. У меня есть список цветов, и я хочу добавить к нему список цветов и сохранить все значения, которые не имеют дубликатов, и удалить остальные.

[green, red, blue, purple, yellow, brown, orange, black, purple]

поэтому фиолетовый дважды появляется в этом списке, и я хочу удалить их оба. Это список, который я хочу вернуть.

[green, red, blue, yellow, brown, orange, black]

В настоящее время у меня есть это, чтобы удалить все дубликаты, но я не могу получить оба пурпура.

mymember(X,[H|_]) :- X==H,!.
mymember(X,[_|T]) :- mymember(X,T).

not(A) :- \+ call(A).

set([],[]).
set([Head|Tail],[Head|Out]) :-
    not(mymember(Head,Tail)),
    set(Tail, Out).
set([Head|Tail],Out) :-
    mymember(Head,Tail),
    set(Tail, Out).

это результат, который я получаю сейчас:

[green, red, blue, yellow, brown, orange, black, purple]

person k0enf0rNL    schedule 21.10.2015    source источник


Ответы (5)


Простой способ... однострочник:

singletons(Xs,Zs) :-
  findall( X , ( append(P,[X|S],Xs), \+member(X,P), \+member(X,S) ) , Zs )
  .
person Nicholas Carey    schedule 22.10.2015
comment
@повторить. Смотрите мой более простой ответ. - person Nicholas Carey; 23.10.2015

Оставайтесь чистым, используя tfilter/3 в сочетании с list_uniqmember_t/3!

list_uniqs(Es, Us) :-
   tfilter(list_uniqmember_t(Es), Es, Us).

Пример запроса, заданный OP, имеет ожидаемый результат:

?- list_uniqs([green,red,blue,purple,yellow,brown,orange,black,purple], Xs).
Xs = [green,red,blue,yellow,brown,orange,black]. % succeeds deterministically

Получаем ли мы логически обоснованные ответы и на более общие вопросы?

?- list_uniqs([A,B,A], []).
   A=B
;  false.

?- list_uniqs([A,B,A], [_]).
dif(A,B).

?- list_uniqs([A,B,A], [_,_]).
false.

?- list_uniqs([A,B,A], Xs).
   Xs = [] ,     A=B
;  Xs = [B], dif(A,B).

Да! Как насчет чего-нибудь немного более общего?

?- list_uniqs([A,B,C],Xs).
   Xs = []     ,     A=B           ,     B=C
;  Xs = [C]    ,     A=B           , dif(B,C)
;  Xs = [B]    ,               A=C , dif(B,C)
;  Xs = [A]    ,           dif(A,C),     B=C 
;  Xs = [A,B,C], dif(A,B), dif(A,C), dif(B,C).

Оно работает!

person repeat    schedule 22.10.2015

Я думаю, ты на правильном пути. Вот подход, использующий -> ; построить и воспользоваться предикатом delete/3, который удаляет ВСЕ дубликаты:

remdup([], _, []).
remdup([H|T], X, R) :-
    (   H == X
    ->  (   member(X, T)
        ->  delete(T, X, R)     % only delete if it's in the list more than once
        ;   R = [H|R1],
            remdup(T, X, R1)
        )
    ;   R = [H|R1],
        remdup(T, X, R1)
    ).

Другое решение, использующее select/3, а также delete/3:

remdup(L, X, R) :-
    (select(X, L, L1), select(X, L1, L2))
->  delete(L2, X, R)
;   L = R.

select/3 извлекает один экземпляр элемента из списка. Если он не может найти элемент, он терпит неудачу. Итак, в приведенном выше примере мы удаляем все экземпляры, если мы можем найти хотя бы два из них.


Решение, которое выполняет весь список (за вычетом среднего аргумента, указывающего один элемент для удаления):

remdup([], []).
remdup([H|T], R) :-
    (   select(H, T, T1)
    ->  delete(T1, H, R1),
        remdup(R1, R)
    ;   R = [H|R1],
        remdup(T, R1)
    ).
person lurker    schedule 21.10.2015

Я исправил это, сделав это:

my_delete(Res, [], Res).
my_delete(Colorslist, [Head|Tail], R) :-  
    my_delete_worker(Colorslist, Head, Result), 
    my_delete(Result, Tail, R).

my_delete_worker([], _, []).
my_delete_worker([X|T], X, R) :-
    my_delete_worker(T, X, R).
my_delete_worker([H|T], X, [H|R]) :-
    X \= H,
    my_delete_worker(T, X, R).

Я забыл поместить результат первого цвета в список цветов для второго цвета. Когда дело доходит до базового случая, я объединяю свой список цветов с результатом. Спасибо за помощь люкеру!

person k0enf0rNL    schedule 21.10.2015
comment
Ваш предикат my_delete_worker/3 удалит элемент, даже если он единственный в списке. Например, my_delete_worker([a,b,c], b, R). дает, R = [a,c]. Я думал, это то, чего вы хотели избежать? - person lurker; 22.10.2015

проще (и нечистее :-)

singletons(Xs, Zs) :- findall(X, (select(X,Xs,Ys), \+memberchk(X,Ys)), Zs).
person CapelliC    schedule 18.11.2015