Squares

[albert]

@Richard
@Dodicat

I got it figured out....

Code: Select all


screen 19

do
   
    dim as string n1 =  right( "00000000" + str( bin( int(rnd*256)) ) , 8)
    dim as string n2 =  right( "00000000" + str( bin( int(rnd*256)) ) , 8)
 
    dim as ulongint v1 = val("&B" + n1)
    dim as ulongint v2 = val("&B" + n2)
   
    dim as ulongint size = 16
    dim as string mul_norm = right( string(size,"0") + bin(v1*v2)                  , size)
    dim as string mul_me    = right( string(size,"0") + str(val(n1) * val(n2)) , size)
   
    dim as string val1
    dim as string answer=""
    for x as longint = len(mul_me) to 1 step -1
        val1 = bin( val(mid(mul_me,x,1)) + val("&B"+val1) )
        answer = right(val1,1) + answer
        val1 = left(val1,len(val1)-1)
    next
    answer = right( answer , size)
   
    print
    print "n1  = " ; n1 , val("&B" + n1)
    print "n2  = " ; n2 , val("&B" + n2)
    print
    print "mul = " ; mul_norm , val("&B" + mul_norm)
    'print "me  = " ; mul_me
    print "me  = "; answer , val("&B" + answer)
   
    sleep
   
loop until inkey = chr(27)

end



[albert]

@Richard
@Dodicat

I got my Multiplier_1 working , returning binary answers.

Code: Select all

declare function multiplier_1(byref num1 as string, byref num2 as string) as string

screen 19

do
   
    dim as longint size = 32
   
    dim as string n1 = ""
    for x as longint = 1 to size
        n1+= str( int( rnd*2 ) )
    next
   
    dim as string n2 = ""
    for x as longint = 1 to size
        n2+= str( int( rnd*2 ) )
    next
   
    dim as string mul_bin = bin( valulng("&B" + n1) * valulng("&B"+n2) )
   
    dim as string mul_albert = multiplier_1( n1 , n2 )
   
    dim as longint diff = valulng("&B"+mul_bin) - valulng("&B"  + mul_albert)
   
    if inkey = chr(27) then end
   
    print
    print  "n1  = "  ; n1
    print  "n2  = "  ; n2
    print  "ans = " ; mul_bin
    print  "me  = " ; mul_albert
    print
    print  "diff  = " ; diff
   
    if diff <> 0 then print "ERROR" : sleep
   
    sleep
   
    if inkey = chr(27) then end
       
loop

END

'==================================================
'==================================================
'begin functions
'==================================================
'==================================================
function multiplier_1(byref num1 as string, byref num2 as string) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    dim as string answer = ""
    dim as longint start1 , stop1 , start2 , stop2
    dim as longint inc1 , inc2
    dim as ulongint total
    dim as string result = ""
   
    dim as longint place = len(number1) + len(number2)
   
    start1 = len(number1)-1
    stop1 =  len(number1)-1
    start2 = len(number2)-1
    stop2 =  len(number2)-1
    result=""
    do
        total = 0
        inc1 = start1
        inc2 = start2
        do
            total += (number2[inc2]-48) * (number1[inc1]-48)
            inc2 += 1
            inc1 -= 1
        loop until inc2 = stop2+1
       
        total = valulng("&B"  + bin(total)) + valulng("&B" + result)
        result = bin(total)
        answer = right(result,1) + answer
        result = left(result,len(result)-1)
       
        stop1 -= 1
        if stop1 =-1 then
            stop1 += 1
            stop2 -=1
            if stop2 =-1 then stop2 += 1
        end if
        start2 -= 1
        if start2 =-1 then
            start2 += 1
            start1 -= 1
            if start1 =-1 then start1 += 1
        end if
   
        place-=1
    loop until place = 1
   
    answer = result + answer
   
    answer = ltrim(answer,"0")
   
    return answer

end function



[Richard]

@Albert. I have no idea what you think you are doing.
But it seems you need to propagate carry by sweeping from right to left.

Code: Select all

0001101110010000 = ans.
0001020302010000 = me.
0001020302010000   2 dec is 10 bin
0001020310010000   3 dec is 11 bin
0001021110010000   2 dec is 10 bin
0001101110010000   carry is now cleared.
0001101110010000 = ans.

