## Squares

General FreeBASIC programming questions.
dodicat
Posts: 6759
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 countEnd Functionfunction countbits(num as ulongint) as integer      dim as integer count       while num            count+= num and 1           num shr=1          wend       return countend functionrandomize 1dim as double tdim as long ctrt=timerFor i As Integer = 0 To 1000000    if pop_cnt(int(rnd*1000000000))=7 then ctr+=1  'richard'sNext iprint timer-t,ctr'=========================================randomize 1ctr=0t=timerFor i As Integer = 0 To 1000000    if countbits(int(rnd*1000000000))=7 then ctr+=1Next iprint timer-t,ctrSleep `
Richard
Posts: 3047
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 countEnd Function`
Richard
Posts: 3047
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 AlgorithmFunction fast_bitcount( Byval x As Ulongint ) As Integer    Dim As Integer count = 0    While x        x And= x - 1        count += 1    Wend    Return countEnd 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: 6759
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: 3047
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: 6759
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 AlgorithmFunction fast_bitcount( Byval x As Ulongint ) As Integer    Dim As Integer count = 0    While x        x And= x - 1        count += 1    Wend    Return countEnd Function'Dodicat and Google cheatam's algorithmFunction 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 FunctionRandomize 1Dim As Double tDim As Long ctrt=TimerFor i As Integer = 0 To 1000000    If fast_bitcount(Int(Rnd*1000000000))=7 Then ctr+=1  Next iPrint Timer-t,ctr'=========================================Randomize 1ctr=0t=TimerFor i As Integer = 0 To 1000000    If getbits(Int(Rnd*1000000000))=7 Then ctr+=1Next iPrint Timer-t,ctrSleep `
Posts: 2178
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: 1805
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 bits31 ms for popcounting a total of 159982282 bits31 ms for popcounting a total of 160004121 bits30 ms for popcounting a total of 159992999 bits31 ms for popcounting a total of 160005776 bits31 ms for popcounting a total of 159994165 bits32 ms for popcounting a total of 160011071 bits31 ms for popcounting a total of 160002935 bits31 ms for popcounting a total of 160013670 bits31 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 popcnt0.662 seconds   50599 popcnt80.991 seconds   50599 countbits0.090 seconds   50599 PopCount asm0.149 seconds   50599 PopCount FB0.119 seconds   50599 PopCount asm0.142 seconds   50599 PopCount FB0.094 seconds   50599 PopCount asm0.146 seconds   50599 PopCount FB`

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

Code: Select all

`#define elements 25000000Dim Shared As Integer values(elements)  for ct as integer=0 to elements   values(ct)=int(rnd*1000000000)  nextFunction 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 countEnd FunctionFunction 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 countEnd Functionfunction countbits(num as ulongint) as integer      dim as integer count       while num            count+= num and 1           num shr=1          wend       return countend functionDim Shared As Integer pcTable(256) for ct as integer=0 to 255  pcTable(ct)=pop_cnt(ct)nextfunction 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  add eax, [esi+4*edx]  bswap ecx  movzx edx, cl  add eax, [esi+4*edx]  movzx edx, ch  add eax, [esi+4*edx]  pop esi  ret  end asmend functionfunction 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 countend functionrandomize 1dim as double tdim as long ctrctr=0t=timerFor i As Integer = 0 To elements    if pop_cnt(values(i))=7 then ctr+=1  'richard'sNext iprint using "#.### seconds   ##### pop_cnt"; timer-t; ctrrandomize 1ctr=0t=timerFor i As Integer = 0 To elements    if pop_cnt8(values(i))=7 then ctr+=1  'richard'sNext iprint using "#.### seconds   ##### pop_cnt8"; timer-t; ctrrandomize 1ctr=0t=timerFor i As Integer = 0 To elements    if countbits(values(i))=7 then ctr+=1Next iprint using "#.### seconds   ##### countbits"; timer-t; ctrfor 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; ctrnextSleep`
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Thanks ; all you guys...For the help...
albert
Posts: 5927
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: 6759
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 25000000Dim Shared As Integer values(elements)  for ct as integer=0 to elements   values(ct)=int(rnd*1000000000)  nextFunction 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 countEnd FunctionFunction 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 countEnd Functionfunction countbits(num as ulongint) as integer      dim as integer count       while num            count+= num and 1           num shr=1          wend       return countend function'Dodicat and Google cheatam's algorithmFunction 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 FunctionDim Shared As Integer pcTable(256) for ct as integer=0 to 255  pcTable(ct)=pop_cnt(ct)nextfunction 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  add eax, [esi+4*edx]  bswap ecx  movzx edx, cl  add eax, [esi+4*edx]  movzx edx, ch  add eax, [esi+4*edx]  pop esi  ret  end asmend functionfunction 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 countend functionrandomize 1dim as double tdim as long ctrctr=0t=timerFor i As Integer = 0 To elements    if pop_cnt(values(i))=7 then ctr+=1  'richard'sNext iprint using "#.### seconds   ##### pop_cnt"; timer-t; ctrrandomize 1ctr=0t=timerFor i As Integer = 0 To elements    if pop_cnt8(values(i))=7 then ctr+=1  'richard'sNext iprint using "#.### seconds   ##### pop_cnt8"; timer-t; ctrrandomize 1ctr=0t=timerFor i As Integer = 0 To elements    if countbits(values(i))=7 then ctr+=1Next iprint using "#.### seconds   ##### countbits"; timer-t; ctrrandomize 1ctr=0t=timerFor i As Integer = 0 To elements    if getbits(values(i))=7 then ctr+=1Next iprint using "#.### seconds   ##### DaG-ca beta"; timer-t; ctrfor 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; ctrnextSleep  `
albert
Posts: 5927
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: 1805
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 beta0.096 seconds   50599 PopCount asm0.142 seconds   50599 PopCount FB0.097 seconds   50599 DaG-ca beta0.093 seconds   50599 PopCount asm0.141 seconds   50599 PopCount FB0.107 seconds   50599 DaG-ca beta0.090 seconds   50599 PopCount asm0.145 seconds   50599 PopCount FB`
albert
Posts: 5927
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    nextsleepend`
albert
Posts: 5927
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 ??