graphschemefoldmit-scheme

One way to construct graph adjacency list based on adjacency pairs similar to `fold` in MIT Scheme


Recently when I self-learnt MIT 6.5151 course, I first read CS 61AS Unit 0 as the preparation. Then I have read SICP 1 to 2.1 (with related lecture notes) as ps0 requires (also read 2.2.1 as CS 61A notes requires) and then Software Design for Flexibility (SDF) Prologue, chapter 1 and partly Appendix on Scheme.

Currently I am reading SDF chapter 2 and doing exercise 2.11 (f).

f. Another big extension is to build make-converter so that it can derive compound conversions, as required, from previously registered conversions. This will require a graph search.

I want to make unit-conversion-key-graph constructed from unit-conversion-pairs equal to ((tonne (kg g)) (celsius (kelvin fahrenheit))) in the following code.

But using set-car! in fold will throw errors since res may be used like the state variable in fold (This is similar to for i in range(10): i=i+1; print(i) in python but the latter doesn't throw errors and i=i+1 does nothing at all.). This is one restriction. It will throw error ";The object #!unspecific, passed as the first argument to car, is not the correct type." sometime after set-car!.

The following unit-conversion-list is to be consistent with this code block in the code base where each unit pair is paired with some conversion procedure.

(define (displayln x)
      (newline)
      (display x))

(define unit-conversion-list '(((celsius . kelvin) . 1) ((tonne . kg) . 2)
                                ((tonne . g) . 3) ((celsius . fahrenheit) . 4)))
(define unit-conversion-pairs (map car unit-conversion-list))
(displayln unit-conversion-pairs)
; display:
; ((celsius . kelvin) (tonne . kg) (tonne . g) (celsius . fahrenheit))

;; https://stackoverflow.com/a/7382392/21294350
(define (list-set! lst k val)
    (if (zero? k)
        (begin
          (displayln "set to")
          (displayln val)
          (set-car! lst val))
        (list-set! (cdr lst) (- k 1) val)))

;; https://cookbook.scheme.org/find-index-of-element-in-list/
(define (list-index fn lst)
  (displayln lst)
  (let iter ((lst lst) (index 0))
    (if (null? lst)
        -1
        (let ((item (car lst)))
          (if (fn item)
              index
              (iter (cdr lst) (+ index 1)))))))

(define (adjacency-pairs-to-adjacency-list adjacency-pairs)
  (fold 
    (lambda (adjacency-pair res) 
      (let* ((from (car adjacency-pair))
            (to (cdr adjacency-pair))
            (from-idx 
              (list-index 
                (lambda (adjacent-list-elem) (equal? from (car adjacent-list-elem))) 
                res)))
        (if (>= from-idx 0)
          (begin 
            (displayln from-idx) 
            (list-set! res from-idx (list from (list (cadr (list-ref res from-idx)) to)))
            (displayln res)
            (displayln "ending"))
          (cons (list from to) res))))
    '()
    adjacency-pairs))

(define unit-conversion-key-graph (adjacency-pairs-to-adjacency-list unit-conversion-pairs))
(displayln unit-conversion-key-graph)

We can define one iterative function to solve with the above problem with the same underlying basic ideas:

(define (adjacency-pairs-to-adjacency-list adjacency-pairs)
  (let iter ((rest-adjacency-pairs adjacency-pairs)
              (res '()))
    (if (null? rest-adjacency-pairs)
      res
      (let* ((adjacency-pair (car rest-adjacency-pairs)))
        (let* ((from (car adjacency-pair))
              (to (cdr adjacency-pair))
              (from-idx 
                (list-index 
                  (lambda (adjacent-list-elem) (equal? from (car adjacent-list-elem))) 
                  res)))
          (let ((rest-adjacency-pairs (cdr rest-adjacency-pairs)))
            (if (>= from-idx 0)
              (begin 
                (displayln from-idx) 
                (list-set! res from-idx (list from (list (cadr (list-ref res from-idx)) to)))
                (displayln res)
                (displayln "ending")
                (iter rest-adjacency-pairs res))
              (iter rest-adjacency-pairs (cons (list from to) res))))))))
)

Then is there some internal MIT Scheme function similar to the above fold (both books recommends functional programming) but without the above restriction to make unit-conversion-key-graph right?


Solution

  • I want to make unit-conversion-key-graph constructed from unit-conversion-pairs equal to ((tonne (kg g)) (celsius (kelvin fahrenheit))) in the following code.

    (In a functional, not imperative style).

    An important part of functional code is immutable data structures -- adding, deleting or changing an element returns a new structure with the changes (possibly sharing structure with the original to save memory). There aren't any standard functions to update an alist that way, but it's easy to write one and combine it with folding over the original list of pairs:

    
    ;;; returns a new alist with the value of the element keyed with `key` replaced
    ;;; with the result of calling `f` on that value. If not present, adds a new
    ;;; mapping with a value created by calling `f` on `(default-thunk)`
    ;;; Uses `eq?` to ompare keys
    (define (alistq-update alist key f default-thunk)
      (cond
       ((null? alist)
        (list (cons key (f (default-thunk)))))
       ((eq? key (caar alist))
        (cons (cons key (f (cdar alist))) (cdr alist)))
       (else
        (cons (car alist) (alistq-update (cdr alist) key f default-thunk)))))
    
    ;;; Like alistq-update, but takes a default value instead of a procedure to
    ;;; call.
    (define (alistq-update/default alist key f default-value)
      (alistq-update alist key f (lambda () default-value)))
    
    (define (adjacency-pairs->lists pairs)
      (fold
       (lambda (p alist)
         (alistq-update/default alist (car p) (lambda (list) (cons (cdr p) list)) '()))
       '() pairs))
    
    ;; ((celsius fahrenheit kelvin) (tonne g kg))
    (displayln (adjacency-pairs->lists unit-conversion-pairs)) 
    

    Note this produces ((celsius fahrenheit kelvin) (tonne g kg)) instead of ((tonne (kg g)) (celsius (kelvin fahrenheit))); order doesn't really matter in an association list, and dropping the extra nested list will make accessing the values later simpler. If the second form is something you really want, you can do

    (map (lambda (p) (list (car p) (cdr p))) '((celsius fahrenheit kelvin) (tonne g kg)))
    

    to get it.


    Association lists, while useful and easy to use, are an O(N) data structure - as the number of things stored in one increases, the time to do things with them increases in a linear fashion. The bigger the list, the slower the program. MIT Scheme comes with a number of different key-value map data structures, including one, weight-balanced trees, that has efficient immutable operations. Let's try that instead:

    
    ;;; No idea why these aren't provided by MIT Scheme already
    (define (wt-tree->alist wt-tree)
      (wt-tree/fold (lambda (key value list) (cons (cons key value) list))
                    '()
                    wt-tree))
    
    (define (wt-tree/update wt-tree key f default)
      (let ((current (wt-tree/lookup wt-tree key default)))
        (wt-tree/add wt-tree key (f current))))
    
    (define symbol-wt-tree-type (make-wt-tree-type symbol<?))
    
    (define (adjacency-pairs->wt-tree pairs)
      (fold
       (lambda (p wt-tree)
         (wt-tree/update wt-tree (car p) (lambda (list) (cons (cdr p) list)) '()))
       (make-wt-tree symbol-wt-tree-type)
       pairs))
    
    (displayln (wt-tree->alist (adjacency-pairs->wt-tree unit-conversion-pairs)))