Squares

General FreeBASIC programming questions.
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 17, 2018 18:17

@Richard
@Dodicat

I got it converted to indexing.....

Code: Select all


screen 19

do
   
        dim as long n1 = int(rnd*1e9)
        dim as long n2 = int(rnd*1e9)
       
        if n2 > n1 then swap n1 , n2
       
        dim as string *4  num1 = string( 4 , chr(0) )
        dim as long ptr usp1 = cptr( long ptr , strptr(num1) ) : *usp1 = n1
       
        dim as string *4  num2 = string( 4 , chr(0) )
        dim as long ptr usp2 = cptr( long ptr , strptr(num2) ) : *usp2 = n2
     
        dim as ulongint ans = 0
               
                ans+= num1[3]  * num2[3] * (2^24)
                ans+= num1[3]  * num2[2] * (2^16)
                ans+= num1[3]  * num2[1] * (2^08)
                ans+= num1[3]  * num2[0]
               
                ans * = 256
               
                ans+= num1[2]  * num2[3] * (2^24)
                ans+= num1[2]  * num2[2] * (2^16)
                ans+= num1[2]  * num2[1] * (2^08)
                ans+= num1[2]  * num2[0]
               
                ans * = 256
               
                ans+= num1[1]  * num2[3] * (2^24)
                ans+= num1[1]  * num2[2] * (2^16)
                ans+= num1[1]  * num2[1] * (2^08)
                ans+= num1[1]  * num2[0]
               
                ans * = 256
               
                ans+= num1[0]  * num2[3] * (2^24)
                ans+= num1[0]  * num2[2] * (2^16)
                ans+= num1[0]  * num2[1] * (2^08)
                ans+= num1[0]  * num2[0]
               
        print
        print num1 , num1[3] , num1[2] , num1[1] , num1[0]
        print num2 , num2[3] , num2[2] , num2[1] , num2[0]
        print
        print "n1 = " ; n1
        print "   = " ; (num1[3] * (2^24)) + (num1[2] * (2^16)) + (num1[1] * (2^8)) + ( num1[0] )
        print
        print "n2 = " ; n2
        print "   = " ; (num2[3] * (2^24)) + (num2[2] * (2^16)) + (num2[1] * (2^8)) + ( num2[0] )
        print
        print "real answer =" ; n1*n2 , len( str(n1*n2) )
        print "my answer   = " ; ans   , len( str(ans) )
       
        if n1 * n2 <. ans then sleep
       
        if inkey = " " then sleep
       
loop until inkey = chr(27)

sleep
end

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

Re: Squares

Postby albert » Dec 18, 2018 1:01

@Richard
@Dodicat

is there a short cut for the following???

*outplace = value mod 1e7
value\= 1e7
outplace-= 1

can i do the mod with and , or , xor or some other way ?? I think the MOD is taking quite a time to do..
also can i short cut the \ 1e7 with shr ??
dodicat
Posts: 6491
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Dec 18, 2018 1:19

if you mod something to a power of 2 then you can use and, and of course shr is a power of 2 also.
10000000 is an awkward number regarding powers of 2.
Richard
Posts: 3013
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 18, 2018 1:57

@dodicat, as I showed, base 1e9 will be faster than base 1e7.
Calculated from the number of partial products; 7^2=49, 9^2=81, the expected time taken will be 49/81 = 60.5%
For 1 million digits my old base 1e9 multiplier code runs in 263 sec on my old system, compared to Albert's base 1e7 which runs in 360 sec. So my old 1e9 code is actually faster, the time taken being 263/360 = 73%
Here is my 1e9 code that has held the million digit multiply forum record for several years.

Code: Select all

'=======================================================================
Declare Sub random_digits( Byref txt As String, Byval n As Integer )
Declare Sub pack( Byref s As String, Byref t As String )
Declare Sub unpack( Byref t As String, Byref s As String )
Declare Sub multiply( Byref a As string, Byref b As string, Byref c As string )
Declare Function show( Byref s As String ) As String
Randomize

'=======================================================================
Dim As Integer n = 1000000, m = n           ' size of inputs
Dim As Double startime, stoptime, elapsed   ' timer is in seconds

