## Squares

General FreeBASIC programming questions.
Richard
Posts: 2953
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

Albert wrote:I need to convert long strings of decimals to base2 and base2 back into base10
like a string of 1,000,000 decimal digits converted to base2..

That will generate unreadable 3.010300 megabyte strings of confusing data.

You do not need the base change to be fast if it is only needed to convert a few thousand characters at most for a real human interface. Long ASCII number strings will always be slow to convert directly between bases. A sensible intermediate data format is needed if you want faster conversion between bases.

An efficient arithmetic processor needs an optimised internal format. You should use that format for the intermediate data in your base conversions. That internal format will certainly not be ASCII.
albert
Posts: 4952
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I sped up your base2 code...
Now to convert it to using pointers and stepping by more than 1 digit at a time..

Code: Select all

`     Function plus(Byval num1 As String,Byval num2 As String) As String    Static As Const Ubyte AddQMod(0 To 19)={48,49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57}    Static As Const Ubyte AddBool(0 To 19)={0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1}    Var n_=0    Dim As Ubyte addup=Any,addcarry    #macro finish()    Return Ltrim(answer,"0")    #endmacro    If Len(num2)>Len(num1) Then  Swap num2,num1    Var diff=Len(num1)-Len(num2)    Var answer="0"+num1    For n_=Len(num1)-1 To diff Step -1        addup=num2[n_-diff]+num1[n_]-96        answer[n_+1]=ADDQmod(addup+addcarry)        addcarry=ADDbool(addup+addcarry)    Next n_    If addcarry=0 Then        finish()    End If    If n_=-1 Then        answer[0]=addcarry+48        finish()    End If    For n_=n_ To 0 Step -1        addup=num1[n_]-48        answer[n_+1]=ADDQmod(addup+addcarry)        addcarry=ADDbool(addup+addcarry)        If addcarry=0 Then Exit For    Next n_    answer[0]=addcarry+48    finish()    End Function               Function Base10(BinaryNumber As String) As String            Dim As String sum=Left(BinaryNumber,1)            For n As Integer=2 To Len(BinaryNumber)                sum=plus(plus(sum,sum),Chr(BinaryNumber[n-1]))            Next n            Return sum        End Function       Function base2(DecimalNumber As String) As String        Dim As String starter = DecimalNumber , ans , m , b = String(4*Len(DecimalNumber),32)        Dim As Ubyte main , carry , temp        Dim As Long c , lens , idx = len(b)-1        Do            c = 0            carry = 0            ans = string(len(starter),"0")            For z As Long = 0 To Len(starter)-1 step 1                temp = (starter[z]-48) + carry                main = temp Shr 1                carry = (temp And 1) Shl 3 + (temp And 1) Shl 1                ans[z] = main + 48            Next z            c = carry \ 10            m = Ltrim(ans,"0")            b[idx] = c  + 48            starter = m            idx-= 1        Loop Until m = ""        b = ltrim( b )        Return bEnd Function           '======================================================================'======================================================================'======================================================================'======================================================================           screen 19            Randomize            #define range(f,l) Int(Rnd*((l+1)-(f))+(f))            Dim As String num                       Dim As Long size = 16                       num=String(size,0)            For n As Long=0 To size-1                If n=0 Then num[n]=range(49,57) Else num[n]=range(48,57)            Next                       Print "original"            Print num            Print            Print            Dim As Double t,t2            t=Timer            Var a= base2(num)            t2=Timer            Print "binary"                        Print a            print bin( val(num))                        Print "time to base two in milliseconds ";(t2-t)'*1000            Print            t=Timer            Var b= base10(a)            t2=Timer            Print            Print "back to original"            'Print b            Print "time to base 10 in milliseconds ";(t2-t)'*1000                       Print Iif(b=num,"OK","ERROR")            Sleep              `
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Albert
Here is a slightly faster base2

Code: Select all

