## Squares

General FreeBASIC programming questions.
dafhi
Posts: 1367
Joined: Jun 04, 2005 9:51

### Re: Squares

working on my newest random number generator, i thought i'd try a multiplier of 4, which produces a cool reflection pattern

Code: Select all

`function CSG_ii as double '' 2018 Sep 17   '' produces a cool pattern  const as ulongint mul = 4   static as ulongint a, state = 0   a += 1 - (state = 0)   state = state shl 57 or state shr 7  state = mul * state xor a   return state / 2^64End function#undef rnd#define rnd csg_ii#include "pathtracer.bas" ' https://www.freebasic.net/forum/viewtopic.php?f=7&t=25232function CSG as double     const mul = 6364136223846793005ull '' Knuth's LCG  const add = 1442695040888963407ull   static as ulongint state = 1   state = mul * (state shr 9) + add   return (state and 4294967295) / 4294967296End function#undef rnd#define rnd csg'#include "util.bas"#Ifndef floor   '' http://www.freebasic.net/forum/viewtopic.php?p=118633  #Define floor(x) (((x)*2.0-0.5)shr 1)  #define ceil(x) (-((-(x)*2.0-0.5)shr 1))#EndIffunction round(in as double, places as ubyte = 0) as string  dim as integer mul = 10 ^ places  return str( floor( in * mul +.5 ) / mul )End Function' ------- util' ------- material democonst BASE_RAD = 50dim shared as tMatte mat sub sphere_as_ground(byref sce as scene, col as v3=type(1,1,1), k as single=.1, fresnel as single=0)  mat.quick_solid col, k, fresnel, 0  sce.add_sphere 0,-BASE_RAD,0, BASE_RAD, sce.add_material(mat.refl, mat.refr, mat.em)End subsub create_lights(byref sce as scene, num as integer=3, brightness as single=1, size_min as single = 1, y as single = .5, size_variance_mult as single = 2.5)  var size_avg = size_min * (1+size_variance_mult) / 2  for i as integer = 1 to num    var a = i / num    mat.quick_light hsv(a*6,.2,1)*brightness    var rad = size_min + rnd * size_variance_mult*size_min, dist=.8, angle = twopi*a    dim as v3 v=type( dist*cos(angle), y, dist*sin(angle) )    sce.add_sphere v.x,v.y,v.z, rad, sce.add_material(mat.refl, mat.refr, mat.em)  nextEnd Subsub Main   var seed = 6  for i as long = 1 to seed    dim as single f = rnd  Next   dim as imagevars buf:  buf.screen_init 800, 600  dim as imagevars buf2: buf2.create buf.w,buf.h   dim as scene    sce0, sce1, sce2   var scale=.333/1.0:  sce0.dimensions buf.w*scale, buf.w*scale  sce0.render_target buf2   with *sce0.pobjects    .bgcol = type(.7,.6,.55)*.6       .cam.zoom = 1.15       var pos_scalar = .7    .cam.o.z = -2.0 * pos_scalar    .cam.o.y = .45 * pos_scalar    .cam.o.x = -.8  end with  sce0.look_at .02, .06, 0   dim as tracer   tr  ' scene ===========   '                                    k, fresnel  sphere_as_ground sce0, hsv(0,0,.8), .3, .5   mat.quick_solid hsv(0,0,.8)       ,.01, .5  'sce0.obj(0).mat_layer sce0.add_material(mat.refl, mat.refr, mat.em), .3   '                   num, brightness, size_min,    y, size_vari_mult  create_lights sce0,   5,         30,     .010,  .35   sce1 = sce0  sce1.pobjects = @sce1.objects   sce2 = sce0  sce2.pobjects = @sce2.objects    ' material tester ===========   var rad = .1, y=rad+.0   var hue = 4, k = 1/25, fres = 0f, refr_amt = 0f, ior = 1f  mat.quick_solid hsv(hue,.3, 1), k, fres, refr_amt  sce0.add_sphere 0,y,0, rad, sce0.add_material(mat.refl, mat.refr, mat.em, ior)   mat.refl.fresnel = 1  sce1.add_sphere 0,y,0, rad, sce1.add_material(mat.refl, mat.refr, mat.em, ior)  '' layered  k = 0  mat.quick_solid hsv(hue, .4, 1), k, mat.refl.fresnel, refr_amt  sce2.add_sphere 0,y,0, rad, sce2.add_material(mat.refl, mat.refr, mat.em, ior), .7 ''layer strength   refr_amt = 1:  ior = 1.22  mat.quick_solid hsv(.5, .3, 1), k,                 0, refr_amt, 0 '' refr_amt, light  sce2.pobjects->obj(sce2.pobjects->ub_obj).mat_layer sce2.add_material(mat.refl, mat.refr, mat.em, ior), .5 ''layer strength   var border=2  dim as double t=timer, t_next = t, t0=t  'randomize   while 1       locate 1,1 ''print statements:  upper left corner       tr.render sce2    tr.render sce0    tr.render sce1    t = Timer    if t >= t_next then      var xw = sce0.w+border, x0=xw*0, x1=xw*1, x2=xw*2, y2=sce0.h+31:  y=sce0.h+1      var y4 = y2 - 10           sce0.image_out x0, 0      sce0.image_out x0, y2,,, true      sce1.image_out x1, 0      sce1.image_out x1, y2,,, true      sce2.image_out x2, 0      sce2.image_out x2, y2,,, true           put (0,0), buf2.im, pset      draw string (x0, y), "reflection"      var matref = sce1.pobjects->obj(sce1.pobjects->ub_obj).msv(0).id      draw string (x1, y), "fresnel = " & str(sce1.pobjects->mat_(matref).o.refl.fresnel)      draw string (x2, y), "k = " & str(mat.refl.k) & ", + new mat layer"      draw string(0,y4), "importance map"      if sce0.pixel_size <= 4 then windowtitle "frame: " & str(sce0.frame) & " time: " & round( (t-t0)/60, 2 ) & " min"      t_next = t + 1.3 / sce0.pixel_size ^ 1.7    endif    sleep 1       if inkey <> "" then exit while  wend  draw string(0,sce0.h+11), "done!"  windowtitle "done! " & round( (t-t0)/60, 2 ) & " minutes"   sleep end subMain`
Last edited by dafhi on Oct 30, 2018 1:29, edited 1 time in total.
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