'------------------------------------------
Dim As String st_a, st_b    ' input strings
Dim As String st_c          ' string to receive the result
Dim As String pk_a, pk_b    ' base billion inputs
Dim As String pk_c          ' base billion output register

'------------------------------------------
' generate the input data
random_digits( st_a, n )
random_digits( st_b, m )

'------------------------------------------
' the timed multiply must include the format conversions
startime = Timer
pack( st_a, pk_a )
pack( st_b, pk_b )
multiply( pk_a, pk_b, pk_c )
unpack( pk_c, st_c )
stoptime = Timer

'------------------------------------------
Print show( st_a )
Print show( st_b )
Print show( st_c )

'------------------------------------------
elapsed = stoptime - startime
Print " Time =";
If elapsed >= 1 Then
    Print Using "####.## second"; elapsed
Else
    elapsed *= 1000
    If elapsed >= 1 Then
        Print Using "####.## millisec"; elapsed
    Else
        elapsed *= 1000
        Print Using "####.## microsec"; elapsed
    End If
End If

'=======================================================================
Print "Done"
Sleep

'=======================================================================
' construct an n digit random integer in a string
Sub random_digits( Byref txt As String, Byval n As Integer )
    txt = String( n, "0" )                      ' make the string
    txt[ 0 ] = Asc( "1" ) + Int( Rnd * 9 )      ' avoid leading zero
    For i As Integer = 1 To Len( txt ) - 1      ' fill the string
        txt[ i ] = Asc( "0" ) + Int( Rnd * 10 ) ' digits 0 to 9
    Next i
End Sub

'=======================================================================
' pack 9 digit blocks of ASCII decimal from s into Ulongs in string t
Sub pack( Byref s As String, Byref t As String )
    Dim As Integer len_s = Len( s )     ' original length
    ' lengthen input string by up to 8 zeros to make full 9 digit blocks
    Dim As Integer n = len_s Mod 9
    If n Then s = String( 9 - n, "0" ) + s
    n = Len( s )
    Dim As Integer nblks = n \ 9        ' number of input blocks in s
    Dim As Integer nbytes = nblks * 4   ' number of output bytes in t
    t = String( nbytes, 0 )             ' set the receiver string size
    Dim As Uinteger Ptr uip = Cast( Uinteger Ptr, Strptr( t ) )
    Dim As Integer k = nblks - 1    ' index most sig block in t
    Dim As Integer i = 0            ' index the most significant digit
    Do
        Dim As Ulong sum = 0
        For j As Integer = 1 To 9   ' 9 digits in each block
            sum = sum * 10 + s[ i ] - Asc( "0" )
            i += 1
        Next j
        uip[ k ] = sum              ' write 32 bits into string t
        k -= 1
    Loop While i < n
End Sub

'=======================================================================
Sub unpack( Byref t As String, Byref s As String )
    Dim As Integer nblks = Len( t ) \ 4 ' packed input string length in blocks
    Dim As Integer nbytes = nblks * 9   ' number of output bytes in t
    s = String( nbytes, "0" )           ' receiver string size
    Dim As Uinteger Ptr uip = Cast( Uinteger Ptr, Strptr( t ) )
    Dim As Integer i = 1
    For k As Integer = nblks - 1 To 0 Step -1       
        Mid( s, i, 9 ) = Right( "00000000" + Str( uip[ k ] ), 9 )
        i += 9
    Next k
End Sub

'=======================================================================
Function show( Byref s As String ) As String
    If Len( s ) < 73 Then
        Return s
    Else
        Return Left( s, 35 ) + "..." + Right( s, 35 )
    End If
End Function