0110101011111100 = ans.
0102012131111100 = me.
0102012211111100   3 dec is 11 bin
0102013011111100   2 dec is 10 bin
0102021011111100   3 dec is 11 bin
0102101011111100   2 dec is 10 bin
0110101011111100   carry is now cleared.
0110101011111100 = ans.


[albert]

@Richard
@Dodicat

I got it working...
Here it is , with Richards base conversions...

I still need to convert multiplier_7 or mul_loop_7 to do binary..

Code: Select all



Declare function              mul_1_bin(byref num1 as string, byref num2 as string) as string
DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as string

Declare Function base_2_to_10( Byref b As String ) As String    ' b may be lengthened
Declare Function base_10_to_2( Byref d As String ) As String  ' d may be lengthened

DECLARE Function minus(NUM1 As String,NUM2 As String) As String
Declare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As String

screen 19

dim as double time1 , time2 , time3 , time4

do
   
    dim as longint size = 45
   
    dim as string n1 = ""
    for x as longint = 1 to size
        n1+= str( int( rnd*2 ) )
    next
   
    dim as string n2 = ""
    for x as longint = 1 to size
        n2+= str( int( rnd*2 ) )
    next
   
    time1=timer
        dim as string mul1 = base_2_to_10( n1)
        dim as string mul2 = base_2_to_10( n2)
        dim as string mul_bin = multiplier_7( mul1 , mul2 )
        mul_bin = left(mul_bin,len(mul_bin)-1)
        mul_bin = base_10_to_2(mul_bin)
    time2 = timer
   
    time3=timer
        dim as string mul_albert = mul_1_bin( n1 , n2 )
    time4=timer
   
    dim as string diff = minus( mul_bin , mul_albert)
   
    if inkey = chr(27) then end
   
    print
    print  "n1  = "  ; n1
    print  "n2  = "  ; n2
    print  "ans = " ; mul_bin
    print  "me  = " ; mul_albert
    print
    print  "diff  = " ; diff
    print
    print "time mul    = " ; time2-time1
    print "time albert = "; time4-time3
   
    if diff <> "0" then print "ERROR" : sleep
   
    sleep
   
    if inkey = chr(27) then end
       
loop

END

'==================================================
'==================================================
'begin functions
'==================================================
'==================================================
'===============================================================================
'===============================================================================
'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
'=======================================================================
' 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
    '================================================
    'begin alberts additons
    '================================================
    dim as string number = d
    dim as string str1
    dim as longint dec1
    do
        str1 = str( len(number) / 9 )
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number = "0" + number
    loop until dec1 = 0
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number)-1 step 9
        val1  = (number[a+0]-48)*100000000ull
        val1+= (number[a+1]-48)*10000000ull
        val1+= (number[a+2]-48)*1000000ull
        val1+= (number[a+3]-48)*100000ull
        val1+= (number[a+4]-48)*10000ull
        val1+= (number[a+5]-48)*1000ull
        val1+= (number[a+6]-48)*100ull
        val1+= (number[a+7]-48)*10ull
        val1+= (number[a+8]-48)*1
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number = left(n1,len_1)
    n1=""
    '================================================
    'end alberts additons
    '================================================
    Dim As ulongint acc( 0 To len(number) \ 8 )  ' the accumulator array
    Dim As Ulongint product, carry  ' 64 bit Unsigned Integer
    Dim As Integer k = 1      ' loop counters
    dim as ulongint ptr ulp2
    ulp1 = cptr(ulongint ptr,strptr(number))
    For j as longint = 1 To Len(number)  Step 8     ' the blocks to convert
        'carry = Valulng( Mid( d, j, 9 ) ) ' get value of 9 digit block
        carry = *ulp1
        ulp1+=1
        ulp2 = cptr( ulongint ptr , varptr( acc(0) ) )
        For i as longint = 0 To k ' Multiply Accumulate
            product = culngint( *ulp2  * 1000000000ull ) + carry
            *ulp2 = product and 4294967295 ' sum is low order 32 bits
            carry = product shr 32 ' carry is the high order 32 bits
            ulp2+=1
        Next i
        If carry Then   ' extend accumulator by one element when needed
            k+=1
            *ulp2 = 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 as longint = k to lbound(acc) Step -1
        txt+= Bin( acc(i) ,32 )
    Next i
    Return ltrim( txt , "0")
