#lang racket (require web-server/servlet web-server/servlet-env web-server/formlets web-server/formlets/servlet net/url graph) ;; scrape data ---------------------------------------------------------------- (define PLT-PUBS-URL (string->url "http://www.ccs.neu.edu/racket/pubs/")) (define neu-pubs-port (get-pure-port PLT-PUBS-URL)) ;(define neu-pubs-port (open-input-file "plt-pubs.html")) (define name-pat "([A-Z][a-z\\-]+\\s?)+") (define word-pat "([A-Za-z\\-]+\\s?)+") (define names-pat (string-append "(" name-pat ",\\s)+" name-pat)) (define title-pat (string-append "(?<=)\\s+(" word-pat ")+")) (define authors-px (pregexp (string-append "(?<=:|
)\\s*" names-pat ".+?" title-pat))) (define matches (regexp-match* authors-px neu-pubs-port)) ;; authors+title : [Listof author-string ... title-string] (define authors+title (for/list ([authors matches]) (define as+title (string-split (string-trim (bytes->string/utf-8 authors)) #px",\\s+")) (define last-auth+title (car (reverse as+title))) (define first-authors (reverse (cdr (reverse as+title)))) (define last-auth+title-match (regexp-split #px"\\s+
|\\s+" last-auth+title)) (define as+t (append first-authors (list (first last-auth+title-match) (string-trim (car (reverse last-auth+title-match)))))) as+t)) ;; populate graph ------------------------------------------------------------- (define PLT-GRAPH (unweighted-graph/undirected null)) (define-edge-property PLT-GRAPH papers) (for ([as+t authors+title]) (define authors (cdr (reverse as+t))) (define title (car (reverse as+t))) (for* ([auth1 authors] [auth2 authors] #:unless (string=? auth1 auth2)) (define papers-curr (papers auth1 auth2 #:default null)) (add-edge! PLT-GRAPH auth1 auth2) (papers-set! auth1 auth2 (cons title papers-curr)))) ;; print to stdout ------------------------------------------------------------ #;(define (plt-bacon auth erdos bacon) (define erdos-path (fewest-vertices-path PLT-GRAPH auth erdos)) (define bacon-path (fewest-vertices-path PLT-GRAPH auth bacon)) ;; print erdos path (for ([a1 erdos-path] [a2 (cdr erdos-path)]) (printf "~a co-authored with ~a:\n" a1 a2) (for ([p (papers a1 a2)]) (printf " ~a\n" p))) (define erdos-num (sub1 (length erdos-path))) (printf "\n** ~a's ~a-number is: ~a\n\n" auth erdos erdos-num) ;; print bacon path (for ([a1 bacon-path] [a2 (cdr bacon-path)]) (printf "~a co-authored with ~a:\n" a1 a2) (for ([p (papers a1 a2)]) (printf " ~a\n" p))) (define bacon-num (sub1 (length bacon-path))) (printf "\n** ~a's ~a-number is: ~a\n\n" auth bacon bacon-num) (printf "## ~a's ~a-~a-number is: ~a\n" auth erdos bacon (+ erdos-num bacon-num))) ;; html output ---------------------------------------------------------------- (define (plt-bacon-html auth erdos bacon) (define erdos-path (fewest-vertices-path PLT-GRAPH auth erdos)) (define bacon-path (fewest-vertices-path PLT-GRAPH auth bacon)) (define erdos-num (sub1 (length erdos-path))) (define bacon-num (sub1 (length bacon-path))) `(table (tr "Computed " (i ,auth) "'s " (b ,erdos) "-" (b ,bacon) " number:") (tr (br) (hr)) (tr ;; print erdos path ,@(for/list ([a1 erdos-path] [a2 (cdr erdos-path)]) `(table (tr (i ,(format "~a" a1)) " co-authored with " (i ,(format "~a" a2)) ":") (tr (ul ,@(for/list ([p (papers a1 a2)]) `(li ,(format "~a" p)))))))) (tr "** " (i ,(format "~a" auth)) "'s " (b ,(format "~a" erdos)) "-number is: " (b ,(format "~a" erdos-num))) (tr (br) (hr)) (tr (br)) (tr ; ;; print bacon path ,@(for/list ([a1 bacon-path] [a2 (cdr bacon-path)]) `(table (tr (i ,(format "~a" a1)) " co-authored with " (i ,(format "~a" a2)) ":") (tr (ul ,@(for/list ([p (papers a1 a2)]) `(li ,(format "~a" p)))))))) (tr "** " (i ,(format "~a" auth)) "'s " (b ,(format "~a" bacon)) "-number is: " (b ,(format "~a" bacon-num))) (tr (br) (hr)) (tr (br)) (tr "## " (i ,(format "~a" auth)) "'s " (b ,(format "~a-~a" erdos bacon)) "-number is: " (b ,(format "~a" (+ erdos-num bacon-num)))) (tr (br) (hr)))) ;;----------------------------------------------------------------------------- ;; web server front end (define author-choices (sort (filter-not (λ (v) (regexp-match #px"and\\s|b>|Felleisen\\." v)) (get-vertices PLT-GRAPH)) string* . author}) (div "\"Bacon\": " ,{(select-input author-choices #:selected? (lambda (x) (string=? x "Felleisen"))) . =>* . bacon}) (div "\"Erdos\": " ,{(select-input author-choices #:selected? (lambda (x) (string=? x "Flatt"))) . =>* . erdos}) (div ,{(submit "Compute!") . =>* . res})) ;(list author erdos bacon))) ;; Q: Why is author etc a list? (let ([response-gen (λ (embed/url) (response/xexpr `(html (title "Results") (body (h1 "Results") (div ,(plt-bacon-html (car author) (car bacon) (car erdos))) (br) (br) (a ([href ,(embed/url serve-bacon)]) "Start Again")))))]) (send/suspend/dispatch response-gen)))) ;(define (start request) (serve-bacon request)) (provide serve-bacon) (define (serve-bacon request) (define (response-generator embed/url) (response/xexpr `(html (head (title "PLT Bacon")) (body (h1 "PLT Bacon") (img ([src "plt-bacon.png"])) ,(embed-formlet embed/url author-formlet))))) (send/suspend/dispatch response-generator)) #;(serve/servlet start #:launch-browser? #t #:quit? #f #:listen-ip #f #:port 8000)