Squares

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

Re: Squares

Postby Richard » Jan 11, 2019 23:44

@Albert.
My code showed you how to propagate carry, or to repair simple examples of delayed carry. Your code must avoid delaying carry for so long that local carry overflows within your register.
dodicat
Posts: 5758
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 12, 2019 14:32

Albert.
I have tested Richard's conversions with a binary multiply (bit by bit) here.
They look to be spot on.

Code: Select all

 
 '=======================================================================
' Convert base two ASCII binary string to base ten ASCII decimal string (RICHARD)
'=======================================================================
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(RICHARD)
'=======================================================================
Function base_10_to_2( Byref d As String ) As String  ' d may be lengthened
    ' lengthen input string by up to 8 digits to make 9 digit blocks
    Dim As Integer n = Len( d ) Mod 9
    If n Then d = String( 9 - n, "0" ) + d
    n = Len( d ) \ 9  ' number of input blocks
    Dim As Ulong acc( 0 To n )  ' the accumulator array
    ' convert blocks of 9 digits to binary in 32 bit Ulong
    Dim As Ulongint product, carry  ' 64 bit Unsigned Integer
    Dim As Integer i, j, k = 1      ' loop counters
    For j = 1 To Len( d ) Step 9     ' the blocks to convert
        carry = Valulng( Mid( d, j, 9 ) ) ' get value of 9 digit block
        For i = 0 To k  ' Multiply Accumulate
            product = ( Culngint( acc( i ) ) * 1000000000ull ) + carry
            acc( i ) = product And &hFFFFFFFFull ' sum is low order 32 bits
            carry = product Shr 32 ' carry is the high order 32 bits
        Next i
        If carry Then   ' extend accumulator by one element when needed
            k += 1
            acc( k ) = carry
        End If
    Next j  ' accumulator now contains result in packed binary
    ' unpack and return it as binary ASCII string
    Dim As String txt
    For i = n To 0 Step -1
        txt += Bin( acc( i ), 32 )
    Next i
    Return Ltrim( txt, "0" )
End Function

'multiply via change to bimary
Function Qmult(Byval a As String,Byval b As String) As String
    a= base_10_to_2(a) 'convert to binary
    b= base_10_to_2(b)
    For n As Long=0 To Len(a)-1 'make bits 0 and 1 as ubyte
        a[n]-=48
    Next
     For n As Long=0 To Len(b)-1
        b[n]-=48
    Next
      Var flag=0,la = Len(a),lb = Len(b)
      If Len(b)>Len(a) Then Swap a,b:Swap la,lb
Dim As Ubyte n,carry
    Var c =String(la+lb,0)
    For i As Integer =la-1 To 0 Step -1
        carry=0
        For j As Integer =lb-1 To 0 Step -1
          n=(a[i] And b[j])+(c[i+j+1]) + carry
             carry =n Shr 1:c[i+j+1]=n And 1
            Next j
        c[i]=carry
    Next i
    For n As Long=0 To Len(c)-1 'convert ubyte bits to string 1 and 0
        c[n]+=48
    Next
    c= base_2_to_10(c) 'convert back th base 10
   Return Ltrim(c,"0")
End Function



 Dim Shared As Ubyte _Mod(0 To 99),_Div(0 To 99)
For z As Integer=0 To 99:_Mod(z)=(z Mod 10+48):_Div(z)=z\10:Next
   ' normal decimal string multiply     
Function Qmult2( a As String,b As String) As String
      Var flag=0,la = Len(a),lb = Len(b)
      If Len(b)>Len(a) Then flag=1:Swap a,b:Swap la,lb
Dim As Ubyte n,carry,ai
    Var c =String(la+lb,"0")
    For i As Integer =la-1 To 0 Step -1
        carry=0:ai=a[i]-48
        For j As Integer =lb-1 To 0 Step -1
         Var n = ai * (b[j]-48) + (c[i+j+1]-48) + carry
              carry =_Div(n):c[i+j+1]=_Mod(n)
            Next j
        c[i]+=carry
    Next i
 If flag Then Swap a,b
   Return Ltrim(c,"0")
End Function

#define range(f,l) Int(Rnd*((l+1)-(f))+(f))

#macro create(g)
       g[0]=range(49,57)
       For n As Long=1 To Len(g)-1
           g[n]=range(48,57)
       Next
