Squares

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

Re: Squares

Post by Richard »

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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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 b
End 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: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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 19

do
    
    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)

sleep
end

dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares top up

Post by dodicat »

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 Point
End Type

sub 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=t
End sub

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

Constructor 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)
Next
pflag=pf
clr=col
aspect=a
wide=w
high=h
centroid=c
End Constructor

Sub 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 i
Next y
End Sub

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

Function 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 sleeptime
End Function
'===================================   demo  ===================
Randomize
Screen 19,32,,64

Dim As rectangle r(1 To 100)
dim as long fps
'initial setup
For 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                                   fill
Next

Dim As Single k=1
Dim As Byte endflag
Do
    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=1
Loop Until k<.4
sleep 1500


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

Re: Squares

Post by Richard »

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

Re: Squares

Post by badidea »

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

Code: Select all

dim as integer N = 10000
dim as integer i
dim as double t
dim as string longNum = "1"

t = timer
'calculate 2 ^ N
for i = 1 to N
	longNum = plus(longNum, longNum)
next
print "Time:"; timer - t

print "Result: "; longNum
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Post by badidea »

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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@badidea

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: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

@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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

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 field
it always made me feel , so inspired

and when i had to face , another team
it'd make me high and i'd , feel so wired

before i signed on life , was so unkind
the team is the key to , my piece of mind

cause you make me feel
you make me feel
you make me feel like 
a nat-u-ral champion (champion)

(music)

and when its time to play , another game
i get a feeling and , i can't name it

and any time that i , can make a score
dance around the field , and i claim it

we love to play and theres , no feeling sore
the fans are the reason , we're playing for

cause you make me feel
you make me feel
you make me feel like
a nat-u-ral champion (champion)

(music)

and when i succeed and , i make a score
my fans are the reason , i'm playin for

cause you make me feel
you make me feel
you make me feel like
a nat-u-ral champion (champion)

(music)

and you just make me feel , so good inside (so good inside)

it's
a
feel
ing
that 
i
can't
seem
to
hide

cause you make me feel
you make me feel
you make me feel like
a nat-u-ral champion (champion)

(exit music)


albert_redditt@yahoo.com

Albert Redditt
315 W. Carrillo St. #104
Santa Barbara, Ca. 93101 U.S.A.

Last edited by albert on Aug 19, 2018 0:38, edited 1 time in total.
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

@ 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: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Post by Richard »

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 ).
Locked