Linked List Exercises
May 4, 2018
For the first task, we run through the list twice, creating intermediate lists of evens and odds, then put them back together:
(define (task1a xs) (append (filter even? xs) (filter odd? xs)))
> (task1a '(1 2 3 4 5 6 7 8 9)) (2 4 6 8 1 3 5 7 9)
We could have written task1 to make a single pass splitting evens and odds, but that’s more work, and probably no faster in practice:
(define (task1b xs)
(let loop ((xs xs) (evens (list)) (odds (list)))
(cond ((null? xs) (append (reverse evens) (reverse odds)))
((even? (car xs)) (loop (cdr xs) (cons (car xs) evens) odds))
(else (loop (cdr xs) evens (cons (car xs) odds))))))
> (task1b '(1 2 3 4 5 6 7 8 9)) (2 4 6 8 1 3 5 7 9)
My preference is strongly for the first version; it is simple and clear to read, which takes precedence over any potential performance advantage, unless you have clear evidence that the two-pass approach is a critical bottlenect in your program.
For the second task, we run through the list once, collecting alternate items:
(define (task2a xs)
(let loop ((xs xs) (odds (list)) (evens (list)))
(cond ((null? xs) (append (reverse odds) (reverse evens)))
((null? (cdr xs)) (append (reverse (cons (car xs) odds)) (reverse evens)))
(else (loop (cddr xs) (cons (car xs) odds) (cons (cadr xs) evens))))))
> (task2a '(1 2 3 4 5 6 7 8 9)) (1 3 5 7 9 2 4 6 8)
This task is much clearer using pattern matching; here we use list-match from the Standard Prelude:
(define (task2b xs)
(let loop ((xs xs) (odds (list)) (evens (list)))
(list-match xs
(() (append (reverse odds) (reverse evens)))
((a) (loop (list) (cons a odds) evens))
((a b . xs) (loop xs (cons a odds) (cons b evens))))))
> (task2b '(1 2 3 4 5 6 7 8 9)) (1 3 5 7 9 2 4 6 8)
The third task is hardest. First we sort the input, then split it into two pieces, los and his, and finally put them back together, being careful to preserve the correct order:
(define (task3 xs)
(call-with-values
(lambda () (split (quotient (length xs) 2) (sort < xs)))
(lambda (los his)
(let loop ((his his) (los los) (xs (list)))
(cond ((null? his) xs)
((null? los) (cons (car his) xs))
(else (loop (cdr his) (cdr los) (cons (car los) (cons (car his) xs)))))))))
> (task3 '(1 2 3 4 5 6 7 8 9)) (9 4 8 3 7 2 6 1 5) > (task3 '(1 2 3 4 5 6 7 8)) (4 8 3 7 2 6 1 5)
You can run the program at https://ideone.com/j53ajn.
Pages: 1 2
;; Obviously, I'm in those exercises to show off the advantages of ;; Common Lisp. The downside is that it usually defeats the purpose ;; of the exercise :-) Those are typical. (defun even-before-odd (loi) "Return a list of the integers in LOI, rearranged it so all the even integers appear before all the odd integers, with both evens and odds appearing in the output in the same order as the input." (stable-sort (copy-list loi) (lambda (a b) (when (evenp a) (oddp b))))) (defun test/even-before-odd () (assert (equal (even-before-odd '()) '())) (assert (equal (even-before-odd '(1)) '(1))) (assert (equal (even-before-odd '(1 3 1 3 5 7 5 7 1 3 1 3)) '(1 3 1 3 5 7 5 7 1 3 1 3))) (assert (equal (even-before-odd '(2 4 2 4 6 8 6 8 2 4 2 4)) '(2 4 2 4 6 8 6 8 2 4 2 4))) (assert (equal (even-before-odd '(1 3 1 3 5 7 2 4 2 4 6 8)) '(2 4 2 4 6 8 1 3 1 3 5 7))) (assert (equal (even-before-odd '(1 2 3 4 5 6 7 8 9)) '(2 4 6 8 1 3 5 7 9))) :success) (defun reorder-alternating-elements (list) "Take a list of integers, split it into two lists each containing alternate elements from the input list, then join the two lists back together." (loop :with left := nil :for element :in list :if (setf left (not left)) :collect element :into left-part :else :collect element :into right-part :finally (return (nconc left-part right-part)))) (defun test/reorder-alternating-elements () (assert (equal (reorder-alternating-elements '()) '())) (assert (equal (reorder-alternating-elements '(a)) '(a))) (assert (equal (reorder-alternating-elements '(a 1)) '(a 1))) (assert (equal (reorder-alternating-elements '(a 1 b 2 c 3 d 4)) '(a b c d 1 2 3 4))) :success) (defun zip (a b) (if a (if b (list* (car a) (car b) (zip (cdr a) (cdr b))) a) b)) (defun test/zip () (assert (equal (zip '() '()) '())) (assert (equal (zip '(a) '()) '(a))) (assert (equal (zip '() '(1)) '(1))) (assert (equal (zip '(a b) '()) '(a b))) (assert (equal (zip '() '(1 2)) '(1 2))) (assert (equal (zip '(a) '(1)) '(a 1))) (assert (equal (zip '(a b c) '(1 2 3)) '(a 1 b 2 c 3))) (assert (equal (zip '(a b c) '(1 2 3 4 5)) '(a 1 b 2 c 3 4 5))) (assert (equal (zip '(a b c d e) '(1 2 3)) '(a 1 b 2 c 3 d e))) :success) (defun alternate-high-low (lor) "Return a list of reals rearranged so alternate elements are each greater than their two adjacent elements; in other words, the reals are in alternating high-low order." ;; This implementation is O(nlogn) but walks the elements 6 more times! ;; But it has two advantages: ;; 1- it's correct, ;; 2- it's implemented quickly, ;; so you can start using it, and have time to develop and debug a more ;; optimized implementation (if needed). (let* ((sorted (sort (copy-list lor) (function <))) (length (length sorted))) (zip (subseq sorted 0 (ceiling length 2)) (reverse (subseq sorted (ceiling length 2)))))) (defun test/alternate-high-low () (flet ((alternatep (list) (or (null (cddr list)) (loop :while (cddr list) :always (and (<= (first list) (second list)) (>= (second list) (third list))) :do (setf list (cddr list))) (loop :while (cddr list) :always (and (>= (first list) (second list)) (<= (second list) (third list))) :do (setf list (cddr list)))))) (assert (alternatep (alternate-high-low '()))) (assert (alternatep (alternate-high-low '(1)))) (assert (alternatep (alternate-high-low '(1 2)))) (assert (alternatep (alternate-high-low '(1 2 3)))) (assert (alternatep (alternate-high-low '(1 2 3 4 5 6 7 8 9))))) :success) ;; slow fast reversed result ;; (1 2 3 4 5 6 7 8) (1 2 3 4 5 6 7 8) ;; (2 3 4 5 6 7 8) (3 4 5 6 7 8) (1) ;; (3 4 5 6 7 8) (5 6 7 8) (2 1) ;; (4 5 6 7 8) (7 8) (3 2 1) ;; (5 6 7 8) () (4 3 2 1) ;; (6 7 8) () (3 2 1) (4 5) ;; (7 8) () (2 1) (3 6 4 5) ;; (8) () (1) (2 7 3 6 4 5) ;; () () () (1 8 2 7 3 6 4 5) ;; slow fast reversed result ;; (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) ;; (2 3 4 5 6 7 8 9) (3 4 5 6 7 8 9) (1) ;; (3 4 5 6 7 8 9) (5 6 7 8 9) (2 1) ;; (4 5 6 7 8 9) (7 8 9) (3 2 1) ;; (5 6 7 8 9) (9) (4 3 2 1) ;; (6 7 8 9) (9) (3 2 1) (4 5) ;; (7 8 9) (9) (2 1) (3 6 4 5) ;; (8 9) (9) (1) (2 7 3 6 4 5) ;; (9) (9) () (1 8 2 7 3 6 4 5) ;; () (9) () (9 1 8 2 7 3 6 4 5) (defun alternate-high-low (lor) "Return a list of reals rearranged so alternate elements are each greater than their two adjacent elements; in other words, the reals are in alternating high-low order." ;; This implementation is O(nlogn) but walks the elements only 1 more time, ;; but it needs O(n/2) storage (reverse stack). ;; Since it's tail recursive, it could be tail call optimized, but since ;; this is not mandatory that a CL implementation performs TCO, we'll ;; rewrite it in iteration form. (if (cddr lor) (labels ((reoder (slow fast reversed result) (cond ((cdr fast) (reoder (cdr slow) (cddr fast) (cons (car slow) reversed) result)) (slow (if reversed (reoder (cdr slow) fast (cdr reversed) (list* (car reversed) (car slow) result)) (cons (car slow) result))) (fast (list* (car fast) result)) (t result)))) (let ((sorted (sort (copy-list lor) (function <)))) (reoder sorted sorted '() '()))) lor)) (defun alternate-high-low (lor) "Return a list of reals rearranged so alternate elements are each greater than their two adjacent elements; in other words, the reals are in alternating high-low order." ;; This implementation is O(nlogn) but walks the elements only 1 more time, ;; but it needs O(n/2) storage (reverse stack). (if (cddr lor) (let ((sorted (sort (copy-list lor) (function <)))) (loop :with slow := sorted :with fast := sorted :with reversed := '() :with result := '() :do (cond ((cdr fast) (setf reversed (cons (car slow) reversed) slow (cdr slow) fast (cddr fast))) (slow (if reversed (setf result (list* (car reversed) (car slow) result) slow (cdr slow) reversed (cdr reversed)) (return (cons (car slow) result)))) (fast (return (list* (car fast) result))) (t (return result))))) lor)) (progn (test/even-before-odd) (test/reorder-alternating-elements) (test/zip) (test/alternate-high-low))task1b is still making two passes. The 2nd pass spans the (reverse evens) and (reverse odds). (And task1a and task1b both have a third partial pass with that append, as it re-scans the even part of the list again).
Here’s a version that truly makes one pass, assuming that the provided list may be mutated in place:
(define (task1c xs) (let loop ((xs xs) (ehead #f) (etail #f) (ohead #f) (otail #f)) (cond ((null? xs) (when (and etail ohead) (set-cdr! etail ohead)) (when otail (set-cdr! otail '())) (or ehead ohead '())) ((even? (car xs)) (when etail (set-cdr! etail xs)) (loop (cdr xs) (or ehead xs) xs ohead otail)) (else (when otail (set-cdr! otail xs)) (loop (cdr xs) ehead etail (or ohead xs) xs)))))I agree, though, that task1a is the easiest to read.
A Haskell solution. Note that altHighLow satisfies the requirements of problem 3, even though its output differs from that of @programmingpraxis’ solution. I interpret “the integers are in alternating high-low order” as meaning the first element should always be a “high” element.
import Data.List (partition, sortOn) import Data.Ord (Down(..)) -- Problem 1 -- -- Re-order the argument so that all its even elements appear before the odd -- elements. Otherwise, maintain the relative order of the elements. evensThenOdds :: Integral a => [a] -> [a] evensThenOdds = uncurry (++) . partition even -- Problem 2 -- -- Partition the argument into a pair of lists containing alternating elements, -- returning the concatenation of the two lists. altJoin :: [a] -> [a] altJoin = uncurry (++) . foldr (\x (l, r) -> (x:r, l)) ([], []) -- Problem 3 -- -- Re-order the argument to alternate between larger and smaller elements, -- always starting the result with the largest element. altHighLow :: Ord a => [a] -> [a] altHighLow xs = let xs' = sortOn Down xs in uncurry merge $ splitAt ((length xs' + 1) `div` 2) xs' -- Merge two lists, alternating between elements of the first, then second, -- lists. merge :: [a] -> [a] -> [a] merge (x:xs) (y:ys) = x : y : merge xs ys merge xs [] = xs merge [] ys = ys main :: IO () main = do print $ evensThenOdds [1, 8, 3, 6, 5, 4, 7, 2, 9] print $ evensThenOdds [1..9] print $ altJoin [1..9] print $ altHighLow [1..9] print $ altHighLow [1..8][…] worked on linked lists in the previous exercise, so today we will work on […]