#endmacro

Dim As String n1=String(1000,0)
Dim As String n2=String(1000,0)
Do
create(n1)
create(n2)

Dim As String tobin=qmult(n1,n2)
Dim As String todec=qmult2(n1,n2)
Print tobin
Print
Print todec

Print Iif(todec=tobin,"OK","ERROR")
Sleep
Loop Until Inkey=Chr(27)

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

Re: Squares

Postby albert » Jan 13, 2019 1:08

@Dodicat

Richards base conversions tamper with the passed vars..and alter them..So you can't use them later on..
They put some zeros in front of them..

So i put some code into them to set the var for the function..

dim as string ?? = passed var_string..
then function works with ?? string..( passed string)
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 13, 2019 1:18

"!!~~OFF TOPIC~~!!"

Deleted at request of imortis

imortis you can contact me at

albert_redditt@yahoo.com
Last edited by albert on Jan 19, 2019 19:00, edited 1 time in total.
dodicat
Posts: 5758
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 13, 2019 15:10

Thanks Albert.
Sadly it will probably all happen again so some other culture in some other place.
Here is an update of my perpetual machine.
Red - north pole, green - south pole, white stuff - magnetic insulator.
It is boring to watch because perpetual motion will probably be boring when it is invented (in squares hopefully).

Code: Select all

dim shared as long cx,cy
cx=400
cy=300
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Type Point
    As single x,y  'need floats for smoothness when moving or rotating points
    Declare sub rotate(As Point,As Single,As Single)' As Point
End Type

sub point.rotate(pivot As Point,a As Single,d As Single)' As Point
 dim as point t=type(d*(Cos(a*.0174533)*(x-pivot.x)-Sin(a*.0174533)*(y-pivot.y)) +pivot.x,_
                     d*(Sin(a*.0174533)*(x-pivot.x)+Cos(a*.0174533)*(y-pivot.y)) +pivot.y)
               this=t
End sub

Type Rectangle
    As Ushort wide
    As Ushort high
    As Single aspect
    As Byte   pflag 'fill or not
    As Ulong  clr   'colour
    im as any ptr=0
    Declare  Constructor(As Point=type(0,0),As Ushort=0,As Ushort=0,As Single =0,As Ulong=0,As Byte=0,as any ptr=0)
    As Point v(1 To 4) 'extra points for vertices/centroid
    As Point centroid
    Declare Sub Draw()
End Type

Constructor rectangle(c As Point,w As Ushort,h As Ushort,a As Single,col As Ulong,pf As Byte,i as any ptr)
v(1)=type(c.x-w/2,c.y-h/2)
v(2)=type(c.x-w/2,c.y+h/2)
v(3)=type(c.x+w/2,c.y+h/2)
v(4)=type(c.x+w/2,c.y-h/2)
For n As Long=1 To 4
    v(n).rotate(c,a,1)
Next
pflag=pf
clr=col
aspect=a
wide=w
high=h
centroid=c
im=i
End Constructor


Sub fill(a() As Point,c As Ulong,min As Long,max As Long,im as any ptr=0)
    #define dist(x1,y1,x2,y2) sqr( (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2))
    'translation of a c snippet
    static As Long i,j,k,dy,dx, x,y,temp
    Static As Long NewX (1 To Ubound(a))
    Static As Single Grad(1 To Ubound(a))
    For i=1 To Ubound(a) - 1
        dy=a(i+1).y-a(i).y
        dx=a(i+1).x-a(i).x
        If(dy=0) Then Grad(i)=1
        If(dx=0) Then Grad(i)=0
        If ((dy <> 0) And (dx <> 0)) Then
            Grad(i) = dx/dy
        End If
    Next i
    For y=min To max
        k = 1
        For i=1 To Ubound(a) - 1
            If( ((a(i).y<=y) Andalso (a(i+1).y>y)) Or ((a(i).y>y) _
            Andalso (a(i+1).y<=y))) Then
            NewX(k)= Int(a(i).x+ Grad(i)*(y-a(i).y))
            k +=1
        End If
    Next i
    For j = 1 To k-2
        For i = 1 To k-2
            If NewX(i) > NewX(i+1) Then
                temp = NewX(i)
                NewX(i) = NewX(i+1)
                NewX(i+1) = temp
            End If
        Next i
    Next j
 
    For i = 1 To k - 2 Step 2
        Line im,(NewX(i),y)-(NewX(i+1)+1,y),c
    Next i
