-- ghc --make -o CgiPlay.cgi CgiPlay.hs
import Network.CGI
cgiMain :: CGI CGIResult
cgiMain = output "Hello World!"
main :: IO ()
main = runCGI (handleErrors cgiMain)
-- ghc -package fastcgi -threaded --make -o FCgiPlay.fcgi FCgiPlay.hs
import Control.Concurrent
import System.Posix.Process (getProcessID)
import Network.FastCGI
test :: CGI CGIResult
test = do setHeader "Content-type" "text/plain"
pid <- liftIO getProcessID
threadId <- liftIO myThreadId
let tid = concat $ drop 1 $ words $ show threadId
output $ unlines [ "Process ID: " ++ show pid,
"Thread ID: " ++ tid]
main = runFastCGIConcurrent' forkIO 10 test
import Happstack.Server.FastCGI
import Happstack.Server.SimpleHTTP (askRq, getData, RqData, ToMessage)
import Happstack.Server (look, fromData, FromData, simpleHTTP, Conf(..), toResponse, ServerPartT)
simpleCGI :: (ToMessage a) => ServerPartT IO a -> IO ()
simpleCGI = runFastCGIConcurrent 10 . serverPartToCGI
main = simpleCGI handleRequest
handleRequest = return $ toResponse "Howdy From Happstack on FastCGI"
main = handleSqlError $ trace "Starting up, try port 8080" (simpleHTTP (Conf 8080 Nothing) $ handleRequest)
main = simpleCGI handleRequest
simpleCGI :: (ToMessage a) => ServerPartT IO a -> IO ()
simpleCGI = runFastCGIConcurrent 10 . serverPartToCGI
ghc --make -package cgi -package xhtml -o main.fcgi Main.hs
when I run it via apache I get
[Tue Sep 01 23:11:12 2009] [error] [client 172.16.46.1] FastCGI: incomplete headers (0 bytes) received from server "/home/some/web/main.fcgi"
I'd really like to find out how to run my app under plain old CGI, so that I can host it at NearlyFreeSpeech. They don't support FastCGI, nor long running processes like the Server mode.Data.ByteString.Lazy.Char8and insert it into the database
Prelude.read: no parse
doWeight :: (ServerMonad m) => String -> m Response
Maybe Stats. Then I ran into some compilation errors and I figured it was with my Maybe plumbing or maybe the IO of the database connection. My compilation error was
WeightController.hs:36:0:
Ambiguous constraint `ServerMonad m'
At least one of the forall'd type variables mentioned by the constraint
must be reachable from the type after the '=>'
In the type signature for `doWeight':
doWeight :: (ServerMonad m) => ServerPartT IO Response
Failed, modules loaded: Config, StatsDal, Stats, FiveBeeX, WeightView.
ServerPartT IO Response.doWeight :: Maybe Stats -> ServerPartT IO Response