'=======================================================================
Sub multiply( Byref a As string, Byref b As string, Byref c As string )
    ' find the dimensions of the problem
    Dim As Integer asize, bsize, xmax, ymax, x, y, count
    asize = Len( a )    ' number of bytes in a
    bsize = Len( b )    ' number of bytes in b
    c = String( asize + bsize, Chr( 0 ) )   ' initialise output register
    xmax = ( asize Shr 2 ) - 1  ' 0 to highest block in a
    ymax = ( bsize Shr 2 ) - 1  ' Shr 2 is faster than \4
    '------------------------------------------------------------
    ' pointers into all the strings
    Dim As Uinteger Ptr iaz, ibz, ia, ib, ic
    iaz = Cptr( Uinteger Ptr, Strptr( a ) )
    ibz = Cptr( Uinteger Ptr, Strptr( b ) )
    ic =  Cptr( Uinteger Ptr, Strptr( c ) )
    '------------------------------------------------------------
    Dim As Uinteger carry
    Dim As Ulongint total = 0
    Const As Ulongint ten9  = 1000000000
    Const As Ulongint ten18 = 1000000000000000000
    y = 0
    For x = 0 To xmax
        If x < ymax Then count = x + 1 Else count = ymax + 1
        '-------------------------------------
        ia = iaz + x
        ib = ibz + y
        carry = 0
        For i As Integer = 1 To count
            total += Culngint( *ia ) * Culngint( *ib )
            If total >= ten18 Then
                total -= ten18
                carry += 1
            End If
            ia -= 1
            ib += 1
        Next i
        *ic = Cuint( total Mod ten9 )
        ic += 1
        total = ( total \ ten9 ) + ( carry * ten9 )
        '-------------------------------------
    Next x   
    '------------------------------------------------------------
    x = xmax
    For y = 1 To ymax
        If ( ymax - y ) < xmax Then count = ( ymax - y ) + 1 Else count = xmax + 1
        '-------------------------------------
        ia = iaz + x
        ib = ibz + y
        carry = 0
        For i As Integer = 1 To count
            total += Culngint( *ia ) * Culngint( *ib )
            If total >= ten18 Then
                total -= ten18
                carry += 1
            End If
            ia -= 1
            ib += 1
        Next i
        *ic = Cuint( total Mod ten9 )
        ic += 1
        total = ( total \ ten9 ) + ( carry * ten9 )
        '-------------------------------------
    Next y
    '------------------------------------------------------------
    *ic = Cuint( total Mod ten9 )
    ' there may be a leading msb zero block
End Sub   

srvaldez
Posts: 2428
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Dec 18, 2018 2:39

@Richard
I am getting a segmentation violation in subroutine pack, MacOS x64
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 18, 2018 3:13

@Richard

Your mul code doesn't run on my computer , it errors and quits..

Somewhere you got an out-of-bounds error....
srvaldez
Posts: 2428
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Dec 18, 2018 3:21

@Richard and @albert
the problem is Integer, on 64-bit systems an Integer is 64-bit, to make it work change all Integers to Longs
time on MacOS x64, 51 seconds
Richard
Posts: 3013
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 18, 2018 3:43

It was written between 2010 and 2013, before FB X64 was common. I run it on Win7 with 32 bit FB ver 1.04.0.
I compile with options -exx -w pedantic so I always have bounds checking and seg error testing on.
I do not use MacOS x64 so I really cannot help with that problem. My condolences for your handicap.

The target of the FB compiler might make a difference with the 32 and 64 bit integer and pointer sizes.
Can anyone run it on FB X64 ?

If it runs on other FB X64 systems then the problem is most likely a bug in the MacOS x64 library implementation.
If it errors on FB X64 then you should be able to isolate the problem to a line of source code.
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 18, 2018 4:02

@Richard

Code: Select all

Unhandled exception: page fault on write access to 0x0031b278 in 64-bit code (0x0000000000401935).
Register dump:
 rip:0000000000401935 rsp:000000000023fa90 rbp:000000000023fb60 eflags:00010206 (  R- --  I   - -P- )
 rax:0000000000000008 rbx:0000000000000001 rcx:0000000000000000 rdx:000000000031b278
 rsi:0000000000000025 rdi:0000000000038170  r8:0000000000000000  r9:ffffffffffffffff r10:0000000000000002
 r11:0000000000242238 r12:0000000000000001 r13:0000000000000008 r14:0000000000000000 r15:0000000000000000