Next y
End Sub

Sub rectangle.draw()
    Static As Single miny=1e6,maxy=-1e6
    Static As Point V1(1 To  Ubound(v)+1)
    For n as long =1 To Ubound(v)
        If pflag=0 Then If n<Ubound(v) Then  Line(v(n).x,v(n).y)-(v(n+1).x,v(n+1).y),clr
        If miny>v(n).y Then miny=v(n).y
        If maxy<v(n).y Then maxy=v(n).y
        V1(n)=v(n)
    Next
    If pflag=0 Then Line -(v(1).x,v(1).y),clr
    v1(Ubound(v1))=v(Lbound(v))
    If pflag Then fill(v1(),clr,miny,maxy,im)
End Sub

Function Regulate(Byval MyFps As long,Byref fps As long) As Integer
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

function DrawBox(x as long,y as long,w as long,h as long, _
    angle as single,length as long,col as ulong,f as byte=1,i as any ptr=0) as point
    dim as rectangle r
    dim as single c=-angle
     angle=angle*.0174532925199433  '=4*atn(1)/180
    var x2=x+length*cos(angle),y2=y-length*sin(angle)
    r=rectangle(type<point>(x2,y2),w,h,c,col,f,i)
    r.draw
    return type(x2,y2)
end function

screen 19,32
dim as any ptr i=imagecreate(800,600,0)
 for n as long=0 to 360 step 15
     DrawBox(400,300,50,21,n+.5,100+100+5,rgb(200,200,200),1,i)
     DrawBox(400,300,50,20,n,150+108,rgb(200,0,0),1,i)
     DrawBox(400,300,50,20,n,100+108,rgb(0,200,0),1,i)
     next
dim as single a
dim as long fps
do
    a+=.2
    if a>360 then a=0
    screenlock
    cls
    put(0,0),i,pset
    draw string(10,10),"Fps  " & fps
    for n as long=0 to 360 step 20
DrawBox(400,300,50,21,a+n-.5,152,rgb(200,200,200),1)
DrawBox(400,300,50,20,a+n,150,rgb(200,0,0))
DrawBox(400,300,50,20,a+n,100,rgb(0,200,0))
next
screenunlock
sleep regulate(160,fps),1
loop until len(inkey)
sleep 
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 13, 2019 17:41

@Dodicat

How about a ring magnet , where you have herring bone north and south strips around the ring.
Then you have a floating magnet attached to the shaft that travels around the circle??

The floating magnet would be both attracted and repelled around the circle...
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Mul Bin

Postby albert » Jan 13, 2019 18:09

@Dodicat

I did a bin multiplier....

Code: Select all


screen 19

do
   
    dim as string binari = bin( int( rnd*256 ) )
   
    dim as longint mul = int(rnd*100) + 1

    dim as string added = string( len(binari) ,  "0" )
    dim as longint carry = 0
    dim as longint val1
    for a as longint = len(binari)-1 to 0 step -1
        val1 = ( ( binari[ a ] - 48 ) * mul ) + carry
        carry = val1 \ 2
        added[a]+= val1 mod 2
    next
    added = bin(carry) + added
   
    print
    print binari  , val("&B" + binari)
    print
    print bin(val("&B" + binari) * mul) , val("&B" + binari) * mul
    print added , val("&B" + added )
   
    sleep

loop until inkey = chr(27)

sleep
end



Now to incorporate it into my multiplier...
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 14, 2019 0:29

@Dodicat
@Richard

I don't know what Hitler did with the infants and toddlers under the reading age??
But they rounded up whole households and charged them with espionage , if they possessed any of the books..
Some 7,000,000 Jews were executed from 1939 to 1948..
At 4 people per household , that's a little more than 1,500,000 households in Germany , Austria , Poland , that were rounded up..


Here's the bin mul with strings...It only works for up to 64 bits..Now , to make it step by more than 1 digit , at a time..

Code: Select all


screen 19