putTraceMsg :: String -> IO ()
trace :: String -> a -> a
some f
becomes
trace "hello world" (some f)
case journalEntry of Just learned -> apply $ whatWas $ learned Nothing -> getAClue $ readComments
The title is Gnuplot in Action: Understanding Data with Graphs. It really coming along swimmingly! gnuplot is a really interesting graphing application. Much like ruby's irb, it gives you an interactive REPL ( read evaluate print loop ) where you can explore a dataset visually. There isn't a contemporary GUI, so figuring out how to setup and use the program has been a chore in the past, just working from man pages.
<string>372</string>
<key>UTExportedTypeDeclarations</key>
<array>
<dict>
<key>UTTypeConformsTo</key>
<array>
<string>public.text</string>
<string>public.plain-text</string>
</array>
<key>UTTypeDescription</key>
<string>Scheme text file</string>
<key>UTTypeIdentifier</key>
<string>org.plt-scheme</string>
<key>UTTypeTagSpecification</key>
<dict>
<key>com.apple.ostype</key>
<string>TEXT</string>
<key>public.filename-extension</key>
<array>
<string>scm</string>
<string>ss</string>
</array>
</dict>
</dict>
</array>
</dict>
</plist>
(assign new-cdrs correctly, so oddly enough I will be using Adobe Reader often for the first time in about X years.I am most of the way through the exercises in Chapter 4, but am totally stalling on finishing. For some yak shaving goodness, I thought I would document the Query system and all the layers on top of Scheme which are need to implement this.
PLT Streams code is originally by Berthold K.P. Horn for 2007 class
I am starting from the bottom up... Without further ado
Doh, LJ doesn't allow iframe... so click to open in a new window
SICP Streams Documentation.
Hopefully once I have it all documented in a Visual Language, then I can polish of the last questions quicker.
So I finished Section 3.4 on concurrency. Sorry no posts for 2.3 - 3.4. Study group has been going well and I have been playing with Scheme instead of writing summaries here... Doh!
An example:
Implementing a backtracking stategy in Scheme:
(define matrix
#{
#{40 53 216}
#{252 52 85}
#{150 36 70}
})
(define (matrix-width)
(vector-length (vector-ref matrix 0)))
(define (matrix-height)
(vector-length matrix))
(define (energy@ matrix x y)
;(display (format "energy@ ~a ~a~n" x y))
(vector-ref (vector-ref matrix y) x))
(define (energy@-test)
(values
(energy@ matrix 0 0) ;=> 40
(energy@ matrix 2 2))) ;=> 70
;problem - find lowest energy path from top row "0"
; to bottom row "2". A path can only go 1 space away
; so 0,1 (value 53 above) can go to
;1,0 (252)
;1,1 (52)
;1,2 (85)
; since they are the left, down, and right spaces from 0,1
;
; The lowest energy path is found by adding cells in path
; Example perhaps
; x:0,y:1 x:1,y:2 x:2,y:1 could have the lowest sum
; when we add up the values 53 + 85 + 36
(define (brute-find-lowest-no-cache)
(define (column-iter n)
(define (try-path x y solution)
(if (or (or (>= y (matrix-height))
(< x 0))
(>= x (matrix-width)))
solution
(let* ((try-left (> x 0))
(left-sum (if try-left
(+ (try-path (- x 1) (+ 1 y) (energy@ matrix x y)) solution)
30000))
(try-down #t) ; see assertion below
(down-sum (if try-down
(+ (try-path x (+ 1 y) (energy@ matrix x y)) solution)
(error "Should never happen, can always go down without hitting an edge")))
(try-right (< x (- (matrix-width) 1)))
(right-sum (if try-right
(+ (try-path (+ 1 x) (+ 1 y) (energy@ matrix x y)) solution)
30000)))
(cond ((and try-left (and (< left-sum down-sum) (< left-sum right-sum)))
left-sum)
((and try-right (and (< right-sum down-sum) (< right-sum left-sum)))
right-sum)
(else
down-sum)))))
;(display (format "Doing ~a~n" n))
(if (>= n (matrix-width))
0
(begin
;(display (format "x=~a~n" n))
(display (format "col ~a lowest=~a~n" n (try-path n 0 0)))
(column-iter (+ 1 n)))))
(column-iter 0))
;(brute-find-lowest-no-cache)
(define (get-cache-key x y)
;todo try sha-digest on this output, profile...
(format "~a:~a" x y))
(define *cache* #f)
(define (brute-find-lowest)
(let ((cache (make-hash-table 'equal)))
(define (column-iter n)
(define (try-path x y solution)
(let* ((cache-key (get-cache-key x y))
(cached-answer (hash-table-get cache cache-key #f)))
(if cached-answer
(begin
;(display (format "Using cached answer for cache-key=~a cached-answer=~a~n" cache-key cached-answer))
(+ cached-answer solution))
(if (or (or (>= y (matrix-height))
(< x 0))
(>= x (matrix-width)))
solution
(let* ((try-left (> x 0))
(left-sum (if try-left
(let* ((new-solution (try-path (- x 1) (+ 1 y) (energy@ matrix x y)))
(new-cache-key (get-cache-key x y)))
;(display (format "at ~a put ~a~n" new-cache-key new-solution))
;(hash-table-put! cache new-cache-key new-solution)
new-solution )
30000))
(try-down #t) ; see assertion below
(down-sum (if try-down
(let* ((new-solution
(try-path x (+ 1 y) (energy@ matrix x y))
)
(new-cache-key (get-cache-key x y)))
;(display (format "at ~a put ~a~n" new-cache-key new-solution))
;(hash-table-put! cache new-cache-key new-solution)
new-solution
)
(error "Should never happen, can always go down without hitting an edge")))
(try-right (< x (- (matrix-width) 1)))
(right-sum (if try-right
(let* ((new-solution
(try-path (+ x 1) (+ 1 y) (energy@ matrix x y))
)
(new-cache-key (get-cache-key x y)))
;(display (format "at ~a put ~a~n" new-cache-key new-solution))
new-solution )
30000)))
(cond ((and try-left (and (< left-sum down-sum) (< left-sum right-sum)))
(hash-table-put! cache (get-cache-key x y) left-sum)
(+ left-sum solution))
((and try-right (and (< right-sum down-sum) (< right-sum left-sum)))
(hash-table-put! cache (get-cache-key x y) right-sum)
(+ right-sum solution))
(else
(hash-table-put! cache (get-cache-key x y) down-sum)
(+ down-sum solution))))))))
;(display (format "Doing ~a~n" n))
(if (>= n (matrix-width))
0
(begin
;(display (format "x=~a~n" n))
;(display (format "col ~a lowest=~a~n" n (try-path n 0 0)))
(column-iter (+ 1 n)))))
(column-iter 0)
(set! *cache* cache)
))
(define lowest-seen 10000)
(define (backtracking-find-lowest)
(define (column-iter n)
(define (try-path x y solution-so-far)
(if (or (or (or (>= y (matrix-height))
(< x 0))
(>= x (matrix-width)))
(>= solution-so-far lowest-seen))
solution-so-far
(let* ((try-left (> x 0))
(left-sum (if try-left
(+ (try-path (- x 1) (+ 1 y) (energy@ matrix x y)) solution-so-far)
30000))
(try-down #t) ; see assertion below
(down-sum (if try-down
(+ (try-path x (+ 1 y) (energy@ matrix x y)) solution-so-far)
(error "Should never happen, can always go down without hitting an edge")))
(try-right (< x (- (matrix-width) 1)))
(right-sum (if try-right
(+ (try-path (+ 1 x) (+ 1 y) (energy@ matrix x y)) solution-so-far)
30000)))
(cond ((and try-left (and (< left-sum down-sum) (< left-sum right-sum)))
left-sum)
((and try-right (and (< right-sum down-sum) (< right-sum left-sum)))
right-sum)
(else
down-sum)))))
;(display (format "Doing ~a~n" n))
(if (>= n (matrix-width))
0
(let ((solution (try-path n 0 0)))
;(display (format "x=~a~n" n))
(if (< solution lowest-seen)
(begin
;(display "New lowest ever")(newline)
(set! lowest-seen solution)))
(display (format "col ~a lowest=~a~n" n solution))
(column-iter (+ 1 n)))))
(column-iter 0))
;(backtracking-find-lowest)
So I coded up a brute force solution, a backtracking solution, and then backtracking with caching. In Land of the Lost terminology that is memoization which simply means caching results. Then I ran
(time-apply brute-find-lowest '())
backtracking.scm has the gory details including a real jpeg converted into an "energy map" for testing with a larger data set.

![]() | You are viewing Log in Create a LiveJournal Account Learn more | Explore LJ: Life Entertainment Music Culture News & Politics Technology |