#cs(module graphing mzscheme (require (lib "error.ss" "htdp") (lib "unit.ss") (lib "draw-sig.ss" "htdp") (lib "big-draw.ss" "htdp") (lib "posn.ss" "lang") (lib "prim.ss" "lang")) (provide-signature-elements draw^) (provide graph-fun graph-line ) (define-higher-order-primitive graph-line graph-line/proc (f _)) (define-higher-order-primitive graph-fun graph-fun/proc (f _)) ;; -------------------------------------------------------------------------- ;; make-graph : sym -> void ;; effect: set up pasteboard for drawing functions ;; between [0,10] and [0,10] on x/y axis (define (make-graph name) (start EAST SOUTH) (let* ([vp+pm #cs(get-@VP)] [vp (car vp+pm)]) (draw-solid-line ORIGIN X-AXIS 'blue) ((draw-string vp) (make-posn (+ OFFSET 10) (+ OFFSET 10)) "Y-AXIS") (draw-solid-line ORIGIN Y-AXIS 'blue) ((draw-string vp) (make-posn (- EAST 100) (- SOUTH 15)) "X-AXIS"))) ;; (num -> num) symbol -> true ;; effect: draw function graph for x in [0,10] at delta = .1 (define (graph-line/proc f color) (check 'graph-line f color) (let ((p1 (translate (make-posn 0 (f 0)))) (p2 (translate (make-posn 10 (f 10))))) (draw-solid-line p1 p2 color))) ;; (num -> num) symbol -> true ;; effect: draw function graph for x in [0,10] at delta = .1 (define (graph-fun/proc f color) (check 'graph-fun f color) (draw-tab (map translate (tabulate f 0 10 DELTA)) color)) ;; check : tst tst tst -> void (define (check tag f color) (check-proc tag f 1 '1st "one argument") (check-arg tag (symbol? color) 'symbol '2nd color)) ;; tabulate : (num -> num) num num num -> (list-of (make-posn num num)) (define (tabulate f left right delta) (if (> left right) null (cons (make-posn left (f left)) (tabulate f (+ left delta) right delta)))) ;; translate : posn -> posn (define (translate p) (make-posn (+ (* FACT (/ 1 DELTA) (posn-x p)) OFFSET) (- (- SOUTH (* FACT (/ 1 DELTA) (posn-y p))) OFFSET))) ;; draw-tab : (list-of (make-posn num num)) symbol -> true (define (draw-tab lop color) (for-each (lambda (p) (draw-solid-disk p DOT color)) lop) (unless (or (null? lop) (null? (cdr lop))) (let loop ([f (car lop)][r (cdr lop)]) (unless (null? r) (let ([next (car r)]) (draw-solid-line f next color) (loop next (cdr r)))))) #t) (define EAST 400) (define SOUTH EAST) (define FACT (/ (- EAST 100) 100)) (define OFFSET 10.) (define ORIGIN (make-posn OFFSET (- SOUTH OFFSET))) (define X-AXIS (make-posn OFFSET OFFSET)) (define Y-AXIS (make-posn (- EAST OFFSET) (- SOUTH OFFSET))) (define GRAPH-COLOR 'red) (define DELTA .1) (define DOT 1) (make-graph 'ok))