A little saying i came up with:

dinner & kinner , groiner & joiner
unless she's a virgin then
you got to kinner before you dinner and joiner before you groiner..
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I came up with a faster way to do the "averager" multiplier. ( stepping by 18's )
I'll post it , in another couple days , when i get it written..
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

For my Averager:
Whats the fastest way to tell if a double precision number has a .5 at the end ?
Richard
Posts: 3047
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

@Albert.
You have no choice but to convert the number to decimal using the st = Str( dp ) function, then parse the string.
You need to better specify the input range and data format to get a better answer.
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

I think i got it!!!

could i do:

ints = int( (n1 + n2) / 2 )
fracts = frac( (n1 + n2) / 2 )
??
I'd like to do it , in one operation.. instead of two separate ops...

Code: Select all

`screen 19dim as double n1 = 121dim as double n2 = 120dim as integer n3 = int( (n1+n2) / 2 )  dim as double n4 = frac( (n1+n2) / 2 ) print "n1 = " ; n1print "n2 = " ; n2printprint "n3 = " ; n3print "n4 = " ; n4sleepend`
Richard
Posts: 3047
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

If you keep everything as integers you can do;
Dim as Integer n1, n2, sum, fract, avg
sum = n1 + n2
fract = sum And 1 ' test if odd, fract is 1 if half
avg = sum shr 1 ' which divides by two
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I invented to new words for the dictionary..

plevin = @#&|\$ long enter vessel many up&down
jevin = @#&|\$ enter vessel many up&down

plevin , jevin , heaven

I'm still working on the averager, it'll be another week or so to write it...
still got to wrap my head around it..
dodicat
Posts: 6767
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Ending in .5

Code: Select all

` #define ending(n) ((n)-.000001)\1 <> ((n)+.000001)\1for n as double=1 to 10000 step .31    if ending(n/20) then print using "####.#"; n/20nextsleep `
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I got my averager working with 1's and 2's but it's returning wrong for 3's

Code: Select all

`DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as longint size = 3  ' works with 1 and 2 but not 3 (????)do        dim as string num1    for a as longint =  1 to size step 1        num1+=str(int(rnd*10))     next    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)        dim as string num2    for a as longint =  1 to size step 1        num2+=str(int(rnd*10))     next    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)        if num2 > num1 then swap num1 , num2    if len(num2) > len(num1) then swap num1 , num2    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2     '==========================================================    'declare vars     '==========================================================        dim as string test = num2        dim as string l_bot =  string( len(num2) , "0" )    dim as string l_avg = string( len(num2) , "0" )    dim as string l_top =  string( len(num2) , "9" )        '==========================================================    'make all var strings a multiple of 18 digits    '==========================================================    test = make_equal( test )        l_bot  = make_equal( l_bot )    l_avg = make_equal( l_avg )    l_top  = make_equal( l_top )    '==========================================================    'convert the numeric strings to use pointers    '==========================================================    test = convert_to_pointers( test )        l_bot = convert_to_pointers( l_bot )    l_avg = convert_to_pointers( l_avg )    l_top = convert_to_pointers( l_top )        dim as string char    dim as ulongint loops = 0        do                loops+=1                l_avg = string( len(l_avg) , chr(0) )          dim as ubyte l_val = 0        dim as ubyte l_frac = 0        dim as ubyte ptr lt_ptr  = cptr( ubyte ptr , strptr( l_top ) )        dim as ubyte ptr la_ptr = cptr( ubyte ptr , strptr( l_avg ) )        dim as ubyte ptr lb_ptr = cptr( ubyte ptr , strptr( l_bot ) )            for a as longint = 1 to len( l_avg) step 1                                if l_frac = 1 then *(la_ptr)+= 5                                 l_val = ( *lt_ptr + *lb_ptr )                l_frac = l_val and 1                                *la_ptr+= ( l_val shr 1 )                                if *(la_ptr) >= 10 then *(la_ptr)-= 10 : *(la_ptr-1)+= 1                                lt_ptr+=1                 la_ptr+=1                lb_ptr+=1            next            if l_frac = 1 then *(la_ptr-1)+= 1            if *(la_ptr-1) >= 10 then *(la_ptr-1)-= 10 : *(la_ptr-2)+= 1                char = less_great( l_avg , test )                print test , l_avg , char                if inkey = chr(27) then exit do                if char = ">" then l_top = l_avg        if char = "<" then l_bot = l_avg        if char = "=" then exit do          loop         dim as ubyte ptr lavg_ptr = cptr( ubyte ptr , strptr(l_avg) )    dim as string l_ans = ""    for a as longint = 1 to len(l_avg) step 1            l_ans+= right(string(1,"0") +  str( *lavg_ptr ) , 1 )            lavg_ptr+=1    next        'dim as string my_answer = ""    'dim as string real_answer = multiplier_7( num1 , num2 )    'real_answer = left( real_answer , len(real_answer)-1 )        dim as string difference = minus( l_ans , num2 )        print    'print "n1    = "  ; num1    print "n2    = "  ; num2    print "l_ans = " ; l_ans , difference    print    'print "real ans = "  ; real_answer    'print "my  ans  = " ; my_answer    'print    'print "diff        =  " ; difference    'print    print "loops = " ; loops         if l_ans <> num2 then sleep        if inkey = " " then sleep    loop until inkey = chr(27)sleepend'================================================== '================================================== function less_great ( n1 as string , n2 as string) as string        dim as string char = "="        if n1 = n2 then return char        dim as ubyte ptr ubp1 = cptr( ubyte ptr , strptr(n1) )        dim as ubyte ptr ubp2 = cptr( ubyte ptr , strptr(n2) )        for a as longint = 1 to len(n1) step 1            if *ubp1 > *ubp2 then char = ">" : exit for            if *ubp1 < *ubp2 then char = "<" : exit for            ubp1+=1            ubp2+=1        next        return charend function'================================================== '================================================== function convert_to_pointers( n as string ) as string        dim as string n1 = n    dim as string n2    dim as ubyte ptr ubp    dim as ushort val1    dim as ushort len_1        n2 = string(len(n1) , chr(0))    ubp = cptr(ubyte ptr,strptr(n2))    len_1 = 0    for a as longint = 0 to len(n1)-1 step 1        val1 =  (n1[a]-48)        *ubp = val1        ubp+=1        len_1+=1    next    return n2end function'================================================== '================================================== function make_equal( n as string) as string    dim as string n1 = n    dim as string str1    dim as ulongint dec1    do        str1 = str( len(n1) / 1)        dec1 = instr(1,str1,".")        if  dec1 <> 0 then n1 = "0" + n1    loop until dec1 = 0    return n1end function'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd 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=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'==============================================================================='===============================================================================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: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I got it returning num2...

Here's 1,000 digits...

I still have to put in the r_avg stuff..

It takes about 3 seconds to return 1,000 digits.

Code: Select all

`DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2dim as longint size = 1000     ' works with 1 and 2 but not 3 (????)do        dim as string num1    for a as longint =  1 to size step 1        num1+=str(int(rnd*10))     next    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)        dim as string num2    for a as longint =  1 to size step 1        num2+=str(int(rnd*10))     next    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)        if num2 > num1 then swap num1 , num2    if len(num2) > len(num1) then swap num1 , num2    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2     '==========================================================    'declare vars     '==========================================================    time1 = timer        dim as string test = num2        dim as string l_bot =  string( len(num2) , "0" )    dim as string l_avg = string( len(num2) , "0" )    dim as string l_top =  string( len(num2) , "9" )          '==========================================================    'make all var strings a multiple of 18 digits    '==========================================================    test = make_equal( test )        l_bot  = make_equal( l_bot )    l_avg = make_equal( l_avg )    l_top  = make_equal( l_top )    '==========================================================    'convert the numeric strings to use pointers    '==========================================================    test = convert_to_pointers( test )        l_bot = convert_to_pointers( l_bot )    l_avg = convert_to_pointers( l_avg )    l_top = convert_to_pointers( l_top )        dim as string char    dim as ulongint loops = 0        do                loops+=1                l_avg = string( len(l_top) , chr(0) )        dim as ubyte l_val = 0        dim as ubyte l_frac = 0        dim as ubyte ptr lt_ptr  = cptr( ubyte ptr , strptr( l_top ) )        dim as ubyte ptr la_ptr = cptr( ubyte ptr , strptr( l_avg ) )        dim as ubyte ptr lb_ptr = cptr( ubyte ptr , strptr( l_bot ) )            for a as longint = 1 to len( l_avg) step 1                                if l_frac = 1 then *(la_ptr)+= 50                                l_val = ( *lt_ptr + *lb_ptr )                *la_ptr+= ( l_val shr 1 )                                l_frac = l_val and 1                                if *(la_ptr) > 99 then *(la_ptr)-= 100 : *(la_ptr-1)+= 1                                 if a >= 2 then                dim as longint place = 1                for b as longint = a to 2  step -1                    if *(la_ptr-place) > 99 then *(la_ptr-place)-=100 : *(la_ptr-place-1)+=1                    place+=1                next                 end if                            lt_ptr+=1                 la_ptr+=1                lb_ptr+=1            next                    char = less_great( l_avg , test )                'print test , l_avg , char        'print len(test) , len(l_avg)                if inkey = " " then exit do                if char = ">" then l_top = l_avg        if char = "<" then l_bot = l_avg        if char = "=" then exit do          loop          dim as ubyte ptr lavg_ptr = cptr( ubyte ptr , strptr(l_avg) )    dim as string l_ans = ""    for a as longint = 1 to len(l_avg) step 1            l_ans+= right(string(2,"0") +  str( *lavg_ptr ) , 2 )            lavg_ptr+=1    next    time2 = timer        'dim as string my_answer = ""    'dim as string real_answer = multiplier_7( num1 , num2 )    'real_answer = left( real_answer , len(real_answer)-1 )        dim as string difference = minus( l_ans , num2 )        print    'print "n1    = "  ; num1    print "n2    = "  ; num2     print "l_ans = " ; l_ans    print    'print "real ans = "  ; real_answer    'print "my  ans  = " ; my_answer    'print    print "diff        =  " ; difference    print    print "loops = " ; loops  ,, time2-time1          if l_ans <> num2 then sleep        if inkey = chr(27) then exit do    loop until inkey = chr(27)sleepend'================================================== '================================================== function less_great ( n1 as string , n2 as string) as string        dim as string char = "="        if n1 = n2 then return char        dim as ubyte ptr ubp1 = cptr( ubyte ptr , strptr(n1) )        dim as ubyte ptr ubp2 = cptr( ubyte ptr , strptr(n2) )        for a as longint = 1 to len(n1) step 1            if *ubp1 > *ubp2 then char = ">" : exit for            if *ubp1 < *ubp2 then char = "<" : exit for            ubp1+=1            ubp2+=1        next        return charend function'================================================== '================================================== function convert_to_pointers( n as string ) as string        dim as string n1 = n    dim as string n2    dim as ubyte ptr ubp    dim as ubyte val1    dim as longint len_1        n2 = string(len(n1) , chr(0))    ubp = cptr(ubyte ptr,strptr(n2))    len_1 = 0    for a as longint = 0 to len(n1)-1 step 2        val1  =  (n1[a+0]-48)*10        val1+=  (n1[a+1]-48)*1        *ubp = val1        ubp+=1        len_1+= 1    next    n2 = left(n2,len_1)    return n2end function'================================================== '================================================== function make_equal( n as string) as string    dim as string n1 = n    dim as string str1    dim as ulongint dec1    do        str1 = str( len(n1) / 2 )        dec1 = instr(1,str1,".")        if  dec1 <> 0 then n1 = "0" + n1    loop until dec1 = 0    return n1end function'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd 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=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'==============================================================================='===============================================================================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'==============================================================================='===============================================================================`
dodicat
Posts: 6767
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Squares

Thanks Albert.
I think I'll tidy up all my big number stuff for general floats.
My string indexing method will not beat 1e9 or 1e7 jumps, but it should do for a kind of extended arithmetic.
albert
Posts: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I got it returning some left digits of the mul...

Every time it prints "GREATER" the mul result is off

Code: Select all

`DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2dim as longint size = 10do        dim as string num1    for a as longint =  1 to size step 1        num1+=str(int(rnd*10))     next    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)        dim as string num2    for a as longint =  1 to size step 1        num2+=str(int(rnd*10))     next    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)        if num2 > num1 then swap num1 , num2    if len(num2) > len(num1) then swap num1 , num2    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2     '==========================================================    'declare vars     '==========================================================    time1 = timer        dim as string test = num2        dim as string l_bot = left(num2,1) + string( len(num2) - 1 , "0" )    dim as string l_avg = string( len(num2) , "0" )    dim as string l_top =  plus( l_bot , l_bot )    'if len(l_top) > len(l_bot) then l_top = string( len(num2) , "9" )    if len(l_top) > len(l_bot) then         l_top = "99" + string( len(num2)-2 , "0")        l_bot = "0" + l_bot        l_avg = l_bot        print        print "GREATER"        print    end  if         dim as string r_bot  = multiplier_7( num1 , left(num2,1) )        r_bot = left( r_bot , instr(1 , r_bot , "." ) - 1 )        r_bot+= string( len(num1) + len(num2) , "0" )        r_bot  = left( r_bot , len(num1)+len(num2) )     dim as string r_avg = string( len(r_bot) , "0" )    dim as string r_top  = plus( r_bot , r_bot )    if len(r_top) > len(r_bot) then r_bot = "0" + r_bot : r_avg = r_bot        '==========================================================    'make all var strings a multiple of 18 digits    '==========================================================    test = make_equal( test )        l_bot  = make_equal( l_bot )    l_avg = make_equal( l_avg )    l_top  = make_equal( l_top )    r_bot   = make_equal( r_bot )    r_avg  = make_equal( r_avg )    r_top   = make_equal( r_top )        '==========================================================    'convert the numeric strings to use pointers    '==========================================================    test = convert_to_pointers( test )        l_bot = convert_to_pointers( l_bot )    l_avg = convert_to_pointers( l_avg )    l_top = convert_to_pointers( l_top )        r_bot = convert_to_pointers( r_bot )    r_avg = convert_to_pointers( r_avg )    r_top = convert_to_pointers( r_top )        '==========================================================    '==========================================================        dim as string char    dim as ulongint loops = 0        do                loops+=1        dim as string l_check = l_avg        l_avg = string( len(l_top) , chr(0) )        dim as ubyte l_val = 0        dim as ubyte l_frac = 0        dim as ubyte ptr lt_ptr  = cptr( ubyte ptr , strptr( l_top ) )        dim as ubyte ptr la_ptr = cptr( ubyte ptr , strptr( l_avg ) )        dim as ubyte ptr lb_ptr = cptr( ubyte ptr , strptr( l_bot ) )            for a as longint = 1 to len( l_avg)  step 1                if l_frac = 1 then *(la_ptr)+= 50                l_val = ( *lt_ptr + *lb_ptr )                *la_ptr+= ( l_val shr 1 )                l_frac = l_val and 1                if *la_ptr > 99 then *la_ptr-= 100 : *(la_ptr-1)+= 1                if a = len(l_avg) then                dim as longint place = 0                for b as longint = a to 2  step -1                    if *(la_ptr-place) > 99 then *(la_ptr-place)-=100 : *(la_ptr-place-1)+=1                    place+=1                next                end if                lt_ptr+=1                 la_ptr+=1                lb_ptr+=1            next                    dim as string r_check = r_avg        r_avg = string( len(r_top) , chr(0) )        dim as ubyte r_val = 0        dim as ubyte r_frac = 0        dim as ubyte ptr rt_ptr  = cptr( ubyte ptr , strptr(r_top ) )        dim as ubyte ptr ra_ptr = cptr( ubyte ptr , strptr( r_avg ) )        dim as ubyte ptr rb_ptr = cptr( ubyte ptr , strptr( r_bot ) )            for a as longint = 1 to len( r_avg) step 1                if r_frac = 1 then *(ra_ptr)+= 50                r_val = ( *rt_ptr + *rb_ptr )                *ra_ptr+= ( r_val shr 1 )                r_frac = r_val and 1                if *ra_ptr > 99 then *ra_ptr-= 100 : *(ra_ptr-1)+=1                if a = len(r_avg) then                dim as longint place = 0                for b as longint = a to 2  step -1                    if *(ra_ptr-place) > 99 then *(ra_ptr-place)-=100 : *(ra_ptr-place-1)+=1                    place+=1                next                end if                rt_ptr+=1                 ra_ptr+=1                rb_ptr+=1            next                    char = less_great( l_avg , test )                if inkey = " " then exit do                if char = ">" then l_top = l_avg : r_top = r_avg        if char = "<" then l_bot = l_avg : r_bot = r_avg        if char = "=" then exit do        'if l_avg = l_check or r_avg = r_check then exit do             loop          dim as ubyte ptr lavg_ptr = cptr( ubyte ptr , strptr(l_avg) )    dim as string l_ans = ""    for a as longint = 1 to len(l_avg) step 1            l_ans+= right(string(2,"0") +  str( *lavg_ptr ) , 2 )            lavg_ptr+=1    next    l_ans = ltrim( l_ans,"0")    dim as ubyte ptr ravg_ptr = cptr( ubyte ptr , strptr(r_avg) )    dim as string r_ans = ""    for a as longint = 1 to len(r_avg) step 1            r_ans+= right(string(2,"0") +  str( *ravg_ptr ) , 2 )            ravg_ptr+=1    next    r_ans = ltrim( r_ans,"0")        time2 = timer        dim as string my_answer = ""    dim as string real_answer = multiplier_7( num1 , num2 )    real_answer = left( real_answer , len(real_answer)-1 )        dim as string difference1 = minus( l_ans , num2 )    dim as string difference2 = minus( r_ans , real_answer )        print    print "n1    = "  ; num1    print "n2    = "  ; num2     print "l_ans = " ; l_ans    print    print "real ans = "  ; real_answer    print "my  ans  = " ; r_ans    print    print "diff        =  " ; difference1 , difference2    print    print "loops = " ; loops  ,, time2-time1          if l_ans <> num2 then sleep    if r_ans <> real_answer then sleep        if inkey = chr(27) then exit do    if inkey = " " then sleep    loop until inkey = chr(27)sleepend'================================================== '================================================== function less_great ( n1 as string , n2 as string) as string        dim as string char = "="        if n1 = n2 then return char        dim as ubyte ptr ubp1 = cptr( ubyte ptr , strptr(n1) )        dim as ubyte ptr ubp2 = cptr( ubyte ptr , strptr(n2) )        for a as longint = 1 to len(n1) step 1            if *ubp1 > *ubp2 then char = ">" : exit for            if *ubp1 < *ubp2 then char = "<" : exit for            ubp1+=1            ubp2+=1        next        return charend function'================================================== '================================================== function convert_to_pointers( n as string ) as string        dim as string n1 = n    dim as string n2    dim as ubyte ptr ubp    dim as ubyte val1    dim as longint len_1        n2 = string(len(n1) , chr(0))    ubp = cptr(ubyte ptr,strptr(n2))    len_1 = 0    for a as longint = 0 to len(n1)-1 step 2        val1  =  (n1[a+0]-48)*10        val1+=  (n1[a+1]-48)*1        *ubp = val1        ubp+=1        len_1+= 1    next    n2 = left(n2,len_1)    return n2end function'================================================== '================================================== function make_equal( n as string) as string    dim as string n1 = n    dim as string str1    dim as ulongint dec1    do        str1 = str( len(n1) / 2 )        dec1 = instr(1,str1,".")        if  dec1 <> 0 then n1 = "0" + n1    loop until dec1 = 0    return n1end function'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd 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=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'==============================================================================='===============================================================================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: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard
@Dodicat

