Sorry your browser is not supported!

        
//current_colour is a variable
current_colour = rnd(2)
	
//colours() is the three colour array	 
colours(current_colour)

global lastcolour as integer
lastcolour=3

...



current_colour = rnd(2)
if current_colour=lastcolour then current_colour=(current_colour+1) mod 3
lastcolour=current_colour
//colours() is the three colour array	 
colours(current_colour)

// Init it to some impossible colour, so the first selection is out of the range of 3
Last_Colour=-1

repeat

  //current_colour is a variable
   current_colour = rnd(2)


until current_colour<>Last_Colour

// Make the last colour index be the same as the newly selected index
// for when we make our next selection
Last_Colour= current_colour


//colours() is the three colour array	 
colours(current_colour)

colour_count = 3
last_colour = 1

current_colour = rnd(colour_count - 2)
if current_colour >= last_colour
   current_colour = current_colour + 1
endif
last_colour = current_colour

	Dim Options(2)

	Do
		Cls

		For lp=0 to 10000		
		   current_colour=mod(current_colour+rndrange(1,2),3) 
			Options(current_colour)++
			frames++
		next

		for lp=0 to 2
			print Options(lp)
		next
	
		Sync
	loop

global lastcolour as integer
global total as integer
global maxcolour=3
lastcolour=maxcolour
total=0
dim col(maxcolour-1)


for n=0 to 1000000
	current_colour = rnd(maxcolour-1)
	if current_colour=lastcolour then current_colour=(current_colour+1) mod maxcolour
	lastcolour=current_colour
	//colours() is the three colour array	 
	col(current_colour)=col(current_colour)+1
	total=total+1
next

for n=0 to maxcolour-1
	print str$(col(n)*1.0/total)
next n
sync
wait key
end

set display mode desktop width(), desktop height(), 32
sync on : sync

dim colours(2) as string
colours(0) = "red"
colours(1) = "green"
colours(2) = "blue"
randomize timer() ` initialize random numbers to a random start

nSamples = 1000000

` KP's modulo method
KP2 = timer()
last_colour = rnd(2)
for i = 1 to nSamples
  current_colour = (1 + last_colour + rnd(1)) mod 3
  colour$ = colours(current_colour)
  last_colour = current_colour
next i
KP2 = timer() - KP2

` KP's rejection method
KP1 = timer()
for i = 1 to nSamples
  ` initialize the previous colour to something impossible
  Last_Colour=-1
  repeat
    //current_colour is a variable
     current_colour = rnd(2)
  until current_colour<>Last_Colour
  Last_Colour = current_colour
  ` lookup the colour so it could be used for something
  colour$ = colours(current_colour)
next i
KP1 = timer() - KP1

` an inefficient string array swapping method
`  **** for some odd reason, any method after this one seems to run faster WHY?
ASM = timer()
` get a random start
colour = rnd(2)
swap$ = colours(colour)
colours(colour) = colours(2)
colours(2) = swap$
for i = 1 to nSamples
  colour = rnd(1)
  swap$ = colours(colour)
  colours(colour) = colours(2)
  colours(2) = swap$
  colour$ = swap$
next i
ASM = timer() - ASM

` DC's method
DC = timer()
last_colour = rnd(2)
for i = 1 to nSamples
  current_colour = rnd(1)
  if current_colour >= last_colour
    current_colour = current_colour + 1
  endif
  last_colour = current_colour
  colour$ = colours(current_colour)
next i
DC = timer() - DC

print "KP1 = ", KP1, "  KP2 = ", KP2, "  DC = ", DC, " ASM = ", ASM
sync
wait key
end

set display mode desktop width(), desktop height(), 32
sync on : sync

dim colours(2) as string
colours(0) = "red"
colours(1) = "green"
colours(2) = "blue"
randomize timer() ` initialize random numbers to a random start

nSamples = 100000

sync