` Function base2(DecimalNumber As String) As String            Dim As String starter=DecimalNumber,ans,m,b=string(4*len(DecimalNumber),32)             static as byte a(48 to 57)={0,10,0,10,0,10,0,10,0,10}            Dim As long c,lens            #macro reverse(s)                lens=Len(s)                For n As Integer=0 To Int((lens-1)/2):Swap s[n],s[lens-1-n]:Next                #endmacro                #macro div2(s,m,c)                c=0:ans=s                For z As long=0 To Len(s)-1                     ans[z]=  (c+s[z]) shr 1 +24                      c=a(s[z])                Next z                m= Ltrim(ans,"0")                #endmacro                dim as long idx                Do                    div2(starter,m,c)                    b[idx]=c\10+48                    starter=m                    idx+=1                Loop Until m="1" orelse m=""                b=rtrim(b)                reverse(b)                b=Str(m)+b                Return b         End Function     `

I still think there might be a method of one run along the string.
I'll keep experimenting.
albert
Posts: 4952
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

How do you get it stepping by 2's or more digits at a time??

Code: Select all

`Function base2(DecimalNumber As String) As String    Dim As String starter = DecimalNumber , ans , m , b = ""    static as byte a(48 to 57) = {0,10,0,10,0,10,0,10,0,10}    Dim As long c                #macro div2(s,m,c)        c = 0        ans = s        For z As long = 0 To Len(s)-1 step 1            ans[z] = ( (c + s[z] ) shr 1 + 24 )            c = a( s[z] )        Next z        m = Ltrim(ans,"0")        #endmacro                Do            div2(starter,m,c)            b = str( c\10) + b            starter=m        Loop Until m=""                b = rtrim(b)        Return b        End Function             '==============================================================='==============================================================='==============================================================='===============================================================screen 19do        randomize        dim as string num    for a as longint = 1 to 10 step 1        num+=str(int(rnd*10))    next    if left(num,1) = "0" then num = str(int(rnd*9)+1) + num        print num    dim as double time1 = timer , time2        dim as string b2  = base2(num)    time2 = timer        print b2 , vaL( "&b" + b2)    print bin(val(num)) , " " + num        print     print "time = " ; time2-time1    print    if inkey = " " then sleep    loop until inkey = chr(27)sleepend`
dodicat
Posts: 5913
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares top up

Hi Albert I'll have a fiddle around later.
But, as you know, during all these years of bigint, I have kept to string[48] to string[57] only.
Yourself and Richard have been using ulong steps, so I kept mine strictly to my own.
So, I have always have the headache of speed.
Maybe I'll branch out.
In the meantime, in the spirit of squares:

Code: Select all