Stack dump:
0x000000000023fa90:  0000000000000000 0000000000000000
0x000000000023faa0:  0000000000000000 0000000000000000
0x000000000023fab0:  ffffffff00000000 0000000000000000
0x000000000023fac0:  0000000000000000 0000000000000000
0x000000000023fad0:  0000000000000000 0000000000242240
0x000000000023fae0:  000000000023fbd0 0000000000411a58
0x000000000023faf0:  000000000006c820 000000000001b208
0x000000000023fb00:  00000000000f4248 000000000023fc30
0x000000000023fb10:  000000000023fac0 0000000000411a58
0x000000000023fb20:  0000000000411a30 00000000000f4248
0x000000000023fb30:  00000000000f4240 00000000000f4240
0x000000000023fb40:  000000000000000a 00000008000f4240
Backtrace:
=>0 0x0000000000401935 in fbidetemp (+0x1935) (0x000000000023fb60)
0x0000000000401935: movq   %rax,(%rdx)
Modules:
Module   Address               Debug info   Name (33 modules)
PE             400000-          420000   Export          fbidetemp
ELF           7b400000-        7b80d000   Deferred        kernel32<elf>
  \-PE           7b420000-        7b80d000   \               kernel32
ELF           7bc00000-        7bd16000   Deferred        ntdll<elf>
  \-PE           7bc20000-        7bd16000   \               ntdll
ELF           7c000000-        7c004000   Deferred        <wine-loader>
ELF       7fb986480000-    7fb9866a6000   Deferred        imm32<elf>
  \-PE       7fb986490000-    7fb9866a6000   \               imm32
ELF       7fb986760000-    7fb986992000   Deferred        libexpat.so.1
ELF       7fb986998000-    7fb986bdd000   Deferred        libfontconfig.so.1
ELF       7fb986be0000-    7fb986dfd000   Deferred        libz.so.1
ELF       7fb986e00000-    7fb987032000   Deferred        libpng16.so.16
ELF       7fb987038000-    7fb9872ec000   Deferred        libfreetype.so.6
ELF       7fb9872f0000-    7fb98750a000   Deferred        version<elf>
  \-PE       7fb987300000-    7fb98750a000   \               version
ELF       7fb987510000-    7fb98788b000   Deferred        gdi32<elf>
  \-PE       7fb987530000-    7fb98788b000   \               gdi32
ELF       7fb987890000-    7fb987ccc000   Deferred        user32<elf>
  \-PE       7fb9878b0000-    7fb987ccc000   \               user32
ELF       7fb987cd0000-    7fb987f9e000   Deferred        msvcrt<elf>
  \-PE       7fb987cf0000-    7fb987f9e000   \               msvcrt
ELF       7fb9880a0000-    7fb988330000   Deferred        advapi32<elf>
  \-PE       7fb9880b0000-    7fb988330000   \               advapi32
ELF       7fb988330000-    7fb988542000   Deferred        libnss_files.so.2
ELF       7fb988548000-    7fb988762000   Deferred        libnsl.so.1
ELF       7fb988768000-    7fb988974000   Deferred        libnss_nis.so.2
ELF       7fb988978000-    7fb988b82000   Deferred        libnss_compat.so.2
ELF       7fb989658000-    7fb989870000   Deferred        libgcc_s.so.1
ELF       7fb989870000-    7fb989c0e000   Deferred        libm.so.6
ELF       7fb989c10000-    7fb989e14000   Deferred        libdl.so.2
ELF       7fb989e18000-    7fb98a209000   Deferred        libc.so.6
ELF       7fb98a210000-    7fb98a42f000   Deferred        libpthread.so.0
ELF       7fb98a7d8000-    7fb98aa02000   Deferred        ld-linux-x86-64.so.2
Threads:
process  tid      prio (all id:s are in hex)
0000000e services.exe
   00000024    0
   0000001f    0
   00000015    0
   00000012    0
   0000000f    0
00000013 winedevice.exe
   0000001e    0
   00000019    0
   00000018    0
   00000014    0
0000001c plugplay.exe
   00000021    0
   00000020    0
   0000001d    0