` KP's modulo method
KP2 = HiTimer(10000)
last_colour = rnd(2)
for i = 1 to nSamples
  current_colour = (1 + last_colour + rnd(1)) mod 3
  colour$ = colours(current_colour)
  last_colour = current_colour
next i
KP2 = HiTimer(10000) - KP2

sync

` KP's rejection method
KP1 = HiTimer(10000)
for i = 1 to nSamples
  ` initialize the previous colour to something impossible
  Last_Colour=-1
  repeat
    //current_colour is a variable
     current_colour = rnd(2)
  until current_colour<>Last_Colour
  Last_Colour = current_colour
  ` lookup the colour so it could be used for something
  colour$ = colours(current_colour)
next i
KP1 = HiTimer(10000) - KP1

sync

` DC's method
DC = HiTimer(10000)
last_colour = rnd(2)
for i = 1 to nSamples
  current_colour = rnd(1)
  if current_colour >= last_colour
    current_colour = current_colour + 1
  endif
  last_colour = current_colour
  colour$ = colours(current_colour)
next i
DC = HiTimer(10000) - DC

sync

` an inefficient string array swapping method
`  **** for some odd reason, any method after this one seems to run faster WHY?
`ASM = timer()
ASM = HiTimer(10000)
` get a random start
colour = rnd(2)
swap$ = colours(colour)
colours(colour) = colours(2)
colours(2) = swap$
for i = 1 to nSamples
  swap array items colours(), rnd(1), 2
  colour$ = colours(2)
next i
`ASM = timer() - ASM
ASM = HiTimer(10000) - ASM

print "KP1 = ", KP1, "  KP2 = ", KP2, "  DC = ", DC, " ASM = ", ASM
sync
wait key
end

Method:      KP1   KP2   DC   ASM
ASM first:   325   302  294   291
ASM last:    555   549  517   457

` Change these as appropriate for your system
#constant ITERATION_COUNT       1000000
#constant TIMER_FREQ            1000000

#constant RS_AS_DEFINED         0
#constant RS_AS_DEFINED_REV     1
#constant RS_SORTED             2
#constant RS_SORTED_REV         3
#constant RS_RANDOM_SHUFFLE     4

` Set this according to your test requirements
RunSequence = RS_AS_DEFINED

sync on
sync rate 0
sync
randomize timer() ` initialize random numbers to a random start

type TestFunctions_t
    Name as string
    Ptr  as dword
    Time as integer
    Seq  as integer
endtype

NameSize = 0
dim TestFunctions() as TestFunctions_t

` Locate all test functions and populate the TestFunctions array appropriately
for i = 1 to get function count()
    if lower$(left$(get function name$(i), 5)) = "test_"
        array insert at bottom TestFunctions()

        TestFunctions().Name = get function name$(i)
        TestFunctions().Ptr  = get ptr to function(i)
        TestFunctions().Time = 0
        TestFunctions().Seq  = i

        ` Get largest function name size, for pretty printing later
        NameSize = max( NameSize, len(get function name$(i)))
    endif
next

SequenceDesc as string = "Function order"

select RunSequence
    case RS_AS_DEFINED
        ` Do nothing
        SequenceDesc = "Functions in order they are defined"
    endcase
    case RS_AS_DEFINED_REV
        sort array TestFunctions(), -4 ` Reverse sort by seq
        SequenceDesc = "Functions in reverse order of definition"
    endcase
    case RS_SORTED
        sort array TestFunctions(), 1  ` sort by name
        SequenceDesc = "Functions sorted by name"
    endcase
    case RS_SORTED_REV
        sort array TestFunctions(), -1 ` reverse sort by name
        SequenceDesc = "Functions reverse sorted by name"
    endcase
    case RS_RANDOM_SHUFFLE
        for i = array count(TestFunctions()) to 1 step -1
            swap array items TestFunctions(), i, rnd(i)
        next
        SequenceDesc = "Functions Randomly shuffled"
    endcase
endselect

` Fix this sequence in place, so that the current order can be recreated later with another sort
for i = 0 to array count( TestFunctions() )
    TestFunctions(i).Seq = i
next

InitialiseTest()