`  Type Point     As single x,y  'need floats for smoothness when moving or rotating points    Declare sub rotate(As Point,As Single,As Single)' As PointEnd Typesub point.rotate(pivot As Point,a As Single,d As Single)' As Point dim as point t=type(d*(Cos(a*.0174533)*(x-pivot.x)-Sin(a*.0174533)*(y-pivot.y)) +pivot.x,_                     d*(Sin(a*.0174533)*(x-pivot.x)+Cos(a*.0174533)*(y-pivot.y)) +pivot.y)               this=tEnd subType Rectangle field=1    As Ushort wide    As Ushort high    As Single aspect     As Byte   pflag 'fill or not    As Ulong  clr   'colour    Declare  Constructor(As Point=type(0,0),As Ushort=0,As Ushort=0,As Single =0,As Ulong=0,As Byte=0)    As Point v(1 To 4) 'extra points for vertices/centroid    As Point centroid    Declare Sub Draw()End TypeConstructor rectangle(c As Point,w As Ushort,h As Ushort,a As Single,col As Ulong,pf As Byte)v(1)=type(c.x-w/2,c.y-h/2)v(2)=type(c.x-w/2,c.y+h/2)v(3)=type(c.x+w/2,c.y+h/2)v(4)=type(c.x+w/2,c.y-h/2)For n As Long=1 To 4    v(n).rotate(c,a,1)Nextpflag=pfclr=colaspect=awide=whigh=hcentroid=cEnd ConstructorSub fill(a() As Point,c As Ulong,min As Long,max As Long)    'translation of a c snippet    static As Long i,j,k,dy,dx, x,y,temp    Static As Long NewX (1 To Ubound(a))    Static As Single Grad(1 To Ubound(a))    For i=1 To Ubound(a) - 1         dy=a(i+1).y-a(i).y        dx=a(i+1).x-a(i).x        If(dy=0) Then Grad(i)=1        If(dx=0) Then Grad(i)=0        If ((dy <> 0) And (dx <> 0)) Then            Grad(i) = dx/dy        End If    Next i    For y=min To max        k = 1        For i=1 To Ubound(a) - 1            If( ((a(i).y<=y) Andalso (a(i+1).y>y)) Or ((a(i).y>y) _            Andalso (a(i+1).y<=y))) Then            NewX(k)= Int(a(i).x+ Grad(i)*(y-a(i).y))            k +=1        End If    Next i    For j = 1 To k-2        For i = 1 To k-2            If NewX(i) > NewX(i+1) Then                temp = NewX(i)                NewX(i) = NewX(i+1)                NewX(i+1) = temp            End If        Next i    Next j    For i = 1 To k - 2 Step 2        Line (NewX(i),y)-(NewX(i+1)+1,y), c    Next iNext yEnd SubSub rectangle.draw()    Static As Single miny=1e6,maxy=-1e6    Static As Point V1(1 To  Ubound(v)+1)    For n as long =1 To Ubound(v)        If pflag=0 Then If n<Ubound(v) Then  Line(v(n).x,v(n).y)-(v(n+1).x,v(n+1).y),clr        If miny>v(n).y Then miny=v(n).y        If maxy<v(n).y Then maxy=v(n).y        V1(n)=v(n)     Next    If pflag=0 Then Line -(v(1).x,v(1).y),clr    v1(Ubound(v1))=v(Lbound(v))    If pflag Then fill(v1(),clr,miny,maxy)End SubFunction Regulate(Byval MyFps As long,Byref fps As long) As Integer    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd Function'===================================   demo  ===================RandomizeScreen 19,32,,64Dim As rectangle r(1 To 100)dim as long fps'initial setupFor n As Long=1 To ubound(r)    dim as point middle=type(Rnd*850-Rnd*50,Rnd*650-Rnd*50) 'centroid of rectangle    r(n)=rectangle(middle,5+Rnd*100,5+Rnd*100,Rnd*360-Rnd*360,Rgba(50+Rnd*205,50+Rnd*205,50+Rnd*205,150*Rnd*105),1)    '                       width        height    aspect               colour                                   fillNextDim As Single k=1Dim As Byte endflagDo    If endflag Then k-=.005    Screenlock    Cls    draw string (20,20),"Fps  " &fps    'change aspects and centroid positions    For n As Long=1 To ubound(r)        r(n).centroid.rotate(type(400,300),.5,k)        r(n).aspect+=Sgn(r(n).aspect)        'refresh via constructor        r(n)=rectangle(r(n).centroid,r(n).wide,r(n).high,r(n).aspect,r(n).clr,r(n).pflag)        r(n).draw    Next    Screenunlock    Sleep regulate(60,fps),1    If Len(inkey) Then endflag=1Loop Until k<.4sleep 1500  `
Richard
Posts: 2953
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

That example of dodicatuana looks like a micrograph of my engine oil.
Posts: 1463
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Squares

With this "plus" function, you can calculate 2 ^ 10000, like so:

Code: Select all

`dim as integer N = 10000dim as integer idim as double tdim as string longNum = "1"t = timer'calculate 2 ^ Nfor i = 1 to N   longNum = plus(longNum, longNum)nextprint "Time:"; timer - tprint "Result: "; longNum`
Posts: 1463
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: Squares

