logo标签列表

Prolog删除唯一元素

listprolog
5
我希望返回一个列表，其中删除所有唯一元素。例如：
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).

我注意到在第二次检查1、2、4时，member(Q1, RestQ)失败了，原因是它们已经不在列表中，并将它们删除。我希望能够解决这个问题，我的想法是检查member(Q1, PreviousQ)，其中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.
我怀疑你得到了不止一个答案。至少，你有六的三倍... - false
我认为我的问题不是它们没有被报告，而是只有两个答案。所以它检查member(6,[6,6])。（统一Q = [6]）然后检查member(6,[6])。（Q = [6,6]）然后检查member(6,[])。这失败了，因此返回Q = [6,6]。这就是我的问题。我想返回Q = [6,6,6]，但不确定如何使用这种方法实现。 - jalog3343646
你的新remUniqueVals/3函数的第一个参数是什么意思？ - false
@jalog3343646：无论如何，你的剪枝都放错了位置，将剪枝设置在递归目标之后几乎没有任何用处。 - false
是的，谢谢。我现在已经把它们清除掉了。 - jalog3343646
显示剩余5条评论
6个回答
6

Prolog规则是独立读取的，因此需要一个规则处理元素唯一的情况，另一个规则处理元素不唯一的情况。如果元素的顺序不重要，可以使用以下方法:

?- remUniqueVals([A,B,C], [1,1]).
   A = 1, B = 1, dif(1,C)
;  A = 1, C = 1, dif(1,B)
;  B = 1, C = 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) ).
好的，谢谢！看起来可能会有用，我会花些时间先仔细研究和理解它。 - jalog3343646
5

这类似于原始解决方案，但它将非唯一值收集到一个辅助列表中，并检查以避免从原始列表中删除最后一个:

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
谢谢，这就是我在寻找的东西。 - jalog3343646
5

这是另一个受@CapelliC解决方案启发的纯关系解决方案。这个方案现在保留了重复项的顺序。有趣的是，@CapelliC解决方案中隐含的量化现在必须明确地完成。

拥有纯关系定义的最大优点是no就是no，yes就是yes。也就是说：您不必担心得到的答案是否正确。它是正确的（或不正确——但它不是部分正确）。非关系型解决方案通常可以通过在方法失败时产生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).
谢谢这个(+1)。这是一个听起来无辜的谓词，但对于一个纯粹的关系解决方案来说似乎特别具有挑战性。 - lurker
1
@mbratch：你考虑过优化你的方法吗？（新建一个独立的回答）。 - false
我一直在闲暇时间里研究它，但只能分散地花一点点时间在上面。经过尝试了几个失败的想法后，目前看起来相当具有挑战性... :) - lurker
3
这是@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 目标的版本。
3

保持！基于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 , dif(C,1)
;      A=1 , dif(B,1),     C=1
;  dif(A,1),     B=1 ,     C=1
;  false.
% 去除列表[A,B,C]中的唯一值，结果为[1,1]时的解，A,B,C可能取1或取不为1。
?- remUniqueValues([1,1,2,2,3,4,4,5,6,6,6], Vs).
Vs = [1,1,2,2,4,4,6,6,6].
% 去除列表[1,1,2,2,3,4,4,5,6,6,6]中的唯一值，得到的结果为[1,1,2,2,4,4,6,6,6]。
2
你能否编辑一下关于“逻辑纯度”标签的说明，解释一下这个“逻辑纯度”的含义？因为按照现在的写法（“仅使用Horn子句的程序”），我不明白if_/3如何符合条件，因为它使用了剪枝操作和各种元逻辑谓词（什么是正确的术语？var/1等），也就是底层的东西。我知道它实现了某种“纯净”的效果，但我希望能够详细说明，这样我（以及其他人）就不必猜测了。非常感谢。那么，if_/3如何符合逻辑纯度的要求呢？ - Will Ness
2
@WillNess：如果您对此有疑问，最好提出一个问题。 - false
2

基于3个内置函数的解决方案：

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

可以理解为

查找在选择后仍然出现在列表中的所有元素

2
不错，但是非关系型的。例如，对于remUniqueValsCC([A,B],[])会失败。 - false
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接