## Uncouple

### June 15, 2018

This is different than the standard scan-down-a-list algorithm because of the need to backtrack after a couple is found:

```; remove adjacent duplicates from a list, recursively.
(define (uncouple eql? xs)
(let loop ((xs xs) (zs (list)))
(cond ((null? xs) (reverse zs))
((null? zs) (loop (cdr xs) (cons (car xs) zs)))
((eql? (car xs) (car zs)) (loop (cdr xs) (cdr zs)))
(else (loop (cdr xs) (cons (car xs) zs))))))```

The first `cond` clause stops the iteration, and the second `cond` clause ensures there are two items to compare. The third `cond` clause removes a couple, and the fourth `cond` clause skips over an uncoupled element of the list. Here are some examples:

```> (uncouple eq? '(red blue green green blue red yellow))
(yellow)
> (uncouple eq? '(red red red))
(red)
> (uncouple eq? '(red red))
()
> (uncouple eq? '(red))
(red)
> (uncouple eq? '())
()
> (uncouple eq? '(red red blue blue))
()
> (uncouple eq? '(red red blue green green))
(blue)```

You can run the program at https://ideone.com/TKsTcg.

Pages: 1 2

### 15 Responses to “Uncouple”

1. chaw said

Here is a standard Scheme solution using fold from SRFI 1.

``` (import (scheme base) (scheme write) (only (srfi 1) fold)) (define (uncouple items item=?) (reverse (fold (lambda (item seen-items) (if (and (pair? seen-items) (item=? item (car seen-items))) (cdr seen-items) (cons item seen-items))) '() items))) (display (uncouple '(red blue green green blue red yellow) eq?)) (newline) ```

``` (yellow) ```

2. If you don’t need the intermediate results, it’s straightforward to do all the matches and deletions in a single pass:

(define (uncouple ls)
(let loop ((past ‘())
(future ls))
(cond ((null? future) (reverse past))
((and (pair? past) (eq? (car past) (car future)))
(loop (cdr past) (cdr future)))
(else
(loop (cons (car future) past) (cdr future))))))

3. Mumps version

```

GTM>w !,"nc=",nc,!,"find=",find,!,"list=",list,!

nc=x find i fnd s \$p(list," ",fnd,fnd+2)=\$p(list," ",fnd+2) x nc ; execute find variable/code, if any matches then get rid of them and execute nc
find=n i s fnd=0 f i=1:1:\$l(list,\$c(32))-1 i \$p(list,\$c(32),i)=\$p(list,\$c(32),i+1) s fnd=i q ; initialize fnd=0 for each entry in list if it matches the next entry return position number and quit
list=red red blue green green blue red yellow yellow

GTM>x nc w !,"new list=",list

new list=red

```
4. Daniel said

Here’s a solution in C.

```#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

typedef struct node {
char* value;
struct node* next;
} node_t;

node_t* argv_to_list(int argc, char* argv[]) {
node_t* list = NULL;
for (size_t i = argc - 1; i > 0; --i) {
node_t* node = (node_t*)malloc(sizeof(node_t));
node->next = list;
node->value = argv[i];
list = node;
}
return list;
}

void print_list(node_t* list) {
printf("{");
while (list != NULL) {
printf("%s", list->value);
list = list->next;
}
printf("}");
}

node_t* reverse(node_t* list) {
node_t* output = NULL;
while (list != NULL) {
node_t* next = list->next;
list->next = output;
output = list;
list = next;
}
return output;
}

node_t* uncouple(node_t* list, node_t** removed) {
node_t* output = NULL;
*removed = NULL;
while (list != NULL) {
node_t* next = list->next;
if (output != NULL && !strcmp(list->value, output->value)) {
output = output->next;
list->next = *removed;
} else {
list->next = output;
output = list;
}
list = next;
}
output = reverse(output);
return output;
}

int main(int argc, char* argv[]) {
node_t* list = argv_to_list(argc, argv);
node_t* removed;
list = uncouple(list, &removed);
print_list(list);
while (removed != NULL) {
node_t* next = removed->next;
free(removed);
removed = next;
}
return EXIT_SUCCESS;
}
```

Example:

```\$ ./uncouple red blue green green blue red yellow
{yellow}
```
5. matthew said

Works nicely with Haskel pattern matching:

```uncouple s = reverse(aux s []) where
aux [] t = t
aux (a:s) (b:t)
| a == b = aux s t
aux (a:s) t = aux s (a:t)

main = print(uncouple[1,2,3,3,4,4,2])
```
6. rube goldberg said

