All useful functions learned over the course of the semester in CS 341 - Programming Languages.

utility-functions.scm

; Contained within are all the useful functions learned in CS 341 this past semester (Fall 2012).
; NOTE:  Any functions used that are not defined in this file are built-in functions in either 
;        MIT-Scheme or Racket.

; length
;  returns the length of the input list
(define length
  (lambda (ls)
    (if (null? ls)
      0
      (+ 1 (length (cdr ls))))))
; rewritten using 'accumulate' (defined below)
(define length
  (lambda (ls)
    (accumulate + (lambda (x) 1) ls)))

; append
;  appends one list to the other
(define append
  (lambda (ls1 ls2)
    (if (null? ls1)
      ls2
      (cons (car ls1) (append (cdr ls1) ls2)))))
; rewritten using 'accumulate' (defined below)
(define append
  (lambda (ls1 ls2)
    (accumulate cons ls2 (lambda (x) x) ls1)))

; reverse
;  reverses the elements in a list
(define reverse
  (lambda (ls)
    (if (null? ls)
      '()
      (append (reverse (cdr ls))
              (list (car ls))))))

; map
;  applies a function to each element in a list
(define map
  (lambda (f ls)
    (if (null? ls)
      '()
      (cons (f (car ls))
            (map f (cdr ls))))))

; stream-map
;  applies a function to each element in a stream
(define stream-map
  (lambda (f str)
    (cond ((stream-null? str) empty-stream)
          (else
            (stream-cons (f (car str))
                         (stream-map f (cdr ls)))))))

