qbs_str my mod

[Jack]

as seen here https://staging.qb64phoenix.com/showthre...114#pid114 I worked on changing the qbs_str function for double and float
I went ahead and incorporated the changes in libqb.cpp and built QB64, here's a sample

Code: (Select All)

$Console:Only
_Dest _Console

Print Factorial_Recursive(1000)

Function Factorial_Recursive## (n As Integer)
    If n = 0 Then Factorial_Recursive## = 1: Exit Function
    Factorial_Recursive## = n * Factorial_Recursive##(n - 1)
End Function

output

4.02387260077093773F+2567

Press any key to continue

even though I did some testing for bugs some may have slipped trough

---

looks like I found a bug, not ready for prime-time

---

it has a strange effect on print using

Code: (Select All)

$Console:Only
_Dest _Console
Dim As _Float f

f = Factorial_Recursive(50)
Print Using "##.##################"; f
Print f

Function Factorial_Recursive## (n As Integer)
    If n = 0 Then Factorial_Recursive## = 1: Exit Function
    Factorial_Recursive## = n * Factorial_Recursive##(n - 1)
End Function

%30414093201713378039796484017234741538658648106343392576177963008.000000000000000000
3.0414093201713378F+64

Press any key to continue

[Pete]

I feel your pain. This is why after a few failed tries with my own numerical experiments, I just stuck to using strings.

Pete

[Jack]

Pete, I think that I may have found the problem, obviously I don't know the inner workings of the qbs string but in this case I think that the problem is I didn't set the string length, it will take a bit of time to set the length and then it should be good to go

[admin]

We're going to have to settle on an "Official Github" for the project sometime soon, so that changes like these can be added and pushed into it so the language can keep growing and moving forward in the future. Many thanks for your efforts, Jack. I hope you get this sorted out soon, and hopefully by that time somebody will have us a github up and shared, which we can all call it our new home for the community's repository.

[Jack]

while I wasn't setting the length of the return qbs_str the bug of print using was not related to any of my code, try this example and see what you get

Code: (Select All)

$Console:Only
_Dest _Console
Dim As _Float f

f = Factorial_Recursive(50)
Print Using "##.##################"; f
Print f

Function Factorial_Recursive## (n As Integer)
    If n = 0 Then Factorial_Recursive## = 1: Exit Function
    Factorial_Recursive## = n * Factorial_Recursive##(n - 1)
End Function

the latest QB64 git repo without any changes gives this

%30414093201713378039796484017234741538658648106343392576177963008.000000000000000000
3.041409320171338D+64

when I first saw that on my modded version I immediately blamed my meddling but that's not the case

---

here are the modified qbs_str functions in case someone wants to try them out

Code: (Select All)

