-1

I need a solution that deletes elements that have pairs of occurrences from list. I did it in haskell, but i don't have any ideas how to interpretate it in Prolog.
For example [1,2,2,2,4,4,5,6,6,6,6] -> [1,2,2,2,5]

Code in Haskell :

import Data.List

count e list = length $ filter (==e) list
isnotEven = (== 1) . (`mod` 2)

removeUnique :: [Int] -> [Int]
removeUnique list = filter (\x ->  isnotEven (count x list)  ) list
false
  • 10,264
  • 13
  • 101
  • 209
Dimamid
  • 41
  • 3
  • 3
    It seems that you think of Prolog as a kind of Haskell. But these two languages are based on very different paradigms. Haskell is functional programming; Prolog is declarative programming. I suggest that you focus on understanding the underlying principles of Prolog - declarative programming, predicate logic and unification. – S.L. Barth is on codidact.com Apr 24 '17 at 08:30
  • 2
    The Haskell code does not reflect what you said. "Pairs of occurrences" (your statement) and "even number of occurrences" (Haskell code) is not the same. [1,1,1] has at least three pairs – false Apr 24 '17 at 10:10

2 Answers2

3

The following follows your Haskell code.

You need library(reif) for SICStus|SWI.

:- use_module(reif).

oddcount_t(List, E, T) :-       % reified: last argument is truth value
   tfilter(=(E), List, Eqs),
   length(Eqs, Nr),
   M is Nr mod 2,
   =(M, 1, T).

removeevenocc(List, RList) :-
   tfilter(oddcount_t(List), List, RList).

?- removeevenocc([1,2,2,2,4,4,5,6,6,6,6], R).
   R = [1,2,2,2,5]. 
?- removeevenocc([1,X], R).
   X = 1, R = []
;  R = [1, X],
   dif(X, 1).

Note the last question. Here, the list was not entirely given: The second element is left unknown. Therefore, Prolog produces answers for all possible values of X! Either X is 1, then the resulting list is empty, or X is not 1, then the list remains the same.

false
  • 10,264
  • 13
  • 101
  • 209
0

this snippet uses some of the libraries (aggregate,lists,yall) available, as well as some builtins, like setof/3, and (=:=)/2:

?- L=[1,2,2,2,4,4,5,6,6,6,6],
|    setof(K,C^(aggregate(count,member(K,L),C),0=:=C mod 2),Ds), 
|    foldl([E,X,Y]>>delete(X,E,Y),Ds,L,R).
L = [1, 2, 2, 2, 4, 4, 5, 6, 6|...],
Ds = [4, 6],
R = [1, 2, 2, 2, 5].

edit

to account for setof/3 behaviour (my bug: setof/3 fails if there are no solutions), a possible correction:

?- L=[1],
(setof(K,C^(aggregate(count,member(K,L),C),0=:=C mod 2),Ds);Ds=[]),
foldl([E,X,Y]>>delete(X,E,Y),Ds,L,R).
L = R, R = [1],
Ds = [].

Now there is a choice point left, the correct syntax could be

?- L=[1],
(setof(K,C^(aggregate(count,member(K,L),C),0=:=C mod 2),Ds)->true;Ds=[]),
foldl([E,X,Y]>>delete(X,E,Y),Ds,L,R).
L = R, R = [1],
Ds = [].
CapelliC
  • 59,646
  • 5
  • 47
  • 90
  • 2
    Fails for `L=[1,E2], ...`. But succeeds for `E2=1, L = [1,E2], ...` – false Apr 24 '17 at 10:15
  • I know, maybe should be the case to explain that delete/3,aggregate/2 behaviour don't fit into your view of Prolog correctness... Or I misunderstood the comment ? – CapelliC Apr 24 '17 at 10:32
  • 1
    Theory ? Don't know, I have just access to *implementations* – CapelliC Apr 24 '17 at 10:35
  • 2
    Even `L=[1]` incorrectly fails. That case has a direct correspondence to the Haskell code. – false Apr 24 '17 at 10:36
  • 2
    Idem `L=[1,2], ...` and so on. – false Apr 24 '17 at 10:37
  • Correction to "Under which": Under which theory is *the behaviour of your code for* the example I gave correct? – false Apr 24 '17 at 10:43
  • Ok, it boils down to what I first asked for... I **didn't** understood your first comment... – CapelliC Apr 24 '17 at 10:48
  • 2
    Now (third version): `L=[1,E2], ...` gives `L = R` which is incorrect since with `E2 = 1` it should rather give `R = []`. – false Apr 24 '17 at 10:59
  • Well, @Dimamid has something to ponder now :) – CapelliC Apr 24 '17 at 11:02
  • 3
    To summarize: You should *explicitly* state when your code works and when it does not work. You could do this for example by wrapping your query with [`iwhen(ground(L), ...)`](http://stackoverflow.com/a/40449516/772868). In this manner, a beginner could at least get clean errors for the cases your code is not designed for. – false Apr 24 '17 at 11:59