; big-map
;  applies a function to each element in a list of lists
(define big-map
  (lambda (f lls)
    (cond ((null? ls) '())
          (else
            (cons (apply f (map car lls))
                  (big-map f (map cdr ls)))))))

(define big-map
  (lambda (f base lls)
    (map (lambda (lls) (accumulate f
                                   base
                                   (lambda (x) (x))
                                   ls))
         (transpose lls))))

; filter
;  returns elements in a list that past the input test
(define filter
  (lambda (test? ls)
    (cond ((null? ls) '())
          ((test? (car ls)) (cons (car ls)
                                 (filter test? (cdr ls))))
          (else
            (filter test? (cdr ls))))))

; isort
;  insertion sort algorithm
(define isort
  (lambda (ls)
    (if (null? ls)
      '()
      (insert (car ls) (isort (cdr ls))))))
(define insert
  (lambda (value sorted-ls)
    (cond ((null? sorted-ls) (cons value '()))
          ((> value (car sorted-ls)) (cons (car sorted-ls)
                                           (insert value (cdr sorted-ls))))
          (else
            (cons value sorted-ls)))))

; accumulate
; applies a function to elements in a list and combines them in a defined fashion
(define accumulate
  (lambda (op base term ls)
    base
    (op (term (car ls)) (accumulate op base term (cdr ls)))))

; select-at-random
;  returns a random element from a list
(define select-at-random
  (lambda (ls)
    (list-ref ls (random (length ls)))))

; exists?
;  determines if a list contains a certain element
(define exists?
  (lambda (item ls)
    (cond ((null? ls) #f)
          ((equal? item (car ls)) #t)
          (else
            (exists? item (cdr ls))))))
; rewritten using 'accumulate'
(define exists?
  (lambda (item ls)
    (accumulate (lambda (x y) (or x y))
                #f
                (lambda (x) (equal? x item))
                ls)))

; delete
;  deletes the first occurence of an element from a list
(define delete
  (lambda (item ls)
    (cond ((null? ls) '())
          ((equal? item (car ls)) (cdr ls))
          (else
            (cons (car ls)
                  (delete item (cdr ls)))))))

; delete-all
;  deletes all occurences of an element from a list
(define delete-all
  (lambda (item ls)
    (cond ((null? ls) '())
          ((equal? item (car ls)) (delete-all item (cdr ls)))
          (else
            (cons (car ls)
                  (delete-all item (cdr ls)))))))
; rewritten using 'filter'
(define delete-all
  (lambda (item ls)
    (filter (lambda (x) (not (equal? x item))) ls)))
; rewritten using 'accumulate'
(define delete-all
  (lambda (item ls)
    (accumulate append
                '()
                (lambda (x) (if (equal? x item)
                              '()
                              (list x)))
                ls)))

; file->list
;  returns the contents of a file in the form of a list
(define file->list
  (lambda (filename)
    (let ((input-port (open-input-file filename)))
      (letrec ((build-input-list
                  (lambda ()
                    (let ((ch (read-char input-port)))
                      (if (end-object? ch)
                        (begin
                          (close-input-port input-port)
                          '()
                        (cons ch (build-input-list))))))))))))

; transpose
;  transposes a list of lists
(define transpose
  (lambda (lls)
    (cond ((null? lls) '())
          ((null? (car lls)) '())
          (else
            (cons (map (car lls))
                  (transpose (map (car lls)))))))))

; dot-product
;  computes the dot product a two lists
(define dot-product
  (lambda (ls1 ls2)
    (apply + (big-map x (list ls1 ls2)))))

; multiply
;  
(define multiply
  (lambda (lls ls)
    (map (lambda (x) (dot-product x ls)) lls)))

; remove-duplicates
;  removes duplicate elements in a list
(define remove-duplicates
  (lambda (ls)
    (cond ((null? ls) '())
          ((exists? (car ls) (cdr ls))
              (remove-duplicates (cdr lS)))
          (else
            (cons (car ls)
                  (remove-duplicates (cdr ls)))))))

; set?
;   determines whether a list is a set
(define set?
  (lambda (ls)
    (equal? ls (remove-duplicates ls))))

; union
;  returns the union of two sets
(define union
  (lambda (set1 set2)
    (remove-duplicates (append set1 set2))))

; intersection
;  returns the intersection of two sets
(define intersection
  (lambda (set1 set2)
    (cond ((null? set2) '())
          ((null? set1) '())
          ((exists? (car set1) set2)
              (remove-duplicates (cons (car set1)
                                       (intersection (cdr set1) set2))))
          (else
            (intersection (cdr set1) set2)))))

; subset?
;  checks if a set is a subset of another list
(define subset?
  (lambda (set1 set2)
    (cond ((null? set1) #t)
          ((null? set2) #f)
          ((exists? (car set1) set2)
              (subset? (cdr set1) set2))
          (else #f))))

; for-all
;  checks if an item in a list satisfies a given condition
(define for-all
  (lambda (test? ls)
    (accumulate (lambda (x y) (and x y))
                #t
                test?
                lls)))

; graph
;  checks if a list only contains pairs
(define graph
  (lambda (lls)
    (for-all (lambda (x) (= 2 (length x))) lls)))

; vertices
;  returns all vertices of a graph
(define vertices
  (lambda (graph)
    (remove-duplicates (accumulate append
                                   '()
                                   (lambda (x) x)
                                   graph))))

; undirected?
;  checks if a graph is undirected
;  whenever (a b) is in the graph, then so is (b a)
(define undirected?
  (lambda (graph)
    (for-all (lambda (x) (exists? (reverse x) graph)) graph)))

; simple
;  checks if a graph is simple
;  it has no item of the form (a a)
(define simple
  (lambda (graph)
    (for-all (lambda (x) (not (equal? (car x) (cdr x)))) graph)))

; pairs
;  pairs an item with each element of a set
(define pairs
  (lambda (item set)
    (accumulate cons
                '()
                (lambda (x) (pairs x set2))
                set)))

; set-product
;  returns the Cartesian product of two sets
(define set-product
  (lambda (set1 set2)
    (accumulate append
                '()
                (lambda (x) (pairs x set2))
                set1)))

; make-stack
;  emulates a stack in computer memory
;  
;  NOTE: the first introduction to object-oriented programming in Scheme
;  
;  EXAMPLE:
;   > (define int-stack (make-stack))
;   > (int-stack 'empty?)
;   #t
;   > (int-stack 'top)
;   <ERROR>
;   > (int-stack 'push! 13)
;   > (int-stack 'top)
;   13
;
(define make-stack
  (lambda ()
    (let ((stack '()))
      (letrec ((this
                  (lambda message
                    (case (car message)
                          ((empty?)
                            (null? stack))
                          ((top)
                            (car stack))
                          ((push!
                              (set! stack (cons (cadr message) stack))))
                          ((pop!
                            (set! stack (cdr stack))))
                          (else
                            (display "unknown stack operation")
                            (newline))))))
      (this)))))