00000022 winedevice.exe
   0000002b    0
   00000026    0
   00000025    0
   00000023    0
00000029 explorer.exe
   0000002e    0
   0000002d    0
   0000002c    0
   0000002a    0
00000031 fbide.exe
   00000044    0
   00000033    0
   00000032    0
00000042 (D) Z:\home\albert\Desktop\FBIDETEMP.exe
   00000043    0 <==
System information:
    Wine build: wine-3.0 (Ubuntu 3.0-1ubuntu1)
    Platform: x86_64
    Version: Windows XP
    Host system: Linux
    Host version: 4.15.0-42-generic

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

Re: Squares

Postby albert » Dec 18, 2018 4:05

@Dodicat

I rewrote the mul to long ptr's instead of ulongint ptr's whats the difference on your system??

Code: Select all


Declare function mul_loop_7( num1 as string , num2 as string ) as string

Declare function ASCII_mul( num1 as string , num2 as string ) as string

Declare Function plus(_num1 As String,_num2 As String) As String
Declare Function minus(NUM1 As String,NUM2 As String) As String

screen 19

dim as double time1 , time2 , time3 , time4

dim as ulongint total = 0
dim as ulongint loops = 0

dim as longint size1 = 1000000
dim as longint size2 = 1000000

do
   
    loops+=1
   
    dim as string num1
    for a as longint =  1 to size1 step 1
        num1+=str(int(rnd*10))
    next
    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)
   
    dim as string num2
    for a as longint =  1 to size2 step 1
        num2+=str(int(rnd*10))
    next
    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)
   
    time1 = timer
        dim as string my_answer = ASCII_mul( num1 , num2 )
     time2 = timer
       
    time3 = timer
        dim as string real_answer = mul_loop_7( num1 , num2 )
    time4 = timer
       
        dim as string difference = minus( real_answer , my_answer )
       
        if difference = "0" then total+= 1
       
        print
        print "n1          = " ; num1
        print "n2          = "  ; num2
        print "real answer = " ; real_answer
        print "mul answer  = " ; my_answer
        print
        print "DIFF = " ; difference
        print
        print "time = " ; time2-time1
        print "time = " ; time4-time3
       
        if difference <> "0" then print "!!~~ERROR~~!!" : sleep
       
        print
        print "correct = " ; total ; " out of " ; loops
       
        if inkey = " " then sleep
       
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'Subs and functions below here
'===============================================================================
'===============================================================================
function ASCII_mul( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    do
        str1 = str( len(number1) / 7 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 > 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str( len(number2) / 7 )
        dec1 = instr( 1, str1 , "." )
        if dec1 > 0 then number2 = "0" + number2
    loop until dec1 = 0
   
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number1)*4,chr(0))
    dim as long ptr ulp1 = cptr( long ptr,strptr(n1))
    dim as longint valu1
    dim as longint len_1 = 0
    for a as longint = 0 to len(number1)-1 step 7
        valu1  = (number1[a     ]-48)*1e6
        valu1+= (number1[a+1]-48)*1e5
        valu1+= (number1[a+2]-48)*1e4
        valu1+= (number1[a+3]-48)*1e3
        valu1+= (number1[a+4]-48)*1e2
        valu1+= (number1[a+5]-48)*1e1
        valu1+= (number1[a+6]-48)'*1
        *ulp1 = valu1
        ulp1+=1
        len_1+=4
    next
    number1 = left(n1,len_1)
    n1=""
   
    'convert the numeric strings to use pointers
    'convert number2
    dim as string n2 = string(len(number2)*4,chr(0))
    dim as long ptr ulp2 = cptr( long ptr,strptr(n2))
    dim as longint valu2
    dim as longint len_2 = 0
    for a as longint = 0 to len(number2)-1 step 7
        valu2 =  (number2[a     ]-48)*1e6
        valu2+= (number2[a+1]-48)*1e5
        valu2+= (number2[a+2]-48)*1e4
        valu2+= (number2[a+3]-48)*1e3
        valu2+= (number2[a+4]-48)*1e2
        valu2+= (number2[a+5]-48)*1e1
        valu2+= (number2[a+6]-48)'*1
        *ulp2 = valu2
        ulp2+=1
        len_2+=4
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 4 )
    dim as ulongint stops =  ( len(number1) \ 4 ) + ( len(number2) \ 4 ) - 2
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = -1
    dim as ulongint high1 = ( len(number1)  \ 4 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 4 ) - 1
    dim as long ptr outplace   = cptr( long ptr , strptr(answer)   ) + outblocks - 1
    dim as long ptr num1_ptr
    dim as long ptr num2_ptr
    do
        hold+= 1
        vals+= 1
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( long ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( long ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( long ptr , strptr(number1) ) - 1 then exit do
            if num2_ptr > cptr( long ptr , strptr(number2) ) + high2  then exit do
        loop
        *outplace = value mod 1e7
         value\= 1e7
         outplace-= 1
    loop until hold = stops
   
     *outplace = value mod 1e7
   
   'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( long ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outtext+= right( "0000000" + str(value) , 7 )
       outplace+= 1
    next   
   
   outtext = ltrim( outtext , "0" )
   
   return outtext
   
end function
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        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()
            Endif
            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 minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

    For z As Integer=0 To 19
        Qmod(z)=cubyte(z Mod 10+48)
        bool(z)=cubyte(-(10>z))
    Next z
    lenf=Len(NUM1)
    lens=Len(NUM2)
    #macro compare(numbers)
        If Lens>lenf Then bigger= -1:Goto fin
        If Lens<lenf Then bigger =0:Goto fin
        If NUM2>NUM1 Then
            bigger=-1
        Else
            bigger= 0
        End If
        fin:
    #endmacro

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'===============================================================================
'===============================================================================
function mul_loop_7( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    do
        str1 = str(len(number1)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/7)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0
       
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number1)*8,chr(0))
    dim as ulongint ptr ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint valu1
    dim as longint len_1 = 0
    for a as longint = 0 to len(number1)-1 step 7
        valu1  = (number1[a     ]-48)*1e6
        valu1+= (number1[a+1]-48)*1e5
        valu1+= (number1[a+2]-48)*1e4
        valu1+= (number1[a+3]-48)*1e3
        valu1+= (number1[a+4]-48)*1e2
        valu1+= (number1[a+5]-48)*1e1
        valu1+= (number1[a+6]-48)'*1
        *ulp1 = valu1
        ulp1+=1
        len_1+=8
    next
    number1 = left(n1,len_1)
    n1=""
   
    'convert the numeric strings to use pointers
    'convert number2
    dim as string n2 = string(len(number2)*8,chr(0))
    dim as ulongint ptr ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint valu2
    dim as longint len_2 = 0
    for a as longint = 0 to len(number2)-1 step 7
        valu2 =  (number2[a     ]-48)*1e6
        valu2+= (number2[a+1]-48)*1e5
        valu2+= (number2[a+2]-48)*1e4
        valu2+= (number2[a+3]-48)*1e3
        valu2+= (number2[a+4]-48)*1e2
        valu2+= (number2[a+5]-48)*1e1
        valu2+= (number2[a+6]-48)'*1
        *ulp2 = valu2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 8 )
    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )
    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = 0
    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1
    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1
    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2
    do
        hold+=1
        vals = hold
        locat = 0
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done
            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done
        loop
        Done:
        *outplace = value mod 1e7
         outplace-= 1
         value = value \ 1e7
    loop until hold = stops-2
   
     *outplace = value mod 1e7
       
    'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( ulongint ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outplace+=1
       outtext+= right("0000000" + str(value),7)
    next   
   
   outtext = ltrim( outtext , "0" )
   
   return outtext
   
