Squares

General FreeBASIC programming questions.
dodicat
Posts: 5947
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

My string tally is a bit slow so here's another way.

Code: Select all

Function pop_cnt( Byval x As Ulongint ) As Integer  ''richard
Dim As Integer count = 0
Do While x
If x And 1 Then count += 1
If x And 2 Then count += 1
If x And 4 Then count += 1
If x And 8 Then count += 1
x = x Shr 4
Loop
Return count
End Function

function countbits(num as ulongint) as integer
dim as integer count
while num
count+= num and 1
num shr=1
wend
return count
end function

randomize 1
dim as double t
dim as long ctr
t=timer

For i As Integer = 0 To 1000000
if pop_cnt(int(rnd*1000000000))=7 then ctr+=1  'richard's
Next i
print timer-t,ctr
'=========================================

randomize 1
ctr=0
t=timer
For i As Integer = 0 To 1000000
if countbits(int(rnd*1000000000))=7 then ctr+=1
Next i
print timer-t,ctr

Sleep
Richard
Posts: 2955
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Avoid 2/3 of the unlikely tests.

Code: Select all

Function count_bits( Byval x As Ulongint ) As Integer
Dim As Integer count = 0
While x
count += x And 1
x Shr= 1
count += x And 1
x Shr= 1
count += x And 1
x Shr= 1
Wend
Return count
End Function
Richard
Posts: 2955
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Avoiding the terminal test 2/3 of the time only made it 7% faster, but here, even with the terminal test always done, it is about 33% faster.

Code: Select all

' Brian Kernighan’s Algorithm
Function fast_bitcount( Byval x As Ulongint ) As Integer
Dim As Integer count = 0
While x
x And= x - 1
count += 1
Wend
Return count
End Function

I conjured up "x Xor= x And -x" which worked OK, but then I found Brian Kernighan’s Algorithm which uses the simpler to understand "x And= x-1". They are both about the same speed.
dodicat
Posts: 5947
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Where do all these names come from?
Brian Kernighan’s Algorithm
Brent's algorithm.
Hopcroft carp algorithm
and . . .
Knuth, Bellman-ford, Floyd-Warshall . . .
There are millions of them.
I notice many are double barrelled which I presume means that a couple of people have went through hellish stages of arguing, including, I suppose, which name appears first.
I propose an Albert-Richard algorithm about something or other. It is time, after all those exhausting years on circles and now squares.

I have my own suggestion for (Dodicat), the law of partial mental pressures, which suggests that no matter how fast you get your algorithm to run, somebody on the freebasic forum comes up with a faster one, and the total mental pressure is then the sum of all these disappointments, which over time will result in a crack up.
I have yet to put it in code form of course.
Richard
Posts: 2955
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

If dodicat had not shown While...Wend was faster than Do While .. Loop and eliminated the If, I would not have looked for and found x Xor= x And -x. When I found that I went looking to see if it was already in play. That is when I found Brian Kernighan’s x And= x-1. So if Albert hadn't asked, dodicat wouldn't have challenged my speed and I wouldn't have searched for and invented a zero-jumping version, then found the best yet already in use. There are faster ways that use look up tables of nybbles or bytes. It is your turn.
If anyone on the FB forum comes up with a faster algorithm we are all winners. The forum is greater than sum of it's members.
dodicat
Posts: 5947
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Once more he stepped into the street, and to his lips again he raised his pipe of long straight cane.
(Pied piper~ ish)
32 bits compiler.

Code: Select all

' Brian Kernighan’s Algorithm
Function fast_bitcount( Byval x As Ulongint ) As Integer
Dim As Integer count = 0
While x
x And= x - 1
count += 1
Wend
Return count
End Function

'Dodicat and Google cheatam's algorithm
Function getbits(num As Integer) As Integer
num=num-((num Shr 1) And &h55555555)
num= (num And &h33333333) + ((num Shr 2) And &h33333333)
Return (((num + (num Shr 4)) And &h0F0F0F0F) * &h01010101) Shr 24
End Function

Randomize 1
Dim As Double t
Dim As Long ctr
t=Timer

For i As Integer = 0 To 1000000
If fast_bitcount(Int(Rnd*1000000000))=7 Then ctr+=1
Next i
Print Timer-t,ctr
'=========================================

Randomize 1
ctr=0
t=Timer
For i As Integer = 0 To 1000000
If getbits(Int(Rnd*1000000000))=7 Then ctr+=1
Next i
Print Timer-t,ctr

Sleep
Posts: 1545
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

dodicat wrote:... I notice many are double barrelled which I presume means that a couple of people have went through hellish stages of arguing, including, I suppose, which name appears first ...

If too much persons are involved, the algorithm names become boring abbreviations, e.g.: DPLL algorithm LZSS algorithm
jj2007
Posts: 1242
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Squares

A table-based solution is fastest:

Code: Select all