End Function
'=======================================================================
'=======================================================================
function mul_1_bin( num1 as string , num2 as string) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    dim as string answer = ""
    dim as longint start1 , stop1 , start2 , stop2
    dim as longint inc1 , inc2
    dim as ulongint total
    dim as string result = ""
   
    dim as longint place = len(number1) + len(number2)
   
    start1 = len(number1)-1
    stop1 =  len(number1)-1
    start2 = len(number2)-1
    stop2 =  len(number2)-1
    result=""
    do
        total = 0
        inc1 = start1
        inc2 = start2
        do
            total += (number2[inc2]-48) * (number1[inc1]-48)
            inc2 += 1
            inc1 -= 1
        loop until inc2 = stop2+1
       
        total = valulng("&B"  + bin(total)) + valulng("&B" + result)
        result = bin(total)
        answer = right(result,1) + answer
        result = left(result,len(result)-1)
       
        stop1 -= 1
        if stop1 =-1 then
            stop1 += 1
            stop2 -=1
            if stop2 =-1 then stop2 += 1
        end if
        start2 -= 1
        if start2 =-1 then
            start2 += 1
            start1 -= 1
            if start1 =-1 then start1 += 1
        end if
   
        place-=1
    loop until place = 1
   
    answer = result + answer
   
    answer = ltrim(answer,"0")
   
    return answer

end function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    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
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        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
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

end function
'===============================================================================
'===============================================================================



[albert]

@Richard
@Dodicat

I wrote the mul to be ( bit variable ) , I still need to speed it up.

Code: Select all



Declare Function mul_var_bin( num1 as string , num2 as string , bits as longint ) as string

Declare Function multiplier_7( num1 as string, num2 as string) as string

Declare Function base_2_to_10( Byref b As String ) As String    ' b may be lengthened
Declare Function base_10_to_2( Byref d As String ) As String  ' d may be lengthened

Declare Function minus(NUM1 As String,NUM2 As String) As String
Declare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As String

screen 19

dim as double time1 , time2 , time3 , time4

do
   
    dim as longint size = 45
   
    dim as string n1 = ""
    for x as longint = 1 to size
        n1+= str( int( rnd*2 ) )
    next
   
    dim as string n2 = ""
    for x as longint = 1 to size
        n2+= str( int( rnd*2 ) )
    next
   
    time1=timer
        dim as string mul1 = base_2_to_10( n1)
        dim as string mul2 = base_2_to_10( n2)
        dim as string mul_bin = multiplier_7( mul1 , mul2 )
        mul_bin = left(mul_bin,len(mul_bin)-1)
        mul_bin = base_10_to_2(mul_bin)
    time2 = timer
   
    time3=timer
        dim as string mul_albert = mul_var_bin( n1 , n2 , 26 )
    time4=timer
   
    dim as string diff = minus( mul_bin , mul_albert)
   
    if inkey = chr(27) then end
   
    print
    print  "n1  = "  ; n1
    print  "n2  = "  ; n2
    print  "ans = " ; mul_bin
    print  "me  = " ; mul_albert
    print
    print  "diff  = " ; diff
    print
    print "time mul    = " ; time2-time1
    print "time albert = "; time4-time3
   
    if diff <> "0" then print "ERROR" : sleep
   
    sleep
   
    if inkey = chr(27) then end
       
loop

END

'==================================================
'==================================================
'begin functions
'==================================================
'==================================================
'===============================================================================
'===============================================================================
'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
'=======================================================================
' 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
    '================================================
    'begin alberts additons
    '================================================
    dim as string number = d
    dim as string str1
    dim as longint dec1
    do
        str1 = str( len(number) / 9 )
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number = "0" + number
    loop until dec1 = 0
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number)-1 step 9
        val1  = (number[a+0]-48)*100000000ull
        val1+= (number[a+1]-48)*10000000ull
        val1+= (number[a+2]-48)*1000000ull
        val1+= (number[a+3]-48)*100000ull
        val1+= (number[a+4]-48)*10000ull
        val1+= (number[a+5]-48)*1000ull
        val1+= (number[a+6]-48)*100ull
        val1+= (number[a+7]-48)*10ull
        val1+= (number[a+8]-48)*1
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number = left(n1,len_1)
    n1=""
    '================================================
    'end alberts additons
    '================================================
    Dim As ulongint acc( 0 To len(number) \ 8 )  ' the accumulator array
    Dim As Ulongint product, carry  ' 64 bit Unsigned Integer
    Dim As Integer k = 1      ' loop counters
    dim as ulongint ptr ulp2
    ulp1 = cptr(ulongint ptr,strptr(number))
    For j as longint = 1 To Len(number)  Step 8     ' the blocks to convert
        'carry = Valulng( Mid( d, j, 9 ) ) ' get value of 9 digit block
        carry = *ulp1
        ulp1+=1
        ulp2 = cptr( ulongint ptr , varptr( acc(0) ) )
        For i as longint = 0 To k ' Multiply Accumulate
            product = culngint( *ulp2  * 1000000000ull ) + carry
            *ulp2 = product and 4294967295 ' sum is low order 32 bits
            carry = product shr 32 ' carry is the high order 32 bits
            ulp2+=1
        Next i
        If carry Then   ' extend accumulator by one element when needed
            k+=1
            *ulp2 = 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 as longint = k to lbound(acc) Step -1
        txt+= Bin( acc(i) ,32 )
    Next i
    Return ltrim( txt , "0")