end function
'===============================================================================
'===============================================================================

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

Re: Squares

Postby Richard » Dec 18, 2018 4:18

@srvaldez.
Let me know what happens if you replace Uinteger with Ulong throughout the pointer declaration and cast code.
Also replace Uinteger in about line 135 with Dim as Ulong carry

Try this...

Code: Select all

'=======================================================================
Declare Sub random_digits( Byref txt As String, Byval n As Integer )
Declare Sub pack( Byref s As String, Byref t As String )
Declare Sub unpack( Byref t As String, Byref s As String )
Declare Sub multiply( Byref a As string, Byref b As string, Byref c As string )
Declare Function show( Byref s As String ) As String
Randomize

'=======================================================================
Dim As Integer n = 1000, m = n              ' size of inputs
Dim As Double startime, stoptime, elapsed   ' timer is in seconds

'------------------------------------------
Dim As String st_a, st_b    ' input strings
Dim As String pk_a, pk_b    ' base billion inputs
Dim As String pk_c          ' base billion output register
Dim As String st_c          ' string to receive the result

'------------------------------------------
' generate the input data
random_digits( st_a, n )
random_digits( st_b, m )

'------------------------------------------
' the timed multiply must include the format conversions
startime = Timer
pack( st_a, pk_a )
pack( st_b, pk_b )
multiply( pk_a, pk_b, pk_c )
unpack( pk_c, st_c )
stoptime = Timer

