Graph a function

Hi List, I have been playing around with a program to graph a function .... The functon draw-line function is based on draw-line2.r by Larry Palmiter (cheers Larry) The GUI is still work in progress .... To use the program just type in a function of x into the input field .... and hit the draw button. You have the following options for plotting a function : View /change the graph limits by hitting the settings button. Change the graph color by hitting the Graph Color button. You can plot a graph as point or joined up points using the choice button. Clear the current image by hitting the clear paper button. Some pretty functions to get you started ..... 5 * sin (0.5 * pi * x) 5 * sin (x * x) exp(0.1 * x) * (sin(4 * pi * x)) 5 * sin (4 * pi / x) 5 * exp(- x) * sin (0.5 * pi * x) 10 / ((3 * x * x) + (4 * x) - 3) The program understands the following standard maths functions sin (radians), cos (radians), tan (radians), sinh, cosh, tanh, exp, fac (factorial) as well as all the normal recol functions. Note that it uses rebol's left to right priority for evaluating expressions, so 5 + 3 * 4 = 32 not 5 + (3 * 4) = 17 (as expected) Anyway .... enjoy Cheers Phil REBOL [ Title: "Graph a function" File: %Graph-v1.0.r Author: "Phil Bevan" Date: 3-Oct-2000 Version: 0.0.1 Purpose: { Graph a function draw-line function adapted from drawline.r by Larry Palmiter } ] ; Convert Degrees to Radians & Radians to Degrees rad: function [x] [] [ x * pi / 180 ] deg: function [x] [] [ x * 180 / pi ] ; trig functions sin: function [x] [] [return sine/radians x] cos: function [x] [] [return cosine/radians x] tan: function [x] [] [return tangent/radians x] ; square-root sqrt: function [x] [] [return square-root x] ; hyperbolic trig functions sinh: function [x] [] [return ((exp(x)) - (exp(- x))) / 2] cosh: function [x] [] [return ((exp(x)) + (exp(- x))) / 2] tanh: function [x] [] [return ((exp(2 * x)) - 1) / ((exp(2 * x)) + 1)] fac: func [x [integer!] /local fa i] [ if x < 0 [return none] fa: 1.0 i: 1 while [i <= x] [ fa: fa * i i: i + 1 ] return fa ] ; create a function create-function: function [t-func [string!]] [f] [ ; return a newly created function if error? try [f: to-block load t-func] [return none] function [x [any-type!]] [] f ] ; paper object paper: make object! [ size: 0x0 x-min: -1 x-max: 1 y-min: -1 y-max: 1 grid: yes x-grid: 20 y-grid: 20 grid-color: red axes: yes axes-color: black paper-color: white pen-color: black axes-color: black image: none crt: func [ size [pair!] xmin [decimal!] xmax [decimal!] ymin [decimal!] ymax [decimal!] ] [ self/size: size self/x-min: xmin self/x-max: xmax self/y-min: ymin self/y-max: ymax self/image: to-image to-pair reduce [size/x size/y] clear-im self/image self/paper-color ] ] ; clear the image to a colour clear-im: func [im [image!] color [tuple!] /local j] [ repeat j im/size/x * im/size/y [poke im j color] ] ; plot a point plot: func [im [image!] p col [tuple!] /local i xs ys] [ set [xs ys] [im/size/x im/size/y] i: ys - p/y * xs + p/x if any [i <= 0 i > (im/size/x * im/size/y)] [return] poke im i col ] draw-line: func [ {draw line from point a to b using Bresenham's algorithm} im [image!] a [pair!] b [pair!] color [tuple!] /local d inc dpr dpru p set-pixel xs ys ][ set [xs ys] [im/size/x im/size/y] set-pixel: func [p c] [poke im (ys - p/y * xs + p/x) c] if any [a/x < 1 a/y < 1 a/x > xs a/y > ys b/x < 1 b/y < 1 b/x > xs b/y > ys] [return] d: abs (b - a) inc: 1x1 if a/x > b/x [inc/x: -1] if a/y > b/y [inc/y: -1] either d/x >= d/y [ dpr: 2 * d/y dpru: dpr - (2 * d/x) p: dpr - d/x loop d/x + 1 [ set-pixel a color either p > 0 [ a: a + inc p: p + dpru ][ a/x: a/x + inc/x p: p + dpr ] ] ][ dpr: 2 * d/x dpru: dpr - (2 * d/y) p: dpr - d/y loop d/y + 1 [ set-pixel a color either p > 0 [ a: a + inc p: p + dpru ][ a/y: a/y + inc/y p: p + dpr ] ] ] ] ; Fixed Width field Styles new-styles: stylize [ fix-area: area font [name: "courier new" size: 12] wrap fix-field: field font [name: "courier new" size: 12] fix-text: text font [name: "courier new" size: 12] ] ; initialise the graph init-graph: func [paper [object!]] [ clear-im paper/image paper/paper-color draw-axes paper ] draw-axes: func [paper /local pt] [ pt: coordinates paper 0 0 if all [pt/y >= 0 pt/y < paper/size/y] [draw-line paper/image to-pair reduce [1 pt/y] to-pair reduce [(paper/size/x - 1) pt/y] paper/axes-color] ; x-axis if all [pt/x >= 0 pt/x < paper/size/x] [draw-line paper/image to-pair reduce [pt/x 1] to-pair reduce [pt/x paper/size/y] paper/axes-color]; y-axis ] ; convert to co-ordinates coordinates: func [paper [object!] x [number!] y [number!] /local xc yc] [ xd: x - paper/x-min xp: (paper/x-max - paper/x-min) / paper/size/x xc: xd / xp if any [xc < 0 xc > paper/size/x] [-1] if error? try[xc: to-integer xc] [return none] yd: y - paper/y-min yp: (paper/y-max - paper/y-min) / paper/size/y yc: yd / yp if any [yc < 0 yc > paper/size/y] [-1] if error? try[yc: to-integer yc] [return none] return make pair! reduce [xc yc] ] ; Draw the graph draw-graph: func [paper [object!] t-fx [string!] trace [string!] /local x x-step fx pt last-pt] [ if t-fx = "" [request/ok "No function entered" return] f-fx: create-function t-fx if not function? :f-fx [request/ok "Improper function entered" return] last-pt: none x-step: (paper/x-max - paper/x-min) / paper/size/x for x paper/x-min paper/x-max x-step [ if not error? try [fx: f-fx x] [ pt: coordinates paper x fx if pt <> none [ switch trace [ "Point" [plot paper/image pt paper/pen-color] "Line" [ either last-pt <> none [draw-line paper/image last-pt pt paper/pen-color] [plot paper/image pt paper/pen-color] ] ] ] last-pt: pt ] ] ] ; Graph Paper settings gr-settings: func [ paper [object!] gr-face [object!] /local prefs f-xmin f-xmax f-ymin f-ymax f-paper-color f-pen-color lv-valid ] [ prefs: view/new layout [ backdrop 0.150.0 styles new-styles origin 10x10 below at 10x10 text "Min X" 60x24 text "Max X" 60x24 text "Min Y" 60x24 text "Max Y" 60x24 text "Paper Color" 80x24 text "Pen Color" 80x24 text "Clear" 80x24 return f-xmin: fix-field to-string(paper/x-min) f-xmax: fix-field to-string(paper/x-max) f-ymin: fix-field to-string(paper/y-min) f-ymax: fix-field to-string(paper/y-max) f-paper-color: fix-field to-string(paper/paper-color) f-pen-color: fix-field to-string(paper/pen-color) cb-clear: check with [state: false] button "Apply" [ lv-valid: yes if error? try [paper/x-min: to-decimal f-xmin/text] [request/ok Invalid Min X value entered lv-valid: no] if error? try [paper/x-max: to-decimal f-xmax/text] [request/ok Invalid Max X value entered lv-valid: no] if error? try [paper/y-min: to-decimal f-ymin/text] [request/ok Invalid Min Y value entered lv-valid: no] if error? try [paper/y-max: to-decimal f-ymax/text] [request/ok Invalid Min Y value entered lv-valid: no] if error? try [paper/paper-color: to-tuple f-paper-color/text] [request/ok "Invalid Paper Color entered" lv-valid: no] if error? try [paper/pen-color: to-tuple f-pen-color/text] [request/ok "Invalid Pen Color entered" lv-valid: no] if cb-clear/data = true [ init-graph paper show gr-face ] if lv-valid = yes [unview prefs] ] ] ] ; ; Main Line ; x-size: 500 y-size: 500 gr-size: to-pair reduce [x-size y-size] eq-size: to-pair reduce [x-size 24] gr-paper: make paper [] gr-paper/crt gr-size -10.0 10.0 -10.0 10.0 draw-axes gr-paper ; ; view the window ; view layout [ backdrop 0.150.0 origin 5x5 styles new-styles below at 5x5 gr-paper-f: image gr-paper/image across t-func1: fix-field eq-size return r-trace: choice 120.20.120 100x24 data ["Line" "Point"] button "Graph Color" [ gr-col: request-color/color gr-paper/pen-color if gr-col <> none [gr-paper/pen-color: gr-col] ] button "Draw f(x)" 100x24 [ draw-graph gr-paper t-func1/text first r-trace/data show gr-paper-f ] return button "Settings" 100x24 [gr-settings gr-paper gr-paper-f] button "Clear Paper" 100x24 [ init-graph gr-paper show gr-paper-f ] button "Save (png)" [ t-save-name: request-file/title/keep/file "Save Graph as png" "Save" graph.png if t-save-name <> none [ if error? try [save/png to-file t-save-name gr-paper/image] [request/OK "Unable to Save graph"] ] ] ]