31 ms for popcounting a total of 159997056 bits
31 ms for popcounting a total of 159982282 bits
31 ms for popcounting a total of 160004121 bits
30 ms for popcounting a total of 159992999 bits
31 ms for popcounting a total of 160005776 bits
31 ms for popcounting a total of 159994165 bits
32 ms for popcounting a total of 160011071 bits
31 ms for popcounting a total of 160002935 bits
31 ms for popcounting a total of 160013670 bits
31 ms for popcounting a total of 160008316 bits
This is PopCount (assembly) for 10 Million random integers, approx. 16*10 Mio bits.

P.S.: Adapted to FB, 25 Mio integers:

Code: Select all

0.741 seconds   50599 popcnt
0.662 seconds   50599 popcnt8
0.991 seconds   50599 countbits
0.090 seconds   50599 PopCount asm
0.149 seconds   50599 PopCount FB
0.119 seconds   50599 PopCount asm
0.142 seconds   50599 PopCount FB
0.094 seconds   50599 PopCount asm
0.146 seconds   50599 PopCount FB

Full source (btw Do ... Loop until is a tick faster than While ... Wend):

Code: Select all

#define elements 25000000
Dim Shared As Integer values(elements)
for ct as integer=0 to elements
values(ct)=int(rnd*1000000000)
next

Function pop_cnt( Byval x As Ulongint ) As Integer  ''richard
Dim As Integer count = 0
Do While x
If x And 1 Then count += 1
If x And 2 Then count += 1
If x And 4 Then count += 1
If x And 8 Then count += 1
x = x Shr 4
Loop
Return count
End Function

Function pop_cnt8( Byval x As Ulongint ) As Integer  ''richard
Dim As Integer count = 0
Do While x
If x And 1 Then count += 1
If x And 2 Then count += 1
If x And 4 Then count += 1
If x And 8 Then count += 1
If x And 16 Then count += 1
If x And 32 Then count += 1
If x And 64 Then count += 1
If x And 128 Then count += 1
x = x Shr 8
Loop
Return count
End Function

function countbits(num as ulongint) as integer
dim as integer count
while num
count+= num and 1
num shr=1
wend
return count
end function

Dim Shared As Integer pcTable(256)

for ct as integer=0 to 255
pcTable(ct)=pop_cnt(ct)
next

function PopCountAsm naked cdecl (num as ulongint) as integer
asm
push esi
lea esi, pcTable
mov ecx, [esp+8]
movzx edx, cl
mov eax, [esi+4*edx]
movzx edx, ch
bswap ecx
movzx edx, cl
movzx edx, ch
pop esi
ret
end asm
end function

function PopCount(num as ulongint) as integer
dim as integer count
#if 0
While num
count+=pcTable(num and 255)
num shr=8
Wend
#else
Do
count+=pcTable(num and 255)
num shr=8
Loop Until num=0
#endif
return count
end function

randomize 1
dim as double t
dim as long ctr

ctr=0
t=timer
For i As Integer = 0 To elements
if pop_cnt(values(i))=7 then ctr+=1  'richard's
Next i
print using "#.### seconds   ##### pop_cnt"; timer-t; ctr

randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if pop_cnt8(values(i))=7 then ctr+=1  'richard's
Next i
print using "#.### seconds   ##### pop_cnt8"; timer-t; ctr

randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if countbits(values(i))=7 then ctr+=1
Next i
print using "#.### seconds   ##### countbits"; timer-t; ctr

for outerct as integer =0 to 2
randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if PopCountAsm(values(i))=7 then ctr+=1
Next i
print using "#.### seconds   ##### PopCount asm"; timer-t; ctr
randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if PopCount(values(i))=7 then ctr+=1
Next i
print using "#.### seconds   ##### PopCount FB"; timer-t; ctr
next
Sleep
albert
Posts: 5055
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Thanks ; all you guys...For the help...
albert
Posts: 5055
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Whats the fastest way , to bubble sort an array()?
Smallest value to biggest value.
dodicat
Posts: 5947
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

jj2007
You forgot the Dodicat and Google cheatam's algorithm, now known as DaG-ca beta (an idea from badidea)
Works now on 64 bits, I got it returning integer<8>, which is big enough.

Code: Select all

#define elements 25000000
Dim Shared As Integer values(elements)
for ct as integer=0 to elements
values(ct)=int(rnd*1000000000)
next

Function pop_cnt( Byval x As Ulongint ) As Integer  ''richard
Dim As Integer count = 0
Do While x
If x And 1 Then count += 1
If x And 2 Then count += 1
If x And 4 Then count += 1
If x And 8 Then count += 1
x = x Shr 4
Loop
Return count
End Function

Function pop_cnt8( Byval x As Ulongint ) As Integer  ''richard
Dim As Integer count = 0
Do While x
If x And 1 Then count += 1
If x And 2 Then count += 1
If x And 4 Then count += 1
If x And 8 Then count += 1
If x And 16 Then count += 1
If x And 32 Then count += 1
If x And 64 Then count += 1
If x And 128 Then count += 1
x = x Shr 8
Loop
Return count
End Function

function countbits(num as ulongint) as integer
dim as integer count
while num
count+= num and 1
num shr=1
wend
return count
end function