'------------------------------------------
Print show( st_a )
Print show( st_b )
Print show( st_c )

'------------------------------------------
elapsed = stoptime - startime
Print " Time =";
If elapsed >= 1 Then
    Print Using "####.## second"; elapsed
Else
    elapsed *= 1000
    If elapsed >= 1 Then
        Print Using "####.## millisec"; elapsed
    Else
        elapsed *= 1000
        Print Using "####.## microsec"; elapsed
    End If
End If

'=======================================================================
Print "Done"
Sleep

'=======================================================================
' construct an n digit random integer in a string
Sub random_digits( Byref txt As String, Byval n As Integer )
    txt = String( n, "0" )                      ' make the string
    txt[ 0 ] = Asc( "1" ) + Int( Rnd * 9 )      ' avoid leading zero
    For i As Integer = 1 To Len( txt ) - 1      ' fill the string
        txt[ i ] = Asc( "0" ) + Int( Rnd * 10 ) ' digits 0 to 9
    Next i
End Sub

'=======================================================================
' pack 9 digit blocks of ASCII decimal from s into Ulongs in string t
Sub pack( Byref s As String, Byref t As String )   
    Dim As Integer n = len( s ) Mod 9   ' lengthen input string by up to 8 zeros
    If n Then s = String( 9 - n, "0" ) + s  ' to make full 9 digit blocks
    n = Len( s )
    Dim As Integer nblks = n \ 9        ' number of input blocks in s
    Dim As Integer nbytes = nblks * 4   ' number of output bytes in t
    t = String( nbytes, 0 )             ' set the receiver string size
    Dim As Ulong Ptr uip = Cast( Ulong Ptr, Strptr( t ) )
    Dim As Integer k = nblks - 1    ' index most sig block in t
    Dim As Integer i = 0            ' index the most significant digit
    Do
        Dim As Ulong sum = 0
        For j As Integer = 1 To 9   ' 9 digits in each block
            sum = sum * 10 + s[ i ] - Asc( "0" )
            i += 1
        Next j
        uip[ k ] = sum              ' write 32 bits into string t
        k -= 1
    Loop While i < n
End Sub

'=======================================================================
Sub unpack( Byref t As String, Byref s As String )
    Dim As Integer nblks = Len( t ) \ 4 ' packed input string length in blocks
    Dim As Integer nbytes = nblks * 9   ' number of output bytes in t
    s = String( nbytes, "0" )           ' receiver string size
    Dim As Ulong Ptr uip = Cast( Ulong Ptr, Strptr( t ) )
    Dim As Integer i = 1
    For k As Integer = nblks - 1 To 0 Step -1       
        Mid( s, i, 9 ) = Right( "00000000" + Str( uip[ k ] ), 9 )
        i += 9
    Next k
End Sub

'=======================================================================
Function show( Byref s As String ) As String
    If Len( s ) < 73 Then
        Return s
    Else
        Return Left( s, 35 ) + "..." + Right( s, 35 )
    End If
End Function

