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.
Programming Praxis 
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)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))))))
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=redHere’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) { bool head = true; printf("{"); while (list != NULL) { if (!head) printf("->"); printf("%s", list->value); head = false; 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)) { node_t* head = output; output = output->next; list->next = *removed; head->next = list; *removed = head; } 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}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])A solution in Racket.
@matthew: Can you explain what the Haskell example is doing?
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);
}
}
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
@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:
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)
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)
@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>
@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.
@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 )
Ok, one module loaded.
*Main> main
[“red”]
*Main>