Here some math-functions.
There are 2 sections:
1.section contains test-programs (test 1 ... test 19) which are considered to help to understand how the functions work. Just remove the /*..*/ in the blue section.
Note: You need coord_trans to run the Demos of section 1 which can be found in this lib
2. the functions themselves.
Hope you can make use of some of them...
Bye, Joel
N.B. you might find functions where some input errors haven't been catched...
Well...they are ment to meet my needs so far...
Code: Select all
/*
COLORS used in code
'y': comments
'' :main progamm
'g':find rapidly the line
'b':sub-programms
'c':functions
'r':watch it!!special lines that might cause some trouble
'm':DATA
''
'r'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
DEMO HAS TO BE USED WITH COORD_TRANS from the library!! *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
''
*/
/*
'b'
'auskommentieren-ANFANG----------
sw=SCREEN_WIDTH() ! sh=SCREEN_HEIGHT()
FIELD "comment" TEXT "" AT sw*0,sh*.86 SIZE sw,sh*.14 ML
FIELD "comment" BACK COLOR 0.717,0.717,0.717
INPUT test
ON test GOSUB test1,test2,test3,test4,test5,test6,test7,test8, test9, test10, test11, test12,test13,test14,test15,test16,test17,test18,test19
END
{{/Bibliothek/coord_trans}}
test1:'i_rnd(a,b) testing equal distribution of random integer numbers
FIELD "comment" TEXT "demonstrates distribution of the function:"&CHR$(10)& "i_rnd(10,15)"&CHR$(10)& "which returns a random integer number between two given integer numbers"
DIM erg(20)
FOR x=1 TO 100000
z=i_rnd(10,15)
erg(z)=erg(z)+1
NEXT x
FOR x= 9 TO 16
PRINT x, erg(x)
NEXT x
RETURN 'of test1
test2:'r_rnd(a,b) testing equal distribution of random real numbers
FIELD "comment" TEXT "demonstrates distribution of the function:"&CHR$(10)& "r_rnd(10,15)"&CHR$(10)& "which returns a random real number between to given real numbers"
DIM erg(20)
FOR x=1 TO 10000
z=r_rnd(10,15)
FOR n= 10 TO 14
IF z>=n AND z<n+1 THEN erg(n)=erg(n)+1
NEXT n
NEXT x
FOR x=10 TO 14
PRINT "x>=";x;"und x<";x+1 ;erg(x)
NEXT x
RETURN 'of test2
test3:'phi_line(x1,y1,x2,y2)
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "phi_line(x1,y1,x2,y2)"&CHR$(10)& "which returns the angle of a line given in Cardassian ahhhrrgh Cartesian coordinates"
OPTION ANGLE DEGREES
INPUT x1,y1,x2,y2
PRINT phi_line(x1,y1,x2,y2)
GOTO test3
RETURN 'of test3
test4:'phi_lines(v1x1,v1y1,v1x2,v1y2,v2x1,v2y1,v2x2,v2y2)
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "phi_lines(v1x1,v1y1,v1x2,v1y2,v2x1,v2y1,v2x2,v2y2)"&CHR$(10)& "which returns the angle of two lines given in Cartesian coordinates"
OPTION ANGLE DEGREES
INPUT v1x1,v1y1,v1x2,v1y2,v2x1,v2y1,v2x2,v2y2
PRINT phi_lines(v1x1,v1y1,v1x2,v1y2,v2x1,v2y1,v2x2,v2y2)
GOTO test4
RETURN 'of test4
test5:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "nearest(a,gridsize,anchor)"&CHR$(10)& "which returns the distance of 'a' to the next gridline of an anchored grid. gridsize is the distance between two gridlines.(Negative results indicate that the shortest distance is to the left)"
INPUT a,gridsize,anchor
PRINT nearest(a,gridsize,anchor)
GOTO test5
RETURN 'of test5
test6:
FIELD "comment" TEXT "gives a graphic demonstration of the function:"&CHR$(10)& "nearest(a,gridsize,anchor)"&CHR$(10)& "which returns the distance of 'a' to the next gridline of an anchored grid. Hence the next glueing - point for a grid for example"
INPUT "GRIDSIZE: (for example 5 or so)":gridsize, "ANCHOR: (for example 0 or something like that)":anchor
GRAPHICS
FIELD "debug" TEXT "" AT 0,0 SIZE 500,100 ML
.xmin=-5
.xmax=5
DRAW COLOR 1,1,1
DRAW SIZE 1
draw_grid(1,1)
DRAW SIZE 5
draw_sys()
DO
GET TOUCH 0 AS tx,ty
UNTIL tx>-1 'proceed at first touch
DO
GET TOUCH 0 AS tx,ty
tx=btc_x(tx) ! ty=btc_y(ty)
FIELD "debug" TEXT tx&" ;"&ty&CHR$(13)&STR$(nearest(tx,gridsize,anchor)+tx)&" ;"&STR$(nearest(ty,gridsize,anchor)+ty)'&"ifthen="&nearest.ifthen
UNTIL tx<.xmin 'terminate when touch released
RETURN 'of test6
test7:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "nextn(n,gridsize,anchor)"&CHR$(10)& "which returns the coordinate of the 'n'-th line of a grid dependent on gridsize and anchor. (n=0 is the position where the grid has been anchored.)"
INPUT n,gridsize,anchor
PRINT nextn(n,gridsize,anchor)
GOTO test7
RETURN 'of test7
test8:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "divide(anchor, length, num_section,n)"&CHR$(10)& "which returns the 'n'-th position on a line with 'length' starting in 'anchor' and divided in a number of sections 'num_section'. Higher numbers for n than num_section are allowed.n=0:anchor-position)"
INPUT anchor, length, num_section,n
PRINT divide(anchor, length, num_section,n)
GOTO test8
RETURN 'of test8
test9:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "nextn(n,gridsize,anchor)"&CHR$(10)& "which returns the number of the gridline of a point with the coordinate 'a' on a grid with 'gridsize' and 'anchor'. (0 is the position where the grid has been anchored.)"
INPUT a,gridsize,anchor
PRINT a,gridsize,anchor
PRINT gridpos(a,gridsize,anchor)
GOTO test9
RETURN 'of test9
test10:
FIELD "comment" TEXT "demonstrates the quick-and-dirty-programmed function:"&CHR$(10)& "point_on_line(px,py,lpx1,lpy1,lpx2,lpy2)"&CHR$(10)& "which returns -1 if point is off line. otherweise returns a value between [0,1] equivalent to the relation to the length of the line. doesn't really work with vertical lines: division by zero"
INPUT px,py,lpx1,lpy1,lpx2,lpy2
PRINT point_on_line(px,py,lpx1,lpy1,lpx2,lpy2)
GOTO test10
RETURN 'of test10
test11:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "length_line(lpx1,lpy1,lpx2,lpy2)"&CHR$(10)& "which is self-explanatory ;-)"
INPUT lpx1,lpy1,lpx2,lpy2
PRINT length_line(lpx1,lpy1,lpx2,lpy2)
RETURN 'of test11
test12:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "length_line(lpx1,lpy1,lpx2,lpy2)"&CHR$(10)& "which is self-explanatory ;-)"
lpx1=2 ! lpy1=1 ! lpx2=4 ! lpy2=3
INPUT lambda
PRINT px_to_line(lambda,lpx1,lpy1,lpx2,lpy2)
PRINT py_to_line(lambda,lpx1,lpy1,lpx2,lpy2)
GOTO test12
RETURN 'of test12
test13:
FIELD "comment" TEXT "demonstrates the quick-and-dirty-coded function:"&CHR$(10)& "insepstr$(section,trenn$,string$)"&CHR$(10)& "which returns the n-th section of a string separated by the separator 'trenn$' e.g. could be used to ''decode'' a colour ''r,g,b'' returned by a function. note: some input-errors haven't been catched so far.."
string$=",10,20,30,40,5. "
PRINT string$
INPUT section
trenn$=","
PRINT insepstr$(section,trenn$,string$)
'WHILE insepstr$(section,trenn$,string$)<>""
'PRINT "nix"
'DEBUG PAUSE
'END WHILE
GOTO test13
test14:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "t_rnd(a,b,control)"&CHR$(10)& "which returns a random integer number between [a...b] only once by calling the function again until all numbers have been returned."&CHR$(10)& "control=1: creates new numbers, control=0:returns random numbers just once until all numbers have been returned - it then returns '-1'"
INPUT a,b
TEXT CLEAR
t_rnd(a,b,1)
DO
a= t_rnd(a,b,0)
PRINT a
UNTIL a=-1
'DEBUG PAUSE
GOTO test14
RETURN 'of test14
test15:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "orthog_cross_x(L1x1,L1y1,L1x2,L1y2,L2x1,L2y1,L2x2,L2y2)"&CHR$(10)& "which returns x-coordinate of x-ing point of to orthogonal lines.returns -1e30 if no intersection"
INPUT L1x1,L1y1,L1x2,L1y2,L2x1,L2y1,L2x2,L2y2
'L1x1=1!L1y1=2!L1x2=3!L1y2=2
'L2x1=2!L2y1=1!L2x2=2!L2y2=3
PRINT orthog_cross_x(L1x1,L1y1,L1x2,L1y2,L2x1,L2y1,L2x2,L2y2)
PRINT orthog_cross_y(L1x1,L1y1,L1x2,L1y2,L2x1,L2y1,L2x2,L2y2)
GOTO test15
RETURN 'of test15
test16:
FIELD "comment" TEXT "demonstrates the mostly useless function:"&CHR$(10)& "point_on_orthog(px,py,lpx1,lpy1,lpx2,lpy2)"&CHR$(10)& "which returns the position of a point (px,py) on a line (lpx1,lpy1,lpx2,lpy2) as the relation to the length of the line. works only with orthogonals. (angle=0 or 90 degrees)"
INPUT px,py,lpx1,lpy1,lpx2,lpy2
PRINT point_on_orthog(px,py,lpx1,lpy1,lpx2,lpy2)
GOTO test16
RETURN 'of test16
test17:
FIELD "comment" TEXT "demonstrates the sloppily programmed function:"&CHR$(10)& "dist_to_horizontal(px,py,lpx1,lpy1,lpx2,lpy2)"&CHR$(10)& "which returns ...arrghh...it's self-explanatory;-)...works really only with horizontal lines (angle=0 degrees)"
INPUT px,py,lpx1,lpy1,lpx2,lpy2
PRINT dist_to_horizontal(px,py,lpx1,lpy1,lpx2,lpy2)
GOTO test17
RETURN 'of test17
test18:
FIELD "comment" TEXT "demonstrates the sloppily programmed function:"&CHR$(10)& "dist_to_vertical(px,py,lpx1,lpy1,lpx2,lpy2)"&CHR$(10)& "which returns ...arrghh...it's self-explanatory;-)...works really only with vertical lines (angle=90 degrees)"
INPUT px,py,lpx1,lpy1,lpx2,lpy2
PRINT dist_to_vertical(px,py,lpx1,lpy1,lpx2,lpy2)
GOTO test18
RETURN 'of test18
test19:
FIELD "comment" TEXT "demonstrates the function:"&CHR$(10)& "str_rnd$(L)"&CHR$(10)& "which returns a string of length L with random letters from a...z. Here:concatenation with the function i_rnd(a,b)"&CHR$(10)&"Thus:str_rnd$(i_rnd(5,15))"
FOR m= 1 TO 10
PRINT str_rnd$(i_rnd(5,15))
NEXT m
RETURN 'of test19
'auskommentieren -ENDE----------
*/
'c'
'returns a string of length L with random letters from a...z
DEF str_rnd$(L)
letter$=""
FOR n=1 TO l
letter$= letter$&CHR$(i_rnd(ASC("a"),ASC("z")))
NEXT n
RETURN letter$
END DEF
'returns a random number between [a...b] only once by calling the function until all numbers have been returned
'returns -1 when all numbers have been returned
'control = 1: creates tupple of numbers [a...b]
'control=0: returns randomly a number of above created tupples and removes it
DEF t_rnd(a,b,control)
IF a<0 OR b<0 OR b<a THEN RETURN -1
OPTION SORT DESCENDING
optionbase=OPTION_BASE()
IF control=1 THEN 'new
num_elements=b-a+1
DIM m(num_elements)
n=0
WHILE n<num_elements
m(n+optionbase)=a
a=a+1
n=n+1
END WHILE
ENDIF
IF control=0 THEN 'return rnd and reduce
IF num_elements=0 THEN RETURN -1
SORT m
random=RND(num_elements)+optionbase
number=m(random)
m(random)=0
num_elements=num_elements-1
'DEBUG PAUSE
RETURN number
ENDIF
END DEF
'==========
DEF i_rnd(a,b) 'returns random integer between two given numbers [a,b]
i_rnd=FLOOR((b+1-a) *RND(1)+a)
END DEF
'==========
DEF r_rnd(a,b) 'returns random real number between two given real numbers (a,b)
r_rnd=(b-a)*RND(1)+a
END DEF
'==========
DEF phi_line(x1,y1,x2,y2) 'angle phi of a line defined by two points
delta_y=y2-y1 ! delta_x=x2-x1
phi_vector=ATAN2(delta_y,delta_x)
END DEF
'==========
DEF phi_lines(v1x1,v1y1,v1x2,v1y2,v2x1,v2y1,v2x2,v2y2) 'v1 to v2 in mathematical sense
phi_lines=phi_line(v2x1,v2y1,v2x2,v2y2)-phi_line(v1x1,v1y1,v1x2,v1y2)
END DEF
'==========
'returns the distance to the nearest number (grid*n+anchor) of a where n is a natural number. (e.g. glueing-to-grid-function of a with c as anchor and b as the gridsize around that anchored point.
DEF nearest(a,grid,anchor)
grid=ABS(grid)
IF grid-(ABS(a-anchor)%grid)>(ABS(a-anchor)%grid) THEN
'ifthen=1
nearest=-1*SIGN(a-anchor)*(ABS(a-anchor)%grid)
ELSE
'ifthen=2
nearest=SIGN(a-anchor)*(grid-(ABS(a-anchor)%grid))
ENDIF
'IF b-((a-anchor)%b)>((a-anchor)%b) THEN nearest=-1*((a-anchor)%b) ELSE nearest=b-((a-anchor)%b)
END DEF
'===========
'returns the nearest number to a with a grid and its anchor
DEF nearest2(a,grid,anchor)
grid=ABS(grid)
IF grid-(ABS(a-anchor)%grid)>(ABS(a-anchor)%grid) THEN
'ifthen=1
nearest2=-1*SIGN(a-anchor)*(ABS(a-anchor)%grid)+a
ELSE
'ifthen=2
nearest2=SIGN(a-anchor)*(grid-(ABS(a-anchor)%grid))+a
ENDIF
END DEF
'==========
'returns the gridposition of a within the grid anchored in anchor. gridpos of anchor = 0
'difference to nearest2(...): this function counts the "gridlines" to 'a' while nearest2 returns the distance
DEF gridpos(a,grid,anchor)
grid=ABS(grid)
IF grid-(ABS(a-anchor)%grid)>(ABS(a-anchor)%grid) THEN
m_nearest=-1*SIGN(a-anchor)*(ABS(a-anchor)%grid)+a
ELSE
m_nearest=SIGN(a-anchor)*(grid-(ABS(a-anchor)%grid))+a
ENDIF
gridpos=(m_nearest-anchor)/grid
END DEF
'==========
'returns the position of 'n'-th line of the grid dependent on gridsize and anchor. complementary of nearest2.
DEF nextn(a,gridsize,anchor)
n=INT(a)
nextn=anchor+gridsize*n
END DEF
'==========
'returns the nth value of a line with length starting in anchor and divided in a number of sections num_section
DEF divide(anchor,length,num_section,n)
length_section=length/num_section
divide= length_section*n+anchor
END DEF
'==========
DEF point_on_orthog(px,py,lpx1,lpy1,lpx2,lpy2)
IF (lpx1=lpx2 AND lpy1<>lpy2) OR (lpx1<>lpx2 AND lpy1=lpy2) THEN
'orthogonal and no point instead of line
IF lpx1=lpx2 THEN
'senkrechte
IF px=lpx1 AND py>=MIN(lpy1,lpy2) AND py<=MAX(lpy1,lpy2) THEN RETURN (py-lpy1)/(lpy2-lpy1)
ELSE
'waagrechte
IF py=lpy1 AND px>=MIN(lpx1,lpx2) AND px<=MAX(lpx1,lpx2) THEN RETURN (px-lpx1)/(lpx2-lpx1)
ENDIF
RETURN -1
ELSE 'not orthogonal
RETURN -1
ENDIF
END DEF
'==========
'returns -1 if point is off line. otherweise returns a value between [0,1] equivalent to the relation to the length of the line
DEF point_on_line(px,py,lpx1,lpy1,lpx2,lpy2)
d_ly=lpy2-lpy1 ! d_lx=lpx2-lpx1
m=(d_ly)/(d_lx) 'gradient of the line
IF px-lpx1<>0 THEN 'check division by zero
IF m<>(py-lpy1)/(px-lpx1) THEN
RETURN -1
ELSE
point_line_relation=(py-lpy1)/d_ly 'actual calculation of relation
RETURN point_line_relation
ENDIF
ELSE 'divisor = 0
IF py-lpy1=0 THEN RETURN 0 'd_x and d_y=0 so point is in the origin of the line
ENDIF
END DEF
'============
DEF length_line(lpx1,lpy1,lpx2,lpy2)
d_y=lpy2-lpy1 ! d_x=lpx2-lpx1
length=SQR(d_y*d_y+d_x*d_x)
RETURN length
END DEF
'============
'returns point on the line px with distance lambda from origin of line (lpx1,lpy1). lambda=1 is length of line.
DEF px_to_line(lambda,lpx1,lpy1,lpx2,lpy2)
d_x=lpx2-lpx1
px=d_x*lambda+lpx1
RETURN px
END DEF
'============
'analogue
DEF py_to_line(lambda,lpx1,lpy1,lpx2,lpy2)
d_y=lpy2-lpy1
py=d_y*lambda+lpy1
RETURN py
END DEF
'============
'returns a substring within a given string$ with trenn$ as separator and thus dividing the string in sections
DEF insepstr$(section,separator$,string$)
IF string$="" THEN RETURN "ERROR" '-1 problematisch bei der auswertung. Stoppzeichen definieren und übergeben?
'insepstr$(2,",","123,4567,890") -> 4567
option_base_=OPTION_BASE()
OPTION BASE 1
length=LEN(string$)
IF INSTR(string$,separator$,1)=-1 THEN RETURN "ERROR" '-1 'trennzeichen nicht vorhanden
pos2=0
FOR n= 1 TO section
pos1=pos2+1
IF pos1<=LEN(string$) THEN pos2=INSTR(string$,separator$,pos1) ELSE RETURN "ERROR" '-1
IF pos2 = -1 THEN BREAK 'letztes komma fehlt
NEXT n
IF n=section AND pos1<=length THEN pos2=length+1 'letzte komma fehlt
IF n<section THEN RETURN "ERROR" '-1 'weniger sections als erwartet
'(n=section und noch zeichen übrig: letztes komma fehlt, sonst zuwenig sections
RETURN MID$(string$,pos1,pos2-pos1)
OPTION BASE option_base_
END DEF
'===========
'returns x-coordinate of x-ing point of to orthogonal lines.returns -1e30 if no intersection
DEF orthog_cross_x(L1x1,L1y1,L1x2,L1y2,L2x1,L2y1,L2x2,L2y2)
L1(1,1)=L1x1
L1(1,2)=L1y1
L1(2,1)=L1x2
L1(2,2)=L1y2
L2(1,1)=L2x1
L2(1,2)=L2y1
L2(2,1)=L2x2
L2(2,2)=L2y2
IF L1(1,1)=L1(2,1) THEN bool(1)=1
IF L1(1,2)=L1(2,2) THEN bool(2)=1
IF L2(1,1)=L2(2,1) THEN bool(3)=1
IF L2(1,2)=L2(2,2) THEN bool(4)=1
IF (bool(1)=0 AND bool(2)=1 AND bool(3)=1 AND bool(4)=0) OR (bool(1)=1 AND bool(2)=0 AND bool(3)=0 AND bool(4)=1) THEN
'orthogonal
IF bool(1)=1 THEN
x=L1(1,1) ! y=L2(1,2)
ELSE
x=L2(1,1) ! y=L1(1,2)
ENDIF
'now check if point is on one line
IF point_on_orthog(x,y,L1x1,L1y1,L1x2,L1y2)>0 AND point_on_orthog(x,y,L2x1,L2y1,L2x2,L2y2)>0 THEN RETURN x
ELSE 'not orthogonal
RETURN -1e308
ENDIF
END DEF
'===========
'returns x-coordinate of x-ing point of to orthogonal lines.returns -1e30 if no intersection
DEF orthog_cross_y(L1x1,L1y1,L1x2,L1y2,L2x1,L2y1,L2x2,L2y2)
L1(1,1)=L1x1
L1(1,2)=L1y1
L1(2,1)=L1x2
L1(2,2)=L1y2
L2(1,1)=L2x1
L2(1,2)=L2y1
L2(2,1)=L2x2
L2(2,2)=L2y2
IF L1(1,1)=L1(2,1) THEN bool(1)=1
IF L1(1,2)=L1(2,2) THEN bool(2)=1
IF L2(1,1)=L2(2,1) THEN bool(3)=1
IF L2(1,2)=L2(2,2) THEN bool(4)=1
IF (bool(1)=0 AND bool(2)=1 AND bool(3)=1 AND bool(4)=0) OR (bool(1)=1 AND bool(2)=0 AND bool(3)=0 AND bool(4)=1) THEN
'orthogonal
IF bool(1)=1 THEN
x=L1(1,1) ! y=L2(1,2)
ELSE
x=L2(1,1) ! y=L1(1,2)
ENDIF
'now check if point is on one line
IF point_on_orthog(x,y,L1x1,L1y1,L1x2,L1y2)>0 AND point_on_orthog(x,y,L2x1,L2y1,L2x2,L2y2)>0 THEN RETURN y
ELSE 'not orthogonal
RETURN -1e308
ENDIF
END DEF
'==========
DEF dist_to_horizontal(px,py,lpx1,lpy1,lpx2,lpy2)
IF lpx1<>lpx2 AND lpy1=lpy2 THEN
'horizontal
IF px>=MIN(lpx1,lpx2) AND px<=MAX(lpx1,lpx2) THEN RETURN py-lpy1 ELSE RETURN -1 'pos if point overhead else neg.
ELSE
'not horizontal
RETURN -1
ENDIF
END DEF
'==========
'remark. generalisation of this problem: turn line(lp2) and point (p) around lp1 then perp_to_orthog
DEF dist_to_vertical(px,py,lpx1,lpy1,lpx2,lpy2)
IF lpy1<>lpy2 AND lpx1=lpx2 THEN
'vertical
IF py>=MIN(lpy1,lpy2) AND py<=MAX(lpy1,lpy2) THEN RETURN px-lpx1 ELSE RETURN -1 'pos if point right else neg.
ELSE
'not horizontal
RETURN -1
ENDIF
END DEF
