[ALLY] Graphing a function

Hi Guys, Thought I might as well post my Graphing function here .... as this is where the View scripts seem to be posted these days .... Cheers Phil REBOL [ Title: "Graph a function" File: %Graph-v1.1.r Author: "Phil Bevan" Date: 3-Oct-2000 Version: 1.0.1 Purpose: { Graph a function draw-line function adapted from drawline.r by Larry Palmiter rounding function by Ladislav Mecir Changes since 1.0.0 round value of x & fx before converting to pair minor gui additions - load & save equations change initial screen limits Usage .... Type in your function of x into the input field Some pretty functions to get you started ..... 3 * sin (0.5 * pi * x) 3 * sin (x * x) exp(0.1 * x) * (sin(4 * pi * x)) 4 * sin (4 * pi / x) 0.2 * exp(- x) * sin (0.5 * pi * x) 10 / ((3 * x * x) + (4 * x) - 3) } ] ; functions 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] if any[p/x < 1 p/x > xs p/y < 1 p/y > ys] [return] 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 ] ] ] ] ; 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 ] mod: func [ {compute a non-negative remainder} a [number!] b [number!] /local r ] [ either negative? r: a // b [ r + abs b ] [r] ] round: func [ "Round a number" n [number!] /places p [integer!] {Decimal places - can be negative} /local factor r ] [ factor: either places [10 ** (- p)] [1] n: 0.5 * factor + n n - mod n factor ] floor: func [ n [number!] /places p [integer!] {Decimal places - can be negative} /local factor r ] [ factor: either places [10 ** (- p)] [1] n - mod n factor ] ceiling: func [ n [number!] /places p [integer!] {Decimal places - can be negative} /local factor r ] [ factor: either places [10 ** (- p)] [1] n + mod (- n) factor ] truncate: func [ n [number!] /places p [integer!] {Decimal places - can be negative} /local factor r ] [ factor: either places [10 ** (- p)] [1] n - (n // factor) ] ; 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 round 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 round yc] [return none] return make pair! reduce [xc yc] ] 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] ] ; 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 [ either 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 ] [last-pt: none] ] ] ; 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 ; gr-size: 500x500 gr-paper: make paper [] gr-paper/crt gr-size -5.0 5.0 -5.0 5.0 gr-paper/pen-color: 0.0.255 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 (gr-size * 1x0 + 0x24) 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 ] button "Save Image" [ t-save-name: request-file/title/filter/keep/file "Save Graph as png" Save "*.png" "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"] ] ] 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 Equation" [ either t-func1/text = "" [request/ok "No equation to Save"] [ filnm: request-file/title/filter/file/keep "Save Equation" Save "*.eqn" "graph.eqn" if filnm <> none [ if error? try [write to-file filnm t-func1/text] [request/OK "Unable to Save Equation"] ] ] ] button "Load Equation" [ filnm: request-file/title/filter/file/keep "Load Equation" "Load" *.eqn "graph.eqn" if filnm <> none [ t-func1/text: read to-file filnm show t-func1 ] ] ]