do
    ` Run all tests
    for i = 0 to array count( TestFunctions() )
        ResetTest()

        StartTime = hitimer( TIMER_FREQ )
        call function ptr TestFunctions(i).Ptr
        FinishTime = hitimer( TIMER_FREQ )

        TestFunctions(i).Time = FinishTime - StartTime
    next

    ` Display the results
    cls
    print SequenceDesc
    print ""
    sort array TestFunctions(), 3  ` Sort by time taken, for pretty printing
    for i = 0 to array count( TestFunctions() )
        print padleft$( TestFunctions(i).Name, NameSize ); " : ";
        print padleft$( str$(TestFunctions(i).Time), 10 ); ", sequence = "; TestFunctions(i).Seq
    next
    print ""
    print "Press ESCAPE to exit"

    sort array TestFunctions(), 4  ` Restore to the previous sort order

    sync
loop

` All globals and functions for testing go here
` All functions prefixed with 'Test_' will be executed

function InitialiseTest()
    dim ColourTable(2) as integer
    ColourTable(0) = rgb(255,0,0)
    ColourTable(1) = rgb(0,255,0)
    ColourTable(2) = rgb(0,0,255)
endfunction

function ResetTest()
endfunction

function Test_NULL()
endfunction

function Test_KP1()
    LastColour=rnd(2)
    for i = 1 to ITERATION_COUNT
        repeat
            CurrentColour = rnd(2)
        until CurrentColour<>LastColour
        LastColour = CurrentColour
        ChosenColour = ColourTable(CurrentColour)
    next i
endfunction

function Test_KP2()
    LastColour = rnd(2)
    for i = 1 to ITERATION_COUNT
        CurrentColour = (1 + LastColour + rnd(1)) mod 3
        ChosenColour = ColourTable(CurrentColour)
        LastColour = CurrentColour
    next i
endfunction

function Test_DC()
    LastColour = rnd(2)
    for i = 1 to ITERATION_COUNT
        CurrentColour = rnd(1)
        if CurrentColour >= LastColour
            CurrentColour = CurrentColour + 1
        endif
        LastColour = CurrentColour
        ChosenColour = ColourTable(CurrentColour)
    next i
endfunction

function Test_ASM()
    swap array items ColourTable(), rnd(2), 2   ` Swapping an item with itself (if it happens) is a safe null-op
    for i = 1 to ITERATION_COUNT
        swap array items ColourTable(), rnd(1), 2
        ChosenColour = ColourTable(2)
    next i
endfunction

10000 iterations
Method:       KP1   KP2   DC   ASM
ASM first:    159    41   34    34
ASM last:     158    36   34    33

100000 iterations
Method:       KP1   KP2   DC   ASM
ASM first:  25927   374  379   335
ASM last:   29324   370  336   365

for i = 1 to nSamples
  ` initialize the previous colour to something impossible
  Last_Colour=-1
  repeat
    //current_colour is a variable
     current_colour = rnd(2)
  until current_colour<>Last_Colour
  Last_Colour = current_colour
  ` lookup the colour so it could be used for something
  colour$ = colours(current_colour)
next i

` initialize the previous colour to something impossible
Last_Colour=-1
for i = 1 to nSamples
  repeat
    //current_colour is a variable
     current_colour = rnd(2)
  until current_colour<>Last_Colour
  Last_Colour = current_colour
  ` lookup the colour so it could be used for something
  colour$ = colours(current_colour)
next i

FunctionPtr  as dword
FunctionPtr = get ptr to function(2) ` this should refer to the second function, i.e. x^2
global s2# ` a diagnostic variable
global s3# ` ditto
result# = test(FunctionPtr, 2.0, 3.0)

print "result = ", result#
print "s2 = ", s2#
print "s3 = ", s3#

wait key

end

function test(f as dword, a as float, b as float)
  ` estimates the definite integral of the function with pointer f 
  s# = (call function ptr(f, a)) + (call function ptr(f, b)) * 0.5
  s2# = s#
endfunction s#

function xSquared(x as float)
  result# = x * x
  s3# = result#
endfunction result#