## Uncouple

### June 15, 2018

Today’s exercise is from a programming textbook:

A couple is two adjacent identical items in a sequence. You are to remove all couples, then process the list recursively to remove any additional couples formed by the removal of the original couples. For instance, given the list {red blue green green blue red yellow}, first remove the green couple, leaving {red blue blue red yellow}, then remove the blue couple, leaving {red red yellow}, and finally remove the red couple, leaving {yellow}.

Your task is to write a program to uncouple a list. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

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 )