I wrote a function in Racket to produce something similar to the following fractal.
(define CUT-OFF 5)
(define CIRCLE-MODE "outline")
(define (circle-fractal size colour)
(local [(define full-circle (circle size CIRCLE-MODE colour))]
(cond [(<= size CUT-OFF) full-circle]
[else
(overlay/align "middle" "middle"
full-circle
(beside (circle-fractal (/ size 2) colour)
(circle-fractal (/ size 2) colour)))])))
It passes my tests.
I changed the code, thinking the below would be more readable.
(define (circle-fractal size colour)
(local [(define full-circle (circle size CIRCLE-MODE colour))
(define half-circle (circle-fractal (/ size 2) colour))]
(cond [(<= size CUT-OFF) full-circle]
[else
(overlay/align "middle" "middle"
full-circle
(beside half-circle half-circle))])))
Now the function doesn't terminate. Racket reaches its memory limit with no output.
Does each corecursive call somehow not approach the trivial case after this change?
In the first version (circle-fractal (/ size 2) colour) is evaluated only if size > CUT-OFF. In the second it's called regardless of size. This way you lost your recursion base case.
Try:
(define (circle-fractal size colour)
(define full-circle (circle size CIRCLE-MODE colour))
(cond [(<= size CUT-OFF) full-circle]
[else
(define half-circle (circle-fractal (/ size 2) colour))
(overlay/align "middle" "middle"
full-circle
(beside half-circle half-circle))]))
Related
I am trying to place a vertically positioned rectangle and another object on an empty-scene using place-images in Beginning Student Language. However, when I run the function, the rectangle only takes up half the scene horizontally when its width is set equal to the width of the scene.
I checked what happens to my code using Stepper and found where the image-width halves but I do not know why. Probably it's to do with cons which I am not very familiar with.
Here's the full code:
(require 2htdp/image)
(define WIDTH 400)
(define HEIGHT 300)
(define HMAX 100)
(define SCENE (empty-scene WIDTH HEIGHT))
(define-struct vcham [x h c])
(define c (make-vcham 0 100 "white"))
(define (render ch)
(place-images (list (rectangle (* 1 WIDTH (/ (vcham-h ch) HMAX)) 50 "solid" "maroon")
(rectangle 1 1 "solid" "blue"))
(list (make-posn 0 0) (make-posn 20 20))
SCENE))
(render c)
I have simplified this code as much as a I could, thus the 1×1 rectangle. I am also interested in elegant alternatives to implement this, but am most interested in finding out why this happens.
place-images is like place-image :
Places image onto scene with its center at the coordinates (x,y)
and crops the resulting image so that it has the same size as
scene. The coordinates are relative to the top-left of scene.
you can change (make-posn 0 0) to (make-posn 200 25), or try place-images/align
(define (render ch)
(place-images/align (list (rectangle (* 1 WIDTH (/ (vcham-h ch) HMAX)) 50 "solid" "maroon")
(rectangle 1 1 "solid" "blue"))
(list (make-posn 0 0) (make-posn 20 20))
"left" "top" SCENE))
I'm playing a little with Racket big-bang mechanism, but I cannot get both smooth and fast going projectile. There's so much ugly flickering. Here's my code:
(require 2htdp/universe
2htdp/image)
(define gx 0)
(define gy 0.35)
(struct ballstate (x y vx vy) #:transparent)
(define startstate (ballstate 10 590 7 -20))
(define (make-new-state old)
(define newvx (+ (ballstate-vx old) gx))
(define newvy (+ (ballstate-vy old) gy))
(ballstate (+ (ballstate-x old) newvx)
(+ (ballstate-y old) newvy)
newvx
newvy))
(define (main)
(big-bang startstate
[on-tick make-new-state]
[to-draw place-ball-at]
[on-key reset]))
(define (place-ball-at s)
(place-image (circle 10 "solid" "red")
(ballstate-x s)
(ballstate-y s)
(empty-scene 800 600)))
(define (reset s ke)
startstate)
(main)
The question is: how to make it better, faster, smoother and flicker-free?
Here are two things that might help:
The on-tick clause takes an optional parameter that determines the time between two ticks. The default is 1/28, so if you lower this you will get more frames resulting in a smoother animation.
If your program takes longer than the time between each tick to produce an image, you will see stuttering. Precomputing everything that can be precomputed is a good thing. For example, there is no reason to produce a new empty scene each time, so below I have simply stored it in a variable.
(define (main)
(big-bang startstate
[on-tick make-new-state 1/50]
[to-draw place-ball-at]
[on-key reset]))
(define background (empty-scene 800 600))
(define (place-ball-at s)
(place-image (circle 10 "solid" "red")
(ballstate-x s)
(ballstate-y s)
background))
This my code:
#lang racket
(require racket/gui)
(define-values (screen-width screen-height) (get-display-size))
(define *app-width* 400)
(define *app-height* 125)
(define *vm-frame* (new frame%
[label "Test"]
[width *app-width*]
[height *app-height*]
[x (- (quotient screen-width 2) (quotient *app-width* 2))]
[y (- (quotient screen-height 2) (quotient *app-height* 2))]
))
(define frame-canvas%
(class canvas%
(super-new)
(inherit get-dc)
(define/override (on-paint)
(let ([my-dc (get-dc)])
(send my-dc clear)
(send my-dc set-background "black")))))
(let ([frame-canvas (new frame-canvas% [parent *vm-frame*])])
(send *vm-frame* show #t))
On mac os, this is normal, show a app with a black background.
But on windows, background is white.
Why? Racket version is 5.3, it's a 5.3 bug?
Reverse the order of set-background and clear.
The call to clear uses the color of the current background to do the fill. If somehow your on-paint were called at least more than once, then you would observe a black background, since the second time around, the current background color would be black. I suspect this is what explains the platform-specific difference you observed.
I'm trying to write a function that makes all the windows in an Emacs frame 120 characters wide. So far I have this:
(defun standard-width ()
"makes the widht of the window 120, our coding standard"
(interactive)
(delete-other-windows)
(set-frame-width (selected-frame) 120 )
)
However I'd like to have this work without the delete-other-windows call. Unfortunately, without this call the total frame width is 120, shared among windows. How can I make the total frame width (maximum number of windows in the horizontal direction) * 120?
I don't know of a simple way to do this. I would use (window-tree (selected-frame)), and parse the return value to find the row with the maximum number of windows laid out horizontally, and use the count to calculate frame width and hope that the windows would scale correctly. If the windows do not scale right, then I'd attempt to resize them individually (after setting the frame width) using the window-resize function defined in window.el.
The format of the return value for window-tree can be found in Emacs Lisp document.
Something along the lines of the following function should do the trick:
(defun horizontal-window-count (tree)
(if (atom tree)
1
(if (car tree)
(apply 'max (mapcar 'horizontal-window-count (cddr tree)))
(apply '+ (mapcar 'horizontal-window-count (cddr tree))))))
You use it as (horizontal-window-count (car (window-tree))). The code can probably be simplified and it may have some issues, but I am also not very fluent in lisp.
This will set the frame size to the number of windows * 120, but the meaning of a "number of windows horizontally" needs greater definition.
(set-frame-width (selected-frame) (* 120 (length (window-list))))
The current solution is all its ugly glory.
(defun horizontal-window-count (tree)
(if (atom tree)
1
(if (car tree)
(apply 'max (mapcar 'horizontal-window-count (cddr tree)))
(apply '+ (mapcar 'horizontal-window-count (cddr tree))))))
(defun horz-count ()
(horizontal-window-count (car (window-tree))))
(defun standard-width ()
"makes the widht of the window 120, our coding standard"
(interactive)
(set-frame-width (selected-frame) (* 120 (horz-count)))
)
My first steps with Lisp macros...
(defconstant width 7)
(defconstant height 6)
...
; board is a 2D array of width x height
; and this is my first ever macro:
(defmacro at (y x)
`(aref board ,y ,x))
; "board" must be available wherever the macro is used.
(defun foo (board ...)
...
(loop for y from 0 to (1- height) do
; thanks to the "at" macro, this is cleaner:
(let ((score (+ (at y 0) (at y 1) (at y 2))))
(loop for x from 3 to (1- width) do
(incf score (at y x))
; ...do something with score
(decf score (at y (- x 3)))))))
The code uses my first ever macro, the "at" one. It emits "access instructions" to read from board[y][x], so it can only be used in places where "board" exists, like the function "foo" above.
This worked - and then I realized that... I can go further.
The two nested loops are "statically" constrained: from 0 to height-1 for y, from 3 to (width-1) for x... so in theory, I can create a macro that emits (unrolls!) the exact incf and decf instructions done in the loops' code!
I tried this:
(defmacro unroll ()
(loop for y from 0 to (1- height) do
`(setf score (+ (at ,y 0) (at ,y 1) (at ,y 2)))
(loop for x from 3 to (1- width) do
`(incf score (at ,y ,x))
`(decf score (at ,y (- ,x 3))))))
...but failed - "(macroexpand-1 '(unroll))" shows me NIL.
What am I doing wrong?
In case it is not clear, I want to use two nested loops and emit "code" at the beginning of the outer loop, and for each iteration of the inner loop.
Any help most appreciated (I am a LISP newbie).
UPDATE: After #larsmans' kind advice, I succeeded in applying this change to my code - and to my immense satisfaction, I watched the Lisp version of my Score4 algorithm become the 2nd fastest implementation, behind only C and C++ (and faster than OCaml!).
You should collect the statements you generate inside the macro's loop, not pretend to execute them with do:
(defmacro unroll ()
(loop for y from 0 to (1- height)
collect
`(begin (setf score (+ (at ,y 0) (at ,y 1) (at ,y 2)))
,#(loop for x from 3 to (1- width)
collect `(begin (incf score (at ,y ,x))
(decf score (at ,y (- ,x 3))))))))