Here a great script to draw graphic functions (graph), it's perfect:
Here the source code:
REBOL [
Title: "Graph a function"
File: %graph.r
Author: "Phil Bevan"
Date: 21-Oct-2001/12:00:00
Version: 1.1.0
Email: philb@upnaway.com
Category: [math]
Purpose: {
Graph a function
rounding function by Ladislav Mecir
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)
}
History: [
1.0.1 ["Initial version" "Phil Bevan"]
1.0.2 ["Initial Version submitted to library" "Phil Bevan"]
1.0.3 ["Tidy up GUI Settings" "Phil Bevan"]
1.0.4 ["Change line type Button choice to rotary" "Phil Bevan"]
1.0.5 ["Add Navigation Panel" "Phil Bevan"]
1.0.6 ["Add Grid Markings & Finish Nav Panel" "Phil Bevan"]
1.0.7 ["Add help function,flash Drawing Graph" "Phil Bevan" ]
1.1.0 ["Use draw dialect to draw graph" "Phil Bevan"]
]
Email: philb@upnaway.com
]
; functions
paper: make object!
[
size: 0x0
x-min: -1
x-max: 1
y-min: -1
y-max: 1
grid: yes
x-grid: 0.5
y-grid: 0.5
zoom-in: 0.5
zoom-out: 2
grid-color: sky
axes: yes
axes-color: black
paper-color: white
pen-color: black
axes-color: black
image: none
draw: copy []
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
]
]
; plot a point
fn-plot: func [paper [object!] p [pair!] col [tuple!] /local i xs ys]
[
xs: paper/size/x
ys: paper/size/y
if any[p/x < 1 p/x > xs p/y < 1 p/y > ys]
[return]
append paper/draw 'pen
append paper/draw col
append paper/draw 'line
append paper/draw p
append paper/draw p
]
fn-draw-line: func [
{draw line from point a to b using Bresenham's algorithm}
paper [object!]
a [pair!]
b [pair!]
color [tuple!]
/local d inc dpr dpru p set-pixel xs ys
][
append paper/draw 'pen
append paper/draw color
append paper/draw 'line
append paper/draw a
append paper/draw b
]
; 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!]]
[
gr-paper-f/color: paper/paper-color
show gr-paper-f
clear paper/draw
fn-draw-axes paper
]
fn-draw-axes: func [paper /local pt]
[
fn-draw-grid paper
pt: coordinates paper 0 0
if all [pt/y >= 0 pt/y < paper/size/y]
[fn-draw-line paper 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]
[fn-draw-line paper to pair! reduce [pt/x 1] to pair! reduce [pt/x paper/size/y] paper/axes-color]; y-axis
]
; draw grid
fn-draw-grid: func [paper [object!] /local gs pt-from pt-to]
[
if all [paper/x-grid <> 0 paper/x-max - paper/x-min > paper/x-grid]
[
; draw x-gridlines
either paper/x-min < 0
[gs: (to-integer (paper/x-min / paper/x-grid) - 1) * paper/x-grid]
[gs: (to-integer (paper/x-min / paper/x-grid) + 1) * paper/x-grid]
while [gs <= paper/x-max]
[
gs: gs + paper/x-grid
pt-from: coordinates paper gs 0
pt-to: coordinates paper gs 0
pt-from/y: 1
pt-to/y: paper/size/y - 1
; print [pt-from pt-to]
fn-draw-line paper pt-from pt-to paper/grid-color
]
]
if all [paper/x-grid <> 0 paper/y-max - paper/y-min > paper/y-grid]
[
; draw y-gridlines
gs: (to-integer (paper/y-min / paper/y-grid)) * paper/y-grid
while [gs <= paper/y-max]
[
gs: gs + paper/y-grid
pt-from: coordinates paper 0 gs
pt-to: coordinates paper 0 gs
pt-from/x: 1
pt-to/x: paper/size/x - 1
fn-draw-line paper pt-from pt-to paper/grid-color
]
]
font-obj: make face/font [
name: font-fixed
size: 12
; style: [italic]
]
lv-coords: rejoin ["(" paper/x-min "," paper/y-min ") - (" paper/x-max "," paper/y-max ")"]
lv-text-pos: make pair! reduce [0 (paper/size/y - 14)]
append paper/draw 'font
append paper/draw font-obj
append paper/draw 'pen
append paper/draw paper/axes-color
append paper/draw 'text
append paper/draw lv-text-pos
append paper/draw lv-coords
]
; 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: paper/size/y - (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 lv-flash
]
[
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]
lv-flash: flash "Drawing graph"
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"
[fn-plot paper pt paper/pen-color]
"Line"
[
either last-pt <> none
[fn-draw-line paper last-pt pt paper/pen-color]
[fn-plot paper pt paper/pen-color]
]
]
]
last-pt: pt
]
[last-pt: none]
]
unview lv-flash
]
; Graph Paper settings
gr-settings: func
[
paper [object!]
gr-face [object!]
/local f-xmin f-xmax f-ymin f-ymax f-paper-color f-pen-color lv-valid lv-col
lv-x-min lv-x-max
lv-y-min lv-y-max
lv-x-grid lv-y-grid
]
[
view/new layout
[
backdrop 0.150.0
styles new-styles
origin 5x5
space 5
across
at 5x5
label "Min X" right 80x24
f-xmin: fix-field to-string(paper/x-min) 100x24
return
label "Max X" right 80x24
f-xmax: fix-field to-string(paper/x-max) 100x24
return
label "Min Y" right 80x24
f-ymin: fix-field to-string(paper/y-min) 100x24
return
label "Max Y" right 80x24
f-ymax: fix-field to-string(paper/y-max) 100x24
return
label "X Grid size" right 80x24
f-xgrid: fix-field to-string(paper/x-grid) 100x24
return
label "Y Grid size" right 80x24
f-ygrid: fix-field to-string(paper/y-grid) 100x24
return
label "Zoom+" right 80x24
f-zoom-in: fix-field to-string(paper/zoom-in) 100x24
return
label "Zoom-" right 80x24
f-zoom-out: fix-field to-string(paper/zoom-out) 100x24
return
pad 0x-3
label "Clear" right 80x24
pad 0x3
cb-clear: check with [state: false]
return
pad 0x-5
button "Paper Color" 80x24
[
lv-col: request-color/color paper/paper-color
if lv-col <> none
[
f-paper-color/color: lv-col
show f-paper-color
]
]
f-paper-color: box paper/paper-color 100x24 edge [size: 2x2 color: gray effect: 'bevel]
return
button "Pen Color" 80x24
[
lv-col: request-color/color paper/paper-color
if lv-col <> none
[
f-pen-color/color: lv-col
show f-pen-color
]
]
f-pen-color: box paper/pen-color 100x24 edge [size: 2x2 color: gray effect: 'bevel]
return
button "Grid Color" 80x24
[
lv-col: request-color/color paper/paper-color
if lv-col <> none
[
f-grid-color/color: lv-col
show f-grid-color
]
]
f-grid-color: box paper/grid-color 100x24 edge [size: 2x2 color: gray effect: 'bevel]
return
button "Apply" 185x24
[
lv-valid: true
if error? try [lv-x-min: to-decimal f-xmin/text] [alert "Invalid Min X value entered" lv-valid: false focus f-xmin]
if lv-valid [if error? try [lv-x-max: to-decimal f-xmax/text] [alert "Invalid Max X value entered" lv-valid: false focus f-xmax]]
if lv-valid [if lv-x-min >= lv-x-max [alert "Min X value must be less than Max X value" lv-valid: no focus f-xmin]]
if lv-valid [if error? try [lv-y-min: to-decimal f-ymin/text] [request/ok "Invalid Min Y value entered" lv-valid: false focus f-ymin]]
if lv-valid [if error? try [lv-y-max: to-decimal f-ymax/text] [request/ok "Invalid Max Y value entered" lv-valid: false focus f-ymax]]
if lv-valid [if lv-y-min >= lv-y-max [alert "Min Y value must be less than Max Y value" lv-valid: false focus f-ymin]]
if lv-valid [if error? try [lv-x-grid: to-decimal f-xgrid/text] [request/ok "Invalid X grid value entered" lv-valid: false focus f-xgrid]]
if lv-valid [if lv-x-grid < 0 [alert "X Grid value cannot be < 0" lv-valid: no focus f-xgrid]]
if lv-valid [if error? try [lv-y-grid: to-decimal f-ygrid/text] [request/ok "Invalid Y grid value entered" lv-valid: false focus f-ygrid]]
if lv-valid [if lv-y-grid < 0 [alert "Y Grid value cannot be < 0" lv-valid: no focus f-ygrid]]
if lv-valid [if error? try [lv-zoom-in: to-decimal f-zoom-in/text] [request/ok "Invalid Zoom in factor entered" lv-valid: false focus f-zoom-in]]
if lv-valid [if any [lv-zoom-in < 0 lv-zoom-in > 1] [alert "Zoom in factor must be between 0 & 1" lv-valid: no focus f-zoom-in]]
if lv-valid [if error? try [lv-zoom-out: to-decimal f-zoom-out/text] [request/ok "Invalid Zoom out factor entered" lv-valid: false focus f-zoom-out]]
if lv-valid [if lv-zoom-out < 1 [alert "Zoom out factor must be > 1" lv-valid: no focus f-zoom-out]]
if lv-valid = yes
[
paper/x-min: lv-x-min
paper/x-max: lv-x-max
paper/y-min: lv-y-min
paper/y-max: lv-y-max
paper/x-grid: lv-x-grid
paper/y-grid: to-decimal f-ygrid/text
paper/zoom-in: lv-zoom-in
paper/zoom-out: lv-zoom-out
paper/paper-color: f-paper-color/color
paper/pen-color: f-pen-color/color
paper/grid-color: f-grid-color/color
unview
if cb-clear/data = true
[
init-graph paper
show gr-face
]
]
]
]
]
fn-left: func [paper [object!] /local dx]
[
dx: (paper/x-max - paper/x-min) / 10
paper/x-min: paper/x-min - dx
paper/x-max: paper/x-max - dx
init-graph paper
draw-graph paper t-func1/text first r-trace/data
show gr-paper-f
]
fn-right: func [paper [object!] /local dx]
[
dx: (paper/x-max - paper/x-min) / 10
paper/x-min: paper/x-min + dx
paper/x-max: paper/x-max + dx
init-graph paper
draw-graph paper t-func1/text first r-trace/data
show gr-paper-f
]
fn-up: func [paper [object!] /local dy]
[
dy: (paper/y-max - paper/y-min) / 10
paper/y-min: paper/y-min + dy
paper/y-max: paper/y-max + dy
init-graph paper
draw-graph paper t-func1/text first r-trace/data
show gr-paper-f
]
fn-down: func [paper [object!] /local dy]
[
dy: (paper/y-max - paper/y-min) / 10
paper/y-min: paper/y-min - dy
paper/y-max: paper/y-max - dy
init-graph paper
draw-graph paper t-func1/text first r-trace/data
show gr-paper-f
]
fn-zoom-in: func [paper [object!] /local mid]
[
mid: paper/x-min + ((paper/x-max - paper/x-min) / 2)
nsize: (paper/x-max - paper/x-min) * paper/zoom-in / 2
paper/x-min: mid - nsize
paper/x-max: mid + nsize
mid: paper/y-min + ((paper/y-max - paper/y-min) / 2)
nsize: (paper/y-max - paper/y-min) * paper/zoom-in / 2
paper/y-min: mid - nsize
paper/y-max: mid + nsize
init-graph paper
draw-graph paper t-func1/text first r-trace/data
show gr-paper-f
]
fn-zoom-out: func [paper [object!] /local mid]
[
mid: paper/x-min + ((paper/x-max - paper/x-min) / 2)
nsize: (paper/x-max - paper/x-min) * paper/zoom-out / 2
paper/x-min: mid - nsize
paper/x-max: mid + nsize
mid: paper/y-min + ((paper/y-max - paper/y-min) / 2)
nsize: (paper/y-max - paper/y-min) * paper/zoom-out / 2
paper/y-min: mid - nsize
paper/y-max: mid + nsize
init-graph paper
draw-graph paper t-func1/text first r-trace/data
show gr-paper-f
]
;
; 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
; colors
panel-back: 80.150.80
fn-draw-axes gr-paper
lv-init-eqn: "(sine (x * 256)) / x"
;
; view the window
;
lv-layout: layout [
backdrop panel-back
origin 0x0
styles new-styles
at 0x0
space 0x0
across
panel teal
[
origin 0x0
space 0
across
vtext "Save" bold white teal 40x24
[
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 to-image gr-paper-f] ; gr-paper/image]
[request/OK "Unable to Save graph"]
]
]
vtext "Settings" bold white teal [gr-settings gr-paper gr-paper-f] 60x24
vtext "Help" bold white teal 40x24
[
either exists? %graph.html
[browse %graph.html]
[browse http://www.upnaway.com/~philb/philip/utils/graph.html]
]
] edge [size: 1x1 color: gray effect: 'bevel] 495x24
image logo.gif
return
panel
[
across
origin 5x5
space 5x5
at 5x5
gr-paper-f: box gr-paper/size gr-paper/paper-color
effect reduce ['draw gr-paper/draw]
return
t-func1: fix-field lv-init-eqn (gr-size * 1x0 + 0x24)
space 0
return
r-trace: rotary 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]
]
space 0x5
button "Draw f(x)" 100x24
[
draw-graph gr-paper t-func1/text first r-trace/data
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
]
]
] 510x510 + (2 * 0x25) + 0x5
panel
[
backdrop panel-back
at 5x5
panel
[
backdrop brick
origin 5x5
space 5
at 5x5
panel
[
at 0x20
arrow left 20x20 [fn-left gr-paper]
at 40x20
arrow right 20x20 [fn-right gr-paper]
at 20x0
arrow up 20x20 [fn-up gr-paper]
at 20x40
arrow down 20x20 [fn-down gr-paper]
] 70x70
button "Zoom +" [fn-zoom-in gr-paper] 60x24
button "Zoom -" [fn-zoom-out gr-paper] 60x24
button "Clear" [init-graph gr-paper show gr-paper-f] 60x24
] edge [size: 2x2 color: gray effect: 'bevel] 90x510 + (2 * 0x24) 0x3
] 80x510 + (2 * 0x25) + 0x10
]
lv-layout/offset: system/view/screen-face/size - lv-layout/size / 2
view/title lv-layout
reform [system/script/header/title system/script/header/version]
No comments:
Post a Comment