do
   
    dim as string num1 = bin( int( rnd * 2^24 ) + 1 )
    dim as string num2 = bin( int( rnd * 2^24 ) + 1 )

    dim as ulongint added( 0 to len(num1)+len(num2))
    dim as longint val1
    dim as longint val2
    dim as longint place_a = ubound(added)+1
    dim as longint place_b = place_a
    for a as longint = len(num1)-1 to 0 step -1
        val1 = ( num1[ a ] - 48 )
        place_a-= 1
        place_b = place_a
        for b as longint = len(num2)-1 to 0 step -1
            val2 = (num2[ b ] - 48 ) * val1
            added(place_b)+=val2 mod 2
            place_b-=1
        next
    next
    dim as longint carry = 0
    dim as string answer=""
    for a as longint = ubound(added) to lbound(added) step -1
        val1 = added(a) + carry
        carry = val1 \ 2
        answer = str(val1 mod 2) + answer
    next
    answer = ltrim(answer,"0")
   
    print
    print "========================================================================="
    print num1  , val("&B" + num1) ; " x " ; val("&B" + num2)
    print
    print bin(val("&B" + num1) * val("&B" + num2) ) , val("&B" + num1) * val("&B"+num2)
    print answer , val("&B"+answer)
    print "========================================================================="
   
    sleep

loop until inkey = chr(27)

sleep
end

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

Re: Squares

Postby dodicat » Jan 14, 2019 2:09

val2 mod 2 is equal to val2 and 1 which is faster.
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 14, 2019 2:24

@Dodicat

Thanks for the idea.. val AND 1 worked..

Any idea on how to make it step by more than 1 digit ??

=============================================================================
@Dodicat

I wrote a sea faring song... It's a Classical Ballad..

Code: Select all


( Genre = Classic Ballad )

( Title = Sail The Mighty Ocean )

   sail the mighty ocean
   sail the mighty sea
   sail the mighty ocean
   my true love , for to see

she lives across the waters
she lives across the sea
she lives across the waters
my true love , waits for me

all aboard the vessle
all aboard the "Lee"
all aboard the vessle
we're headed off to sea

   sail the mighty ocean
   sail the mighty sea
   sail the mighty ocean
   my true love , for to see

a hail to the captain
a hail to the "Lee"
a hail to the captian
we're headed out to sea

embark upon a voyage
embark upon the sea
embark upon a voyage
my true love waits for me

   sail the mighty ocean
   sail the mighty sea
   sail the mighty ocean
   my true love , for to see

several weeks on the ocean
several weeks on the sea
several weeks on the ocean
my true love for to see

she lives across the waters
she lives across the sea
she lives across the waters
my true love , waits for me

   sail the mighty ocean
   sail the mighty sea
   sail the mighty ocean
   my true love , for to see

batten down the hatches
batten down the "Lee"
batten down the hatches
theres a strom upon the sea

not long i will see her
not long i'll be there
not long i will see her
and smell her precious hair

   sail the mighty ocean
   sail the mighty sea
   sail the mighty ocean
   my true love , for to see

   sail the mighty ocean
   sail the mighty sea
   sail the mighty ocean
   my true love , for to see

albert_redditt@yahoo.com

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



I edited it to make some minor changes..
Last edited by albert on Jan 15, 2019 17:50, edited 1 time in total.
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 15, 2019 17:26

@Dodicat

I got it stepping by 24 bits...see mul_var()

I'd like to make the bits var , to self adjust to the highest val possible for the length of the strings.
It takes 4,500 seconds to run for 1,000,000 length. So i have to speed it up...

Code: Select all


Declare Function mul_var( n1 as string , n2 as string ) as string

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

