list homework problems

Write functions that maintain sets, keep count, and find indices.

 $ cat hw.rkt 
 #lang racket 
  
 (require srfi/1) 
  
 (define (adjoin-set l e) 
    
   ; Return a copy of the given list; the copy contains the 
   ; given element.  The given list is assumed to be sorted 
   ; in strictly ascending order, as will be the copy. 
  
   (define (as l) 
     (if (null? l) 
         (list e) 
         (let ((hd (car l))) 
           (cond 
             ((char<? e hd) 
               (cons e l)) 
             ((char=? e hd) 
               l) 
             (#t 
               (cons hd (as (cdr l)))))))) 
  
   (as l)) 
  
  
 (define (adjoin-set-tr l e) 
    
   ; Return a copy of the given list; the copy contains the 
   ; given element.  The given list is assumed to be sorted 
   ; in strictly ascending order, as will be the copy. 
  
   (let as ((unsearched l) (searched '())) 
     (if (null? unsearched) 
       (reverse (cons e searched)) 
       (let ((hd (car unsearched))) 
         (cond 
           ((char<? e hd) 
             (append (reverse searched) (cons e unsearched))) 
           ((char=? e hd) 
             (append (reverse searched) unsearched)) 
           (#t 
             (as (cdr unsearched) (cons hd searched)))))))) 
  
  
 (define (list-index l e [eq? eq?]) 
  
   ; Return the index of the left-most occurrence of the 
   ; given element in the given list, or -1 if the given 
   ; element doesn't appear in the given list. 
  
   (let loop ((l l) (i 0)) 
     (cond 
       ((null? l) 
         -1) 
       ((eq? (car l) e) 
          i) 
       (#t 
          (loop (cdr l) (+ i 1)))))) 
  
  
 (define (list-index-cc l e [eq? eq?]) 
  
   ; Return the index of the left-most occurrence of the 
   ; given element in the given list, or -1 if the given 
   ; element doesn't appear in the given list. 
  
   (call-with-current-continuation 
     (lambda (k) 
       (fold (lambda (le i) 
               (if (eq? le e) (k i) (+ i 1))) 
             0 
             l) 
       -1))) 
  
  
 (define (update-count l k) 
  
   ; Return a copy of the list of (key . count) pairs l.  If 
   ; (k . c) appears in l, it is replaced in the copy by (k 
   ; . c + 1); if no pair in l has key k, (k . 1) appears in 
   ; the copy. 
  
   (let uc ((l l)) 
     (if (null? l) 
       (list (cons k 1)) 
       (let ((hd (car l)) 
             (tl (cdr l))) 
         (if (eq? (car hd) k) 
           (cons (cons k (+ 1 (cdr hd))) tl) 
           (cons hd (uc tl))))))) 
  
  
 (define (update-count-tr l k) 
  
   ; Return a copy of the list of (key . count) pairs l.  If 
   ; (k . c) appears in l, it is replaced in the copy by (k 
   ; . c + 1); if no pair in l has key k, (k . 1) appears in 
   ; the copy. 
  
   (let uc ((unsearched l) (searched '())) 
     (if (null? unsearched) 
       (cons (cons k 1) searched) 
       (let ((hd (car unsearched)) 
             (tl (cdr unsearched))) 
         (if (eq? (car hd) k) 
           (append searched (cons (cons k (+ 1 (cdr hd))) tl)) 
           (uc tl (cons hd searched))))))) 
  
  
 (require rackunit "utl.rkt") 
  
 (define (run-tests as li uc str) 
  
   (let*  
     ((N 10) 
      (nums (iota N))) 
  
     (do ((i 0 (+ i 1))) ((= i N) #t) 
       (check-eq? (li nums i) i)) 
     (check-eq? (li nums N) -1) 
     (check-eq? (li '() 0) -1)) 
  
   (let* 
     ((chars (string->list str)) 
      (char-set (fold (lambda (e l) (as l e)) '() chars)) 
      (counts (fold (lambda (e l) (uc l e)) '() chars)) 
      (N (length counts))) 
  
     (check-eq? (length char-set) N) 
     (check-eq? 
       (fold (lambda (e cnt) (+ (cdr e) cnt)) 0 counts) 
       (string-length str)) 
      
     (let loop ((lst char-set)) 
       (unless (null? lst) 
         (let ((fst (car lst)) 
               (rst (cdr lst))) 
           (check-eq? (li rst fst) -1) 
           (loop rst)))) 
  
     (for-each 
       (lambda (ch) 
         (let ((i (li counts ch (lambda (e x) (eq? (car e) x))))) 
           (check-true (and (< -1 i) (< i N))))) 
       char-set))) 
  
 (for-each 
   (lambda (s) 
     (run-tests adjoin-set list-index update-count s) 
     (run-tests adjoin-set-tr list-index-cc update-count-tr s)) 
   '("" "0123456789" "mississippi banana")) 
  
 $ racket hw.rkt 
  
 $