End Function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    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
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        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
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

end function
'=======================================================================
'=======================================================================
function mul_var_bin( num1 as string , num2 as string , bits as longint ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    dim as longint size = bits
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    do
        str1 = str(len(number1)/size)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/size)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0

    dim as string answer = ""
   
    dim as longint start1 = len(number1)-size+1
    dim as longint stop1 = len(number1)-size+1
    dim as longint start2 = len(number2)-size+1
    dim as longint stop2 = len(number2)-size+1
   
    dim as longint inc1 , inc2
   
    dim as ulongint total
    dim as string result = ""
   
    dim as longint place = len(number1) + len(number2)
    do
        total = 0
        inc1 = start1
        inc2 = start2
        do
            total += val( "&B" + mid(number1,inc1,size) )  * val( "&B" + mid(number2,inc2,size) )
            inc2 += size
            inc1 -= size
        loop until inc1 < size
       
        total = val("&B"+bin(total)) + val("&B"+result)
        result = bin(total)
        answer = right(string(size,"0")+ result,size) + answer
        result = left(result,len(result)-size)
       
        stop1 -= size
        if stop1 = 0 then
            stop1+= 1
            stop2-= size
            if stop2 = 0 then stop2 += 1
        end if
        start2 -= size
        if start2 = 0 then
            start2 += 1
            start1 -= size
            if start1 = 0 then start1 +=1
        end if
   
        place-=size
   
    loop until place < 1
   
    answer = result + answer
   
    answer = ltrim(answer,"0")
   
    return answer

end function



[albert]

@Richard
@Dodicat

I'm having trouble converting an added binary number to binary.... When the added value goes above 9

Code: Select all


  12123354566880767675543322100  'having trouble with 807
101110111100110100111001010100

n1   = 0011011110101111
n2   = 1101011111101100
ans = 101110111101110100111001010100
me  = 101110111100110100111001010100

diff  = 1000000000000000000

time mul    =  0.0001051998697221279
time albert =  0.002562100067734718
ERROR

'==========================================================================
  dim as string outtext = 12123354566880767675543322100  'having trouble with 807
    dim as string ans=""
    dim as string r =""
    for x as longint = len(outtext)-1 to 0 step -1
        r = bin( (outtext[x]-48) + val( "&B" + r ) )
        ans = right( "0" + r , 1 ) + ans
        r =  left( r , len(r) - 1 )
    next
    ans = r + ans

    return ans
'==========================================================================
   


[Richard]

@Albert.
I am not surprised since you are using decimal addition to do binary addition and delaying carry for too long.

[albert]

@Richard

https://en.wikipedia.org/wiki/Multiplication_algorithm

Look under pesant multiply (examples)

They show a binary addition, but they don't tell you how to turn the example result , into binary..

Decimal: Binary:
5830 23958233 1011011000110 1011011011001001011011001
2915 47916466 101101100011 10110110110010010110110010
1457 95832932 10110110001 101101101100100101101100100
728 191665864 1011011000 1011011011001001011011001000
364 383331728 101101100 10110110110010010110110010000
182 766663456 10110110 101101101100100101101100100000
91 1533326912 1011011 1011011011001001011011001000000
45 3066653824 101101 10110110110010010110110010000000
22 6133307648 10110 101101101100100101101100100000000
11 12266615296 1011 1011011011001001011011001000000000
5 24533230592 101 10110110110010010110110010000000000
2 49066461184 10 101101101100100101101100100000000000
1 98132922368 1 1011011011001001011011001000000000000
——————— 1022143253354344244353353243222210110 (before carry) ' how to turn to binary???
139676498390 10000010000101010111100011100111010110