'Dodicat and Google cheatam's algorithm
Function getbits(num As integer<32>) As integer<8>
num=num-((num Shr 1) And 1431655765)
num= (num And 858993459) + ((num Shr 2) And 858993459)
Return (((num + (num Shr 4)) And 252645135l) * 16843009l) Shr 24
End Function

Dim Shared As Integer pcTable(256)

for ct as integer=0 to 255
pcTable(ct)=pop_cnt(ct)
next

function PopCountAsm naked cdecl (num as ulongint) as integer
asm
push esi
lea esi, pcTable
mov ecx, [esp+8]
movzx edx, cl
mov eax, [esi+4*edx]
movzx edx, ch
bswap ecx
movzx edx, cl
movzx edx, ch
pop esi
ret
end asm
end function

function PopCount(num as ulongint) as integer
dim as integer count
#if 0
While num
count+=pcTable(num and 255)
num shr=8
Wend
#else
Do
count+=pcTable(num and 255)
num shr=8
Loop Until num=0
#endif
return count
end function

randomize 1
dim as double t
dim as long ctr

ctr=0
t=timer
For i As Integer = 0 To elements
if pop_cnt(values(i))=7 then ctr+=1  'richard's
Next i
print using "#.### seconds   ##### pop_cnt"; timer-t; ctr

randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if pop_cnt8(values(i))=7 then ctr+=1  'richard's
Next i
print using "#.### seconds   ##### pop_cnt8"; timer-t; ctr

randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if countbits(values(i))=7 then ctr+=1
Next i
print using "#.### seconds   ##### countbits"; timer-t; ctr

randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if getbits(values(i))=7 then ctr+=1
Next i
print using "#.### seconds   ##### DaG-ca beta"; timer-t; ctr

for outerct as integer =0 to 2
randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if PopCountAsm(values(i))=7 then ctr+=1
Next i
print using "#.### seconds   ##### PopCount asm"; timer-t; ctr
randomize 1
ctr=0
t=timer
For i As Integer = 0 To elements
if PopCount(values(i))=7 then ctr+=1
Next i
print using "#.### seconds   ##### PopCount FB"; timer-t; ctr
next
Sleep
albert
Posts: 5055
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

I got it figured out...
This prints all the number of bits set for for the different numbers.

Code: Select all

screen 19

redim as string tally(0 to 255)
dim as string ins
dim as ubyte count=0
for a as longint = 0 to 255
ins = bin(a)
count=0
for b as longint = 0 to len(ins)-1
if ins[b]-48=1 then count+=1
next
tally(a)=str(count) + " " + right("000"+str(a),3)
next
for a as longint = 0 to ubound(tally)
for b as longint = a to ubound(tally)
if tally(b) < tally(a) then swap tally(a),tally(b)
next
next
for a as longint = 0 to ubound(tally)
print tally(a);" ";
next
print
print
count=0
for a as longint = 0 to ubound(tally)
count+=1
print left(tally(a),1);
if left(tally(a+1),1) <> left(tally(a),1) then print ; "  " ;count:count=0
next
sleep

jj2007
Posts: 1242
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Squares

dodicat wrote:You forgot the Dodicat and Google cheatam's algorithm, now known as DaG-ca beta (an idea from badidea)
Excellent!

Code: Select all

0.106 seconds   50599 DaG-ca beta
0.096 seconds   50599 PopCount asm
0.142 seconds   50599 PopCount FB
0.097 seconds   50599 DaG-ca beta
0.093 seconds   50599 PopCount asm
0.141 seconds   50599 PopCount FB
0.107 seconds   50599 DaG-ca beta
0.090 seconds   50599 PopCount asm
0.145 seconds   50599 PopCount FB
albert
Posts: 5055
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Here's number of bits set for ( 0 to 65,535 ) , and how many numbers have that number of bits set.

The bubble sort takes like 8 minutes... Any ideas as how to speed it up?

Code: Select all

screen 19

print "counting 1's"
redim as string*8 tally(0 to 65535)
dim as string ins
dim as ubyte count=0
for a as longint = 0 to 65535
ins = bin(a)
count=0
for b as longint = 0 to len(ins)-1
if ins[b]-48=1 then count+=1
next
tally(a) = right("00" + str(count),2) + " " + right("00000"+str(a),5)
if a mod 256 = 0 then print a
next
print "bubble sorting"
for a as longint = 0 to ubound(tally)
for b as longint = a to ubound(tally)
if tally(b) < tally(a) then swap tally(a),tally(b)
next
if a mod 1024 = 0 then print 65535 - a
next
'for a as longint = 0 to ubound(tally)
'    print tally(a);" ";
'next
'print
'print
count=0
for a as longint = 0 to ubound(tally)
count+=1
'print left(tally(a),1);
if left(tally(a+1),2) <> left(tally(a),2) then print left(tally(a),2); " " ; count : count=0
next

sleep
end

albert
Posts: 5055
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Does anyone have a faster INSTR() function... The FB builtin INSTR() , is taking several minutes..

I know there's processor function scan-string? i think its called SCASB ??