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.

Advertisements

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) {
      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}
    
  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 )
    Ok, one module loaded.
    *Main> main
    [“red”]
    *Main>

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

w

Connecting to %s

%d bloggers like this: