Project Euler 14

[abyss]

Before saying anything, let me introduce myself to this forum. Browsing basic.mindteq.com I found a few weeks ago about thinBasic and found it interesting. At the same time I found out about Project Euler (hey, news sometimes reach me slowly!) and what better way to try to learn some thinBasic, out of hobbyist interest, than solving some Project Euler problems.

What follows is my solution to problem 14 - not smart or anything, but it works. BTW, before declaring the main variables used for the calculation as QUAD, I couldn't find the right solution.

Ideas for optimization are always welcome

Thanks to everybody who is responsible, in one way or another, for thinBasic - it's a quite special project.


' Project Euler 14 solution
' by Spyros Paraschis


uses "math"
uses "console"

const MAXNUM AS LONG = 1000000
dim l,g as quad
dim lMaxNum as long
dim i, iMaxCount,iCount as integer
dim iAllNums(MAXNUM) as integer
dim s as string

console_cls
console_printat("Project Euler 14 solution",1,1)
i=0
for l=1 to MAXNUM:iAllNums(l)=0:next

for l=1 to MAXNUM
incr i
if i=100 then
i=0
console_printat("Checking number: " & l,1,4)
Console_ProgressBar(1, 1, 3, 50, 24, 1, MAXNUM, l)
end if

g=l:iCount=1
s=""
while g>1
incr iCount
'console_printat(icount & ": " & g,30,4)
g=GenerateMember(g)

if g<MAXNUM and g>0 then
if iAllNums(g)<>0 then exit while
end if
wend
if g<MAXNUM and g>0 then
if iAllNums(g)>0 then iCount=iCount+iAllNums(g)
end if
if iCount>iMaxCount then
iMaxCount=iCount
lMaxNum=l
console_printat("Best candidate so far: " & lMaxNum & " with " & iMaxCount & " sequence length",1,7)
end if
iAllNums(l)=iCount
next

console_printat( "The answer is " & lMaxNum,1,9)
console_printat( "Press a key to continue",1,11)
waitkey

function GenerateMember(n as quad) as quad
if IsOdd(n) then
return (3*n) + 1
else
return n/2
end if
end function

[matthew]

Hi abyss, welcome to the forum, nice solution to lesson 14. :)

I haven't got that far with the solutions yet, I'm still messing about with problems 2 & 3. :D

[ErosOlmi]

Ciao abyss and welcome to thinBasic community forum.



BTW, before declaring the main variables used for the calculation as QUAD, I couldn't find the right solution.


Interesting :read: I need to understand why

[Petr Schreiber]

Welcome Abyss,

and thanks for great code!

There is just one detail redundant:


for l=1 to MAXNUM:iAllNums(l)=0:next


This is not needed, as ThinBasic automatically assigns default values to variables. So zero to numbers, empty string to strings.

When you want to initialize array to have same values inside, you can do it simply as:

dim arr(100) as long = 5


Thanks,
Petr

[ErosOlmi]

1 second execution time (or so) can be gained removing the support function:



uses "console"

const MAXNUM AS LONG = 1000000
dim l as long
dim g as quad
dim lMaxNum as long
dim i, iMaxCount, iCount as long
dim iAllNums(MAXNUM) as long
dim T1, T2 as double


printat "Project Euler 14 solution", 1, 1

T1 = timer
for l = 1 to MAXNUM
incr i
if i = 10000 then
i = 0
printat "Checking number: " & l, 1, 4
Console_ProgressBar(1, 1, 3, 50, 24, 1, MAXNUM, l)
end if

g = l
iCount = 1
while g > 1
incr iCount

if IsOdd(g) then
g = (3 * g) + 1
else
g = g / 2
end if

if g > 0 and g < MAXNUM then
if iAllNums(g) then exit while
end if
wend

if g > 0 and g < MAXNUM then
if iAllNums(g) > 0 then iCount = iCount + iAllNums(g)
end if

if iCount > iMaxCount then
iMaxCount = iCount
lMaxNum = l
printat "Best candidate so far: " & lMaxNum & " with " & iMaxCount & " sequence length", 1, 7
end if
iAllNums(l) = iCount
next

T2 = timer

printat "The answer is " & lMaxNum, 1, 9
printat "Time taken " & format$(T2 - T1, "#0.00"), 1, 10
printat "Press a key to continue", 1, 12
waitkey

[dcromley]

Thanks for the interesting post.



BTW, before declaring the main variables used for the calculation as QUAD, I couldn't find the right solution.


I added the following two BIGNUM lines to show why.



' Project Euler 14 solution
' by Spyros Paraschis

uses "math"
uses "console"

const MAXNUM AS LONG = 1000000
const BIGNUM as Quad = 2147483647
dim l,g as quad
dim lMaxNum as long
dim i, iMaxCount,iCount as integer
dim iAllNums(MAXNUM) as integer
dim s as string

console_cls
console_printat("Project Euler 14 solution",1,1)
i=0
for l=1 to MAXNUM:iAllNums(l)=0:next

for l=1 to MAXNUM
incr i
if i=100 then
i=0
console_printat("Checking number: " & l,1,4)
Console_ProgressBar(1, 1, 3, 50, 24, 1, MAXNUM, l)
end if

g=l:iCount=1
s=""
while g>1
incr iCount
'console_printat(icount & ": " & g,30,4)
g=GenerateMember(g)
if g > BIGNUM then msgbox 0,"quad needed for " & g

if g<MAXNUM and g>0 then
if iAllNums(g)<>0 then exit while
end if
wend
if g<MAXNUM and g>0 then
if iAllNums(g)>0 then iCount=iCount+iAllNums(g)
end if
if iCount>iMaxCount then
iMaxCount=iCount
lMaxNum=l
console_printat("Best candidate so far: " & lMaxNum & " with " & iMaxCount & " sequence length",1,7)
end if
iAllNums(l)=iCount
next

console_printat( "The answer is " & lMaxNum,1,9)
console_printat( "Press a key to continue",1,11)
waitkey

function GenerateMember(n as quad) as quad
if IsOdd(n) then
return (3*n) + 1
else
return n/2
end if
end function

[ErosOlmi]

Thanks a lot Don.

[abyss]

Exactly, some sequences lead to very big numbers. The "problem", if I might say so, is that when a number is over its allocated range, no error message is produced - I kind of depended on that to find out if I was using the right data type. Of course you can always use the largest capacity datatype, but that is aesthetically and performance-wise bad.

Thanks for the comments and the advice.

I guess the speed gain when removing the GenerateMember function is because of the interpreted nature of thinBasic or there is room for improvement there?

[Petr Schreiber]

Hi Abyss,

Eros will tell more on the internal workings, from my side I can only add that GenerateMember can be converted to one liner:


g = iif(IsOdd(g), g = (3 * g) + 1, g/2 )


So the code becomes the following and is slightly faster:


uses "console"

const MAXNUM AS LONG = 1000000
dim l as long
dim g as quad
dim lMaxNum as long
dim i, iMaxCount, iCount as long
dim iAllNums(MAXNUM) as long
dim T1, T2 as quad

printat "Project Euler 14 solution", 1, 1

hiResTimer_Init
T1 = hiResTimer_Get
for l = 1 to MAXNUM
incr i
if i = 10000 then
i = 0
printat "Checking number: " & l, 1, 4
Console_ProgressBar(1, 1, 3, 50, 24, 1, MAXNUM, l)
end if

g = l
iCount = 1
while g > 1
incr iCount

g = iif( IsOdd(g), (3 * g) + 1, g / 2 )

if inside(g, 1, MAXNUM) then
if iAllNums(g) then exit while
end if
wend

if inside(g, 1, MAXNUM) then
if iAllNums(g) > 0 then iCount += iAllNums(g)
end if

if iCount > iMaxCount then
iMaxCount = iCount
lMaxNum = l
printat "Best candidate so far: " & lMaxNum & " with " & iMaxCount & " sequence length", 1, 7
end if
iAllNums(l) = iCount
next

T2 = hiResTimer_Get

printat "The answer is " & lMaxNum, 1, 9
printat "Time taken " & format$((T2 - T1)/1000000, "#0.00"), 1, 10
printat "Press a key to continue", 1, 12
waitkey


ThinBasic functions like Inside/Between make conditions even more easy to read, and usually mean speed improvement.

[ErosOlmi]

The "problem", if I might say so, is that when a number is over its allocated range, no error message is produced

Sincerely I do not know many programming languages that verify variable overflow unless specified with optional parameters that will lead in a lot of internal code to be added in order to check it. But even than how be sure the overflow is not something wanted by the programmer? In a signed numeric variable there will just be a sign change.



Of course you can always use the largest capacity datatype, but that is aesthetically and performance-wise bad.

You will note no difference between LONG and QUAD unless millions of iterations.
I think on 32bit OS 32 and 64 bits variables are faster than 16 bits in many cases.



I guess the speed gain when removing the GenerateMember function is because of the interpreted nature of thinBasic or there is room for improvement there?

Well, yes and no.
Of course yes because thinBasic is interpreted and you will note the difference when you call so many times a function.
But also on compiled applications there is a lost in time execution when a function with parameters or local variables is executed due the time needed to allocate/de allocate memory. Of course you will note it much less.

[abyss]

Grazie!




Sincerely I do not know many programming languages that verify variable overflow unless specified with optional parameters that will lead in a lot of internal code to be added in order to check it. But even than how be sure the overflow is not something wanted by the programmer? In a signed numeric variable there will just be a sign change.


Well, being mainly a VB guy, I'm used to overflows reported and I always thought just sign change was a C eccentricity!

Concerning Petr's suggestion of using inline if, is that really faster or just more compact in source code?

[dcromley]

Well, I have this obsession with TBGL.
This shows the algorithm output in 3D.
The Z axis is from 1 to 200 for which the algorithm is performed.
The X axis is from 1 to 125 (computed) which is the number of iterations for each Z.
The Y axis is from 1 to 9232 (computed) which is the value of each iteration.

o) Maybe I'm using features in the beta release, so not everybody can run this.
o) It computed 8618 points, so it is slow.
o) I see the comments that could speed it up.
o) Notice that the higher point are in "layers". If I had more interest, I might follow it up.
o) Not as interesting as "TBGL whatsit", but that's life.



uses "Console", "TBGL", "Math"
Type Quat ' Quaternion
t as string*4 ' "Quat" typecheck
W as double ' cos of Angle / 2
X as double ' x
Y as double ' y
Z as double ' z
End Type

const NumOfNums as long = 200
global MaxX as long, MaxY as quad ' y gets outrageous
global hWnd as long, gy(,) as long
'----TBGL loop
hWnd = TBGL_CREATEWINDOWEX( _
"Arrow keys, PgUp, PgDn to rotate; ESC to quit", _
1024, 738, 32, %TBGL_WS_WINDOWED or %TBGL_WS_CLOSEBOX)
local hFont AS DWORD = TBGL_FontHandle("Courier New", 9)
TBGL_BuildFont(hFont) ' for print
TBGL_ShowWindow
TBGL_ResetKeyState()
Populate1() ' get MaxNum arrays
'----TBGL loop
TBGL_BindPeriodicFunction( hWnd, "TBGLLoop", 10)
TBGL_ProcessPeriodicFunction(hWnd)
'----End TBGL loop
TBGL_DestroyWindow

sub TBGLLoop()
if not TBGL_IsWindow(hWnd) then exit sub' ---------------------------loop
tbgl_ClearFrame
TBGL_Camera 0,0,3, 0,0,0
PreRotation() ' fixed items
DoRotation() ' do the rotation
PostRotation() ' rotating items
tbgl_DrawFrame
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then TBGL_UnBindPeriodicFunction( hWnd )
End Sub

Sub PreRotation()
End Sub

Sub DoRotation() ' using quaternions
Static Sw1 as integer, QMain, QRotX, QRotY, QRotZ as Quat
local Cosa, Sina, Ang as single
local dx, dy, dz as integer ' rotation deltas
IF TBGL_GetWindowKeyState( hWnd, %VK_Down) Then dx = +1 ' sign only
IF TBGL_GetWindowKeyState( hWnd, %VK_Up) Then dx = -1
IF TBGL_GetWindowKeyState( hWnd, %VK_Right) Then dy = +1
IF TBGL_GetWindowKeyState( hWnd, %VK_Left) Then dy = -1
IF TBGL_GetWindowKeyState( hWnd, %VK_PgUp) Then dz = +1
IF TBGL_GetWindowKeyState( hWnd, %VK_PgDn) Then dz = -1
if Sw1 = 0 then ' set up static variables
Sw1 = 1
Cosa = cos(pi/360.): Sina = sin(pi/360.) '
QMain = QLoadWXYZ(1, 0, 0, 0)
QRotX = QLoadWXYZ(Cosa, Sina, 0, 0)
QRotY = QLoadWXYZ(Cosa, 0, Sina, 0)
QRotZ = QLoadWXYZ(Cosa, 0, 0, Sina)
end if
if dx <> 0 then QMain = QMultQ(QRotX, QMain, dx)
if dy <> 0 then QMain = QMultQ(QRotY, QMain, dy)
if dz <> 0 then QMain = QMultQ(QRotZ, QMain, dz)
Ang = atan2(sqr(1.-QMain.W^2), QMain.W) * 2
TBGL_Rotate Ang, QMain.X, QMain.Y, QMain.Z
End Sub

Sub PostRotation()
local iNum, ix as long, x, y, z as single
TBGL_Translate -.5,-.5,-.5
PlotGrid(1,2,3, 0,1,.1, 0,1,.1, 000,000,192) ' x,y,z, ylo,yhi,dy, zlo,zhi,dz, r,g,b)
PlotGrid(2,3,1, 0,1,.1, 0,1,.1, 000,192,000) ' x,y,z, ylo,yhi,dy, zlo,zhi,dz, r,g,b)
PlotGrid(3,1,2, 0,1,.1, 0,1,.1, 192,000,000) ' x,y,z, ylo,yhi,dy, zlo,zhi,dz, r,g,b)
TBGL_Color 255,255,255
for iNum = 1 to NumOfNums
ix = 0
do
incr ix
x = ix / MaxX
y = gy(iNum, ix)
y = min(y, MaxY) / MaxY
z = iNum / NumOfNums
PlotPoint(x, y, z, 1)
if y = 0 or ix = MaxX then exit do
loop
'waitkey
next iNum
End Sub

Sub Populate1() ' get the kMaxNum arrays
local iNum2, j as long, x, nPoints as long
For iNum2 = 1 to NumOfNums
x = GenerateCount(iNum2, nPoints)
MaxX = max(MaxX, x)
Next iNum2
Printl nPoints, " points"
Printl "MaxX =", MaxX
Printl "MaxY =", MaxY
End Sub

Function GenerateCount(Num as long, ByRef nPoints as long) as long
local iCount as long, n as quad
n = Num
do
incr iCount
if iCount > MaxX then
MaxX = iCount
redim preserve gy(NumOfNums, MaxX)
end if
gy(Num, iCount) = n
incr nPoints
if n = 1 then exit do
n = GenerateMember(n)
MaxY = max(MaxY, n)
loop
Function = iCount
End Function

Function GenerateMember(n as quad) as quad
if IsOdd(n) then
return (3*n) + 1
else
return n/2
end if
End function

Function LinInterp(ylo as single, yhi as single, x as single, xlo as single, xhi as single) as single
Function = (ylo * (xhi - x) + yhi * (x - xlo)) / (xhi - xlo) ' what's a function for?
End Function