A solution in Racket.

7. Steve said

@matthew: Can you explain what the Haskell example is doing?

8. Tom Parrish said

A solution in c#

``` void Main() { var input = new[] {1,2,2,1,3,3,3,4,4,3,5,4,4,5,5,5,5,5}; input.Uncouple().Dump(); input.Uncouple().Uncouple().Dump(); }```

``` public static class UncoupleExtensions { public static IEnumerable Uncouple(this IEnumerable input) { return Uncouple(input, Comparer.Default); } public static IEnumerable<T> Uncouple<T>(this IEnumerable<T> input, Comparer<T> comparer) { T previous = default; var mustInitialise = true; var previousIdenticalCount = 0; foreach (var entry in input) { if (mustInitialise) { previous = entry; mustInitialise = false; continue; } if (comparer.Compare(previous, entry) != 0) { if(previousIdenticalCount % 2 == 0) { yield return previous; } previousIdenticalCount = 0; } else { previousIdenticalCount++; } previous = entry; } if (previousIdenticalCount % 2 == 0) { yield return previous; } } ```

```} ```

9. V said

In Ruby.

```def uncouple(list)
out = []
duped = false

(0...list.size).each do |i|
if list[i] == list[i+1]
duped = true
elsif duped
duped = false
else
out << list[i]
end
end

out.size == list.size ? out : uncouple(out)
end

puts uncouple(%w(red blue green green green blue red yellow pink pink))
```

Output:

yellow

10. Daniel said

@V, in the example you gave I believe that only two of the “green” elements should be removed, as opposed to all three.

Here’s a Ruby implementation that retains one of the “green” elements.

```def uncouple(list)
out = []
list.each do |x|
if out.length > 0 && x == out.last
out.pop
else
out.push(x)
end
end
out
end

puts uncouple(%w(red blue green green green blue red yellow pink pink))
```

Output:

```red
blue
green
blue
red
yellow
```
11. sbocq said

Clojure/Script

```(defn remove-dups [xs]
(loop [stack nil xs xs]
(if-let [[x & xs] xs]
(recur (if (= (first stack) x) (next stack) (conj stack x)) xs)
(reverse stack))))
```

Test:
``` cljs.user=> (remove-dups '(red blue green green blue red yellow)) (yellow) ```

12. sbocq said

Common Lisp, (complicated) destructive function that does not require to reverse the intermediate result.

```(defun nuncouple (l)
(setf l (cons nil l))
(labels ((_recur (trail rest)
(if rest
(if (equal (caar trail) (car rest))
(_recur (cdr trail) (setf (cdadr trail) (cdr rest)))
(_recur (cons rest trail) (cdr rest)))
(cdr l))))
(_recur (list l) (cdr l))))
```

Test:
``` * (nuncouple '(red blue green green blue red yellow))```

``` ```

```(YELLOW) ```

13. Steve said

@matthew: I get this when following your solution in GHCi
Prelude> uncouple s = reverse(aux s []) where
Prelude> aux [] t = t
Prelude> aux (a:s) (b:t) | a == b = aux s t
Prelude> aux (a:s) t = aux s (a:t)
Prelude> print(uncouple[1,2,3,3,4,4,2])
*** Exception: :22:3-27: Non-exhaustive patterns in function aux

Prelude>

14. matthew said

@Steve: Don’t know what’s going on there with the ghci repl – I run the program with “runghc uncouple.hs” which seems to do the right thing. For your question above (I’d have replied sooner, but I’ve been on holiday) – the idea is much the same as many of the other solutions, maintain a stack of processed items, when the next item in input and the stack top are the same, discard both, otherwise copy the next input to the stack – the main work is done by the second clause in aux, which combines pattern matching and a boolean guard.

15. Steve said

@matthew: Thanks, tried it your way and it worked fine. Then tried the following with a new uncouple.hs:

uncouple s = reverse(aux s []) where
aux [] t = t
aux (a:s) (b:t)
| a == b = aux s t
aux (a:s) t = aux s (a:t)

main = print(uncouple[“red”,”red”,”blue”,”green”,”green”,”blue”,”red”,”yellow”,”yellow”])

GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help
Prelude> :l c:\Users\Steve\Documents\uncouple.hs
[1 of 1] Compiling Main ( C:\Users\Steve\Documents\uncouple.hs, interpreted )