[Richard]

You are ignoring the carry when you add decimal strings that are really binary.
You must keep a separate track of carry when you add in binary.
Here is one way to clear carry in your previous problem.

Code: Select all

Dim As String a = "101110111100110100111001010100"
Dim As String s = "012123354566880767675543322100"

Dim As Integer c = 0, i = Len( s )
Do While i      ' sweep carry along the string
    i -= 1
    c += s[ i ] - Asc("0")
    s[ i ] = Iif( c And 1, Asc("1"), Asc("0") )
    c Shr= 1
Loop

Do While c      ' extend string if carry overflows
    s = Iif( c And 1, "1", "0" ) + s
    c Shr= 1
Loop

Print a ' 101110111100110100111001010100
Print s ' 101110111100110100111001010100


[albert]

How do you access the real-time-clock of the computer from FB??

hour / minute

I'm writing a "Rhyme with the time" program...

I think i remember that QBasic had a time keyword? Not sure?

[Richard]

See; "Date and Time Functions", Date Serial and Time Serial. Now() gets the date and time in a Double.

Code: Select all

#include "vbcompat.bi"
Dim a As Double = Now()
Print Format(a, "yyyy/mm/dd hh:mm:ss")
Print Hour( a ), Minute( a ), Second( a )


[dodicat]

crt.bi also has clock things.
This should be in circles.

Code: Select all

#include "vbcompat.bi"
#include "crt.bi"
Sub circles(numballs As Long,OutsideRadius As Long,cx As Long,cy As Long,c As Ulong,n As Long,md As Long)
    Dim As Double r,bigr,num,x,y,k=OutsideRadius, pi=4*Atn(1)
    Dim As Ulong clr
    #define rad *pi/180 
    Dim As Long counter
    num= (45*(2*numballs-4)/numballs) rad
    num=Cos(num)
    r=num/(1+num)
    bigr=((1-r))*k  'radius to ring ball centres
    r=(r)*k -1       'radius of ring balls
    For z As Double=0 -pi/2 To 2*pi -pi/2 Step 2*pi/numballs
        counter+=1
        x=cx+bigr*Cos(z)
        y=cy+bigr*Sin(z)
        If counter>numballs Or counter>n+1  Then Exit For
        If (counter-1) Mod md=0 Then clr=c+Rgb(50,50,200) Else clr=c
        Circle(x,y),r,clr,,,,f
        Var g=Right("0"+Str(counter-1),2)
        Var l=Len(Str((counter-1)))
        If counter>n Then
            Var h=Iif(Hour(Now)=12,12,counter-1)
            If md<>3 Then Draw String(x-8,y-6),g,Rgb(0,0,0)Else Draw String(x-4*Len(Str(h))*l,y-6),Str(h),Rgb(0,0,0)
        End If
    Next z
End Sub

Function F(t As Long,Byref z As Long=0) As Long
    t=t Mod 12
    If t=12 Then t=1
    z=t
    If  z < 12 Then Return 12 Else Return 1   
End Function

Screen 19,32,,64
Color ,Rgb(0,155,255)
Cls
Dim As Long z,lst,s
Do
    '======  using crt ========
    Dim As time_t  rawtime
    Dim As tm Ptr timeinfo
    time_(@rawtime)
    timeinfo = localtime( @rawtime )
    Var dt=Rtrim(*asctime(timeinfo),Chr(10)) 'Format( now, "dd-mmmm-yyyy" )
    '================= 
    s=Second(Now)
    Screenlock
    If lst<>s Then
        Circle(400,300),300,Rgb(180,200,225),,,,f
        Draw String(400-4*Len(dt),294),dt,Rgb(0,0,0)
        circles(60,290,400,300,Rgb(255,150,0),Second(Now),5)
        circles(60,250,400,300,Rgb(250,250,250),Minute(Now),5)
        circles(F(Hour(Now),z),190,400,300,Rgb(0,150,200),z,3)
    End If
    Screenunlock
    lst=s
    Sleep 100
Loop Until Len(Inkey)
Sleep


 

[Tourist Trap]

crt.bi also has clock things.
This should be in circles.

Pretty nice :)

[albert]

Thanks Richard & Dodicat!

[albert]

@Richard

