lists.scm - hefdoeshwk - Code exercises for the blog Hef Does Homework.

Source path: svn/ trunk/ 99problems/ scheme/ lists.scm

‹r23

r24

;;;;; PROBLEMS 1 - 28: WORKING WITH LISTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define test
  (lambda (expected actual-exp)
    (let ((actual (eval actual-exp)))
      (if (equal? expected actual)
          (let ()
            (display (car actual-exp))
            (display " matched expected value of ")
            expected)
          (let ()
           (display (car actual-exp))
           (display " FAILED: expected ")
           (display expected)
           (display ", actual ")
           actual)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P01: Find the last box of a list.
(define p01-last
  (lambda (lst)
    (cond
      ((null? lst) '())
      ((null? (cdr lst)) lst)
      (else (p01-last (cdr lst))))))


(test '(d) '(p01-last '(a b c d)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P02: Find the last but one box of a list.
(define p02-last-but-one
  (lambda (lst)
    (cond
      ((null? lst) '())
      ((null? (cddr lst)) lst)
      (else (p02-last-but-one (cdr lst))))))


(test '(c d) '(p02-last-but-one '(a b c d)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P03: Find the K'th element of a list.  The first element in the list is
; number 1.
(define p03-element-at
  (lambda (lst k)
    (if (null? lst)
        'ERROR
        (if (equal? k 1)
            (car lst)
            (p03-element-at (cdr lst) (- k 1))))))


(test 'c '(p03-element-at '(a b c d e) 3))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P04: Find the number of elements of a list.
(define p04-count
  (lambda (lst)
    (if (null? lst)
        0
        (+ 1 (p04-count (cdr lst))))))


(test '4 '(p04-count '(a b c d)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P05: Reverse a list.
(define p05-reverse
  (lambda (lst)
   (p05-reverse.2 lst '())))

(define p05-reverse.2
  (lambda (todo done)
    (if (null? todo)
        done
        (p05-reverse.2 (cdr todo) (cons (car todo) done)))))


(test '(a b c d) '(p05-reverse '(d c b a)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P06: Find out whether a list is a palindrome.  A palindrome can be read
; forward or backward; e.g. (x a m a x).
(define p06-palindrome?
  (lambda (lst)
    (null? (p06-palindrome?.2 lst lst))))

(define p06-palindrome?.2
  (lambda (orig lst)
    (if (null? lst) 
        #t ; safe guard
        (if (null? (cdr lst)) 
            (if (equal? (car orig) (car lst)) ; base case
                (cdr orig)
                #f)
            (let ((induc (p06-palindrome?.2 orig (cdr lst)))) ; induction case
              (if (not (list? induc))
                  induc
                  (if (equal? (car induc) (car lst))
                      (cdr induc)
                      #f)))))))


(test '#t '(p06-palindrome? '(x a m a x)))(test '#f '(p06-palindrome? '(x a m b x)))(test '#f '(p06-palindrome? '(x b m a x)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P07: Flatten a nested list structure.  Transform a list, possibly holding
; lists as elements into a "flat" list by replacing each list with its
; elements (recursively).
(define p07-flatten
  (lambda (lst)
    (cond
      ((null? lst) '())
      ((not (list? (car lst))) (cons (car lst) (p07-flatten (cdr lst))))
      (else 
       (let ((flat (p07-flatten (car lst))))
         (if (null? flat)
             (p07-flatten (cdr lst))
             (cons (car flat) (p07-flatten.2 (cdr flat) (cdr lst)))))))))

(define p07-flatten.2
  (lambda (sublist lst)
    (if (null? sublist)
        (p07-flatten lst)
        (cons (car sublist) (p07-flatten.2 (cdr sublist) lst)))))


(test '(a b c d e) '(p07-flatten '(a (b (c d) e))))(test '(a b c d e) '(p07-flatten '(a (()) (b ()) (((c))) (() (()) d) ((() ((e) ()))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P08: Eliminate consecutive duplicates of list elements.  If a list contains
; repeated elements they should be replaced with a single copy of the
; element. The order of the elements should not be changed.
(define p08-compress
  (lambda (lst)
    (if (null? lst)
        '()
        (p08-compress.2 (cdr lst) (car lst)))))

(define p08-compress.2
  (lambda (lst curr)
    (if (null? lst)
        (list curr)
        (if (equal? curr (car lst))
            (p08-compress.2 (cdr lst) curr)
            (cons curr (p08-compress.2 (cdr lst) (car lst)))))))


(test '(a b c a d e) '(p08-compress '(a a a a b c c a a d e e e e)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P09: Pack consecutive duplicates of list elements into sublists.  If a list
; contains repeated elements they should be placed in separate sublists.
(define p09-pack
  (lambda (lst)
    (if (null? lst)
        '()
        (p09-pack.2 (cdr lst) (list (car lst))))))

(define p09-pack.2
  (lambda (lst curr)
    (if (null? lst)
        (list curr)
        (if (equal? (car lst) (car curr))
            (p09-pack.2 (cdr lst) (cons (car lst) curr))
            (cons curr (p09-pack lst))))))


(test '((a a a a) (b) (c c) (a a) (d) (e e e e)) '(p09-pack '(a a a a b c c a a d e e e e)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P10: Run-length encoding of a list.  Use the result of problem P09 to
; implement the so-called run-length encoding data compression method.
; Consecutive duplicates of elements are encoded as lists (N E) where N is
; the number of duplicates of the element E.
(define p10-encode
  (lambda (lst)
    (let ((lst (p09-pack lst)))
      (if (null? lst)
          '()
          (p10-encode.2 (cdr lst) (car lst) 1)))))

(define p10-encode.2
  (lambda (lst curr cnt)
    (if (null? (cdr curr))
        (cons (list cnt (car curr))
              (if (null? lst)
                  '()
                  (p10-encode.2 (cdr lst) (car lst) 1)))
        (p10-encode.2 lst (cdr curr) (+ cnt 1)))))


(test '((4 a) (1 b) (2 c) (2 a) (1 d) (4 e)) '(p10-encode '(a a a a b c c a a d e e e e)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P11: Modified run-length encoding.  Modify the result of problem P10 in
; such a way that if an element has no duplicates it is simply copied into
; the result list. Only elements with duplicates are transferred as (N E)
; lists.
(define p11-encode-modified
  (lambda (lst)
    (p11-encode-modified.2 (p10-encode lst))))

(define p11-encode-modified.2
  (lambda (lst)
    (if (null? lst)
        '()
        (cons
         (if (= 1 (caar lst)) (cadar lst) (car lst))
         (p11-encode-modified.2 (cdr lst))))))


(test '((4 a) b (2 c) (2 a) d (4 e)) '(p11-encode-modified '(a a a a b c c a a d e e e e)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P12: Decode a run-length encoded list.  Given a run-length code list
; generated as specified in problem P11, construct its uncompressed version.
(define p12-decode
  (lambda (lst)
    (if (null? lst)
        '()
        (if (list? (car lst))
            (p12-decode.2 (cdr lst) (cadar lst) (caar lst))
            (cons (car lst) (p12-decode (cdr lst)))))))

(define p12-decode.2
  (lambda (lst curr cnt)
    (if (zero? cnt)
        (p12-decode lst)
        (cons curr (p12-decode.2 lst curr (- cnt 1))))))


(test '(a a a a b c c a a d e e e e) '(p12-decode '((4 a) b (2 c) (2 a) d (4 e))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P13: Run-length encoding of a list (direct solution).  Implement the
; run-length encoding from problem P11 directly, i.e. don't create the
; sublists containing the duplicates as in problem P09.
(define p13-encode-direct
  (lambda (lst)
    (if (null? lst)
        '()
        (p13-encode-direct.2 (cdr lst) (car lst) 1))))

(define p13-encode-direct.2
  (lambda (lst curr cnt)
    (if (null? lst)
        (list (if (= cnt 1) curr (list cnt curr)))
        (if (equal? (car lst) curr)
            (p13-encode-direct.2 (cdr lst) curr (+ cnt 1))
            (cons (if (= cnt 1) curr (list cnt curr)) (p13-encode-direct lst))))))


(test '((4 a) b (2 c) (2 a) d (4 e)) '(p13-encode-direct '(a a a a b c c a a d e e e e)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P14: Duplicate the elements of a list.
(define p14-duplicate
  (lambda (lst)
    (if (null? lst)
        '()
        (cons (car lst) (cons (car lst) (p14-duplicate (cdr lst)))))))


(test '(a a b b c c c c d d) '(p14-duplicate '(a b c c d)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P15: Replicate the elements of a list a given number of times.
(define p15-replicate
  (lambda (lst n)
    (if (null? lst)
        '()
        (p15-replicate.2 (cdr lst) n (car lst) n))))

(define p15-replicate.2
  (lambda (lst n curr cnt)
    (if (zero? cnt)
        (p15-replicate lst n)
        (cons curr (p15-replicate.2 lst n curr (- cnt 1))))))


(test '(a a a b b b c c c) '(p15-replicate '(a b c) 3))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P16: Drop every N'th element from a list.
(define p16-drop
  (lambda (lst n)
    (p16-drop.2 lst n n)))

(define p16-drop.2
  (lambda (lst n cnt)
    (if (null? lst)
        '()
        (if (= cnt 1)
            (p16-drop (cdr lst) n)
            (cons (car lst) (p16-drop.2 (cdr lst) n (- cnt 1)))))))


(test '(a b d e g h k) '(p16-drop '(a b c d e f g h i k) 3))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P17: Split a list into two parts; the length of the first part is given.
(define p17-split
  (lambda (lst n)
    (if (null? lst)
        (list '() '())
        (if (zero? n)
            (list '() lst)
            (let ((induc (p17-split (cdr lst) (- n 1))))
              (cons (cons (car lst) (car induc)) (cdr induc)))))))


(test '((a b c) (d e f g h i k)) '(p17-split '(a b c d e f g h i k) 3))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P18: Extract a slice from a list.  Given two indices, I and K, the slice
; includes the I'th and K'th elements of the original list and the elements
; between them.  Start counting the elements with 1.
(define p18-slice
  (lambda (lst i k)
    (if (or (null? lst) (zero? k))
        '()
        (if (<= i 1)
            (cons (car lst) (p18-slice (cdr lst) 0 (- k 1)))
            (p18-slice (cdr lst) (- i 1) (- k 1))))))


(test '(c d e f g) '(p18-slice '(a b c d e f g h i k) 3 7))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P19: Rotate a list N places to the left.
(define p19-rotate
  (lambda (lst n)
    (let ((halves (p17-split lst (if (> n 0) n (+ (length lst) n)))))
      (append (cadr halves) (car halves)))))

(test '(d e f g h a b c) '(p19-rotate '(a b c d e f g h) 3))(test '(g h a b c d e f) '(p19-rotate '(a b c d e f g h) -2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P20: Remove the K'th element from a list.
(define p20-remove-at
  (lambda (lst k)
    (if (null? lst)
        '()
        (if (> k 1)
            (cons (car lst) (p20-remove-at (cdr lst) (- k 1)))
            (cdr lst)))))


(test '(a c d) '(p20-remove-at '(a b c d) 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P21: Insert an element at a given position into a list.
(define p21-insert-at
  (lambda (el lst i)
    (if (null? lst)
        (list el)
        (if (> i 1)
            (cons (car lst) (p21-insert-at el (cdr lst) (- i 1)))
            (cons el lst)))))


(test '(a alfa b c d) '(p21-insert-at 'alfa '(a b c d) 2))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P22: Create a list containing all integers within a given range.  If first
; argument is smaller than second, produce a list in decreasing order.
(define p22-range
  (lambda (i j)
    (cond
      ((= i j) (list i))
      ((< i j) (cons i (p22-range (+ i 1) j)))
      ((> i j) (cons i (p22-range (- i 1) j))))))


(test '(4 5 6 7 8 9) '(p22-range 4 9))(test '(9 8 7 6 5 4) '(p22-range 9 4))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P23: Extract a given number of randomly selected elements from a list.
(define p23-rand-select
  (lambda (lst n)
    (if (or (null? lst) (zero? n))
        '()
        (let ((k (+ (random (length lst) 1))))
          (cons (p03-element-at lst k) (p23-rand-select (p20-remove-at lst k) (- n 1)))))))



; (test '(e d a) '(p23-rand-select '(a b c d e f g h) 3))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P24: Lotto: Draw N different random numbers from the set 1..M.
(define p24-lotto-select
  (lambda (n m)
    (p23-rand-select (p22-range 1 m) n)))



; (test '(23 1 17 33 21 37) '(p24-lotto-select 6 49))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P25: Generate a random permutation of the elements of a list.
(define p25-rand-permutation
  (lambda (lst)
    (p23-rand-select lst (length lst))))



; (test '(b a d c e f) '(p25-rand-permutation '(a b c d e f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P26: Generate the combinations of K distinct objects chosen from the N
; elements of a list
(define p26-combination
  (lambda (k lst)
    (cond
      ((or (> k (length lst)) (< k 1)) '())
      ((= k 1) (cons (list (car lst)) (p26-combination k (cdr lst))))
      (else 
       (append 
        (p26-combination.combine (car lst) (p26-combination (- k 1) (cdr lst)))
        (p26-combination k (cdr lst)))))))

(define p26-combination.combine
  (lambda (head tuples)
    (if (null? tuples)
        '()
        (cons (cons head (car tuples)) (p26-combination.combine head (cdr tuples))))))


(test '((a) (b) (c) (d)) '(p26-combination 1 '(a b c d)))(test '((a b) (a c) (a d) (b c) (b d) (c d)) '(p26-combination 2 '(a b c d)))(test '((a b c) (a b d) (a c d) (b c d)) '(p26-combination 3 '(a b c d)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P27: Group the elements of a set into disjoint subsets.  Note that we do
; not want permutations of the group members; i.e. ((a b) ...) is the same
; solution as ((b a) ...).  However, we make a difference between
; ((a b) (c d) ...) and ((c d) (a b) ...).  You may find more about this
; combinatorial problem in a good book on discrete mathematics under the term
; "multinomial coefficients".
(define p27-group
  (lambda (lst ks)
    (if (null? ks)
        '()
        (p27-group.2 lst (cdr ks) (p26-combination (car ks) lst)))))

(define p27-group.2
  (lambda (lst ks heads)
    (if (null? heads)
        '()
        (let ((tails (p27-group (p27-remove-multi lst (car heads)) ks)))
          (if (null? tails)
              (p26-combination 1 heads) ; ex: turns ((a b) (a c) (b c)) into (((a b)) ((a c)) ((b c)))
              (append ; instead of a append, for efficiency, could define a function like p26-combination.combine, but that adds on to a running result of p27-group.2
               (p26-combination.combine (car heads) tails)
               (p27-group.2 lst ks (cdr heads))))))))

(define p27-remove-multi ; removes first instance of each `els` from `lst`
  (lambda (lst els)
    (if (null? els)
        lst
        (p27-remove-multi (p27-remove lst (car els)) (cdr els)))))

(define p27-remove ; removes first instance `el` from `lst`
  (lambda (lst el)
    (if (null? lst)
        '()
        (if (equal? (car lst) el)
            (cdr lst)
            (cons (car lst) (p27-remove (cdr lst) el))))))


(test '(((a b) (c d))
        ((a c) (b d))
        ((a d) (b c))
        ((b c) (a d))
        ((b d) (a c))
        ((c d) (a b)))
      '(p27-group '(a b c d) '(2 2)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P28A: Sort a list of lists according to length of sublists, i.e. short
; lists first, longer lists later.

(define p28-sort
  (lambda (lst pred)
    (let ((result (p28-merge-listlists (p26-combination 1 lst) pred)))
      (if (null? result)
          result
          (car result)))))

(define p28-merge
  (lambda (lst1 lst2 pred)
    (cond
      ((null? lst1) lst2)
      ((null? lst2) lst1)
      ((pred (car lst1) (car lst2)) (cons (car lst1) (p28-merge (cdr lst1) lst2 pred)))
      (else (cons (car lst2) (p28-merge lst1 (cdr lst2) pred))))))

(define p28-merge-listlists ; takes a list of lists and binary merges them, ex: ((c) (a) (b) (d)) --> ((a c) (b d)) --> ((a b c d))
  (lambda (lolst pred)
    (if (or (null? lolst) (null? (cdr lolst)))
        lolst
        (p28-merge-listlists (cons 
                              (p28-merge (car lolst) (cadr lolst) pred)
                              (p28-merge-listlists (cddr lolst) pred))
                             pred))))

(define p28a-sort
  (lambda (lolst)
    (p28a-decode (p28-sort (p28a-encode lolst) p28a-first-el-lt?))))

(define p28a-first-el-lt?
  (lambda (lst1 lst2)
    (< (car lst1) (car lst2))))

(define p28a-encode
  (lambda (lolst)
    (if (null? lolst)
        '()
        (cons
         (cons (length (car lolst)) (car lolst)) 
         (p28a-encode (cdr lolst))))))

(define p28a-decode
  (lambda (lolst)
    (if (null? lolst)
        '()
        (cons (cdar lolst) (p28a-decode (cdr lolst))))))


(test '((o) (m n) (d e) (d e) (f g h) (a b c) (i j k l)) '(p28a-sort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; P28B: Sort a list of lists according to frequency of the lengths of the
; sublists, i.e. lists with rare lengths are placed first, others with a more
; frequent length come later.

(define p28b-sort
  (lambda (lolst)
    (let ((sorted-lenenc-lolst (p28-sort (p28a-encode lolst) p28a-first-el-lt?)))
      (p28a-decode (p28-sort (p28b-reencode sorted-lenenc-lolst) p28a-first-el-lt?)))))

(define p28b-reencode
  (lambda (lolst)
    (cdr (p28b-reencode.2 lolst -1 0))))

(define p28b-reencode.2
  (lambda (lolst len freq)
    (if (null? lolst)
        (list freq)
        (let ((lst (cdar lolst))
              (lstlen (caar lolst))
              (rest (cdr lolst)))
          (let ((rest-result (p28b-reencode.2 rest lstlen (if (= len lstlen) (+ freq 1) 1)))) ; first element of rest-result is total freq for lstlen
            (cons (if (= len lstlen) (car rest-result) freq) ; put the total freq for len onto the result...
                  (cons (cons (car rest-result) lst) ; ...followed by lst with lstlen's total freq as lst's first element...
                        (cdr rest-result)))))))) ; ...followed by the rest


(test '((i j k l) (o) (a b c) (f g h) (d e) (d e) (m n)) '(p28b-sort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o))))

Show details Hide details

Change log

r24 by jonathan.hefner on Aug 13, 2008 Diff

[No log message]

Go to:

Project members, sign in to write a code review

Older revisions

r23 by jonathan.hefner on Aug 13, 2008 Diff

[No log message]

All revisions of this file

File info

Size: 19591 bytes, 589 lines

View raw file