Sub PlotGrid(iv1 as long, iv2 as long, iv3 as long, _
v2lo as single, v2hi as single, v2d as single, _
v3lo as single, v3hi as single, v3d as single, _
r as long, g as long, b as long)
PlotGrid2(iv1, iv2, iv3, v2lo, v2hi, v2d, v3lo, v3hi, v3d, r,g,b)
PlotGrid2(iv1, iv3, iv2, v3lo, v3hi, v3d, v2lo, v2hi, v2d, r,g,b)
End Sub

Sub PlotGrid2(iv1 as long, iv2 as long, iv3 as long, _
v2lo as single, v2hi as single, v2d as single, _
v3lo as single, v3hi as single, v3d as single, _
r as long, g as long, b as long)
local i, n as long, av(2,3), x, y, z as single
n = round((v2hi - v2lo) / v2d, 0)
for i = 0 to n
av(1,iv1) = 0: av(2,iv1) = 0 ' e.g. x
av(1,iv2) = v2lo: av(2,iv2) = v2hi
av(1,iv3) = LinInterp(v3lo, v3hi, i, 0, n): av(2,iv3) = av(1,iv3)
TBGL_Color r/2,g/2,b/2
if av(1,iv3) >= 0 then
av(1,iv2) = v2lo: av(2,iv2) = 0
plotline(av(1,1), av(1,2),av(1,3), av(2,1), av(2,2),av(2,3))
av(1,iv2) = 0: av(2,iv2) = v2hi
TBGL_Color r,g,b
plotline(av(1,1), av(1,2),av(1,3), av(2,1), av(2,2),av(2,3))
else
plotline(av(1,1), av(1,2),av(1,3), av(2,1), av(2,2),av(2,3))
end if
next n
End Sub

Sub PlotLine(x1 as single, y1 as single, z1 as single, _
optional x2 as single, y2 as single, z2 as single)
static x3, y3, z3 as single
TBGL_Beginpoly %GL_lines
if x2 = -999 then
TBGL_Vertex x3, y3, z3
TBGL_Vertex x1, y1, z1
x3 = x1: y3 = y1: z3 = z1
else
TBGL_Vertex x1, y1, z1
TBGL_Vertex x2, y2, z2
x3 = x2: y3 = y2: z3 = z2
end if
TBGL_Endpoly
End Sub

Sub PlotPoint(x1 as single, y1 as single, z1 as single, sz as long)
TBGL_Pointsize sz
TBGL_BEGINPOLY %GL_points
TBGL_VERTEX x1, y1, z1
TBGL_ENDPOLY
End Sub

Function QLoadWXYZ(qW as double, qX as double, qY as double, qZ as double) as string
local q as Quat
q.t = "Quat" ' for typecheck
q.W = qW: q.X = qX: q.Y = qY: q.Z = qZ
Function = q
End Function

Function QMultQ(sq1 as string, sq2 as string, iSign as long) as string ' quaternion multiplication
' q1 and q2 had better be type "Quat"s
local q, q1, q2 as Quat
q.t = "Quat": q1 = sq1: q2 = sq2
if q1.t <> "Quat" then msgbox 0,"TypeErr QM1": stop
if q2.t <> "Quat" then msgbox 0,"TypeErr QM2": stop
if abs(iSign) <> 1 then msgbox 0,"iSign must be -1 or 1": stop
q.W = q1.W*q2.W - (q1.X*q2.X + q1.Y*q2.Y + q1.Z*q2.Z) * iSign
q.X = q1.W*q2.X + (q1.X*q2.W + q1.Y*q2.Z - q1.Z*q2.Y) * iSign
q.Y = q1.W*q2.Y + (q1.Y*q2.W + q1.Z*q2.X - q1.X*q2.Z) * iSign
q.Z = q1.W*q2.Z + (q1.Z*q2.W + q1.X*q2.Y - q1.Y*q2.X) * iSign
Function = q
End Function

