Deques

September 6, 2011

We represent a deque as a pair containing two normal lists, the front of the list and the back of the list, with the back of the list in reverse order, with the invariant that if either the front or the back is null, the other one is either null or a singleton. First some simple definitions:

(define dq-null (cons (list) (list)))

(define (dq-null? xs) (equal? xs dq-null))

It is sometimes useful to test whether a deque has only a single element:

(define (dq-singleton? xs) (or (and (null? (car xs)) (pair? (cdr xs))) (and (pair? (car xs)) (null? (cdr xs)))))

The constructors at both ends check for a null list, which implies that the other list is a singleton and requires special handling:

(define (dq-cons x xs) (if (null? (car xs)) (cons (list x) (cdr xs)) (if (null? (cdr xs)) (cons (list x) (car xs)) (cons (cons x (car xs)) (cdr xs)))))

(define (dq-snoc x xs) (if (null? (cdr xs)) (cons (car xs) (list x)) (if (null? (car xs)) (cons (cdr xs) (list x)) (cons (car xs) (cons x (cdr xs))))))

Fetching either end of the deque is just a matter of taking the car of the appropriate element, being careful to properly handle the case of a singleton deque and signalling an error if the deque is null:

(define (dq-head xs) (if (pair? (car xs)) (caar xs) (if (pair? (cdr xs)) (cadr xs) (error 'dq-head "null deque"))))

(define (dq-last xs) (if (pair? (cdr xs)) (cadr xs) (if (pair? (car xs)) (caar xs) (error 'dq-last "null deque"))))

The only tricky functions are the two functions that delete one of the ends of the queue. When both lists have sufficient elements, it is simple to delete the requested element. But if the deletion would make the list null, we have to be careful. One approach would move a single element from one list to the other when the other list becomes null, but some sequences of inserts and deletes would make that thrash, giving a linear update time. The approach used below splits the deque in two when one of the lists becomes null, which gives amortized constant-time updates and deletes:

(define (dq-tail xs) (if (null? (car xs)) (if (pair? (cdr xs)) dq-null (error 'dq-tail "null deque")) (if (pair? (cdar xs)) (cons (cdar xs) (cdr xs)) (call-with-values (lambda () (split (quotient (length (cdr xs)) 2) (reverse (cdr xs)))) (lambda (f b) (cons f (reverse b)))))))

(define (dq-init xs) (if (null? (cdr xs)) (if (pair? (car xs)) dq-null (error 'dq-init "null deque")) (if (pair? (cddr xs)) (cons (car xs) (cddr xs)) (call-with-values (lambda () (split (quotient (length (car xs)) 2) (reverse (car xs)))) (lambda (f b) (cons f (reverse b)))))))

Although they weren’t required in the definition of the deque library, it is handy to have functions that convert between deques and standard lists, both for testing and in production use:

(define (list->dq xs) (call-with-values (lambda () (split (quotient (length xs) 2) xs)) (lambda (f b) (cons f (reverse b)))))

(define (dq->list xs) (append (car xs) (reverse (cdr xs))))

We use the split function shown below, which we will add to the Standard Prelude along with its cousin split-while.

(define (split n xs) (let loop ((n n) (xs xs) (zs (list))) (if (or (zero? n) (null? xs)) (values (reverse zs) xs) (loop (- n 1) (cdr xs) (cons (car xs) zs)))))

You can run the program at http://programmingpraxis.codepad.org/ll2dgmTM, where you will also find a modest test suite.

Posted by programmingpraxis

Filed in Exercises

14 Comments »

14 Responses to “Deques”

Adolfo said

September 6, 2011 at 6:17 PM

In Racket:

#lang racket

(require rackunit)
(require racket/mpair)

(struct deque (front rear) #:mutable #:transparent)

(define (empty-deque)
  (deque '() '()))

(define (deque-empty? d)
  (and (null? (deque-front d))
       (null? (deque-rear d))))

(define (deque-add-front! d item)
  (cond ((deque-empty? d)
         (let ((x (mlist item)))
           (set-deque-front! d x)
           (set-deque-rear! d x)
           d))
        (else 
         (set-deque-front! d (mcons item (deque-front d)))
         d)))

(define (deque-add-rear! d item)
  (cond ((deque-empty? d)
         (deque-add-front! d item))
        (else
         (let ((last-node (deque-rear d)))
           (set-mcdr! last-node (mcons item (mcdr last-node)))
           (when (not (eq? last-node (deque-front d)))
             (set-deque-rear! d (mcdr last-node)))
           d))))

(define (deque-first d)
  (mcar (deque-front d)))

(define (deque-last d)
  (let ((rear (deque-rear d)))
    (if (null? (mcdr rear))
        (mcar rear)
        (mcdr rear))))

(define (deque-delete-first! d)
  (set-deque-front! d (mcdr (deque-front d)))
  (when (null? (deque-front d))
    (set-deque-rear! d '()))
  d)

(define (deque-delete-last! d)
  (cond ((null? (mcdr (deque-front d)))
         (set-deque-front! d '())
         (set-deque-rear! d '())
         d)
        (else
         (set-mcdr! (deque-rear d) '())
         d)))

Adolfo said
September 6, 2011 at 6:58 PM
Sometimes I wish I could delete my comments: my implementation doesn’t work at all (but soon I’ll be back :-) )

slabounty said

September 6, 2011 at 9:27 PM

A ruby version …

class Deque
    def initialize 
        @a = []
    end

    def add_front(item)
        @a.unshift item
    end

    def add_back(item)
        @a << item
    end

    def get_front
        @a.first
    end

    def get_back
        @a.last
    end

    def remove_front
        @a.shift
    end

    def remove_back
        @a.pop
    end

end

It cheats a bit by using the ruby array and its assorted functions … but easy.

fengshaun said

September 7, 2011 at 4:21 AM

I’m practically just using normal haskell functions, wrapping them in a nice coat of Deque-ness! Kind of cheating, I know!

data Deque a = Deque { deque :: [a] }
               deriving (Show)

beg :: Deque a -> a
beg d = head . deque $ d

end :: Deque a -> a
end d = last . deque $ d

delBeg :: Deque a -> Deque a
delBeg d = Deque $ tail . deque $ d

delEnd :: Deque a -> Deque a
delEnd d = Deque $ init . deque $ d

fengshaun said

September 7, 2011 at 4:26 AM

And of course I forgot the ‘add’ functions:

addBeg :: a -> Deque a -> Deque a
addBeg i d = Deque $ ((:) i) . deque $ d

addEnd :: a -> Deque a -> Deque a
addEnd i d = Deque $ (flip (++) $ [i]) . deque $ d

Axio said

September 7, 2011 at 7:57 AM

;; The "two stacks" implementation of dequeues
;; The code looks duplicated, but macros would make it harder to understand…
(define-structure dequeue s1 s2)

(define dq (make-dequeue '() '()))

(define (dequeue-push! d v)
  (dequeue-s1-set! d (cons v (dequeue-s1 d))))

(define (dequeue-enqueue! d v)
  (dequeue-s2-set! d (cons v (dequeue-s2 d))))

(define (dequeue-pop! d)
  (let ((s1 (dequeue-s1 d))
        (s2 (dequeue-s2 d)))
    (if (null? s1)
      (if (null? s2)
        (error "empty queue")
        (let ((tmp (reverse s2)))
          (dequeue-s1-set! d (cdr tmp))
          (dequeue-s2-set! d '())
          (car tmp)))
      (let ((tmp (car s1)))
        (dequeue-s1-set! d (cdr s1))
        tmp))))

(define (dequeue-dequeue! d)
  (let ((s1 (dequeue-s1 d))
        (s2 (dequeue-s2 d)))
    (if (null? s2)
      (if (null? s1)
        (error "empty queue")
        (let ((tmp (reverse s1)))
          (dequeue-s2-set! d (cdr tmp))
          (dequeue-s1-set! d '())
          (car tmp)))
      (let ((tmp (car s2)))
        (dequeue-s2-set! d (cdr s2))
        tmp))))

(define (test)
  (dequeue-push! dq 3) ;;
  (dequeue-push! dq 2) ;; 2 3
  (dequeue-push! dq 1) ;; 1 2 3
  (= 3 (dequeue-dequeue! dq)) ;; 1 2
  (= 1 (dequeue-pop! dq)) ;; 2
  (dequeue-enqueue! dq 3) ;; 2 3
  (dequeue-enqueue! dq 4) ;; 2 3 4
  (dequeue-enqueue! dq 5) ;; 2 3 4 5 
  (= 2 (dequeue-pop! dq)) ;; 3 4 5
  (= 3 (dequeue-pop! dq)) ;; 4 5
  (= 4 (dequeue-pop! dq)) ;; 5
  (= 5 (dequeue-dequeue! dq))) ;; 0

Rubens Mariuzzo (@rmariuzzo) said

September 7, 2011 at 2:46 PM

JavaScript & NodeJS:


/**
 * Function library that implements deques; you should be sure that all 
 * operations are performed in constant time.
 * 
 * @see https://programmingpraxis.com/2011/09/06/deques/
 * @author rmariuzzo
 */
var Deque = function() {
    
    // Internal array.
    var array = [];
    
    /**
     * Return the first element.
     */
    this.getFirst = function() {
        return array[0];
    };
    
    /**
     * Return the last element.
     */
    this.getLast = function() {
        return array[array.length-1];
    };
    
    /**
     * Remove the first element.
     */
    this.removeFirst = function() {
        array = array.slice(1);
    };
    
    /**
     * Remove the last element.
     */
    this.removeLast = function() {
        array.pop();
    };
    
    /**
     * Add an element as the first element.
     */
    this.addFirst = function(element) {
        var t = array;
        array = [element];
        for (var i = 0; i < t.length; i++) {
            array.push(t[i]);
        }
    };
    
    /**
     * Add an element as the last element.
     */
    this.addLast = function(element) {
        array.push(element);
    };

    /**
     * Return the internal array.
     */
    this.array = function() {
        return array;
    };
};

Adolfo said

September 7, 2011 at 6:00 PM

An implementation in Racket using doubly linked lists.

#lang racket

(require rackunit)

(struct dlist (prev value next) #:mutable #:transparent)

(define (dlist-add-before! dl value)
  (set-dlist-prev! dl (dlist #f value dl)))

(define (dlist-add-after! dl value)
  (set-dlist-next! dl (dlist dl value #f)))

(struct deque (front back) #:mutable #:transparent)

(define (empty-deque? dq)
  (null? (deque-front dq)))

(define (deque-first dq)
  (dlist-value (deque-front dq)))

(define (deque-last dq)
  (dlist-value (deque-back dq)))

(define (deque-add-front! dq item)
  (cond ((empty-deque? dq)
         (let ((dl (dlist #f item #f)))
           (set-deque-front! dq dl)
           (set-deque-back! dq dl)
           dq))
        (else
         (dlist-add-before! (deque-front dq) item)
         (set-deque-front! dq (dlist-prev (deque-front dq)))
         dq)))

(define (deque-add-back! dq item)
  (cond ((empty-deque? dq)
         (deque-add-front! dq item))
        (else
         (dlist-add-after! (deque-back dq) item)
         (set-deque-back! dq (dlist-next (deque-back dq)))
         dq)))

(define (deque-pop-front! dq)
  (let ((dl (deque-front dq)))
    (set-deque-front! dq (dlist-next dl))
    (unless (deque-front dq)
      (set-deque-back! dq #f))
    dq))

(define (deque-pop-back! dq)
  (let ((dl (deque-back dq)))
    (set-deque-back! dq (dlist-prev dl))
    (set-dlist-next! (dlist-prev dl) #f)
    (unless (deque-back dq)
      (set-deque-front! dq #f))
    dq))
    
(define (list->deque lst)
  (let* ((fst (dlist #f (car lst) #f))
         (dq (deque fst fst)))
    (for-each (λ (x) (deque-add-back! dq x))
              (cdr lst))
    dq))

(define (deque->list dq)
  (let loop ((dl (deque-front dq)))
    (if dl
        (cons (dlist-value dl)
              (loop (dlist-next dl)))
        '())))

(test-case
 "Deque tests."
 
 (check-equal? (deque->list (list->deque '(1 2 3 4 5)))
               '(1 2 3 4 5))
 
 (check-equal? (deque->list (deque-add-front! (list->deque '(1 2 3)) 'a))
               '(a 1 2 3))
 
 (check-equal? (deque->list (deque-add-back! (list->deque '(1 2 3)) 'b))
               '(1 2 3 b))
 
 (check-equal? (deque->list (deque-pop-front! (list->deque '(1 2 3))))
               '(2 3))
 
 (check-equal? (deque->list (deque-pop-back! (list->deque '(1 2 3))))
               '(1 2)))

Axio said

September 9, 2011 at 6:58 AM

With better amortisation: splitting a list in two when it is empty and accessed.

(define-structure dequeue s1 s2 size1 size2)

(define dq (make-dequeue '() '() 0 0))

(define (dequeue-push! d v)
  (dequeue-s1-set! d (cons v (dequeue-s1 d)))
  (dequeue-size1-set! d (1+ (dequeue-size1 d))))

(define (dequeue-enqueue! d v)
  (dequeue-s2-set! d (cons v (dequeue-s2 d)))
  (dequeue-size2-set! d (1+ (dequeue-size2 d))))

;; assume the size is good
(define (split-at* pos l t)
  (let loop ((pos pos) (front '()) (rear l))
    (if (zero? pos)
      (values (if t front (reverse front)) (reverse rear))
      (loop (1- pos) (cons (car rear) front) (cdr rear)))))

(define (dequeue-pop! d)
  (let ((s1 (dequeue-s1 d))
        (s2 (dequeue-s2 d))
        (size1 (dequeue-size1 d))
        (size2 (dequeue-size2 d)))
    (if (zero? size1)
      (if (zero? size2)
        (error "empty queue")
        (let ((mid (ceiling (/ size2 2))))
          (call-with-values
          (lambda ()
            (split-at* mid s2 #f))
          (lambda (front rear)
            (dequeue-s1-set! d (cdr rear) )
            (dequeue-s2-set! d front)
            (dequeue-size1-set! d (1- mid))
            (dequeue-size2-set! d (- size2 mid))
            (car rear)))))
      (let ((tmp (car s1)))
       (dequeue-s1-set! d (cdr s1))
       (dequeue-size1-set! d (1- (dequeue-size1 d)))
        tmp))))

(define (dequeue-dequeue! d)
  (let ((s1 (dequeue-s1 d))
        (s2 (dequeue-s2 d))
        (size1 (dequeue-size1 d))
        (size2 (dequeue-size2 d)))
    (if (zero? size2)
      (if (zero? size1)
        (error "empty queue")
        (let ((mid (floor (/ size1 2))))
          (call-with-values
          (lambda ()
            (split-at* mid s1 #t))
          (lambda (front rear)
            (dequeue-s1-set! d (reverse front))
            (dequeue-s2-set! d (reverse (cdr rear)))
            (dequeue-size2-set! d (- size1 mid 1))
            (dequeue-size1-set! d mid)
            (car rear)))))
      (let ((tmp (car s2)))
        (dequeue-s2-set! d (cdr s2))
        (dequeue-size2-set! d (1- (dequeue-size2 d)))
        tmp))))

ijp said
September 13, 2011 at 11:50 AM
I put a purely functional version up on github the other day https://github.com/ijp/pfds/blob/master/deques.sls

kawas said

September 19, 2011 at 11:30 PM

Clojure: immutable, all operations in constant time thanks to clojure vector’s properties

(defn deque-empty [] {:dqf [] :dqb []})

(defn dq-cons [e dq]
  (let [{fq :dqf bq :dqb} dq] {:dqf (conj fq e), :dqb bq}))

(defn dq-snoc [e dq]
  (let [{fq :dqf bq :dqb} dq] {:dqf fq, :dqb (conj bq e)}))

(defn dq-head [dq]
  (let [{fq :dqf bq :dqb} dq]
    (cond
      (seq fq) (peek fq)
      (seq bq) (nth bq 0)
      :else    (throw (Exception. "empty deque")))))

(defn dq-last [dq]
  (let [{fq :dqf bq :dqb} dq]
    (cond
      (seq bq) (peek bq)
      (seq fq) (nth fq 0)
      :else    (throw (Exception. "empty deque")))))

(defn dq-tail [dq]
  (let [{fq :dqf bq :dqb} dq]
    (cond
      (seq fq) {:dqf (pop fq), :dqb bq}
      (seq bq) {:dqf fq, :dqb (subvec bq 1)}
      :else    dq)))

(defn dq-init [dq]
  (let [{fq :dqf bq :dqb} dq]
    (cond
      (seq bq) {:dqf fq, :dqb (pop bq)}
      (seq fq) {:dqf (subvec fq 1), :dqb bq}
      :else    dq)))

Phil said
September 21, 2011 at 6:18 PM
A Python implementation. Keep in mind that I’m a new Python programmer, so this should not be considered an optimal implementation :)

class deque:
def __init__(self):
self._data = []

def add_front(self, i):
self._data.insert(0, i)

def add_back(self, i):
self._data.append(i)

def remove_front(self):
return self._data.pop(0)

def remove_back(self):
return self._data.pop()

def front(self):
return self._data[0]

def back(self):
return self._data[-1]

def is_empty(self):
return len(self._data) == 0

def __str__(self):
return self._data.__str__()
Phil said
September 21, 2011 at 6:22 PM
I can’t edit my post, so it would be nice if the previous post could be deleted. Here’s one that’s correctly formatted on pastbin.

source
Ying Yin said
September 25, 2011 at 1:37 AM
C++ implementation

Programming Praxis

Deques

September 6, 2011

14 Responses to “Deques”

Leave a comment

Categories

Archives

Archives

Programming Praxis

Deques

September 6, 2011

Share this:

Related

14 Responses to “Deques”

Leave a comment

Categories

Archives

Archives