Your to_bin() code is erroring... try setting size to different longer values , above size = 14 , it errors when an added bin place goes higher than 9..

Code: Select all


Declare Function mul_ascii( byref num1 as string, byref num2 as string) as string

Declare Function mul_var_bin( num1 as string , num2 as string , bits as longint ) as string

Declare Function multiplier_7( num1 as string, num2 as string) as string

Declare Function base_2_to_10( Byref b As String ) As String    ' b may be lengthened
Declare Function base_10_to_2( Byref d As String ) As String  ' d may be lengthened

Declare Function minus(NUM1 As String,NUM2 As String) As String
Declare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As String

screen 19

dim as double time1 , time2 , time3 , time4

do
   
    dim as longint size = 21
   
    dim as string n1 = ""
    do
        n1=""
        for x as longint = 1 to size
            n1+= str( int( rnd*2 ) )
        next
        n1 = ltrim(n1,"0")
    loop until n1 > "0"
   
    dim as string n2 = ""
    do
        n2 = ""
        for x as longint = 1 to size
            n2+= str( int( rnd*2 ) )
        next
        n2 = ltrim(n2,"0")
    loop until n2 > "0"
   
    time1=timer
        dim as string v1 = n1
        dim as string v2 = n2
        dim as string mul1 = base_2_to_10( v1 )
        dim as string mul2 = base_2_to_10( v2 )
        dim as string mul_bin = multiplier_7( mul1 , mul2 )
        mul_bin = left( mul_bin , len( mul_bin ) - 1 )
        mul_bin = base_10_to_2(mul_bin)
    time2 = timer
   
    time3=timer
        dim as string mul_albert = mul_ascii( n1 , n2 )
        dim as string s = mul_albert
        Dim As Integer c = 0, i = Len( s )
        'Richards to_bin()
        Do While i      ' sweep carry along the string
            i -= 1
            c += s[ i ] - Asc("0")
            s[ i ] = Iif( c And 1, Asc("1"), Asc("0") )
            c Shr= 1
        Loop
        Do While c      ' extend string if carry overflows
            s = Iif( c And 1, "1", "0" ) + s
            c Shr= 1
        Loop
        mul_albert = s
    time4=timer
   
    dim as string diff = minus( mul_bin , mul_albert)
   
    if inkey = chr(27) then end
   
    print
    print  "n1  = "  ; n1
    print  "n2  = "  ; n2
    print  "ans = " ; mul_bin
    print  "me  = " ; mul_albert
    print
    print  "diff  = " ; diff
    print
    print "time mul    = " ; time2-time1
    print "time albert = "; time4-time3
   
    if diff <> "0" then print "ERROR" : sleep
   
    if inkey = " " then sleep
   
    if inkey = chr(27) then end
       
loop

END

'==================================================
'==================================================
'begin functions
'==================================================
'==================================================
'===============================================================================
'===============================================================================
'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
'=======================================================================
' 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
    '================================================
    'begin alberts additons
    '================================================
    dim as string number = d
    dim as string str1
    dim as longint dec1
    do
        str1 = str( len(number) / 9 )
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number = "0" + number
    loop until dec1 = 0
    'convert the numeric strings to use pointers
    'convert number1
    dim as string n1 = string(len(number)*8,chr(0))
    dim as ulongint ptr ulp1
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number)-1 step 9
        val1  = (number[a+0]-48)*100000000ull
        val1+= (number[a+1]-48)*10000000ull
        val1+= (number[a+2]-48)*1000000ull
        val1+= (number[a+3]-48)*100000ull
        val1+= (number[a+4]-48)*10000ull
        val1+= (number[a+5]-48)*1000ull
        val1+= (number[a+6]-48)*100ull
        val1+= (number[a+7]-48)*10ull
        val1+= (number[a+8]-48)*1
        *ulp1 = val1
        ulp1+=1
        len_1+=8
    next
    number = left(n1,len_1)
    n1=""
    '================================================
    'end alberts additons
    '================================================
    Dim As ulongint acc( 0 To len(number) \ 8 )  ' the accumulator array
    Dim As Ulongint product, carry  ' 64 bit Unsigned Integer
    Dim As Integer k = 1      ' loop counters
    dim as ulongint ptr ulp2
    ulp1 = cptr(ulongint ptr,strptr(number))
    For j as longint = 1 To Len(number)  Step 8     ' the blocks to convert
        'carry = Valulng( Mid( d, j, 9 ) ) ' get value of 9 digit block
        carry = *ulp1
        ulp1+=1
        ulp2 = cptr( ulongint ptr , varptr( acc(0) ) )
        For i as longint = 0 To k ' Multiply Accumulate
            product = culngint( *ulp2  * 1000000000ull ) + carry
            *ulp2 = product and 4294967295 ' sum is low order 32 bits
            carry = product shr 32 ' carry is the high order 32 bits
            ulp2+=1
        Next i
        If carry Then   ' extend accumulator by one element when needed
            k+=1
            *ulp2 = 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 as longint = k to lbound(acc) Step -1
        txt+= Bin( acc(i) ,32 )
    Next i
    Return ltrim( txt , "0")