'=======================================================================
Sub multiply( Byref a As string, Byref b As string, Byref c As string )
    ' find the dimensions of the problem
    Dim As Integer asize, bsize, xmax, ymax, x, y, count
    asize = Len( a )    ' number of bytes in a
    bsize = Len( b )    ' number of bytes in b
    c = String( asize + bsize, Chr( 0 ) )   ' initialise output register
    ' note that it does not accumulate partial products in the output string
    xmax = ( asize Shr 2 ) - 1  ' 0 to highest block in a
    ymax = ( bsize Shr 2 ) - 1  ' Shr 2 is faster than \4
    '------------------------------------------------------------
    ' pointers into all the strings
    Dim As Ulong Ptr iaz, ibz, ia, ib, ic
    iaz = Cptr( Ulong Ptr, Strptr( a ) )  ' changed from Uinteger
    ibz = Cptr( Ulong Ptr, Strptr( b ) )
    ic =  Cptr( Ulong Ptr, Strptr( c ) )
    '------------------------------------------------------------
    Dim As Ulongint carry       ' changed from Uinteger
    Dim As Ulongint total = 0
    Const As Ulongint ten9  = 1000000000
    Const As Ulongint ten18 = 1000000000000000000
    y = 0
    For x = 0 To xmax
        If x < ymax Then count = x + 1 Else count = ymax + 1
        '-------------------------------------
        ia = iaz + x
        ib = ibz + y
        carry = 0
        For i As Integer = 1 To count
            total += Culngint( *ia ) * Culngint( *ib )
            If total >= ten18 Then
                total -= ten18
                carry += 1
            End If
            ia -= 1
            ib += 1
        Next i
        *ic = Culng( total Mod ten9 )   ' was Cuint
        ic += 1
        total = ( total \ ten9 ) + ( carry * ten9 )
        '-------------------------------------
    Next x   
    '------------------------------------------------------------
    x = xmax
    For y = 1 To ymax
        If ( ymax - y ) < xmax Then count = ( ymax - y ) + 1 Else count = xmax + 1
        '-------------------------------------
        ia = iaz + x
        ib = ibz + y
        carry = 0
        For i As Integer = 1 To count
            total += Culngint( *ia ) * Culngint( *ib )
            If total >= ten18 Then
                total -= ten18
                carry += 1
            End If
            ia -= 1
            ib += 1
        Next i
        *ic = Culng( total Mod ten9 )   ' was Cuint
        ic += 1
        total = ( total \ ten9 ) + ( carry * ten9 )
        '-------------------------------------
    Next y
    '------------------------------------------------------------
    *ic = Culng( total Mod ten9 )
    ' there may be a leading msb zero block
End Sub   

'=======================================================================
srvaldez
Posts: 2428
Joined: Sep 25, 2005 21:54

Re: Squares

Postby srvaldez » Dec 18, 2018 10:24

@Richard, I will ignore your snide remarks.
your last code compiles and runs ok
as for compiling with option -exx, it's helpful when debugging but the execution speed can be half, that is, twice as slow than if compiled without -exx
for benchmarks, I suggest compiling without option -exx
dodicat
Posts: 6491
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Dec 18, 2018 11:18

Richard I ran your code with n=1000000
Result
00000000244086490472630048814485756...81743673993299420201478719755454379
00000000139174002698508002279424850...69786171591319863635589183890422838
00000000000000000339704938837071622...84695503493840498983640711128707602
Time = 29.29 second
Done

fb 1.05.0
64 bit -gen gcc -Wc -O3
dodicat
Posts: 6491
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Dec 18, 2018 13:43

Albert
I get about 5 seconds longer on average with the ascii method.
64 bit -Wc -O3
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 18, 2018 17:44

@Richard

I get 286.?? seconds for n = 1,000,000 .... Just plain FB with no compiler options

For my multipliers i get
260.?? for ASCII_mul()
275.?? for mul_loop_7()

2GHz AMD quad core...With 64 bit Ubuntu 18.04

For Geany IDE -gen GCC -O3 I get...

ASCII_mul = 113.??
Mul_loop_7 = 118.??
Richard = 106.??

So Richard beats me by a few seconds...( 7 seconds...)

Return to “General”

Who is online

Users browsing this forum: No registered users and 8 guests