## Squares

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

### Re: Squares

@Richard
@Dodicat

I got it figured out....

Code: Select all

`screen 19do         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
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### MUL_1_BIN

@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 stringscreen 19do        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        loopEND'================================================== '================================================== '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 answerend function`
Richard
Posts: 2950
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@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 bin0001020310010000   3 dec is 11 bin0001021110010000   2 dec is 10 bin0001101110010000   carry is now cleared. 0001101110010000 = ans.0110101011111100 = ans.0102012131111100 = me.0102012211111100   3 dec is 11 bin0102013011111100   2 dec is 10 bin0102021011111100   3 dec is 11 bin0102101011111100   2 dec is 10 bin0110101011111100   carry is now cleared. 0110101011111100 = ans.`
albert
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### mul_bin_1

@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 stringDECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as stringDeclare Function base_2_to_10( Byref b As String ) As String    ' b may be lengthenedDeclare Function base_10_to_2( Byref d As String ) As String  ' d may be lengthenedDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As Stringscreen 19dim as double time1 , time2 , time3 , time4do        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        loopEND'================================================== '================================================== '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=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=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 answerend 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 outtextend function'==============================================================================='===============================================================================`
albert
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### Mul Bin

@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 stringDeclare Function multiplier_7( num1 as string, num2 as string) as stringDeclare Function base_2_to_10( Byref b As String ) As String    ' b may be lengthenedDeclare Function base_10_to_2( Byref d As String ) As String  ' d may be lengthenedDeclare Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As Stringscreen 19dim as double time1 , time2 , time3 , time4do        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        loopEND'================================================== '================================================== '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=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=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 outtextend 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 answerend function`
albert
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 101110111100110100111001010100n1   = 0011011110101111n2   = 1101011111101100ans = 101110111101110100111001010100me  = 101110111100110100111001010100diff  = 1000000000000000000time mul    =  0.0001051998697221279time albert =  0.002562100067734718ERROR'==========================================================================  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
Posts: 2950
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@Albert.
I am not surprised since you are using decimal addition to do binary addition and delaying carry for too long.
albert
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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

### Re: Squares

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= 1LoopDo While c      ' extend string if carry overflows    s = Iif( c And 1, "1", "0" ) + s    c Shr= 1LoopPrint a ' 101110111100110100111001010100Print s ' 101110111100110100111001010100`
albert
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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

### Re: Squares

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
Posts: 5893
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

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 zEnd SubFunction 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 FunctionScreen 19,32,,64Color ,Rgb(0,155,255)ClsDim As Long z,lst,sDo    '======  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 100Loop Until Len(Inkey)Sleep `
Tourist Trap
Posts: 2758
Joined: Jun 02, 2015 16:24

### Re: Squares

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

Pretty nice :)
albert
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Thanks Richard & Dodicat!
albert
Posts: 4922
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 stringDeclare Function mul_var_bin( num1 as string , num2 as string , bits as longint ) as stringDeclare Function multiplier_7( num1 as string, num2 as string) as stringDeclare Function base_2_to_10( Byref b As String ) As String    ' b may be lengthenedDeclare Function base_10_to_2( Byref d As String ) As String  ' d may be lengthenedDeclare Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As Stringscreen 19dim as double time1 , time2 , time3 , time4do       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       loopEND'=================================================='=================================================='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=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=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 outtextend 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 answerend 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`

Return to “General”

### Who is online

Users browsing this forum: No registered users and 13 guests