I don't think that the ascii number adder can be made much faster, even with assembly (maybe 2 or 3 times faster). One could load 8 bytes at a time into a cpu register, but the problem is the carry bit which requires the code to process it byte for byte. In binary format, this carry stuff happens in 1 or 2 clockcycles for all 64 bits at once. To use this, conversion to binary in assembly needs to be made, which also takes multiple steps. I haven't done any assembly code the last 15 years, so I could be wrong.
albert
Posts: 4952
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

With binary numbers:
You can add 63 bits at a time.
You can subtract 64 bits at a time.

I'm looking for the fastest way to convert a decimal string number to binary and back to decimal..
Richard
Posts: 2953
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@Albert. Give these a try. They have not been fully tested yet.
How do they rate speed-wise compared to others you have ?

Code: Select all

`'=======================================================================' Convert base two ASCII binary string to base ten ASCII decimal string'=======================================================================Function base_2_to_10( Byref b As String ) As String    ' b may be lengthened    ' lengthen input string by up to 28 zero bits to make 29 bit blocks    Dim As Integer n = Len( b ) Mod 29    If n Then b = String( 29 - n, "0" ) + b    n = Len( b ) \ 29  ' number of input blocks    Dim As Ulong acc( 0 To n )  ' accumulator array    ' convert blocks of 9 digits to binary in 32 bit Ulong    Dim As Ulongint product, carry  ' 64 bit Unsigned Integer    Dim As Integer i, j, k = 1      ' loop counters    For j = 1 To Len( b ) Step 29   ' the blocks to convert        carry = Valulng( "&b" + Mid( b, j, 29 ) ) ' value of 29 bit block        For i = 0 To k  ' Multiply Accumulate,   2^29 = 536870912            product = ( Culngint( acc( i ) ) * 536870912ull ) + carry            acc( i ) = product Mod 1000000000ull    ' sum is low part            carry = product \ 1000000000ull     ' carry is the high part        Next i        If carry Then   ' extend accumulator by one element when needed            k += 1            acc( k ) = carry        End If    Next j  ' accumulator now contains result blocks of base 1 billion    ' unpack and return acc as decimal ASCII string    Dim As String txt    For i = n To 0 Step -1        txt += Right( "000000000" + Str( acc( i ) ), 9 )    Next i    Return Ltrim( txt, "0" )End Function'=======================================================================' Convert base ten ASCII decimal string to base two ASCII binary string'=======================================================================Function base_10_to_2( Byref d As String ) As String  ' d may be lengthened    ' lengthen input string by up to 8 digits to make 9 digit blocks    Dim As Integer n = Len( d ) Mod 9    If n Then d = String( 9 - n, "0" ) + d    n = Len( d ) \ 9  ' number of input blocks    Dim As Ulong acc( 0 To n )  ' the accumulator array    ' convert blocks of 9 digits to binary in 32 bit Ulong    Dim As Ulongint product, carry  ' 64 bit Unsigned Integer    Dim As Integer i, j, k = 1      ' loop counters    For j = 1 To Len( d ) Step 9     ' the blocks to convert        carry = Valulng( Mid( d, j, 9 ) ) ' get value of 9 digit block        For i = 0 To k  ' Multiply Accumulate            product = ( Culngint( acc( i ) ) * 1000000000ull ) + carry            acc( i ) = product And &hFFFFFFFFull ' sum is low order 32 bits            carry = product Shr 32 ' carry is the high order 32 bits        Next i        If carry Then   ' extend accumulator by one element when needed            k += 1            acc( k ) = carry        End If    Next j  ' accumulator now contains result in packed binary    ' unpack and return it as binary ASCII string    Dim As String txt    For i = n To 0 Step -1        txt += Bin( acc( i ), 32 )    Next i    Return Ltrim( txt, "0" )End Function'=======================================================================`
albert
Posts: 4952
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

Thanks for the code....
It converts 100,000 decimal digits to binary in .63 seconds.

I haven't yet tried to do a 1,000,000 digits yet...Having problems with my processor overheating..