I got it returning some correct answers...still need to troubleshoot it some...

I still got to figure out why , some numbers are greater than the mul result..

Code: Select all

`DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2dim as longint size = 10dim as longint total = 0dim as longint r_correct = 0do        total+=1        dim as string num1    for a as longint =  1 to size step 1        num1+=str(int(rnd*10))     next    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)        dim as string num2    for a as longint =  1 to size step 1        num2+=str(int(rnd*10))     next    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)        if len(num2) = len(num1) then if num2 > num1 then swap num1 , num2    if len(num2) > len(num1) then swap num1 , num2    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2        '==========================================================    'declare vars     '==========================================================    time1 = timer        dim as string test = num2        dim as string l_bot = left(num2,1) + string( len(num2) - 1 , "0" )    dim as string l_avg    dim as string l_top =  plus( l_bot , l_bot )        dim as string r_bot  = multiplier_7( num1 , left(num2,1) )        r_bot = left( r_bot , len(r_bot) - 1 )        r_bot+= string( len(num1) + len(num2) , "0" )        r_bot  = left( r_bot , len(num1)+len(num2) )     dim as string r_avg    dim as string r_top  = plus( r_bot , r_bot )        dim as string point_5 = half( num1 )        if right(point_5 , 2 ) = ".5" then point_5 = left( point_5 , instr( 1 , point_5 , "." ) - 1 )        '==========================================================    'make all var strings a multiple of 18 digits    '==========================================================    test = make_equal( test )        l_bot  = make_equal( l_bot )    l_avg = make_equal( l_avg )    l_top  = make_equal( l_top )    r_bot   = make_equal( r_bot )    r_avg  = make_equal( r_avg )    r_top   = make_equal( r_top )        '==========================================================    'convert the numeric strings to use pointers    '==========================================================    test = convert_to_pointers( test )        l_bot = convert_to_pointers( l_bot )    l_avg = convert_to_pointers( l_avg )    l_top = convert_to_pointers( l_top )        r_bot = convert_to_pointers( r_bot )    r_avg = convert_to_pointers( r_avg )    r_top = convert_to_pointers( r_top )        if len(l_top) > len(l_bot)  then         l_bot = chr(0) + l_bot        test = chr(0) + test    end if    if len(r_top) > len(r_bot)  then         r_bot = chr(0) + r_bot    end if        point_5 = convert_to_pointers( point_5 )        '==========================================================    '==========================================================        dim as string char    dim as ulongint loops = 0    do                loops+=1                dim as string l_check = l_avg        l_avg = string( len(l_top) , chr(0) )        dim as ubyte l_val = 0        dim as ubyte l_frac = 0        dim as ubyte ptr lt_ptr  = cptr( ubyte ptr , strptr( l_top ) )        dim as ubyte ptr la_ptr = cptr( ubyte ptr , strptr( l_avg ) )        dim as ubyte ptr lb_ptr = cptr( ubyte ptr , strptr( l_bot ) )            for a as longint = 1 to len( l_avg)  step 1                if l_frac = 1 then *(la_ptr)+= 50                l_val = ( *lt_ptr + *lb_ptr )                *la_ptr+= ( l_val shr 1 )                l_frac = l_val  and 1                if *la_ptr > 99 then *la_ptr-= 100 : *(la_ptr-1)+= 1                lt_ptr+=1                 la_ptr+=1                lb_ptr+=1            next            if l_frac = 1 then  *(la_ptr-1)+= 1            dim as longint place = 1            for a as longint = len(l_avg) to 2  step -1                if *(la_ptr-place) > 99 then *(la_ptr-place)-=100 : *(la_ptr-place-1)+=1                place+=1            next                            dim as string r_check = r_avg        r_avg = string( len(r_top) , chr(0) )        dim as ubyte r_val = 0        dim as ubyte r_frac = 0        dim as ubyte ptr rt_ptr  = cptr( ubyte ptr , strptr(r_top ) )        dim as ubyte ptr ra_ptr = cptr( ubyte ptr , strptr( r_avg ) )        dim as ubyte ptr rb_ptr = cptr( ubyte ptr , strptr( r_bot ) )            for a as longint = 1 to len( r_avg) step 1                if r_frac = 1 then *(ra_ptr)+= 50                r_val = ( *rt_ptr + *rb_ptr )                *ra_ptr+= ( r_val shr 1 )                r_frac = r_val and 1                if *ra_ptr > 99 then *ra_ptr-= 100 : *(ra_ptr-1)+=1                rt_ptr+=1                 ra_ptr+=1                rb_ptr+=1            next            place = 1            for a as longint = len(r_avg) to 2  step -1                if *(ra_ptr-place) > 99 then *(ra_ptr-place)-=100 : *(ra_ptr-place-1)+=1                place+=1            next                      if l_frac = 1 then                if r_frac = 1 then *(ra_ptr-1)+=1                dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( point_5 ) ) + len(point_5) - 1                dim as longint place = 1                for a as longint = len(point_5) to 1 step -1                    *(ra_ptr-place)+=*ubp                    ubp-=1                    place+=1                next                place = 1                for a as longint = len(r_avg) to 2  step -1                    if *(ra_ptr-place) > 99 then *(ra_ptr-place)-=100 : *(ra_ptr-place-1)+=1                    place+=1                next           end if                   char = less_great( l_avg , test )                if inkey = " " then exit do                if char = ">" then l_top = l_avg : r_top = r_avg        if char = "<" then l_bot = l_avg : r_bot = r_avg        if char = "=" then exit do        'if l_avg = l_check or r_avg = r_check then exit do             loop          dim as ubyte ptr lavg_ptr = cptr( ubyte ptr , strptr(l_avg) )    dim as string l_ans = ""    for a as longint = 1 to len(l_avg) step 1            l_ans+= right(string(2,"0") +  str( *lavg_ptr ) , 2 )            lavg_ptr+=1    next    l_ans = ltrim( l_ans,"0")    dim as ubyte ptr ravg_ptr = cptr( ubyte ptr , strptr(r_avg) )    dim as string r_ans = ""    for a as longint = 1 to len(r_avg) step 1            r_ans+= right(string(2,"0") +  str( *ravg_ptr ) , 2 )            ravg_ptr+=1    next    r_ans = ltrim( r_ans,"0")        time2 = timer        dim as string my_answer = ""    dim as string real_answer = multiplier_7( num1 , num2 )    real_answer = left( real_answer , len(real_answer)-1 )        dim as string difference1 = minus( l_ans , num2 )    dim as string difference2 = minus( r_ans , real_answer )        if difference2 = "0" then r_correct+=1        print    print "n1    = "  ; num1    print "n2    = "  ; num2     print "l_ans = " ; l_ans    print    print "real ans = "  ; real_answer    print "my  ans  = " ; r_ans    print    print "L diff        =  " ; difference1    print "R diff       =   " ; difference2    print    print "loops = " ; loops  ,, time2-time1      print    print "correct " ; r_correct ; " out of" ; total            if l_ans <> num2 then sleep    if r_ans <> real_answer then sleep        if inkey = chr(27) then exit do    if inkey = " " then sleep    loop until inkey = chr(27)sleepend'================================================== '================================================== function less_great ( n1 as string , n2 as string) as string        dim as string char = "="        if n1 = n2 then return char        dim as ubyte ptr ubp1 = cptr( ubyte ptr , strptr(n1) )        dim as ubyte ptr ubp2 = cptr( ubyte ptr , strptr(n2) )        for a as longint = 1 to len(n1) step 1            if *ubp1 > *ubp2 then char = ">" : exit for            if *ubp1 < *ubp2 then char = "<" : exit for            ubp1+=1            ubp2+=1        next        return charend function'================================================== '================================================== function convert_to_pointers( n as string ) as string        dim as string n1 = n    dim as string n2    dim as ubyte ptr ubp    dim as ubyte val1    dim as longint len_1        n2 = string(len(n1) , chr(0))    ubp = cptr(ubyte ptr,strptr(n2))    len_1 = 0    for a as longint = 0 to len(n1)-1 step 2        val1  =  (n1[a+0]-48)*10        val1+=  (n1[a+1]-48)*1        *ubp = val1        ubp+=1        len_1+= 1    next    n2 = left(n2,len_1)    return n2end function'================================================== '================================================== function make_equal( n as string) as string    dim as string n1 = n    dim as string str1    dim as ulongint dec1    do        str1 = str( len(n1) / 2 )        dec1 = instr(1,str1,".")        if  dec1 <> 0 then n1 = "0" + n1    loop until dec1 = 0    return n1end function'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd 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=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'==============================================================================='===============================================================================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: 5927
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat
@Richard

I got it working,,, But the size of the digits has to be greater than 4, 5 digits or higher....

Still got to figure out why it won't do 1's , 2's , 3's and 4's

Code: Select all

`DECLARE FUNCTION multiplier_7(byref num1 as string, byref num2 as string) as stringDeclare Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As StringDECLARE Function minus(NUM1 As String,NUM2 As String) As StringDeclare Function       plus( NUMber1 As String  ,  NUMber2 As String ) As StringDeclare Function half(fl As String) As Stringdeclare function convert_to_pointers( n as string ) as stringdeclare function make_equal( n as string) as stringdeclare function less_great ( n1 as string , n2 as string) as stringscreen 19dim as double time1 , time2dim as longint size = 10dim as longint total = 0dim as longint r_correct = 0do        total+=1        dim as string num1    for a as longint =  1 to size step 1        num1+=str(int(rnd*10))     next    if left(num1,1) = "0" then mid(num1,1,1) = str(int(rnd*9)+1)        dim as string num2    for a as longint =  1 to size step 1        num2+=str(int(rnd*10))     next    if left(num2,1) = "0" then mid(num2,1,1) = str(int(rnd*9)+1)        if len(num2) = len(num1) then if num2 > num1 then swap num1 , num2    if len(num2) > len(num1) then swap num1 , num2    if len(num2) = len(num1) then if val(left(num2,1)) > val(left(num1,1)) then swap num1,num2        '==========================================================    'declare vars     '==========================================================    time1 = timer        dim as string test = num2        dim as string l_bot = left(num2,1) + string( len(num2) - 1 , "0" )    dim as string l_avg    dim as string l_top =  plus( l_bot , l_bot )        dim as string r_bot  = multiplier_7( num1 , left(num2,1) )        r_bot = left( r_bot , len(r_bot) - 1 )        r_bot+= string( len(num2)-1 , "0" )    dim as string r_avg    dim as string r_top  = plus( r_bot , r_bot )        dim as string point_5 = half( num1 )        if right(point_5 , 2 ) = ".5" then point_5 = left( point_5 , len(point_5) - 2 )            '==========================================================    'make all var strings a multiple of 18 digits    '==========================================================    test = make_equal( test )        l_bot  = make_equal( l_bot )    l_top  = make_equal( l_top )    r_bot   = make_equal( r_bot )    r_top   = make_equal( r_top )        point_5 = make_equal( point_5 )        '==========================================================    'convert the numeric strings to use pointers    '==========================================================    test = convert_to_pointers( test )        l_bot = convert_to_pointers( l_bot )    l_top = convert_to_pointers( l_top )        r_bot = convert_to_pointers( r_bot )    r_top = convert_to_pointers( r_top )        if len(l_top) > len(l_bot)  then         l_bot = chr(0) + l_bot        test   = chr(0) + test    end if    if len(r_top) > len(r_bot)  then         r_bot = chr(0) + r_bot    end if        point_5 = convert_to_pointers( point_5 )        '==========================================================    '==========================================================        dim as string char    dim as ulongint loops = 0    do                loops+=1                dim as string l_check = l_avg        l_avg = string( len(l_top) , chr(0) )        dim as ubyte l_val = 0        dim as ubyte l_frac = 0        dim as ubyte ptr lt_ptr  = cptr( ubyte ptr , strptr( l_top ) )        dim as ubyte ptr la_ptr = cptr( ubyte ptr , strptr( l_avg ) )        dim as ubyte ptr lb_ptr = cptr( ubyte ptr , strptr( l_bot ) )            for a as longint = 1 to len( l_avg)  step 1                if l_frac = 1 then *(la_ptr)+= 50                l_val = ( *lt_ptr + *lb_ptr )                *la_ptr+= ( l_val shr 1 )                l_frac = l_val  and 1                if *la_ptr > 99 then *la_ptr-= 100 : *(la_ptr-1)+= 1                lt_ptr+=1                 la_ptr+=1                lb_ptr+=1            next            if l_frac = 1 then  *(la_ptr-1)+= 1            dim as longint l_place = 1            for a as longint = len(l_avg) to 2  step -1                if *(la_ptr-l_place) > 99 then *(la_ptr-l_place)-=100 : *(la_ptr-l_place-1)+=1                l_place+=1            next                            dim as string r_check = r_avg        r_avg = string( len(r_top) , chr(0) )        dim as ubyte r_val = 0        dim as ubyte r_frac = 0        dim as ubyte ptr rt_ptr  = cptr( ubyte ptr , strptr(r_top ) )        dim as ubyte ptr ra_ptr = cptr( ubyte ptr , strptr( r_avg ) )        dim as ubyte ptr rb_ptr = cptr( ubyte ptr , strptr( r_bot ) )            for a as longint = 1 to len( r_avg) step 1                if r_frac = 1 then *(ra_ptr)+= 50                r_val = ( *rt_ptr + *rb_ptr )                *ra_ptr+= ( r_val shr 1 )                r_frac = r_val and 1                if *ra_ptr > 99 then *ra_ptr-= 100 : *(ra_ptr-1)+=1                rt_ptr+=1                 ra_ptr+=1                rb_ptr+=1            next            if r_frac = 1 then *(ra_ptr-1)+=1            dim as longint r_place = 1            for a as longint = len(r_avg) to 2  step -1                if *(ra_ptr-r_place) > 99 then *(ra_ptr-r_place)-=100 : *(ra_ptr-r_place-1)+=1                r_place+=1            next                       if l_frac = 1 then                dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( point_5 ) ) + len(point_5) - 1                dim as longint place = 1                for a as longint = len(point_5) to 1 step -1                    *(ra_ptr-place)+=*ubp                    ubp-=1                    place+=1                next                r_place = 1                for a as longint = len(r_avg) to 2  step -1                    if *(ra_ptr-r_place) > 99 then *(ra_ptr-r_place)-=100 : *(ra_ptr-r_place-1)+=1                    r_place+=1                next            end if                char = less_great( l_avg , test )                if inkey = " " then exit do                if char = ">" then l_top = l_avg : r_top = r_avg        if char = "<" then l_bot = l_avg : r_bot = r_avg        if char = "=" then exit do        'if l_avg = l_check or r_avg = r_check then exit do                             loop          dim as ubyte ptr lavg_ptr = cptr( ubyte ptr , strptr(l_avg) )    dim as string l_ans = ""    for a as longint = 1 to len(l_avg) step 1            l_ans+= right(string(2,"0") +  str( *lavg_ptr ) , 2 )            lavg_ptr+=1    next    l_ans = ltrim( l_ans,"0")        dim as ubyte ptr ravg_ptr = cptr( ubyte ptr , strptr(r_avg) )    dim as string r_ans = ""    for a as longint = 1 to len(r_avg) step 1            r_ans+= right(string(2,"0") +  str( *ravg_ptr ) , 2 )            ravg_ptr+=1    next    r_ans = ltrim( r_ans,"0")        time2 = timer        dim as string my_answer = ""    dim as string real_answer = multiplier_7( num1 , num2 )    real_answer = left( real_answer , len(real_answer)-1 )        dim as string difference1 = minus( l_ans , num2 )    dim as string difference2 = minus( r_ans , real_answer )        if difference2 = "0" then r_correct+=1        print    print "n1    = "  ; num1    print "n2    = "  ; num2     print "l_ans = " ; l_ans    print    print "real ans = "  ; real_answer    print "my  ans  = " ; r_ans    print    print "L diff        =  " ; difference1    print "R diff       =   " ; difference2    print    print "loops = " ; loops  ,, time2-time1      print    print "correct " ; r_correct ; " out of" ; total        if l_ans <> num2 then sleep    if r_ans <> real_answer then print left(num2,1) : sleep        if inkey = chr(27) then exit do    if inkey = " " then sleep    loop until inkey = chr(27)sleepend'================================================== '================================================== function less_great ( n1 as string , n2 as string) as string        dim as string char = "="        if n1 = n2 then return char        dim as ubyte ptr ubp1 = cptr( ubyte ptr , strptr(n1) )        dim as ubyte ptr ubp2 = cptr( ubyte ptr , strptr(n2) )        for a as longint = 1 to len(n1) step 1            if *ubp1 > *ubp2 then char = ">" : exit for            if *ubp1 < *ubp2 then char = "<" : exit for            ubp1+=1            ubp2+=1        next        return charend function'================================================== '================================================== function convert_to_pointers( n as string ) as string        dim as string n1 = n    dim as string n2    dim as ubyte ptr ubp    dim as ubyte val1    dim as longint len_1        n2 = string( len(n1) * 2 , chr(0) )    ubp = cptr( ubyte ptr , strptr( n2 ) )    len_1 = 0    for a as longint = 0 to len(n1)-1 step 2        val1  =  (n1[a+0]-48)*10        val1+=  (n1[a+1]-48)*1        *ubp = val1        ubp+=1        len_1+= 1    next    n2 = left( n2 , len_1 )    return n2end function'================================================== '================================================== function make_equal( n as string) as string    dim as string n1 = n    dim as string str1    dim as ulongint dec1    do        str1 = str( len(n1) / 2 )        dec1 = instr(1,str1,".")        if  dec1 <> 0 then n1 = "0" + n1    loop until dec1 = 0    return n1end function'================================================== '================================================== Function divide(n1 As String,n2 As String,decimal_places As integer,dpflag As String="s") As String          Dim As String number=n1,divisor=n2          dpflag=lcase(dpflag)          'For MOD          dim as integer modstop          if dpflag="mod" then               if len(n1)<len(n2) then return n1              if len(n1)=len(n2) then                  if n1<n2 then return n1                  end if              modstop=len(n1)-len(n2)+1              end if          if dpflag<>"mod" then     If dpflag<>"s"  Then dpflag="raw"      end if        Dim runcount As integer        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte        Dim bool(0 To 19) As Ubyte        For z As Integer=0 To 19    Qmod(z)=(z Mod 10+48)    bool(z)=(-(10>z))Next zDim answer As String   'THE ANSWER STRING  '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Thenpart1=Mid\$(s,1,position-1)part2=Mid\$(s,position)s=part1+char+part2End if#endmacroinsert(answer,".",decpos)  answer=thepoint+zeros+answerIf dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    End if#endmacro'______________________________________________'__________ SPLIT A STRING ABOUT A CHARACTRR __________Dim As String var1,var2    Dim pst As integer      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    End if    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As integer lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    End ifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    End ifDim As integer numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATORDim _sgn As Byte=-Sgn(decpos)If _sgn=0 Then _sgn=1Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009if dpflag<>"mod" thenIf Len(zeros) =0 Then dpflag="s"end ifDim As integer runlengthIf Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            End If            End IfElsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")End if'___________DECIMAL POSITION DETERMINED  _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As integer        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As integer lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As integer n3,diff       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=0        Do            count=count+1            copytemp=temp                Do'___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If  lens<lenf=0 Then 'notIf Lens>lenf Thentemp= "done"Exit DoEnd ifIf divisor>topstring Then temp= "done"Exit DoEnd ifEnd if  diff=lenf-lens        temp=topstring        subtractcarry=0                For n3=lenf-1 To diff Step -1            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry            temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)        Next n3         If subtractcarry=0 Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= topstring[n3]-38-subtractcarry             temp[n3]=Qmod(takeaway)            subtractcarry=bool(takeaway)            if subtractcarry=0 then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")        If temp="" Then temp= "0"            topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       if dpflag="mod" then       if runcount=modstop then            if topstring="" then return "0"           return mid(topstring,1,len(topstring)-1)           end if       end if       answer[runcount-1]=count+47       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           End if   Loop Until runcount=runlength+1      ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function '==============================================================================='===============================================================================Function half(fl As String) As String    Dim As Ubyte main,carry,temp    Dim As String sign   , s    If Instr(fl,".")=0 Then s=fl+".0" Else s=fl+"0"     If Instr(s,"-") Then sign="-":s=Ltrim(s,"-")    Dim As String ans=s    For z As Integer=0 To Len(s)-1        If s[z]<>46 Then             temp=(s[z]-48+carry)            main=temp Shr 1            carry=(temp And 1) Shl 3 +(temp And 1) Shl 1            ans[z]=main+48        End If    Next z    If Instr(ans,".") Then ans=Rtrim(ans,"0")    ans=Rtrim(ans,".")    ans=Ltrim(ans,"0")    Return ansEnd 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=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'==============================================================================='===============================================================================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'==============================================================================='===============================================================================`