Multithreaded bouncing balls program using agents in Clojure - multithreading

I have written a multithreaded bouncing balls program in clojure. After starting the animation thread, I do-
(send-balls)
to start the bouncing balls threads. The balls dont move and this is displayed on the console -
(#<Agent#5675b3ee FAILED: #<Ref#313d21d6: {:x 759, :y 629, :x-speed 3, :y-speed 1}>> #<Agent#22cf3539 FAILED: #<Ref#247881db: {:x 794, :y 258, :x-speed 2, :y-speed 3}>> #<Agent#51af4309 FAILED: #<Ref#445ead9d: {:x 831, :y 251, :x-speed 4, :y-speed 2}>>)
Can someone point out whats happening here?
(import
'(java.awt Color Graphics Dimension)
'(java.awt.image BufferedImage)
'(javax.swing JPanel JFrame))
(def width 1000)
(def height 1000)
(def number-of-balls 3)
(def rad 20)
(def origin-x 100)
(def origin-y 100)
(def box-height 500)
(def box-width 700)
(def max-x (+ origin-x box-width (* 4 rad)))
(def max-y (+ origin-y box-height (* 4 rad)))
(def min-x origin-x)
(def min-y origin-y)
(defn init-x
[]
(+ (rand-int (- max-x min-x)) min-x))
(defn init-y
[]
(+ (rand-int (- max-y min-y)) min-y))
(defstruct ball :x :y :x-speed :y-speed)
(def balls
(apply vector (map (fn [_] (ref (struct ball (init-x) (init-y)
(rand-int 10) (rand-int 10))))
(range number-of-balls))))
(def ball-agents (apply vector (map agent balls)))
(defn get-ball
[n]
(balls n))
(defn set-new-x
[ball]
(let [x (#ball :x)
x-speed (#ball :x-speed)
new-x (+ x x-speed)]
(dosync
(if (and (>= new-x min-x) (<= new-x max-x))
(ref-set ball (assoc #ball :x new-x))
(ref-set ball (assoc #ball :x-speed (* -1 x-speed)))))
(println "the new x is " #(ball :x)))
#ball)
(defn set-new-y
[ball]
(let [y (#ball :y)
y-speed (#ball :y-speed)
new-y (+ y y-speed)]
(dosync
(if (and (>= new-y min-y) (<= new-y max-y))
(ref-set ball (assoc #ball :y new-y))
(ref-set ball (assoc #ball :y-speed (* -1 y-speed))))))
#ball)
(defn paint-balls
[bg x y]
(doto bg
(.setColor (. Color red))
(.fillOval x y rad rad)))
(defn render
[g]
(let [img (new BufferedImage width height
(. BufferedImage TYPE_INT_ARGB))
bg (. img (getGraphics))]
(doto bg
(.setColor (. Color white))
(.fillRect 0 0 (. img (getWidth)) (. img (getHeight)))
(.setColor (. Color red))
(.drawRect origin-x origin-y (+ origin-x box-width) (+ origin-y box-height)))
(dorun
(for [i (range number-of-balls)]
(do
(paint-balls bg (#(get-ball i) :x) (#(get-ball i) :y)))))
(. g (drawImage img 0 0 nil))
(. bg (dispose))))
(def panel (doto (proxy [JPanel] []
(paint [g] (render g)))
(.setPreferredSize (new Dimension
width
height))))
(def frame (doto (new JFrame) (.add panel) .pack .show))
(def animator (agent nil))
(defn bounce
[x]
(while true
(set-new-x #*agent*)
(set-new-y #*agent*)
(. Thread (sleep 100))
(println "here in bounce " *agent*)))
(defn animation
[x]
(send-off *agent* animation)
(. panel (repaint))
(. Thread (sleep 100)))
(defn send-balls
[]
(doall
(for [i (range number-of-balls)]
(do
(send-off (ball-agents i) bounce)))))
(send-off animator animation)

As i see the main problem - functions that you send-off to agents operate NOT with agent, but with its value (the ref). By eliminating # in set-new-x and set-new-y functions you could make it work.
(ns balls)
(import
'(java.awt Color Graphics Dimension)
'(java.awt.image BufferedImage)
'(javax.swing JPanel JFrame))
(def width 1000)
(def height 1000)
(def number-of-balls 3)
(def rad 20)
(def origin-x 100)
(def origin-y 100)
(def box-height 500)
(def box-width 700)
(def max-x (+ origin-x box-width (* 4 rad)))
(def max-y (+ origin-y box-height (* 4 rad)))
(def min-x origin-x)
(def min-y origin-y)
(defn init-x
[]
(+ (rand-int (- max-x min-x)) min-x))
(defn init-y
[]
(+ (rand-int (- max-y min-y)) min-y))
(defstruct ball :x :y :x-speed :y-speed)
(def balls
(apply vector (map (fn [_] (ref (struct ball (init-x) (init-y)
(rand-int 10) (rand-int 10))))
(range number-of-balls))))
(def ball-agents (apply vector (map agent balls)))
(defn get-ball
[n]
(balls n))
(defn set-new-x
[ball]
(let [x (ball :x)
x-speed (ball :x-speed)
new-x (+ x x-speed)]
(dosync
(if (and (>= new-x min-x) (<= new-x max-x))
(alter ball assoc :x new-x)
(alter ball assoc :x-speed (* -1 x-speed)))))
ball)
(defn set-new-y
[ball]
(let [y (ball :y)
y-speed (ball :y-speed)
new-y (+ y y-speed)]
(dosync
(if (and (>= new-y min-y) (<= new-y max-y))
(alter ball assoc :y new-y)
(alter ball assoc :y-speed (* -1 y-speed))))
ball))
(defn paint-balls
[bg x y]
(doto bg
(.setColor (. Color red))
(.fillOval x y rad rad)))
(defn render
[g]
(let [img (new BufferedImage width height
(. BufferedImage TYPE_INT_ARGB))
bg (. img (getGraphics))]
(doto bg
(.setColor (. Color white))
(.fillRect 0 0 (. img (getWidth)) (. img (getHeight)))
(.setColor (. Color red))
(.drawRect origin-x origin-y (+ origin-x box-width) (+ origin-y box-height)))
(dorun
(for [i (range number-of-balls)]
(do
(paint-balls bg (#(get-ball i) :x) (#(get-ball i) :y)))))
(. g (drawImage img 0 0 nil))
(. bg (dispose))))
(def panel (doto (proxy [JPanel] []
(paint [g] (render g)))
(.setPreferredSize (new Dimension
width
height))))
(def frame (doto (new JFrame) (.add panel) .pack .show))
(def animator (agent nil))
(defn bounce
[ball_cur]
(do
(Thread/sleep 100)
(send-off *agent* bounce)
(set-new-x (set-new-y ball_cur))))
(defn animation
[x]
(send-off *agent* animation)
(. panel (repaint))
(. Thread (sleep 100)))
(defn send-balls
[]
(doall
(for [i (range number-of-balls)]
(do
(send-off (ball-agents i) bounce)))))
(send-off animator animation)
(send-balls)

I think you don't need refs inside agents. Please see below for a working version with just agents. You can load the code eg. via load-file then simply issue start. A frame will pop up with the desired animation. It can be stopped by reset!ing the returned atom to false. You can have as you many independent animation frames as you wish by calling start more than once.
Hope that helps.
(import
'(java.awt Color Graphics Dimension)
'(java.awt.image BufferedImage)
'(javax.swing JPanel JFrame))
(def width 1000)
(def height 1000)
(def number-of-balls 3)
(def rad 20)
(def origin-x 100)
(def origin-y 100)
(def box-height 500)
(def box-width 700)
(def min-borders {:x origin-x
:y origin-y})
(def max-borders {:x (+ origin-x box-width (* 4 rad))
:y (+ origin-y box-height (* 4 rad))})
(defn init
[coord]
(+ (rand-int (- (get max-borders coord) (get min-borders coord)))
(get min-borders coord)))
(defn init-balls
[]
(->> (repeatedly number-of-balls
#(array-map :x (init :x) :y (init :y)
:x-speed (rand-int 10)
:y-speed (rand-int 10)))
(map agent)
vec))
(defn update-coordinate
[ball coord-key speed-key]
(let [coord (get ball coord-key)
speed (get ball speed-key)
new-c (+ coord speed)]
(if (<= (get min-borders coord-key) new-c (get max-borders coord-key))
(assoc ball coord-key new-c)
(assoc ball speed-key (- speed)))))
(defn paint-ball
[bg x y]
(doto bg
(.setColor Color/red)
(.fillOval x y rad rad)))
(defn render
[g balls]
(let [img (BufferedImage. width height BufferedImage/TYPE_INT_ARGB)
bg (.getGraphics img)]
(doto bg
(.setColor Color/white)
(.fillRect 0 0 (.getWidth img) (.getHeight img))
(.setColor Color/red)
(.drawRect origin-x origin-y
(+ origin-x box-width) (+ origin-y box-height)))
(doseq [b balls]
(let [ball #b]
(paint-ball bg (:x ball) (:y ball))))
(.drawImage g img 0 0 nil)))
(defn bounce
[ball running?]
(when #running?
(send-off *agent* bounce running?))
(Thread/sleep 100)
(-> ball
(update-coordinate :x :x-speed)
(update-coordinate :y :y-speed)))
(defn animation
[panel running?]
(while #running?
(javax.swing.SwingUtilities/invokeAndWait #(.repaint panel))
(Thread/sleep 100)))
(defn start
[]
(let [running? (atom true)
balls (init-balls)
panel (doto (proxy [JPanel] []
(paint [g] (render g balls)))
(.setPreferredSize (Dimension. width height)))
frame (doto (JFrame.) (.add panel) .pack .show)]
(doseq [b balls]
(send-off b bounce running?))
(future (animation panel running?))
running?))

Your send (or send-off) function (in this case: bounce) should return the (new) state of the agents. This is fully described here.

There are a couple of problems with the code -
As Maurits pointed out, bounce does not return the new state of the agent.
There is no place in the bounce function where bounce is added to the action queue of the agent again. This is needed as the new coordinated need to be calculated again and again.

Related

Agents and threads synchronization in Clojure

I have to rewrite this code using agents in someway the result of x is 0 (It means that each thread is executed one after one). But I have problems because I do not have enough knowledge about agents use.
The original code is:
(def x 0)
(let [t1 (Thread. #(dotimes [_ 10000] (def x (inc x))))
t2 (Thread. #(dotimes [_ 10000] (def x (dec x))))]
(.start t1)
(.start t2)
(.join t1)
(.join t2)
(println x))
When I want to use an agent with await(agent_name) to make each thread run separately, it does not work, the result is always different from zero.
Please any suggestions about this?
I gave this a try and it prints 0 as expected:
(ns agent-demo.core
(:gen-class))
(def counter
(agent 0))
(defn -main [& args]
(let [t1 (Thread. #(dotimes [_ 10000]
(send counter inc)))
t2 (Thread. #(dotimes [_ 10000]
(send counter dec)))]
(.start t1)
(.start t2)
(.join t1)
(.join t2)
(await counter)
(println #counter)
(shutdown-agents)))

Error with values in structs

I have started to build a small game in racket using the 2htdp/universe library. My code so far:
#lang racket
(require 2htdp/image 2htdp/universe)
(define BIRD-IMG (scale .2 (object:image% ...)) ; Image URL: http://i.stack.imgur.com/Vz26B.png
(struct world (bird) #:transparent)
(struct pos (x y) #:transparent)
(struct bird (pos img) #:transparent)
(define-values (WIDTH HEIGHT)
(values 600 600))
(define DEFAULT-STATE (world (bird (pos (/ WIDTH 2) (/ HEIGHT 2)) BIRD-IMG)))
(define (move-bird w x y dir)
(world
(bird
(pos
(let
([new-x (+ (pos-x (bird-pos (world-bird w))) x)]
[new-y (+ (pos-y (bird-pos (world-bird w))) y)])
(values
(cond
[(> new-x WIDTH) WIDTH]
[(< new-x 0) 0]
[else new-x])
(cond
[(> new-y HEIGHT) HEIGHT]
[(< new-y 0) 0]
[else new-y]))))
(case dir
[("up") BIRD-IMG]
[("down") (rotate 180 BIRD-IMG)]
[("left") (rotate 90 BIRD-IMG)]
[("right") (rotate -90 BIRD-IMG)]
[else (bird-img (world-bird w))]))))
(define (render w)
(place-image (bird-img (world-bird w))
(pos-x (bird-pos (world-bird w)))
(pos-y (bird-pos (world-bird w)))
(empty-scene WIDTH HEIGHT)))
(define (handle-keys w key)
(case key
[("up") (move-bird w 0 -5 key)]
[("down") (move-bird w 0 5 key)]
[("left") (move-bird w -5 0 key)]
[("right") (move-bird w 5 0 key)]
[else w]))
(big-bang DEFAULT-STATE
(on-draw render)
(on-key handle-keys)
(on-tick (lambda (w) w) 20)
(name "Bird Simulator 2016"))
My problem: When I try to press the arrow keys to move the bird in a direction, there is an error in the 'move-bird' function:
result arity mismatch;
expected number of values not received
expected: 1
received: 2
values...:
Running it through DrRacket's debugger, I can see that it is where the variables from the let have gone out of scope, but the program is at a lower level than the outermost world struct. I am confused because the arity mismatch error didn't name any particular place/function, and I certainly don't see any place where more values are given then are required. The world struct is passed only a bird struct, and the bird struct only a pos and an img. It might have to do with the let inside of the pos struct, but I am not sure. Please help!

Threading and busy-waiting in scheme

I'm writing a scheme program that allows a user to create planets that follow gravitational laws. For the assignment, I have to alter the code to avoid busy waiting and also create a new thread for each planet, or every time that the mouse is clicked. I don't have a good understanding of GUIs in scheme, and would be very thankful for some help.
Here is the code:
#lang racket
(require racket/gui)
;; Small 2d vector library for the Newtonian physics
(define (x v) (vector-ref v 0))
(define (y v) (vector-ref v 1))
(define (x! v value) (vector-set! v 0 value))
(define (y! v value) (vector-set! v 1 value))
(define (v* v value) (vector-map (lambda (x) (* x value)) v))
(define (v+ v w) (vector-map + v w))
(define (v- v w) (vector-map - v w))
(define (v-zero! v) (vector-map! (lambda (x) 0) v))
(define (v-dot v w) (let ((vw (vector-map * v w))) (+ (x vw) (y vw))))
(define (v-mag v) (sqrt (v-dot v v)))
;; Planet object
(define planet%
(class object%
(public m p v calculate-force move draw)
(init-field (mass 1)
(position (vector 0 0 ))
(velocity (vector 0 0 ))
(force (vector 0 0 )))
(define (m) mass)
(define (p) position)
(define (v) velocity)
;; Use Newton's law of gravitation.
;; I assume the gravitational constant is one
(define (calculate-force pl)
(v-zero! force)
(for-each (lambda (other-planet)
(when (not (equal? this other-planet))
(let* ((direction (v- (send other-planet p) position))
(dist (max 1 (v-mag direction)))
(other-mass (send other-planet m))
(new-force (v* direction (/ (* mass other-mass) (* dist dist))))
)
(vector-map! + force new-force))))
pl)
)
;; Simple Euler integration of acceleration and velocity
(define (move)
(let ((acc (v* force (/ 1.0 mass))))
(vector-map! + velocity acc)
(vector-map! + position velocity)))
;; Draw a circle
(define (draw dc)
(send dc set-brush brush)
(send dc set-pen pen)
(send dc draw-ellipse (x position) (y position) radius radius ))
;; Initialize to random velocity, mass, and color
(x! velocity (* 2 (random)))
(y! velocity (* 2 (random)))
(set! mass (+ 1 (* 10 (random))))
(define radius (* 5 (sqrt mass)))
(define color
(let* ((r (random))
(b (real->floating-point-bytes r 4)))
(make-object color% (bytes-ref b 0) (bytes-ref b 1) (bytes-ref b 2) )))
(define brush (make-object brush% color))
(define pen (make-object pen% color))
;; Don't forget the super-new!
(super-new)
))
;; Abstract the list-handling for a list of planets
(define planet-container%
(class object%
(public add-planet calculate-force move draw get-planets)
(init-field (planets '()))
(define (get-planets) planets)
(define (add-planet planet)
(set! planets (cons planet planets)))
(define (calculate-force)
(for-each (lambda (planet)
(send planet calculate-force planets))
planets))
(define (move)
(for-each (lambda (planet)
(send planet move))
planets))
(define (draw dc)
(for-each (lambda (planet)
(send planet draw dc))
planets))
(super-new)
)
)
(define planet-container (new planet-container%))
;; The GUI
(define frame (new frame%
(label "Planets")
(min-width 120)
(min-height 80)
))
(send frame create-status-line)
(send frame show #t)
(define h-panel
(new horizontal-panel%
(parent frame)
(stretchable-height #f)
(style '(border))
(border 2)))
(define run-checkbox
(new check-box%
(parent h-panel)
(label "Run animation")
))
(define my-canvas%
(class canvas%
(override on-paint on-event)
(define (on-paint)
(let ((dc (send this get-dc))
(w (send this get-width))
(h (send this get-height)))
(send dc clear)
(send planet-container draw dc)
))
(define (on-event event)
(when (send event button-down?)
(let ((x (send event get-x))
(y (send event get-y)))
(send frame set-status-text (format "Mouse at ~a ~a" x y))
(send planet-container add-planet (new planet% (position (vector x y))))
(send this refresh)))
)
(super-new)
(send (send this get-dc) set-background (make-object color% 8 8 64))
))
(define canvas
(new my-canvas%
(parent frame)
(style '(border))
(min-width 640)
(min-height 480)))
;; Busy loop planet animator
(let loop ()
(sleep/yield .05)
(when (send run-checkbox get-value)
(send planet-container calculate-force)
(send planet-container move)
(send canvas refresh)
)
(loop))
Here's the crucial bit of code:
(define ch (make-channel))
(define run-checkbox
(new check-box%
(parent h-panel)
(label "Run animation")
[callback (λ _ (channel-put ch (send run-checkbox get-value)))]))
(thread (λ ()
(define moving? #f)
(let loop ()
;; either get a message on ch, or wait for 50 ms
(define r (sync ch (alarm-evt (+ (current-inexact-milliseconds) 50))))
;; if we got a message, update the state
(when (boolean? r) (set! moving? r))
;; move things if necessary
(when moving?
(send planet-container calculate-force)
(send planet-container move)
(send canvas refresh))
(loop))))
We first create a channel to communicate between the checkbox and the update thread.
Then, whenever there's a click on the checkbox, we send the value of the checkbox over the channel.
In the thread, we keep track of whether we're moving or not with the moving? variable. The thread simply sits in a loop updating the canvas whenever we're in the "moving" state.
To check for new messages, we use sync. The call to sync will return a result either if there's a message on ch (either #t or #f) or the alarm-evt finishes (in 50 milliseconds). If we actually got a message, ie a boolean message on the channel, we update which state we're in, update the canvas if necessary, and go back around the loop.

Thread-suspend/thread-resume in scheme

I'm writing a scheme program for an assignment that creates "planets" when the user clicks, and starts/stops the planets from orbiting each other when a checkbox is clicked. We are supposed to implement this with a thread. However, thread-suspend does not seem to work when I click the checkbox, but resume does.
Thanks for any help you can offer! Here is the code:
#lang racket
(require racket/gui)
(require racket/block)
;; Small 2d vector library for the Newtonian physics
(define (x v) (vector-ref v 0))
(define (y v) (vector-ref v 1))
(define (x! v value) (vector-set! v 0 value))
(define (y! v value) (vector-set! v 1 value))
(define (v* v value) (vector-map (lambda (x) (* x value)) v))
(define (v+ v w) (vector-map + v w))
(define (v- v w) (vector-map - v w))
(define (v-zero! v) (vector-map! (lambda (x) 0) v))
(define (v-dot v w) (let ((vw (vector-map * v w))) (+ (x vw) (y vw))))
(define (v-mag v) (sqrt (v-dot v v)))
(define sem (make-semaphore))
;; Planet object
(define planet%
(class object%
(public m p v calculate-force move draw)
(init-field (mass 1)
(position (vector 0 0 ))
(velocity (vector 0 0 ))
(force (vector 0 0 )))
(define (m) mass)
(define (p) position)
(define (v) velocity)
;; Use Newton's law of gravitation.
;; I assume the gravitational constant is one
(define (calculate-force planet-list)
(v-zero! force)
(for-each (lambda (other-planet)
(when (not (equal? this other-planet))
(let* ((direction (v- (send other-planet p) position))
(dist (max 1 (v-mag direction)))
(other-mass (send other-planet m))
(new-force (v* direction (/ (* mass other-mass) (* dist dist))))
)
(vector-map! + force new-force))))
planet-list)
)
;; Simple Euler integration of acceleration and velocity
(define (move)
(let ((acc (v* force (/ 1.0 mass))))
(vector-map! + velocity acc)
(vector-map! + position velocity)))
;; Draw a circle
(define (draw dc)
(send dc set-brush brush)
(send dc set-pen pen)
(send dc draw-ellipse (x position) (y position) radius radius ))
;; Initialize to random velocity, mass, and color
(x! velocity (random))
(y! velocity (random))
(set! mass (+ 1 (* 10 (random))))
(define radius (* 5 (sqrt mass)))
(define color
(let* ((r (random))
(b (real->floating-point-bytes r 4)))
(make-object color% (bytes-ref b 0) (bytes-ref b 1) (bytes-ref b 2) )))
(define brush (make-object brush% color))
(define pen (make-object pen% color))
;; Don't forget the super-new!
(super-new)
))
;; Abstract the list-handling for a list of planets
(define planet-list%
(class object%
(public add-planet calculate-force move draw)
(init-field (planets '()))
(define (add-planet planet)
(set! planets (cons planet planets)))
(define (calculate-force)
(for-each (lambda (planet)
(send planet calculate-force planets))
planets))
(define (move)
(for-each (lambda (planet)
(send planet move))
planets))
(define (draw dc)
(for-each (lambda (planet)
(send planet draw dc))
planets))
(super-new)
)
)
(define planet-list (new planet-list%))
;; The GUI
(define frame (new frame%
(label "Planets")
(min-width 120)
(min-height 80)
))
(send frame create-status-line)
(send frame show #t)
(define h-panel
(new horizontal-panel%
(parent frame)
(stretchable-height #f)
(style '(border))
(border 2)))
(define run-checkbox
(new check-box%
(parent h-panel)
(label "Run animation")
(callback
(lambda (button event)
(cond [(send run-checkbox get-value)(thread-resume (thread-a))]
[(not (send run-checkbox get-value)) (thread-suspend (thread-a))]
)))
))
(define my-canvas%
(class canvas%
(override on-paint on-event)
(define (on-paint)
(let ((dc (send this get-dc))
(w (send this get-width))
(h (send this get-height)))
(send dc clear)
(send planet-list draw dc)
))
(define (on-event event)
(when (send event button-down?)
(let ((x (send event get-x))
(y (send event get-y)))
(send frame set-status-text (format "Mouse at ~a ~a" x y))
(send planet-list add-planet (new planet% (position (vector x y))))
(send this refresh)))
)
(super-new)
(send (send this get-dc) set-background (make-object color% 8 8 64))
))
(define canvas
(new my-canvas%
(parent frame)
(style '(border))
(min-width 640)
(min-height 480)))
;; planet animator
(define thread-a (lambda ()
(let loop ()
(sleep/yield .1)
(send planet-list calculate-force)
(send planet-list move)
(send canvas refresh)
(loop))))
; this creates the thread-a and starts the program
(thread-suspend (thread thread-a))
It's actually miraculous that you got this working as much as it does.
The problem is that thread-a is not a thread. It's not a function that produces a thread. It's a function that runs forever, moving planets around and updating the canvas.
So when your checkbox's callback does (thread-suspend (thread-a)), for example, the thread-suspend never actually happens. The call to thread-a just starts running and never returns.
The reason the GUI doesn't lock up (which it normally would if an event callback didn't return) is that thread-a periodically calls sleep/yield, which allows the GUI event loop to process more events. (That's why I said the code is miraculous.)
The fix is to define thread-a as the thread itself:
(define thread-a
(thread
(lambda ()
(let loop () ....))))
(thread-suspend thread-a)
and change the other references from (thread-a) to just thread-a.

Can xmonad make our often used functions available anytime?

We have some functions needed to be called at any time and places. For example:
(defun winG (qty pb ps)
(- (* qty ps (- 1 SXF YHS)) (* 2 GHF) (* qty pb (+ 1 SXF))))
(defun winQ (qty pb ps)
(- (* qty ps (- 1 SXF)) (* 2 GHF) (* qty pb (+ 1 SXF))))
(defun stopLoss (qty pb &optional (lossRate 0.02))
(let ((tot (* qty pb (+ 1 SXF))))
(format t "Stop Loss at:~$~%" (- pb (/ (* tot lossRate) qty)))
(format t "Lost Money:~$(~d%)~%" (* tot lossRate) (* 100 lossRate))))
(defun div618 (p1 p2)
(let ((ratio '(0. 0.191 0.236 0.382 0.5 0.618 0.809 1.))
(price #'(lambda (r) (if (<= p1 p2) (+ p1 (* (- p2 p1) r)) (- p1 (* (- p1 p2) r))))))
(if (<= p1 p2)
(dolist (r (reverse ratio)) (format t "-------~3$ ~$-------~%" r (funcall price r)))
(dolist (r ratio) (format t "-------~3$ ~$-------~%" r (funcall price r))))))
Now we use stumpwm which can load our functions once started and we can call those functions just by striking hot key to open its eval window at any time and places. It is VERY convenient. However, the stumpwm is not VERY steady as xmonad. So we want to use xmonad instead of stumpwm and we donot mind to implement those Common Lisp functions using haskell.
Any suggestion is appreciated!
you should be able to do this via something like this
myKeys conf#(XConfig {XMonad.modMask = modm}) = M.fromList $
[ ((modm, xK_F1 ), spawn $ XMonad.terminal conf) --starts the terminal
, ((mod4Mask,xK_F1 ), spawn "gvim" >> -- you can concatenate commands too
spawn "notify-send -t 1000 gVim" >>
focusUrgent) -- or haskell functions
, ((mod4Mask,xK_F2 ), spawn "lisp evaluate lispy function")
, ((modm, xK_F3 ), haskellFunctionPortedFromLisp )]
hope this helps.

Resources