qbs *qbs_str(double value){
    static qbs *tqbs;
    tqbs=qbs_new(32,1);
    static int32 l, i,j,digits,exponent;
   
    #ifdef QB64_MINGW
        __mingw_sprintf((char*)&qbs_str_buffer,"% .14Le",(long double) value);
    #else
        sprintf((char*)&qbs_str_buffer,"% .14Le",(long double) value);
    #endif
    exponent=atoi((char*)&qbs_str_buffer[18]);
    digits=16;
    while((qbs_str_buffer[digits]=='0')&&(digits>0)) digits--;
    tqbs->chr[0]=qbs_str_buffer[0]; // copy sign
    if(exponent==0){
        for(i=1;i<=(digits);i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.') // if no digits after . then nip it
            tqbs->len=digits;  // by zero terminating
        else
            tqbs->len=digits+1; // zero terminate
    }
    else if(exponent<0){
        if((digits-exponent)>=19){ // use sci format
            for(i=1;i<=digits;i++){
                tqbs->chr[i]=qbs_str_buffer[i];
            }
            if(tqbs->chr[digits]=='.'){
                tqbs->chr[digits]='D';
                sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
                l=digits+1;
                while((tqbs->chr[l])!=0) l++;
                tqbs->len=l;
            }
            else{
                tqbs->chr[digits+1]='D';
                sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
                l=digits+2;
                while((tqbs->chr[l])!=0) l++;
                tqbs->len=l;
            }
        }
        else{
            tqbs->chr[1]='.';
            for(i=2;i<=abs(exponent);i++){
                tqbs->chr[i]='0';
            }
            tqbs->chr[abs(exponent)+1]=qbs_str_buffer[1]; // first non-zero digit
            j=3;                    // skip decimal point
            for(i=abs(exponent)+2;i<(abs(exponent)+digits);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            tqbs->len=abs(exponent)+digits; // zero terminate
        }
    }
    else if(exponent>0){
        if((digits<17)&&(exponent<15)){
            tqbs->chr[1]=qbs_str_buffer[1]; // first digit
            j=3;            // skip over .
            for(i=2;i<=(exponent+1);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            if((digits>exponent)&&(digits>(j-1))){
                tqbs->chr[exponent+2]='.';
                for(i=exponent+3;i<=(digits);i++){
                    tqbs->chr[i]=qbs_str_buffer[j];
                    j++;
                }
                tqbs->len=digits+1;
            }
            else{
                tqbs->len=exponent+2;
            }
    }
    else{
        for(i=0;i<=digits;i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.'){
            tqbs->chr[digits]='D';
            sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
            l=digits+1;
            while((tqbs->chr[l])!=0) l++;
            tqbs->len=l;
        }
        else{
            tqbs->chr[digits+1]='D';
            sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
            l=digits+2;
            while((tqbs->chr[l])!=0) l++;
            tqbs->len=l;
        }
    }
}
    return tqbs;
}

qbs *qbs_str(long double value){
    static qbs *tqbs;
    tqbs=qbs_new(32,1);
    static int32 l, i,j,digits,exponent;
   
    #ifdef QB64_MINGW
        __mingw_sprintf((char*)&qbs_str_buffer,"% .17Le", value);
    #else
        sprintf((char*)&qbs_str_buffer,"% .17Le", value);
    #endif
    exponent=atoi((char*)&qbs_str_buffer[21]);
    digits=19;
    while((qbs_str_buffer[digits]=='0')&&(digits>0)) digits--;
    tqbs->chr[0]=qbs_str_buffer[0]; // copy sign
    if(exponent==0){
        for(i=1;i<=(digits);i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.') // if no digits after . then nip it
            tqbs->len=digits;  // by zero terminating
        else
            tqbs->len=digits+1; // zero terminate
    }
    else if(exponent<0){
        if((digits-exponent)>=22){ // use sci format
            for(i=1;i<=digits;i++){
                tqbs->chr[i]=qbs_str_buffer[i];
            }
            if(tqbs->chr[digits]=='.'){
                tqbs->chr[digits]='F';
                sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
l=digits+1;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
            }
            else{
                tqbs->chr[digits+1]='F';
                sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
l=digits+2;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
            }
        }
        else{
            tqbs->chr[1]='.';
            for(i=2;i<=abs(exponent);i++){
                tqbs->chr[i]='0';
            }
            tqbs->chr[abs(exponent)+1]=qbs_str_buffer[1]; // first non-zero digit
            j=3;                    // skip decimal point
            for(i=abs(exponent)+2;i<(abs(exponent)+digits);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            tqbs->len=abs(exponent)+digits; // zero terminate
        }
    }
    else if(exponent>0){
        if((digits<20)&&(exponent<18)){
            tqbs->chr[1]=qbs_str_buffer[1]; // first digit
            j=3;            // skip over .
            for(i=2;i<=(exponent+1);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            if((digits>exponent)&&(digits>(j-1))){
                tqbs->chr[exponent+2]='.';
                for(i=exponent+3;i<=(digits);i++){
                    tqbs->chr[i]=qbs_str_buffer[j];
                    j++;
                }
                tqbs->len=digits+1;
            }
            else{
                tqbs->len=exponent+2;
            }
    }
    else{
        for(i=0;i<=digits;i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.'){
            tqbs->chr[digits]='F';
            sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
l=digits+1;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
        }
        else{
            tqbs->chr[digits+1]='F';
            sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
l=digits+2;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
        }
    }
}
    return tqbs;
}

[Jack]

the zip file had the code without setting the qbs_str length, so please don't use it
the code above should be ok but it could use more testing
btw, in the above double to string function I set the digits limit to 15 instead of 16
with 16 digits there are too many instances where floating-point to string conversion does not work as desired, for example
1D-21 would print as 9.999999999999999D-22

[Jack]

I have an idea, you could set the max-digits to 16 and make two conversions to string, one with 15 digits and the other with 16 digits, if the exponents are the same then use 16 digits else use 15
it's just a matter of doing it, but I think I have spring laziness 
on the other hand restricting double to string conversion to 15 digits you are less likely to have output like 4.99999999999999 so I vote to leave it at 15

[Jack]

let me give an example to illustrate the difference between converting double to 16 digits and 15 digits as implemented in the C code above

Code: (Select All)

Dim As Double x
For x = -1 To 1 Step .1#
    Print x
Next

output using unmodified QB64

-1
-.9
-.8
-.7000000000000001
-.6000000000000001
-.5000000000000001
-.4000000000000001
-.3000000000000002
-.2000000000000001
-.1000000000000001
-1.387778780781446D-16
9.999999999999987D-02
.2
.3
.4
.5
.6
.6999999999999998
.7999999999999998
.8999999999999998
.9999999999999998

output when using my modified qbs_str routine

-1
-.9
-.8
-.7
-.6
-.5
-.4
-.3
-.2
-.1
-1.38777878078145D-16
.0999999999999999
.2
.3
.4
.5
.6
.7
.8
.9
1

[Jack]

ok, for completeness I will make one last post since no-one seems to be interested
the following version sets the digits to 16 but it converts the double in two buffers, one to 15 digits the other to 16 digits
it counts the trailing 0's of the two buffers and if the difference between them is greater than 1 and also the exponents remain the same then use the 15-digit buffer
qbs_str code

Code: (Select All)

qbs *qbs_str(double value){
    static qbs *tqbs;
    tqbs=qbs_new(32,1);
    char buf1[32];
    static int32 l, i,j,digits,exponent, digits1, exponent1;
   
    sprintf((char*)&buf1,"% .14e", value);
    sprintf((char*)&qbs_str_buffer,"% .15e", value);

    exponent=atoi((char*)&qbs_str_buffer[19]);
    exponent1=atoi((char*)&buf1[18]);
    digits=17;
    while((qbs_str_buffer[digits]=='0')&&(digits>0)) digits--;
    digits1=16;
    while((buf1[digits1]=='0')&&(digits1>0)) digits1--;
    if(((digits-digits1)>1)&&(exponent==exponent1)){
for(i=1;i<17;i++){
qbs_str_buffer[i]=buf1[i];
}
qbs_str_buffer[17]='0';
digits=17;
while((qbs_str_buffer[digits]=='0')&&(digits>0)) digits--;
}
    tqbs->chr[0]=qbs_str_buffer[0]; // copy sign
    if(exponent==0){
        for(i=1;i<=(digits);i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.') // if no digits after . then nip it
            tqbs->len=digits;  // by zero terminating
        else
            tqbs->len=digits+1; // zero terminate
    }
    else if(exponent<0){
        if((digits-exponent)>=19){ // use sci format
            for(i=1;i<=digits;i++){
                tqbs->chr[i]=qbs_str_buffer[i];
            }
            if(tqbs->chr[digits]=='.'){
                tqbs->chr[digits]='D';
                sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
                l=digits+1;
                while((tqbs->chr[l])!=0) l++;
                tqbs->len=l;
            }
            else{
                tqbs->chr[digits+1]='D';
                sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
                l=digits+2;
                while((tqbs->chr[l])!=0) l++;
                tqbs->len=l;
            }
        }
        else{
            tqbs->chr[1]='.';
            for(i=2;i<=abs(exponent);i++){
                tqbs->chr[i]='0';
            }
            tqbs->chr[abs(exponent)+1]=qbs_str_buffer[1]; // first non-zero digit
            j=3;                    // skip decimal point
            for(i=abs(exponent)+2;i<(abs(exponent)+digits);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            tqbs->len=abs(exponent)+digits; // zero terminate
        }
    }
    else if(exponent>0){
        if((digits<18)&&(exponent<16)){
            tqbs->chr[1]=qbs_str_buffer[1]; // first digit
            j=3;            // skip over .
            for(i=2;i<=(exponent+1);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            if((digits>exponent)&&(digits>(j-1))){
                tqbs->chr[exponent+2]='.';
                for(i=exponent+3;i<=(digits);i++){
                    tqbs->chr[i]=qbs_str_buffer[j];
                    j++;
                }
                tqbs->len=digits+1;
            }
            else{
                tqbs->len=exponent+2;
            }
    }
    else{
        for(i=0;i<=digits;i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.'){
            tqbs->chr[digits]='D';
            sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
            l=digits+1;
            while((tqbs->chr[l])!=0) l++;
            tqbs->len=l;
        }
        else{
            tqbs->chr[digits+1]='D';
            sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
            l=digits+2;
            while((tqbs->chr[l])!=0) l++;
            tqbs->len=l;
        }
    }
}
    return tqbs;
}

qbs *qbs_str(long double value){
    static qbs *tqbs;
    tqbs=qbs_new(32,1);
    static int32 l, i,j,digits,exponent;
   
    #ifdef QB64_MINGW
        __mingw_sprintf((char*)&qbs_str_buffer,"% .17Le", value);
    #else
        sprintf((char*)&qbs_str_buffer,"% .17Le", value);
    #endif
    exponent=atoi((char*)&qbs_str_buffer[21]);
    digits=19;
    while((qbs_str_buffer[digits]=='0')&&(digits>0)) digits--;
    tqbs->chr[0]=qbs_str_buffer[0]; // copy sign
    if(exponent==0){
        for(i=1;i<=(digits);i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.') // if no digits after . then nip it
            tqbs->len=digits;  // by zero terminating
        else
            tqbs->len=digits+1; // zero terminate
    }
    else if(exponent<0){
        if((digits-exponent)>=22){ // use sci format
            for(i=1;i<=digits;i++){
                tqbs->chr[i]=qbs_str_buffer[i];
            }
            if(tqbs->chr[digits]=='.'){
                tqbs->chr[digits]='F';
                sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
l=digits+1;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
            }
            else{
                tqbs->chr[digits+1]='F';
                sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
l=digits+2;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
            }
        }
        else{
            tqbs->chr[1]='.';
            for(i=2;i<=abs(exponent);i++){
                tqbs->chr[i]='0';
            }
            tqbs->chr[abs(exponent)+1]=qbs_str_buffer[1]; // first non-zero digit
            j=3;                    // skip decimal point
            for(i=abs(exponent)+2;i<(abs(exponent)+digits);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            tqbs->len=abs(exponent)+digits; // zero terminate
        }
    }
    else if(exponent>0){
        if((digits<20)&&(exponent<18)){
            tqbs->chr[1]=qbs_str_buffer[1]; // first digit
            j=3;            // skip over .
            for(i=2;i<=(exponent+1);i++){
                tqbs->chr[i]=qbs_str_buffer[j];
                j++;
            }
            if((digits>exponent)&&(digits>(j-1))){
                tqbs->chr[exponent+2]='.';
                for(i=exponent+3;i<=(digits);i++){
                    tqbs->chr[i]=qbs_str_buffer[j];
                    j++;
                }
                tqbs->len=digits+1;
            }
            else{
                tqbs->len=exponent+2;
            }
    }
    else{
        for(i=0;i<=digits;i++){
            tqbs->chr[i]=qbs_str_buffer[i];
        }
        if(tqbs->chr[digits]=='.'){
            tqbs->chr[digits]='F';
            sprintf((char*)&tqbs->chr[digits+1],"%+03d", exponent);
l=digits+1;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
        }
        else{
            tqbs->chr[digits+1]='F';
            sprintf((char*)&tqbs->chr[digits+2],"%+03d", exponent);
l=digits+2;
while((tqbs->chr[l])!=0) l++;
tqbs->len=l;
        }
    }
}
    return tqbs;
}

QB64 sample

Code: (Select All)

Dim As Double x
For x = -1 To 1 Step .1#
    Print x
Next
Print "-----------------"
For x = 1 To 10
    Print x / 9#
Next

output

-1
-.9
-.8
-.7
-.6
-.5
-.4
-.3
-.2
-.1
-1.387778780781446D-16
9.999999999999987D-02
.2
.3
.4
.5
.6
.7
.8
.9
.9999999999999998
-----------------
.1111111111111111
.2222222222222222
.3333333333333333
.4444444444444444
.5555555555555556
.6666666666666666
.7777777777777778
.8888888888888888
1
1.111111111111111

I realize that the output differs from that of QB-4.5 but this is the best that I care to do

[admin]

ok, for completeness I will make one last post since no-one seems to be interested

I'm interested, I just don't have time to give these a look like they deserve at the moment.  I'm running around like a cat trying to cover up poop in the Sahara!  

Give me a good week or so to get everything else around here sorted out, and then I can start looking and running other people's code samples once again.