Squares

dodicat · Post by **dodicat** » Mar 10, 2019 4:52

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

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 · Post by **Richard** » Mar 10, 2019 5:21

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 · Post by **Richard** » Mar 10, 2019 8:30

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 · Post by **dodicat** » Mar 10, 2019 11:51

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 · Post by **Richard** » Mar 10, 2019 12:36

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 · Post by **dodicat** » Mar 10, 2019 13:50

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

badidea · Post by **badidea** » Mar 10, 2019 14:25

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 · Post by **jj2007** » Mar 10, 2019 15:03

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[0]
  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 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 · Post by **albert** » Mar 10, 2019 17:41

Thanks ; all you guys...For the help...

albert · Post by **albert** » Mar 10, 2019 17:48

Whats the fastest way , to bubble sort an array()?
Smallest value to biggest value.

dodicat · Post by **dodicat** » Mar 10, 2019 18:04

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[0]
  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 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 · Post by **albert** » Mar 10, 2019 18:18

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 · Post by **jj2007** » Mar 10, 2019 19:48

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 · Post by **albert** » Mar 10, 2019 20:15

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 · Post by **albert** » Mar 11, 2019 2:33

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 ??

Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares

Re: Squares