End Function
'===============================================================================
'===============================================================================
function multiplier_7(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as string int1,frac1,int2,frac2
    dim as ulongint dec,dec1,len1,len2
    dim as string str1
    dim as string sign1,sign2,outsign
   
    number1 = num1
    number2 = num2
   
    sign1 = left(number1,1)
    if sign1 = "+" or sign1 = "-" then number1 = mid(number1,2) else sign1 = ""
   
    sign2 = left(number2,1)
    if sign2 = "+" or sign2 = "-" then number2 = mid(number2,2) else sign2 = ""
   
    if (sign1 = sign2) then outsign = ""
    if (sign1 <> sign2) then outsign = "-"
   
    dec = instr(1,number1,".")
    if dec > 0 then
        int1 = left(number1,dec-1)
        frac1 = mid(number1,dec+1)
    else
        int1 = number1
        frac1 = ""
    end if
   
    dec = instr(1,number2,".")
    if dec > 0 then
        int2 = left(number2,dec-1)
        frac2 = mid(number2,dec+1)
    else
        int2 = number2
        frac2 = ""
    end if

    dec = len(frac1)+len(frac2)
    number1 = int1+frac1
    number2 = int2+frac2

    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    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
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        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
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry else *outplace = 0
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   

    'put in the decimal point
    outtext = left(outtext,len(outtext)-dec) + "." +  mid(outtext,(len(outtext)-dec)+1)
    'trim leading zeros
    outtext = trim(outtext,"0") 'if multiplying by 1, we have a zero in front.
    outtext = outsign + outtext

    return outtext

end function
'=======================================================================
'=======================================================================
function mul_var_bin( num1 as string , num2 as string , bits as longint ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    dim as longint size = bits
   
    'make numbers equal multiple of 7 bytes
    dim as string str1
    dim as longint dec1
    do
        str1 = str(len(number1)/size)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number1 = "0" + number1
    loop until dec1 = 0
    do
        str1 = str(len(number2)/size)
        dec1 = instr(1,str1,".")
        if dec1 <> 0 then number2 = "0" + number2
    loop until dec1 = 0

    dim as string answer = ""
   
    dim as longint start1 = len(number1)-size+1
    dim as longint stop1 = len(number1)-size+1
    dim as longint start2 = len(number2)-size+1
    dim as longint stop2 = len(number2)-size+1
   
    dim as longint inc1 , inc2
   
    dim as ulongint total
    dim as string result = ""
   
    dim as longint place = len(number1) + len(number2)
    do
        total = 0
        inc1 = start1
        inc2 = start2
        do
            total += val( "&B" + mid(number1,inc1,size) )  * val( "&B" + mid(number2,inc2,size) )
            inc2 += size
            inc1 -= size
        loop until inc1 < size
       
        total = val("&B"+bin(total)) + val("&B"+result)
        result = bin(total)
        answer = right(string(size,"0")+ result,size) + answer
        result = left(result,len(result)-size)
       
        stop1 -= size
        if stop1 = 0 then
            stop1+= 1
            stop2-= size
            if stop2 = 0 then stop2 += 1
        end if
        start2 -= size
        if start2 = 0 then
            start2 += 1
            start1 -= size
            if start1 = 0 then start1 +=1
        end if
   
        place-=size
   
    loop until place < 1
   
    answer = result + answer
   
    answer = ltrim(answer,"0")
   
    return answer

end function
'===============================================================================
'===============================================================================
function mul_ascii( byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
    dim as string answer,outtext
   
    dim as ulongint dec1
    dim as string str1
   
    number1 = num1
    number2 = num2
   
    'swap numbers so that bigger number is number1 and smaller is number2
    if len(number2) > len(number1) then swap number1,number2
    if len(number1) = len(number2) then
        if val(left(number2,1)) > val(left(number1,1)) then swap number1,number2
    end if

    'make numbers equal multiple of 7 bytes
    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
    ulp1 = cptr(ulongint ptr,strptr(n1))
    dim as longint val1
    dim as longint len_1 = 0
    dim as uinteger a
    for a = 0 to len(number1)-1 step 7
        val1 = (number1[a+0]-48)*1000000ull
        val1+= (number1[a+1]-48)*100000ull
        val1+= (number1[a+2]-48)*10000ull
        val1+= (number1[a+3]-48)*1000ull
        val1+= (number1[a+4]-48)*100ull
        val1+= (number1[a+5]-48)*10ull
        val1+= (number1[a+6]-48)*1ull
        *ulp1 = val1
        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
    ulp2 = cptr(ulongint ptr,strptr(n2))
    dim as longint val2
    dim as longint len_2 = 0
    for a = 0 to len(number2)-1 step 7
        val2 = (number2[a+0]-48)*1000000ull
        val2+= (number2[a+1]-48)*100000ull
        val2+= (number2[a+2]-48)*10000ull
        val2+= (number2[a+3]-48)*1000ull
        val2+= (number2[a+4]-48)*100ull
        val2+= (number2[a+5]-48)*10ull
        val2+= (number2[a+6]-48)*1ull
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""
   
    'create accumulator
    answer = string( len(number1) + len(number2) + 8 , chr(0) )
    'dimension vars for the mul
    dim as longint ptr start1,stop1,start2,stop2 'use longint because the pointers go negative
    dim as longint ptr chk_1 , chk_2
    dim as longint ptr inc1,inc2
    dim as longint ptr outplace
    dim as ulongint carry
    dim as ulongint total
    dim as ulongint blocknumber1 = len(number1)/8
    dim as ulongint blocknumber2 = len(number2)/8
    dim as ulongint outblocks = len(answer)/8
   
    'set initial accumulator place
    outplace = cptr(longint ptr , strptr(answer)) + (outblocks - 1)
    'set initial pointers into number1
    start1 = cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    stop1 =  cptr(longint ptr , strptr(number1))+(blocknumber1-1)
    'set initial pointers into number2
    start2 = cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    stop2 =  cptr(longint ptr , strptr(number2))+(blocknumber2-1)
    'set comparison to beg of numbers
    chk_1 = cptr( longint ptr , strptr(number1))
    chk_2 = cptr( longint ptr , strptr(number2))
   
    'zero the carry
    carry = 0
   
    'begin looping thru strings multiplying
    do
        'set total to zero
        total = 0
        'we are going to be incrementing thru number2 while decrementing thru number1
        'working in opposite directions from start1 to stop1 and start2 to stop2
        'inc1 works from right to left in the top number1 string
        'inc2 works from start2 to stop 2, in the bottom number2 string, decrementing each loop.
        inc1 = start1
        inc2 = start2
        do
            total += *inc1 * *inc2
            inc1-= 1
            inc2+= 1
        loop until inc2 = stop2+1
   
        total = total + carry
        carry = total \ 1e7
        *outplace = total mod 1e7
        '*outplace = imod(total , 1e7)
       
        outplace -= 1
       
        'each loop we need to decrement stop1
        'if stop1 goes negative we reset it to zero and decrement stop2
        stop1 -= 1
        if stop1 < chk_1 then
            stop1 += 1
            stop2 -=1
            if stop2 < chk_2 then stop2+= 1
        end if
        'each loop we decrement start2 to the left
        start2 -= 1
        'if start2 goes negative we reset it to zero and decrement start1
        'start1 is the rightmost digit of number1 we need to multiply
        if start2 < chk_2 then
            start2 += 1
            start1 -= 1
            if start1 < chk_1 then start1+=1
        end if
   
    loop until outplace = cptr(ulongint ptr,strptr(answer))+1
   
    'put in the carry at the end
    if carry > 0  then *outplace = carry mod 1e7
   
    'convert answer back to ascii
    for a as ulongint = 1 to outblocks-1 step 1
        val1 = *outplace
        outplace +=1
        outtext = outtext + right("0000000" + str(val1),7)
    next   
   
    outtext = ltrim(outtext,"0") 'if multiplying by 1, we have a zero in front.

    return outtext
   
end function