teaching machines

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