[ErosOlmi]

Great 3D example.

Maybe to speedup you can use a display lists. Points and grids do not change so display lists can do a big improve job.

Ciao
Eros

[Petr Schreiber]

Good idea with visualization!,

here comes display listed version as Eros suggested - rendering is realtime.


uses "Console", "TBGL", "Math"
Type Quat ' Quaternion
t as string*4 ' "Quat" typecheck
W as double ' cos of Angle / 2
X as double ' x
Y as double ' y
Z as double ' z
End Type

const NumOfNums as long = 200
global MaxX as long, MaxY as quad ' y gets outrageous
global hWnd as long, gy(,) as long
'----TBGL loop
hWnd = TBGL_CREATEWINDOWEX( _
"Arrow keys, PgUp, PgDn to rotate; ESC to quit", _
1024, 738, 32, %TBGL_WS_WINDOWED or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
local hFont AS DWORD = TBGL_FontHandle("Courier New", 9)
TBGL_BuildFont(hFont) ' for print
TBGL_ResetKeyState()

Populate1() ' get MaxNum arrays

%list_PostRotation = 1
BuildPostRotation(%list_PostRotation)
'----TBGL loop
TBGL_BindPeriodicFunction( hWnd, "TBGLLoop", 10)
TBGL_ProcessPeriodicFunction(hWnd)
'----End TBGL loop
TBGL_DestroyWindow

sub TBGLLoop()
if not TBGL_IsWindow(hWnd) then exit sub' ---------------------------loop
tbgl_ClearFrame
TBGL_Camera 0,0,3, 0,0,0
PreRotation() ' fixed items
DoRotation() ' do the rotation
tbgl_CallList %list_PostRotation ' rotating items
tbgl_DrawFrame
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then TBGL_UnBindPeriodicFunction( hWnd )
End Sub

Sub PreRotation()
End Sub

Sub DoRotation() ' using quaternions
Static Sw1 as integer, QMain, QRotX, QRotY, QRotZ as Quat
local Cosa, Sina, Ang as single
local dx, dy, dz as integer ' rotation deltas
IF TBGL_GetWindowKeyState( hWnd, %VK_Down) Then dx = +1 ' sign only
IF TBGL_GetWindowKeyState( hWnd, %VK_Up) Then dx = -1
IF TBGL_GetWindowKeyState( hWnd, %VK_Right) Then dy = +1
IF TBGL_GetWindowKeyState( hWnd, %VK_Left) Then dy = -1
IF TBGL_GetWindowKeyState( hWnd, %VK_PgUp) Then dz = +1
IF TBGL_GetWindowKeyState( hWnd, %VK_PgDn) Then dz = -1
if Sw1 = 0 then ' set up static variables
Sw1 = 1
Cosa = cos(pi/360.): Sina = sin(pi/360.) '
QMain = QLoadWXYZ(1, 0, 0, 0)
QRotX = QLoadWXYZ(Cosa, Sina, 0, 0)
QRotY = QLoadWXYZ(Cosa, 0, Sina, 0)
QRotZ = QLoadWXYZ(Cosa, 0, 0, Sina)
end if
if dx <> 0 then QMain = QMultQ(QRotX, QMain, dx)
if dy <> 0 then QMain = QMultQ(QRotY, QMain, dy)
if dz <> 0 then QMain = QMultQ(QRotZ, QMain, dz)
Ang = atan2(sqr(1.-QMain.W^2), QMain.W) * 2
TBGL_Rotate Ang, QMain.X, QMain.Y, QMain.Z
End Sub

Sub BuildPostRotation( listId as long )
local iNum, ix as long, x, y, z as single
tbgl_NewList listId
TBGL_Translate -.5,-.5,-.5
PlotGrid(1,2,3, 0,1,.1, 0,1,.1, 000,000,192) ' x,y,z, ylo,yhi,dy, zlo,zhi,dz, r,g,b)
PlotGrid(2,3,1, 0,1,.1, 0,1,.1, 000,192,000) ' x,y,z, ylo,yhi,dy, zlo,zhi,dz, r,g,b)
PlotGrid(3,1,2, 0,1,.1, 0,1,.1, 192,000,000) ' x,y,z, ylo,yhi,dy, zlo,zhi,dz, r,g,b)
TBGL_Color 255,255,255
for iNum = 1 to NumOfNums
ix = 0
do
incr ix
x = ix / MaxX
y = gy(iNum, ix)
y = min(y, MaxY) / MaxY
z = iNum / NumOfNums
PlotPoint(x, y, z, 1)
if y = 0 or ix = MaxX then exit do
loop
next iNum
tbgl_EndList
End Sub


Sub Populate1() ' get the kMaxNum arrays
local iNum2, j as long, x, nPoints as long
For iNum2 = 1 to NumOfNums
x = GenerateCount(iNum2, nPoints)
MaxX = max(MaxX, x)
Next iNum2
Printl nPoints, " points"
Printl "MaxX =", MaxX
Printl "MaxY =", MaxY
End Sub

Function GenerateCount(Num as long, ByRef nPoints as long) as long
local iCount as long, n as quad
n = Num
do
incr iCount
if iCount > MaxX then
MaxX = iCount
redim preserve gy(NumOfNums, MaxX)
end if
gy(Num, iCount) = n
incr nPoints
if n = 1 then exit do
n = GenerateMember(n)
MaxY = max(MaxY, n)
loop
Function = iCount
End Function

Function GenerateMember(n as quad) as quad
if IsOdd(n) then
return (3*n) + 1
else
return n/2
end if
End function

Function LinInterp(ylo as single, yhi as single, x as single, xlo as single, xhi as single) as single
Function = (ylo * (xhi - x) + yhi * (x - xlo)) / (xhi - xlo) ' what's a function for?
End Function

Sub PlotGrid(iv1 as long, iv2 as long, iv3 as long, _
v2lo as single, v2hi as single, v2d as single, _
v3lo as single, v3hi as single, v3d as single, _
r as long, g as long, b as long)
PlotGrid2(iv1, iv2, iv3, v2lo, v2hi, v2d, v3lo, v3hi, v3d, r,g,b)
PlotGrid2(iv1, iv3, iv2, v3lo, v3hi, v3d, v2lo, v2hi, v2d, r,g,b)
End Sub

Sub PlotGrid2(iv1 as long, iv2 as long, iv3 as long, _
v2lo as single, v2hi as single, v2d as single, _
v3lo as single, v3hi as single, v3d as single, _
r as long, g as long, b as long)
local i, n as long, av(2,3), x, y, z as single
n = round((v2hi - v2lo) / v2d, 0)
for i = 0 to n
av(1,iv1) = 0: av(2,iv1) = 0 ' e.g. x
av(1,iv2) = v2lo: av(2,iv2) = v2hi
av(1,iv3) = LinInterp(v3lo, v3hi, i, 0, n): av(2,iv3) = av(1,iv3)
TBGL_Color r/2,g/2,b/2
if av(1,iv3) >= 0 then
av(1,iv2) = v2lo: av(2,iv2) = 0
plotline(av(1,1), av(1,2),av(1,3), av(2,1), av(2,2),av(2,3))
av(1,iv2) = 0: av(2,iv2) = v2hi
TBGL_Color r,g,b
plotline(av(1,1), av(1,2),av(1,3), av(2,1), av(2,2),av(2,3))
else
plotline(av(1,1), av(1,2),av(1,3), av(2,1), av(2,2),av(2,3))
end if
next n
End Sub

Sub PlotLine(x1 as single, y1 as single, z1 as single, _
optional x2 as single, y2 as single, z2 as single)
static x3, y3, z3 as single
TBGL_Beginpoly %GL_lines
if x2 = -999 then
TBGL_Vertex x3, y3, z3
TBGL_Vertex x1, y1, z1
x3 = x1: y3 = y1: z3 = z1
else
TBGL_Vertex x1, y1, z1
TBGL_Vertex x2, y2, z2
x3 = x2: y3 = y2: z3 = z2
end if
TBGL_Endpoly
End Sub

Sub PlotPoint(x1 as single, y1 as single, z1 as single, sz as long)
TBGL_Pointsize sz
TBGL_BEGINPOLY %GL_points
TBGL_VERTEX x1, y1, z1
TBGL_ENDPOLY
End Sub

Function QLoadWXYZ(qW as double, qX as double, qY as double, qZ as double) as string
local q as Quat
q.t = "Quat" ' for typecheck
q.W = qW: q.X = qX: q.Y = qY: q.Z = qZ
Function = q
End Function

Function QMultQ(sq1 as string, sq2 as string, iSign as long) as string ' quaternion multiplication
' q1 and q2 had better be type "Quat"s
local q, q1, q2 as Quat
q.t = "Quat": q1 = sq1: q2 = sq2
if q1.t <> "Quat" then msgbox 0,"TypeErr QM1": stop
if q2.t <> "Quat" then msgbox 0,"TypeErr QM2": stop
if abs(iSign) <> 1 then msgbox 0,"iSign must be -1 or 1": stop
q.W = q1.W*q2.W - (q1.X*q2.X + q1.Y*q2.Y + q1.Z*q2.Z) * iSign
q.X = q1.W*q2.X + (q1.X*q2.W + q1.Y*q2.Z - q1.Z*q2.Y) * iSign
q.Y = q1.W*q2.Y + (q1.Y*q2.W + q1.Z*q2.X - q1.X*q2.Z) * iSign
q.Z = q1.W*q2.Z + (q1.Z*q2.W + q1.X*q2.Y - q1.Y*q2.X) * iSign
Function = q
End Function


Petr

[ErosOlmi]

Fantastic !
Real Time even with 4000 numbers

[ErosOlmi]

Concerning Petr's suggestion of using inline if, is that really faster or just more compact in source code?

Maybe similar speed. thinBasic does not produce any intermediate code (like pCode) but it works like a continuous parser.
The less code to parse the faster thinBasic will be. That is one of the reasons why thinBasic has a very rich set of native commands and thousands of commands coming from external modules developed by thinBasic or by thinBasic users.

[dcromley]

Oh Petr,

Oh my God, Petr. :eusaclap: You outdid yourself. This is unbelievable! Yes, this is fantastic!. I can't believe this. I just got up and ran your "list" approach and am stunned at the speed. This opens up a whole new world!

Thank you thank you thank you.

[Petr Schreiber]

Abyss,

interesting idea with the overflow. I must say I remember some situations I took advantage of ability to overflow without error. In case TB would support overflow checking, I would prefer to be able to turn this kind of check on/off, to gain speed.

Dave - applaus goes to driver developers, implementation of lists in TBGL differs from OpenGL only in garbage collection - lists are preallocated and deallocated automatically. The whole idea is based on "recording" commands between NewList/EndList, and optimizing them. The speed gain is mainly caused by reducing multiple function calls to single one.
Disadvantage is that the geometry you cache this way is static.

If everything will go nice, this summer TBGL will get new commands to boost rendering of dynamic geometry sets.

[abyss]

OK, since that 3D example does not run in 1.7.7, I really need to get the beta! It looks intriguing.

[Petr Schreiber]

Hi Abyss,

that would be nice, you can pick beta in dedicated post (http://community.thinbasic.com/index.php?topic=2588.0).

ThinBasic scripts can be marked with #MINVERSION a.b.c.d in the code to let users know which version is required, and it also makes ThinBasic stop in case it is lower version.

[ErosOlmi]

OK, since that 3D example does not run in 1.7.7, I really need to get the beta! It looks intriguing.


Maybe a camera zooming command can be added ;)