Two weeks ago I posted an entry called "You are the paramount computer technician without letup!", wherein I wrote a program, called PamFRI, to solve a problem that my friend, Pam, was having with her keyboard. I got a lot of comments from people claiming that the program was "useless". The program solved a problem that only one person had and she wouldn't even have the problem the on following day. Furthermore, it didn't even actually solve the problem since it's impossible to use the program if you have the problem. Alright, to be fair it was me that said all those things but I just can't handle criticism, regardless of how self-inflicted it may be.
Feeling like my reputation as a computer programmer was on the line I knew I had to rewrite the program. This time I decided to be a little more ambitious and end world hunger.
(require
(planet "csv.ss" ("neil" "csv.plt" 1 1))
(planet "sxml.ss" ("lizorkin" "sxml.plt" 1 4))
(planet "htmlprag.ss" ("neil" "htmlprag.plt" 1 3))
(planet "aif.ss" ("schematics" "macro.plt" 1 0))
(only (lib "1.ss" "srfi") list-index)
(lib "uri-codec.ss" "net")
(lib "url.ss" "net")
(lib "etc.ss")
(lib "list.ss")
(lib "string.ss"))
(define thesaurus
(let ([table (make-hash-table 'equal)]
[get-line
(make-csv-reader
(open-input-file "mobythes.aur")
'((separator-chars . (#\,))
(strip-leading-whitespace? . #t)
(strip-trailing-whitespace? . #t)))])
(let loop ([line (get-line)])
(unless (empty? line)
(let ([word (first line)])
(string-lowercase! word)
(hash-table-put! table word (rest line))
(loop (get-line)))))
table))
(define (post url data)
(html->sxml
(post-pure-port
(string->url url)
(string->bytes/utf-8 (alist->form-urlencoded data)))))
(define (check word options)
(foldl
(lambda (synonym ans)
(if (member synonym options) synonym ans))
false
(hash-table-get thesaurus word (lambda () empty))))
(define ((sxpath/f path) sxml)
(first ((sxpath path) sxml)))
(define (answer page)
(let* ([words ((sxpath "//div/div/ol/li") page)]
[word ((sxpath/f "strong/text()") (first words))]
[choices (map (sxpath/f "a/text()") (rest words))]
[answer
(number->string
(add1
(aif ans identity (check word choices)
(list-index (lambda (e) (string=? e ans))
choices)
(random 4))))])
(cons
(cons 'SELECTED answer)
(map (lambda (tag)
(cons (string->symbol
((sxpath/f "@name/text()") tag))
((sxpath/f "@value/text()") tag)))
((sxpath
"//input[@type='hidden' and @name!='SELECTED']")
page)))))
(let loop ([data empty])
(let ([p (post "http://freerice.com/index.php" data)])
(write ((sxpath "//p[@class='vocabLevel']/text()") p))
(newline)
(sleep 10)
(loop (answer p))))
Inspiration for this program came last week, right after I wrote PamFRI. One of my coworkers, Fred Henle, sent out a nice, little time waster know as Free Rice to the developers' mailing list. Free Rice is a non-profit web site where users are given a vocabulary quiz. For every answer the user gets right, the organization donates ten grains of rice to third-world countries through the UN.
Moments after Fred's email, Ben Mathes responded with his solution to end world hunger: a link to dictionary.com. As soon as I got Ben's mail it was pretty obvious to me what I had to do. "I can automate that!" I thought to myself. I had just written PamFRI, which uses a machine-readable thesaurus and PLT Scheme has a really nice web-scraping module on Planet. With only a few more lines of code I could modify my original program to grab the web page, read and answer the question, and then post it back. Calling such a program in a loop ought donate a lot of rice and would, at least in theory, end world hunger.
It's probably not advisable for me to encourage my readers to run this program since it generates a page hit to Free Rice once every ten seconds. If everyone one of my readers ran this program at the same time it could generate up to five page hits to Free Rice every ten seconds. On second thought, maybe that's not so bad. My friend, Trevor, points out that the real danger is when the OLPC project really takes off. We'll have ourselves a veritable DDoS attack if this program were to get into the hands of the kids who actually benefit from the rice donations.
On a serious note, the real reason I wrote this entry is to let people know about Free Rice and encourage them to play for real. I also wanted to show how darn cool the webscrape functionality is in PLT Scheme in case anyone has any need for it.