» CS 330 Lecture 35 – Lsystem evaluation

CS 330 Lecture 35 – Lsystem evaluation

April 30, 2012 by Chris Johnson. Filed under cs330, lectures, spring 2012.
Agenda

lexical vs. dynamic scope
Perl’s scope
narrowing scope in Scheme with let
executing user code
sandboxed evaluation
side-effects in Scheme
Code

lsystem.ss

#lang racket

(require racket/sandbox)

(define apply-productions-once
  (lambda (loa substitutions)
    (cond
      ((null? loa) '())
      (else (append
             (cdr (assoc (car loa) substitutions))
             (apply-productions-once (cdr loa) substitutions))))))

(define apply-productions-n-times
  (lambda (current substitutions n)
    (cond
      ((= n 0) current)
      (else (apply-productions-n-times
             (apply-productions-once current substitutions)
             substitutions
             (- n 1))))))

(define evaler
  (parameterize ((sandbox-output 'string))
    (make-evaluator
     '(begin (define (deg2rad rad) (/ (* rad pi) 180))
             
             (define-struct turtle (x y theta))
             
             (define theta 90)
             
             (define x 0)
             
             (define y 0)
             
             (define delta 0)
             
             (define stack '())
             
             (define (push)
               (set! stack (cons (make-turtle x y theta) stack)))
             
             (define (pop)
               (let ((popped (car stack)))
                 (set! stack (cdr stack))
                 (set! x (turtle-x popped))
                 (set! y (turtle-y popped))
                 (set! theta (turtle-theta popped))))
             
             (define (flyward)
               (let ((newX (+ x (cos (deg2rad theta))))
                     (newY (+ y (sin (deg2rad theta)))))
                 (set! x newX)
                 (set! y newY)))
             
             (define (forward)
               (let ((newX (+ x (cos (deg2rad theta))))
                     (newY (+ y (sin (deg2rad theta)))))
                 (printf "plot([~a,~a], [~a,~a])\n" x newX y newY)
                 (set! x newX)
                 (set! y newY)))
             
             (define (turn-right)
               (set! theta (- theta delta)))
             
             (define (turn-left)
               (set! theta (+ theta delta)))))))

(define (lsys start substitutions delta n)
  (let* ((expanded (apply-productions-n-times start substitutions n))
         (expandeded (apply-productions-once expanded
                                             '((+ (turn-right))
                                               (- (turn-left))
                                               (L '())
                                               (R '())
                                               (< (push))
                                               (> (pop))
                                               (F (forward))
                                               (f (flyward))))))
    (begin
      (evaler (list 'define 'delta delta))
      (evaler (list 'define 'pi pi))
      (evaler (append '(begin) expandeded))
      (display "clf\n")
      (display "hold on\n")
      (display "axis equal\n")
      (display (get-output evaler)))))

;(lsys '(F - F - F - F)
;      '((F F + F F - F F - F - F + F + F F - F - F + F + F F + F F - F)
;        (- -)
;        (+ +))
;      90 
;      1)

;(lsys '(F - F - F - F)
;      '((F F - F + F + F F - F - F + F)
;        (- -)
;        (+ +))
;      90 
;      2)


;(lsys '(F + F + F + F)
;      '((F F + f - F F + F + F F + F f + F F - f + F F - F - F F - F f - F F F)
;        (f f f f f f f)
;        (- -)
;        (+ +))
;      90
;      2)

;(lsys '(- L)
;      '((L L F + R F R + F L - F - L F L F L - F R F R +)
;        (R - L F L F + R F R F R + F + R F - L F L - F R)
;        (- -)
;        (+ +)
;        (F F))
;      90
;      3)

(lsys '(F)
      '((F F < + F > F < - F > F)
        (< <)
        (> >)
        (+ +)
        (- -))
       25.7
       3)
Haiku

show