(edited)

I did 1,000,000 decimal to binary and it takes 60.9 seconds to convert 1,000,000 digits to binary.
albert
Posts: 4952
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I rewrote Aretha Franklin's song " ( you make me feel ) like a natural woman"
I made it to be about sports " ( you make me feel ) like a natural champion"

Code: Select all

`( Genre = Pop )( Title = ( You make me feel ) like a natural champion )Looking out upon the , grassy fieldit always made me feel , so inspiredand when i had to face , another teamit'd make me high and i'd , feel so wiredbefore i signed on life , was so unkindthe team is the key to , my piece of mindcause you make me feelyou make me feelyou make me feel like a nat-u-ral champion (champion)(music)and when its time to play , another gamei get a feeling and , i can't name itand any time that i , can make a scoredance around the field , and i claim itwe love to play and theres , no feeling sorethe fans are the reason , we're playing forcause you make me feelyou make me feelyou make me feel likea nat-u-ral champion (champion)(music)and when i succeed and , i make a scoremy fans are the reason , i'm playin forcause you make me feelyou make me feelyou make me feel likea nat-u-ral champion (champion)(music)and you just make me feel , so good inside (so good inside)it'safeelingthat ican'tseemtohidecause you make me feelyou make me feelyou make me feel likea nat-u-ral champion (champion)(exit music)albert_redditt@yahoo.comAlbert Redditt315 W. Carrillo St. #104Santa Barbara, Ca. 93101 U.S.A.`
Last edited by albert on Aug 19, 2018 0:38, edited 1 time in total.
Richard
Posts: 2953
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@ Albert.
Introducing the advancing k marker only doubled the speed of the process over the brute force solution. The use of 9 digit and 29 bit blocks is probably not optimum, but it does seem to give the right answer ever time without too much head scratching. I guess there might be another 5% available without going to assembly code to do the Div and Mod in one parallel instruction.

This algorithm follows square law order. If it takes 0.63 seconds to do 100 kchar, then 1000 kchar is 10 times the size, so it will take 10^2 = 100 times longer than 100kchar, which would be 63 seconds on your overclocked radiator.

Code: Select all

`' On 2012 technology ... having trouble with my brain overheating.'   decimal ascii,  dec to bin   bin to dec'      100 digits,  27.1 usec,   22.9 usec'    1,000 digits, 199.4 usec,  265.3 usec'   10,000 digits,  11.488 msec, 13.360 msec'  100,000 digits,   1.087 sec,   1.210 sec'  200,000 digits,   4.333 sec,   4.818 sec'  250,000 digits,   6.766 sec,   7.526 sec'  500,000 digits,  27.024 sec,  30.038 sec' 1000,000 digits, 108.091 sec, 120.102 sec`
albert
Posts: 4952
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

I found a bottle neck!!
The end of the base_10_to_2()

Dim As String txt
For i = n To 0 Step -1
txt += Bin( acc( i ), 32 )
Next i
Return Ltrim( txt, "0" )

The txt+= Bin ?? (line)

acc( i ) takes 16 clock cycles each time , maybe use a pointer to make it 1 clock cycle??
Richard
Posts: 2953
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

My array indexing code is even slower because I do -exx checking when writing code like this. The loop speed limitation will be the bin( txt, 32 ) conversion from Ushort to the 32 character ASCII string, then the memory allocation needed for the continuous extension of that string as it grows.

Anyhow, only you need that bit of “special code for Albert”, others would avoid ASCII binary and use the 32 bit Ushort accumulator array for their calculations. I have trouble reading more than a byte of ASCII binary, let alone 3 million characters.

If you think you can squeeze more speed out of that ASCII generator, then give it a try.
I would start by creating the result txt string full length with txt = String( (n+1) * 32, “0”), then overwrite it with the 32 character substrings using something like; Mid( txt, 1+ ( i * 32 ) ) = Bin( a( n - i ), 32 ).

### Who is online

Users browsing this forum: No registered users and 1 guest