;; The textual version (require-library "compat.ss") (define-struct route (start end dist intermed)) (define all-routes (list (make-route 'boston 'providence 50 empty) (make-route 'boston 'new-york 300 (list 'providence 'hartford)) (make-route 'providence 'hartford 150 empty) (make-route 'hartford 'new-york 100 empty) (make-route 'boston 'new-york 350 (list 'worcester 'hartford)) )) ;; only store routes one direction; can lookup in either though. ;; find-fwd-routes : sym sym -> list[route] ;; extract all routes matching from and to cities (define (find-fwd-routes from to) (filter (lambda (aroute) (and (symbol=? from (route-start aroute)) (symbol=? to (route-end aroute)))) all-routes)) ;; find-reverse-routes : sym sym -> list[route] ;; extract all routes in reverse of desired cities, return in fwd dir (define (find-reverse-routes from to) (map (lambda (rte) (make-route from to (route-dist rte) (reverse (route-intermed rte)))) (find-fwd-routes to from))) ;; find-routes : sym sym -> list[route] ;; find all routes between cities in database (define (find-routes from to) (append (find-fwd-routes from to) (find-reverse-routes from to))) ;; shortest : non-empty-list[route] -> route (define (shortest routelst) (first (quicksort routelst (lambda (r1 r2) (< (route-dist r1) (route-dist r2)))))) ;; avoids: list[route] sym -: list[route] ;; removes all routes that visit sym in intermed (define (avoids routelst city) (filter (lambda (aroute) (not (memq city (route-intermed aroute)))) routelst)) ;; visits: list[route] sym -: list[route] ;; keeps only routes that visit sym in intermed (define (visits routelst city) (filter (lambda (aroute) (memq city (route-intermed aroute))) routelst)) ;; constrain : list[route] sym sym -> list[route] ;; filter routes relative to visit/avoid, either of which may be 'none (define (constrain routes visit avoid) (cond [(symbol=? visit 'none) (avoids routes avoid)] [else (visits (avoids routes avoid) visit)])) ;; ------------ THE INTERFACE ----------------- (define (prompt-read promptstr) (printf "~a " promptstr) (read)) (define (prompt-read-many plist) (map prompt-read plist)) (define (display-many strlist) (for-each printf strlist)) (define (display-routes origininfo otherinfo) (let ([origin (first origininfo)] [dest (first otherinfo)] [which (second otherinfo)] [avoid (third otherinfo)] [visit (fourth otherinfo)]) (let ([routes (constrain (find-routes origin dest) visit avoid)]) (cond [(empty? routes) (display-many (list "Sorry, no routes match your request~n"))] [else (display-many (cons (format "Routes from ~a to ~a avoiding ~a and visiting ~a : ~n" origin dest avoid visit) (map (lambda (rte) (format "~a~n" (append (list origin) (route-intermed rte) (list dest)))) (cond [(symbol=? which 'shortest) (list (shortest routes))] [else routes]))))])))) (define (drive) (display-routes (prompt-read-many (list "Enter origin city:")) (prompt-read-many (list "Enter destination city:" "Which routes (shortest, all)?" "Avoid city (city name or none)" "Include city (city name or none)")))) ;;-------------------------------------------------------------------------- ;; The Web Prototype with CGI scripts written in Scheme ;; The initial html page

Driving Directions: Origin Information

Origin City:

;; -------------------------------------------------------------- ;; the script that takes the origin city (drive1.cgi) #!/bin/sh string=? ; exec /usr/local/plt/bin/mzscheme -r $0 "$@" (require-library "cgi.ss" "net") (let ([bindings (get-bindings)]) (let ([origin (extract-binding/single 'origin bindings)]) (generate-html-output "Driving Stage 2" (list "" "

Destination City:

" "

Which Routes?: Shortest All

" "

Avoid City:

" "

Visit City:

" (string-append "") "" )))) ;; -------------------------------------------------------------- ;; the script that takes the other route info (drive2.cgi) #!/bin/sh string=? ; exec /usr/local/plt/bin/mzscheme -r $0 "$@" (require-library "cgi.ss" "net") (require-library "function.ss") (require-library "compat.ss") (define-struct route (start end dist intermed)) (define all-routes (list (make-route 'boston 'providence 50 empty) (make-route 'boston 'new-york 300 (list 'providence 'hartford)) (make-route 'providence 'hartford 150 empty) (make-route 'hartford 'new-york 100 empty) (make-route 'boston 'new-york 350 (list 'worcester 'hartford)) )) ;; only store routes one direction; can lookup in either though. ;; find-fwd-routes : sym sym -> list[route] ;; extract all routes matching from and to cities (define (find-fwd-routes from to) (filter (lambda (aroute) (and (symbol=? from (route-start aroute)) (symbol=? to (route-end aroute)))) all-routes)) ;; find-reverse-routes : sym sym -> list[route] ;; extract all routes in reverse of desired cities, return in fwd dir (define (find-reverse-routes from to) (map (lambda (rte) (make-route from to (route-dist rte) (reverse (route-intermed rte)))) (find-fwd-routes to from))) ;; find-routes : sym sym -> list[route] ;; find all routes between cities in database (define (find-routes from to) (append (find-fwd-routes from to) (find-reverse-routes from to))) ;; shortest : non-empty-list[route] -> route (define (shortest routelst) (first (quicksort routelst (lambda (r1 r2) (< (route-dist r1) (route-dist r2)))))) ;; avoids: list[route] sym -: list[route] ;; removes all routes that visit sym in intermed (define (avoids routelst city) (filter (lambda (aroute) (not (memq city (route-intermed aroute)))) routelst)) ;; visits: list[route] sym -: list[route] ;; keeps only routes that visit sym in intermed (define (visits routelst city) (filter (lambda (aroute) (memq city (route-intermed aroute))) routelst)) ;; constrain : list[route] sym sym -> list[route] ;; filter routes relative to visit/avoid, either of which may be 'none (define (constrain routes visit avoid) (cond [(symbol=? visit 'none) (avoids routes avoid)] [else (visits (avoids routes avoid) visit)])) (let ([bindings (get-bindings)]) (let ([origin (string->symbol (extract-binding/single 'origin bindings))] [dest (string->symbol (extract-binding/single 'dest bindings))] [which (extract-binding/single 'which bindings)] [avoid (string->symbol (extract-binding/single 'avoid bindings))] [visit (string->symbol (extract-binding/single 'visit bindings))]) (let ([routes (constrain (find-routes origin dest) visit avoid)]) (generate-html-output "Driving Results" (cond [(empty? routes) (list "Sorry, no routes match your request")] [else (cons (format "

Routes from ~a to ~a avoiding ~a and visiting ~a :

" origin dest avoid visit) (map (lambda (rte) (format "

~a

" (append (list origin) (route-intermed rte) (list dest)))) (cond [(string=? which "shortest") (list (shortest routes))] [else routes])))]))))) ;;-------------------------------------------------------------------------- ;============================================================= ;; The CGI version written as a series of Scheme functions (require-library "compat.ss") (require-library "function.ss") (define-struct route (start end dist intermed)) (define all-routes (list (make-route "boston" "providence" 50 empty) (make-route "boston" "new-york" 300 (list "providence" "hartford")) (make-route "providence" "hartford" 150 empty) (make-route "hartford" "new-york" 100 empty) (make-route "boston" "new-york" 350 (list "worcester" "hartford")) )) ;; only store routes one direction; can lookup in either though. ;; find-fwd-routes : sym sym -> list[route] ;; extract all routes matching from and to cities (define (find-fwd-routes from to) (filter (lambda (aroute) (and (string=? from (route-start aroute)) (string=? to (route-end aroute)))) all-routes)) ;; find-reverse-routes : sym sym -> list[route] ;; extract all routes in reverse of desired cities, return in fwd dir (define (find-reverse-routes from to) (map (lambda (rte) (make-route from to (route-dist rte) (reverse (route-intermed rte)))) (find-fwd-routes to from))) ;; find-routes : sym sym -> list[route] ;; find all routes between cities in database (define (find-routes from to) (append (find-fwd-routes from to) (find-reverse-routes from to))) ;; shortest : non-empty-list[route] -> route (define (shortest routelst) (first (quicksort routelst (lambda (r1 r2) (< (route-dist r1) (route-dist r2)))))) ;; avoids: list[route] sym -: list[route] ;; removes all routes that visit sym in intermed (define (avoids routelst city) (filter (lambda (aroute) (not (memq city (route-intermed aroute)))) routelst)) ;; visits: list[route] sym -: list[route] ;; keeps only routes that visit sym in intermed (define (visits routelst city) (filter (lambda (aroute) (memq city (route-intermed aroute))) routelst)) ;; constrain : list[route] sym sym -> list[route] ;; filter routes relative to visit/avoid, either of which may be 'none (define (constrain routes visit avoid) (cond [(string=? visit "none") (avoids routes avoid)] [else (visits (avoids routes avoid) visit)])) ;; ------------ THE INTERFACE ----------------- (define (prompt-read-str promptstr) (printf "~a " promptstr) (symbol->string (read))) (define (display-many strlist) (for-each printf strlist)) (define drive1html (lambda () (drive1cgi (prompt-read-str "Enter origin city:")))) (define drive1cgi (lambda (origin) (drive2cgi (prompt-read-str "Enter destination city:") (prompt-read-str "Which routes (shortest, all)?") (prompt-read-str "Avoid city (city name or none)") (prompt-read-str "Include city (city name or none)") origin))) (define drive2cgi (lambda (dest which avoid visit origin) (let ([routes (constrain (find-routes origin dest) visit avoid)]) (cond [(empty? routes) (display-many (list "Sorry, no routes match your request~n"))] [else (display-many (cons (format "Routes from ~a to ~a avoiding ~a and visiting ~a : ~n" origin dest avoid visit) (map (lambda (rte) (format "~a~n" (append (list origin) (route-intermed rte) (list dest)))) (cond [(string=? which "shortest") (list (shortest routes))] [else routes]))))])))) ;;-------------------------------------------------------------------------- ;============================================================= ;; The CGI version written as a series of Scheme functions, but where ;; each script name (from the previous version) is replaced with the ;; corresponding lambda (require-library "compat.ss") (require-library "function.ss") (define-struct route (start end dist intermed)) (define all-routes (list (make-route "boston" "providence" 50 empty) (make-route "boston" "new-york" 300 (list "providence" "hartford")) (make-route "providence" "hartford" 150 empty) (make-route "hartford" "new-york" 100 empty) (make-route "boston" "new-york" 350 (list "worcester" "hartford")) )) ;; only store routes one direction; can lookup in either though. ;; find-fwd-routes : sym sym -> list[route] ;; extract all routes matching from and to cities (define (find-fwd-routes from to) (filter (lambda (aroute) (and (string=? from (route-start aroute)) (string=? to (route-end aroute)))) all-routes)) ;; find-reverse-routes : sym sym -> list[route] ;; extract all routes in reverse of desired cities, return in fwd dir (define (find-reverse-routes from to) (map (lambda (rte) (make-route from to (route-dist rte) (reverse (route-intermed rte)))) (find-fwd-routes to from))) ;; find-routes : sym sym -> list[route] ;; find all routes between cities in database (define (find-routes from to) (append (find-fwd-routes from to) (find-reverse-routes from to))) ;; shortest : non-empty-list[route] -> route (define (shortest routelst) (first (quicksort routelst (lambda (r1 r2) (< (route-dist r1) (route-dist r2)))))) ;; avoids: list[route] sym -: list[route] ;; removes all routes that visit sym in intermed (define (avoids routelst city) (filter (lambda (aroute) (not (memq city (route-intermed aroute)))) routelst)) ;; visits: list[route] sym -: list[route] ;; keeps only routes that visit sym in intermed (define (visits routelst city) (filter (lambda (aroute) (memq city (route-intermed aroute))) routelst)) ;; constrain : list[route] sym sym -> list[route] ;; filter routes relative to visit/avoid, either of which may be 'none (define (constrain routes visit avoid) (cond [(string=? visit "none") (avoids routes avoid)] [else (visits (avoids routes avoid) visit)])) ;; ------------ THE INTERFACE ----------------- (define (prompt-read-str promptstr) (printf "~a " promptstr) (symbol->string (read))) (define (display-many strlist) (for-each printf strlist)) (define drive1html (lambda () ((lambda (origin) ((lambda (dest which avoid visit) (let ([routes (constrain (find-routes origin dest) visit avoid)]) (cond [(empty? routes) (display-many (list "Sorry, no routes match your request~n"))] [else (display-many (cons (format "Routes from ~a to ~a avoiding ~a and visiting ~a : ~n" origin dest avoid visit) (map (lambda (rte) (format "~a~n" (append (list origin) (route-intermed rte) (list dest)))) (cond [(string=? which "shortest") (list (shortest routes))] [else routes]))))]))) (prompt-read-str "Enter destination city:") (prompt-read-str "Which routes (shortest, all)?") (prompt-read-str "Avoid city (city name or none)") (prompt-read-str "Include city (city name or none)"))) (prompt-read-str "Enter origin city:"))))