Declare Function base_2_to_10( Byref num As String ) As String    ' b may be lengthened
Declare Function base_10_to_2( Byref num 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
   
    '=======================================================
    'begin create binary numbers
    '=======================================================
    dim as longint size = 100
    dim as string num1 = ""
    do
        num1=""
        for x as longint = 1 to size
            num1+= str( int( rnd*2 ) )
        next
        num1 = ltrim(num1,"0")
    loop until num1 > "0"
   
    dim as string num2 = ""
    do
        num2 = ""
        for x as longint = 1 to size
            num2+= str( int( rnd*2 ) )
        next
        num2 = ltrim(num2,"0")
    loop until num2 > "0"
   
    if len(num2) > len(num1) then swap num1 , num2
    if num2 > num1 then swap num1 , num2
    '=======================================================
    'end create binary numbers
    '=======================================================
    time1=timer
        dim as string mul1 = base_2_to_10( num1 )
        dim as string mul2 = base_2_to_10( num2 )
        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 answer = mul_var( num1 , num2 )
    time4 = timer
   
    dim as string diff = minus( mul_bin , answer )
   
    print
    print "========================================================================="
    print base_2_to_10( num1 )
    print base_2_to_10( num2 )
    print
    print mul_bin
    print answer
    print
    print "diff = " ; diff
    print "Time multiplier_7 = " ; time2-time1
    print "Time mul loop     = "  ; time4-time3
    print "========================================================================="
   
    if diff <> "0" then print "ERROR" : sleep
   
    sleep

loop until inkey = chr(27)

sleep
end
'=======================================================================
'=======================================================================
' subs and functions below here
'=======================================================================
'=======================================================================
'=======================================================================
Function mul_var( n1 as string , n2 as string ) as string
    dim as string num1 = n1
    dim as string num2 = n2
    '=======================================================
    'make equal lenths
    '=======================================================
    dim as ubyte bits = 24 ' set val for mul loop stepping.. I want to make the bits variable..to ( auto_adust ) to the largest val possible...
    if len(num1) > len(num2) then num2 = string( len(num1) - len(num2) , "0" ) + num2
    if len(num2) > len(num1) then num1 = string( len(num2) - len(num1) , "0" ) + num1
    if len(num1) mod bits > 0 then num1 = string( ( bits - len(num1) mod bits ) , "0") + num1
    if len(num2) mod bits > 0 then num2 = string( ( bits - len(num2) mod bits ) , "0") + num2
    '=======================================================
    'end make equal lenths
    '=======================================================
       
    '=======================================================
    'begin mul loop
    '=======================================================
    dim as ulongint added( 0 to len(num1)+len(num2))
    dim as longint val1
    dim as longint val2
    dim as longint place_a = ubound(added)+bits
    dim as longint place_b = place_a
    dim as longint carry
    for a as longint = len(num1)-(bits-1) to 1 step -bits
        val1 = val("&B"+mid( num1 , a , bits ))
        place_a-= bits
        place_b = place_a
        if val1 > 0 then
            for b as longint = len(num2)-(bits-1) to 1 step -bits
                val2 = val("&B"+mid( num2 , b , bits )) * val1
                added(place_b)+= val2 'mod 2
                place_b-=bits
            next
        end if
    next
    carry = 0
    dim as string answer=""
    for a as longint = ubound(added) to lbound(added) step -1
        'print added(a) ; " " ;
        val1 = added(a) + carry
        carry = val1 \ 2
        answer = str(val1 and 1) + answer
    next
    answer = ltrim(answer,"0")
    '=======================================================
    'end mul loop
    '=======================================================
    return answer
end function
'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

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

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'=======================================================================
'=======================================================================
'Richards base converters
'=======================================================================
'=======================================================================
'=======================================================================
' Convert base two ASCII binary string to base ten ASCII decimal string
'=======================================================================
Function base_2_to_10( Byref num As String ) As String    ' b may be lengthened
    dim as string b = num
    ' 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 num As String ) As String  ' d may be lengthened
    dim as string d = num
    '================================================
    '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

Imortis
Moderator
Posts: 1614
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: Squares

Postby Imortis » Jan 19, 2019 18:34

albert wrote:"!!~~OFF TOPIC~~!!"
...


@albert,
I tried to find a way to reach out to you privately regarding this post, but you don't have a publicly accessible contact. I would have preferred to contact you privately, but I don't have the same access to user info that full Admins have so was unable.

You understand that the above linked post has no purpose here (as you marked it off-topic), and I also think you can understand how it is in-appropriate for this forum. I would like to request that you edit the post to remove the content. If you do not, I can and will do it for you, but would prefer not to.

I would like to request that you keep this kind of post off of the forum. I understand that we are pretty easy going when it comes to off-topic stuff, but this is not the first time in this thread that you have gone off-topic in this particular direction.

I don't want to discourage you from posting here or anywhere else on the forum, but please keep in mind that the purpose of this forum is to discuss the freeBASIC programming language.
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 19, 2019 19:03

@Dodicat
@Richard

I tried and tried but i can't get the following code to step by more than 26 bits..
See mul_26_bit() at bottom of code..

Any ideas????

Code: Select all


Declare Function mul_1_bit( num1 as string , num2 as string ) as string
Declare Function mul_26_bit(byref num1 as string, byref num2 as string) as string

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

Declare Function base_2_to_10( Byref num As String ) As String    ' b may be lengthened
Declare Function base_10_to_2( Byref num 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 = 26
   
    dim as string n1 = ""
    for x as longint = 1 to size
        n1+= str( int( rnd*2 ) )
    next
    if left( n1 ,1)  = "0" then mid( n1 , 1 , 1 ) = "1"
   
    dim as string n2 = ""
    for x as longint = 1 to size
        n2+= str( int( rnd*2 ) )
    next
    if left( n2 ,1)  = "0" then mid( n2 , 1 , 1 ) = "1"
   
    if len( n2 ) > len( n1 ) then swap n1 , n2
   
    time1=timer
        dim as string mul1 = base_2_to_10( n1 )
        dim as string mul2 = base_2_to_10( n2 )
        dim as string mul_7 = multiplier_7( mul1 , mul2 )
        mul_7 = left( mul_7 , len( mul_7 ) - 1 )
        mul_7 = base_10_to_2(mul_7)
        mul_7 = ltrim( mul_7 , "0")
    time2 = timer
   
    time3=timer
        dim as string mul_albert = mul_26_bit( n1 , n2 )
    time4=timer
   
    dim as string diff = minus( mul_7 , mul_albert)
   
    print
    print  "n1  = "  ; n1
    print  "n2  = "  ; n2
    print  "multiplier_7 = " ; mul_7
    print  "mul_1_bit    = " ; 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 num As String ) As String    ' b may be lengthened
    dim as string b = num
    ' 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 num As String ) As String  ' d may be lengthened
    dim as string d = num
    '================================================
    '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_1_bit( num1 as string , num2 as string ) as string
   
    dim as string number1 = num1
    dim as string number2 = num2
   
    dim as longint size = 1
   
    if len(number1) > len(number2) then number2 = string( len(number1) - len(number2) , "0" ) + number2
    if len(number2) > len(number1) then number1 = string( len(number2) - len(number1) , "0" ) + number1
    if len(number1) mod size > 0 then number1 = string( ( size - len(number1) mod size ) , "0") + number1
    if len(number2) mod size > 0 then number2 = string( ( size - len(number2) mod size ) , "0") + number2

    dim as ulongint added( 0 to len(number1)+len(number2) )
    dim as longint place_a = ubound(added)
   
    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 ulongint carry = 0
    dim as longint place = len(number1) + len(number2)
    do
        total = 0
        inc1 = start1
        inc2 = start2
        do
            total+= valulng( mid(number1,inc1,size) )  * valulng( mid(number2,inc2,size) )
            inc2 += size
            inc1 -= size
        loop until inc1 < 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
       
        total+=carry
        carry = total \ 2
        added(place_a) = total and 1
       
        place_a-=1
        place-=size
       
    loop until place < size+1
   
    added(place_a) = carry and 1
       
    dim as string answer=""
    dim as ulongint val1
    for a as longint = lbound(added) to ubound(added) step 1
        val1 = added( a )
        answer+= str(val1)
    next
    answer = ltrim(answer,"0")
    return answer
end function
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================
function mul_26_bit(byref num1 as string, byref num2 as string) as string
   
    dim as string number1,number2
   
    number1 = num1
    number2 = num2
   
    dim as longint size = 26
   
    if len(number1) mod size > 0 then number1 = string( ( size - len(number1) mod size ) , "0") + number1
    if len(number2) mod size > 0 then number2 = string( ( size - len(number2) mod size ) , "0") + number2

    '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
    for a as longint = 1 to len(number1) step size
        val1 = valulng("&B" + mid( number1 , a , size ) )
        *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 as longint = 1 to len(number2) step size
        val2 = valulng("&B" + mid( number2 , a , size) )
        *ulp2 = val2
        ulp2+=1
        len_2+=8
    next
    number2 = left(n2,len_2)
    n2=""

    'create accumulator
    dim as string answer = string( len(number1) + len(number2) , chr(0) )
    dim as ulongint outblocks = ( len(answer) \ 8 )
    dim as ulongint ptr outplace = cptr(ulongint ptr , strptr(answer)) + (outblocks - 1 )
    dim as ulongint stops = ( (len(number1)\8) + (len(number2)\8) )
    dim as ulongint value = 0
    dim as longint hold = -1
    dim as longint locat = 0
    dim as longint vals = 0
    dim as ulongint high1 = ( len(number1)  \ 8 ) - 1
    dim as ulongint high2 = ( len(number2)  \ 8 ) - 1
    dim as longint ptr num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1
    dim as longint ptr num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2
    do
        hold+=1
        vals = hold
        locat = 0
        if vals > high2 then vals = high2 : locat = (hold - high2)
        num1_ptr = cptr( ulongint ptr , strptr(number1) ) + high1 - locat
        num2_ptr = cptr( ulongint ptr , strptr(number2) ) + high2 - vals
        do
            value+= *( num1_ptr ) * *( num2_ptr )
            num1_ptr-=1
            num2_ptr+=1
            if num1_ptr = cptr( ulongint ptr , strptr(number1) ) - 1 then goto done
            if num2_ptr > cptr( ulongint ptr , strptr(number2) ) + high2  then goto done
        loop
        Done:
        *outplace = value mod 1e8
         outplace-= 1
         value = value \ 1e8
    loop until hold = stops-2
   
     *outplace = value mod 1e8
       
    'convert answer back to ascii
   dim as string outtext=""
   outplace = cptr( ulongint ptr , strptr(answer) )
   for a as ulongint = 1 to outblocks step 1
       value = *outplace
       outplace+=1
       outtext+= right("00000000" + str(value),8)
    next   
   
   outtext = ltrim(outtext,"0")
   
   return bin( valulng( outtext ) )
   
end function

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

Re: Squares

Postby albert » Jan 20, 2019 17:57

@Richard

How do you tell if a "size" is too big for a number of digits. overflows a ulongint

I want to make my multiplier , step-size , variable..

Smaller numbers of digits , you can step by bigger sizes.
Larger numbers of digits , you need to step by smaller sizes..

What's the formula to set the size , for different lengths of numbers??
albert
Posts: 4749
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 22, 2019 0:40

I did a ( shift & add ) mul loop...

I need to speed it up... How would you do a binary adder that steps by 16 or 18 bits??

Code: Select all


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

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

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

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

screen 19

dim as ulongint loops = 0
dim as ulongint correct = 0

dim as double time1 , time2 , time3 , time4

do
   
    loops+=1
   
    dim as longint size = 45
   
    dim as string n1 = ""
    for x as longint = 1 to size
        n1+= str( int( rnd*2 ) )
    next
    if left( n1 ,1)  = "0" then mid( n1 , 1 , 1 ) = "1"
   
    dim as string n2 = ""
    for x as longint = 1 to size
        n2+= str( int( rnd*2 ) )
    next
    if left( n2 ,1)  = "0" then mid( n2 , 1 , 1 ) = "1"
   
    if len( n2 ) > len( n1 ) then swap n1 , n2
   
    time1=timer
        dim as string mul1 = base_2_to_10( n1 )
        dim as string mul2 = base_2_to_10( n2 )
        dim as string multiplier = multiplier_7( mul1 , mul2 )
        multiplier = left( multiplier , len( multiplier) - 1 )
        multiplier = base_10_to_2(multiplier)
    time2 = timer

   
    'begin ( shift & add ) mul loop
    time3 = timer
        dim as string result = string( len(n1) + len(n2) ,"0" )
        dim as ubyte val1
        dim as string shft = ""
        for a as longint = len(n2) to 1 step -1
            val1 = n2[ a - 1 ]
            if val1 = 49 then
                shft =  n1 + string( len(n2) - a , "0" )
                result = bin_add( result , shft )
            end if
        next
        result = ltrim( result , "0" )
    time4 = timer
    'end ( shift & add ) mul loop
   
    dim as string diff = minus( multiplier , result )
    if diff = "0" then correct+=1
   
    print
    print "n1 = " ; n1
    print "n2 = " ; n2
    print
    print "ans = " ; multiplier
    print "me  = " ;  result
    print
    print "diff = " ; diff
    print
    print "time multiplier_7 = " ; time2 - time1
    print "time bin loop     = "; time4 - time3
   
    if diff <> "0" then print "ERROR" : sleep
   
    if inkey = " " then sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'functions below here
'===============================================================================
'===============================================================================
Function bin_add( num1 as string , num2 as string ) as string
   
    dim as string n2      = num2
    dim as string result = num1
   
    dim as ubyte ptr n_2 = cptr( ubyte ptr , strptr( n2 ) + len( n2 ) - 1 )
    dim as ubyte ptr res  = cptr( ubyte ptr , strptr( result ) + len(result) - 1 )
   
    dim as ubyte val1
    for a as longint = 1 to len(n2)
        *res+= (*n_2 - 48)
        val1 = *res
        if val1 = 50 then *res = 48 : *(res-1) += 1
        if val1 = 51 then *res = 49 : *(res-1) += 1
        res-= 1
        n_2-= 1
    next
   
    return result
   
end function
'===============================================================================
'===============================================================================

'===============================================================================
'===============================================================================
'Dodicats plus & Minus functions
'===============================================================================
'===============================================================================
    Function plus(_num1 As String,_num2 As String) As String
        Dim  ADDQmod(0 To 19) As Ubyte
        Dim  ADDbool(0 To 19) As Ubyte
        For z As Integer=0 To 19
            ADDQmod(z)=(z Mod 10+48)
            ADDbool(z)=(-(10<=z))
        Next z
        Var _flag=0,n_=0
        Dim As Ubyte addup=Any,addcarry=Any
        #macro finish()
        answer=Ltrim(answer,"0")
        If _flag=1 Then Swap _num2,_num1
        Return answer
        #endmacro
        If Len(_num2)>Len(_num1) Then
            Swap _num2,_num1
            _flag=1
        End If
        Var diff=Len(_num1)-Len(_num2)
        Var answer="0"+_num1
        addcarry=0
        For n_=Len(_num1)-1 To diff Step -1
            addup=_num2[n_-diff]+_num1[n_]-96
            answer[n_+1]=ADDQmod(addup+addcarry)
            addcarry=ADDbool(addup+addcarry)
        Next n_
        If addcarry=0 Then
            finish()
        End If
        If n_=-1 Then
            answer[0]=addcarry+48
            finish()
            Endif
            For n_=n_ To 0 Step -1
                addup=_num1[n_]-48
                answer[n_+1]=ADDQmod(addup+addcarry)
                addcarry=ADDbool(addup+addcarry)
                If addcarry=0 Then Exit For
            Next n_
            answer[0]=addcarry+48
            finish()
        End Function
'===============================================================================
'===============================================================================
Function minus(NUM1 As String,NUM2 As String) As String
     'Dim As String copyfirstnum=mul_num_1,copysecondnum=mul_num_2
    Dim As Byte swapflag           
    Dim As Long lenf,lens
    Dim sign As String * 1
    'Dim As String part1,part2
    Dim bigger As Byte
     'set up tables
    Dim As Ubyte Qmod(0 To 19)
    Dim bool(0 To 19) As Ubyte

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

    compare(numbers)
    If bigger Then
        sign="-"
        Swap NUM2,NUM1
        Swap lens,lenf
        swapflag=1
    Endif
    'lenf=Len(NUM1)
    'lens=Len(NUM2)
    Dim diff As Long=lenf-lens-Sgn(lenf-lens)
    Dim As String one,two,three
    three=NUM1
    two=String(lenf-lens,"0")+NUM2
    one=NUM1
    Dim As Long n2
    Dim As Ubyte takeaway,subtractcarry
    Dim As Ubyte ten=10
    'Dim z As Long
    subtractcarry=0
    Do
         For n2=lenf-1 To diff Step -1
           takeaway= one[n2]-two[n2]+ten-subtractcarry
           three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n2
        If subtractcarry=0 Then Exit Do
        If n2=-1 Then Exit Do
        For n2=n2 To 0 Step -1
            takeaway= one[n2]-two[n2]+ten-subtractcarry
            three[n2]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            Next n2
        Exit Do
    Loop
   
    three=Ltrim(three,"0")
    If three="" Then Return "0"
    If swapflag=1 Then Swap NUM1,NUM2
   
    Return sign+three
   
End Function
'=======================================================================
' Convert base two ASCII binary string to base ten ASCII decimal string
'=======================================================================
Function base_2_to_10( Byref num As String ) As String    ' b may be lengthened
    dim as string b = num
    ' 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 num As String ) As String  ' d may be lengthened
    dim as string d = num
    '================================================
    '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


Return to “General”

Who is online

Users browsing this forum: albert and 4 guests