I was trying to clone an object in Scheme, something like
(define o1
(new cl%
[a 1] [b 2]))
and then
(define o2 o1)
When I used set! on o1, it changed o2 along with o1. But I want independent cloning with same attributes. What should I do?
Write a copy method. Then:
(define o2 (copy-cl%-thingy o1))
Like this:
(define (new aval bval)
`(cl% [a ,aval] [b ,bval]))
(define cl%-aval caddr)
(define cl%-bval cadddr)
(define (copy-cl%-thingy o)
(new (cl%-aval o) (cl%-bval o)))
Related
I need convert this code to Haskell. Please help me.
I would be very grateful for your help.
#lang scheme
(define (lab1 currentList counter result)
(let countdown ((i (- (length currentList) 1)))
(if (= i 0)
(display result)
(begin
(if (list? (list-ref currentList i))
(if (> (+ 1 counter) result)
(begin
(set! counter (+ 1 counter))
(set! result (+ 1 result))
(countdown(- i 1)))
(begin
(set! counter (+ 1 counter))
(countdown(- i 1))))
(begin
(set! counter 0)
(countdown(- i 1))))))))
I think I need to use something like:
data PolarBear a = P a | B [PolarBear a]
task :: [PolarBear a] -> Int
task [] = 0
task ((P _):ps) = task ps
task ((B p):ps) | null p = 1 + task ps
| otherwise = task ps + (task p)
main = task $ [B [ P 1, B [], B [ P 2, B [ P 3, B [], B []]]]]
?
As molbdnilo indicated, that's a really wretched excuse for Scheme code. To really get a feel for translating Scheme to Haskell, you should first make versions of counter and result that are bound in the countdown named let and updated on each pass without using set!.
(define (lab1 currentList counter0 result0)
(let countdown
((i (- (length currentList) 1))
(counter counter0)
(result result0))
(if (= i 0)
(display result)
(if (list? (list-ref currentList i))
(if (> (+ 1 counter) result)
(countdown (- i 1) (+ 1 counter) (+ 1 result))
(countdown (- i 1) (+ 1 counter) result))
(countdown (- i 1) 0 result)))))
Once you've done that, you can expand the named let out into a local recursive function. Remember that
(let loop ((x x0)) body)
is basically the same as
(letrec ((loop (lambda (x) body)))
(loop x0))
Once you've done that, the translation to Haskell should be pretty much immediate. It will be really bad Haskell code, because Haskell's !! is every bit as horribly inefficient as Scheme's list-ref (Will Ness shows how to do it much better), but it will faithfully reproduce the original code's behavior and (terrible) performance.
The thing to notice in your code is that it processes the input list from back to front, passing the info along in the same direction (in two variables). This is the same as what foldr does, when the combining function is strict in its second argument.
The pair which is the second argument to the combining function emulates the updatable "environment" for the two vars in Scheme.
I'm leaving spaces to be filled, since it's a homework.
lab1 ... = ... $
foldr (\x (counter,result)->
if (listP x)
then (if counter >= result
then (counter+1,result+1)
else (counter+1,result))
else (0,result)) (....,....) currentlist
assuming a datatype to which there exists a listP predicate returning a Boolean result. Like e.g.
data NestedList a = Atom a | List [NestedList a]
with
listP (Atom _) = ...
listP (...) = ...
If you need to present an explicitly recursive code, you need to write down the definition for foldr, and fuse it with the definition for the combining function above (let's call it g), turning
foldr g ... = ...
into
foldr_g ... = ...
then just renaming the foldr_g to your liking. The postprocessing step can go into a separate, "interface" function. Like so,
foldr_g z [] = z
foldr_g z (x:xs) = -- g x (foldr_g z xs)
g x r
where
r = foldr_g z xs
g x (counter, result)
| listP x = if counter >= result then ... else ...
| otherwise = ....
Actually inline the definition of g into the foldr_g by interchanging the code lines and smashing the two definitions together, as
foldr_g z [] = z
foldr_g z (x:xs) -- g x (foldr_g z xs)
-- g x r
| listP x = if counter >= result then ... else ...
| otherwise = ....
-- where
-- r = foldr_g z xs
where
(counter, result) = foldr_g z xs
and we call it as
lab1 currentList counter result =
... (foldr_g (...,...) currentlist)
How am I supposed to call this stuff from main?
data Poly' = Lit Integer |
Add Poly' Poly' |
Sub Poly' Poly'
eval::Poly'->Integer
eval (Lit n) = n
eval (Add p1 p2) = (eval p1) + (eval p2)
eval (Sub p1 p2) = (eval p1) - (eval p2)
I am trying this, but it doesn't work:
main = do
print(eval Add(2 3))
Try main = print . eval $ Add (Lit 2) (Lit 3)
Your use of parens suggests you don't quite understand haskell function application. You should almost never write a(b c) because its really a (b c), that is, a $ b c whereas the former looks more like C function application, which it is most certainly not.
I am pretty sure your problem is that Add takes two Poly's unfortunately you are calling it with ints not Poly's. Lit 2 is a Poly', 2 is an int.
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.
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.
I like how you can retain representation in transparent structs:
(struct posn (x y)
#:transparent)
> (posn 1 2)
(posn 1 2)
But is there a way to customize it? Like in Python?
Check out the prop:custom-write property here. Here's a simple implementation:
(struct pr (x y)
#:transparent
#:property prop:custom-write (λ (v p w?)
(fprintf p "<~a,~a>" (pr-x v) (pr-y v))))
> (pr 1 2)
<1,2>
Note that this works with non-#:transparent structures as well.