[REBOL] Graph a function
From: philb::upnaway::com at: 18-Mar-2001 19:34
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"]
]
]
]
