88 lines
2.6 KiB
Racket
88 lines
2.6 KiB
Racket
#lang scheme
|
|
|
|
(require htdp/error
|
|
lang/posn
|
|
lang/prim
|
|
mzlib/unit
|
|
htdp/draw-sig
|
|
htdp/big-draw)
|
|
|
|
(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)
|