Page 1 of 1

Native Format$() function similar to or better than sprintf?

Posted: Fri Feb 05, 2010 5:46 am
by skywalk
Hi,
I used VB6's Format$(somenumber, someformat) function a lot for reporting data in scientific notation and other formats.

After a fair amount of searching, found a sprintf import here on the forum.

Code: Select all

ImportC "MSVCRT.LIB" 
  sPrintf.l(result.s,num_format.s,number.d) As "_sprintf" 
EndImport 
x.d = -3.1415926535897932e4
s.s = Space(32)
sprintf(s, "%+3.4E", x)
Debug s  ;-> -3.1416E+004
Not sure how to limit the zeros after the 'E' in the format statement?
In VB6, "000.0000E+00" or "000.0000E+0" would change the number of zeros.
In PB, I have to add some logic around the ReplaceString function...
s = ReplaceString(s, "E+00", "E+0")
Debug s

Not ready yet, but for cross platform, what would I use for Mac and Linux?
ImportC "stdio.lib"
sPrintf.l(result.s,num_format.s,number.d) As "_sprintf"
endimport

It would be cool to have this "built-in" to PurebasiC like the formatdate() function.

Re: Native Format$() function similar to or better than sprintf?

Posted: Sat Feb 06, 2010 10:07 am
by mdp
what would I use for Mac and Linux?

Code: Select all

ImportC ""
  sprintf.l(result.s,num_format.s,number.d) 
EndImport
x.d = -3.1415926535897932e4
s.s = Space(32)
sprintf(s, "%+3.4E", x)
Debug s 
Your code works, you can skip the library name

Re: Native Format$() function similar to or better than spri

Posted: Fri Mar 26, 2010 11:50 am
by Frarth
Here is a full working example I once wrote with QuickBASIC and ported to PureBasic. Documentation and examples included:

Code: Select all

; FormatX Library
; written by Frank Hoogerbeets
; website: http://www.ditrianum.org
; e-mail: info@ditrianum.org

EnableExplicit

;{ DOCUMENTATION
; -----------------------------------------------------------------------
; FormatI, FormatF, FormatD
;
;   Syntax
;     FormatX(Value, Format$)
;
;   Parameters
;     Value     - number to be formatted
;     Format$   - format defintion
;
;   Usage
;     Use the following symbols to define a format:
;       #   - digit placeholder
;       .   - as rightmost occurance, decimal point
;       ,   - as rightmost occurance, decimal comma
;       0   - as first character, fills leading placeholders with zeros
;       /   - as first character, removes leading placeholders
;
;     Any other character will be part of the format
;
;     Note 1
;       Make sure to provide sufficient placeholders for a given number.
;       Example:  FormatI(21, "#") returns "1", not "21"
;                 FormatI(21, "##") returns "21"
;                 FormatI(21, "####") returns "  21"
;                 FormatI(21, "/####") returns "21"
;     Note 2
;       The number of placeholders behind the decimal point or comma
;       determines the number of digits of the decimal part.
;       Example:  FormatD(2/3, "#.##") returns "0.67"
;                 FormatD(2/3, "#.####") returns "0.6667"
;                 FormatD(1/3, "#.##") returns "0.33"
;                 FormatD(1/3, "#.####") returns "0.3333"
;   Examples
;     See below
; -----------------------------------------------------------------------
;}

Structure ByteType
  b.b[0]
EndStructure

;- INTERNAL PROCEDURES:

Procedure.i Format_mDecPoint(*TFormat.ByteType)
  ;return position of decimal point/comma
  Protected flen = MemoryStringLength(*TFormat) - 1, i.i
  For i = flen To 0 Step -1
    Select *TFormat\b[i]
    Case ',', '.'
      ProcedureReturn flen - i + 1
    EndSelect
  Next
EndProcedure

Procedure.s Format_mRound(Buffer.s, rpos.i)
  Protected fpos.i, ascii.i, result.s, i.i
  
  ; floating point position
  fpos = FindString(Buffer, Chr(46), 1)
  If fpos = 0
    ProcedureReturn Buffer
  EndIf
  result = Left(Buffer, fpos + rpos)
  
  ;get next digit to determine round-off
  If rpos = 0
    result = Left(Buffer, fpos - 1)
  EndIf
  
  ; < 5 means nothing to round off
  If Val(Mid(Buffer, fpos + rpos + 1, 1)) < 5
    Goto Format_mRound_Exit
  EndIf
  
  ;round off
  For i = Len(result) To 1 Step -1
    ascii = Asc(Mid(result, i, 1))
    Select ascii
    Case 46
      If i = 1
        result = Chr(49) + result
        Break
      EndIf
    Case 48 To 56
      result = Left(result, i - 1) + Chr(ascii + 1) + Mid(result, i + 1)
      Break
    Case 57
      result = Left(result, i - 1) + Chr(48) + Mid(result, i + 1)
      If i = 1
        result = Chr(49) + result
        Break
      EndIf
    EndSelect
  Next
Format_mRound_Exit:
  If fpos = 1
    result = Chr(48) + result
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s Format_mFormat(Buffer.s, Format.s)
  Protected blen.i, flen.i, lzero.i, nospc.i, bdpnt.i, fdpnt.i, n.i
  Protected char.s, result.s, i.i
  
  Select Left(Format, 1)
  Case Chr(47) ;no (leading) space
    nospc = #True
  Case Chr(48) ;leading zero
    lzero = #True
  EndSelect
  
  ;remove special character if present
  If lzero Or nospc
    Format = Mid(Format, 2)
  EndIf
  
  flen = Len(Format)
  n = 0
  
  ;get round-off position (n)
  fdpnt = Format_mDecPoint(@Format)
  If fdpnt > 0
    For i = flen - fdpnt + 2 To flen
      If Mid(Format, i, 1) = Chr(35)
        n + 1
      EndIf
    Next
  EndIf
  Buffer = Format_mRound(Buffer, n)
  blen = Len(Buffer)
  bdpnt = Format_mDecPoint(@Buffer)
  fdpnt = flen - fdpnt + 1
  
  ; do the part left of the decimal point
  n = blen - bdpnt
  For i = fdpnt - 1 To 1 Step -1
    char = Mid(Format, i, 1)
    Select char
    Case Chr(35)
      If n > 0
        char = Mid(Buffer, n, 1)
        n - 1
      ElseIf lzero
        char = Chr(48)
      ElseIf nospc
        char = ""
      Else
        char = Chr(32)
      EndIf
    Case Chr(44), Chr(46)
      If n = 0
        If nospc
          char = ""
        Else
          char = Chr(32)
        EndIf
      EndIf
    EndSelect
    result = char + result
  Next
  
  ; do the part right of the decimal point
  n = blen - bdpnt + 2
  For i = fdpnt To flen
    char = Mid(Format, i, 1)
    Select char
    Case Chr(35)
      If n <= blen
        char = Mid(Buffer, n, 1)
        n + 1
      Else
        char = Chr(48)
      EndIf
    EndSelect
    result + char
  Next
  ProcedureReturn result
EndProcedure

Procedure.s Format_mFloatD(Value.d, Format.s)
  Protected decimals.i
  ;find decimal sign (point or comma)
  decimals = Format_mDecPoint(@Format) - 1
  ;convert to string
  If decimals > 0
    ProcedureReturn StrD(Value, decimals)
  EndIf
  ProcedureReturn Str(Value)
EndProcedure

Procedure.s Format_mFloatF(Value.f, Format.s)
  Protected decimals.i
  ;find decimal sign (point or comma)
  decimals = Format_mDecPoint(@Format) - 1
  ;convert to string
  If decimals > 0
    ProcedureReturn StrF(Value, decimals)
  EndIf
  ProcedureReturn Str(Value)
EndProcedure

;- FORMAT PROCEDURES:

Procedure.s FormatD(Value.d, Format.s)
  Protected Buffer.s = Format_mFloatD(Value, Format)
  ProcedureReturn Format_mFormat(Buffer, Format)  
EndProcedure

Procedure.s FormatF(Value.f, Format.s)
  Protected Buffer.s = Format_mFloatF(Value, Format)
  ProcedureReturn Format_mFormat(Buffer, Format)
EndProcedure

Procedure.s FormatI(Value.q, Format.s)
  Protected Buffer.s = Str(Value)
  ProcedureReturn Format_mFormat(Buffer, Format)
EndProcedure

;- EXAMPLES
;{
; -----------------------------------------------------------------------
;
; ;6-digits precision with decimal *point*
; x.d = 33 / 7
; Debug x
; Debug FormatD(x, "#.######")

; ;6-digits precision with decimal *comma*
; x.d = 33 / 7
; Debug x
; Debug FormatD(x, "#,######")

; ;leading zeros
; x.l = 75
; Debug FormatI(x, "0####")

; ;decimal notation with integer
; x.l = 75
; Debug FormatI(x, "$####.##")

; ;remove unused leading placeholders
; x.d = 333 / 7
; Debug x
; Debug FormatD(x, "/####.########")
; ;round to integer
; Debug FormatD(x, "/###")

; currency notation
; OpenConsole()
;   PrintN(FormatD(1.35, "$ #.###.###,##"))
;   PrintN(FormatD(4895.208, "$ #.###.###,##"))
;   ; remove unused digit placeholders
;   PrintN(FormatD(4895.208, "/$ #.###.###,##"))
;   Input()
; CloseConsole()
; -----------------------------------------------------------------------
;}

Re: Native Format$() function similar to or better than spri

Posted: Fri Mar 26, 2010 2:55 pm
by skywalk
Thanks Frarth,
I'll give it a look!

Re: Native Format$() function similar to or better than spri

Posted: Sat Mar 27, 2010 1:27 am
by skywalk
Hi Frarth,
This is good, but I need to express numbers in scientific or engineering notation.
Say in VB6, I would use Format$(12345600, "##.####E+0") --> 12.3456E+6

Re: Native Format$() function similar to or better than spri

Posted: Sat Mar 27, 2010 2:19 am
by ozzie
Thanks, Frarth - this could be useful.

Re: Native Format$() function similar to or better than spri

Posted: Sat Mar 27, 2010 3:21 am
by IdeasVacuum

Re: Native Format$() function similar to or better than spri

Posted: Sat Mar 27, 2010 4:19 pm
by Frarth
skywalk wrote:Hi Frarth,
This is good, but I need to express numbers in scientific or engineering notation.
Say in VB6, I would use Format$(12345600, "##.####E+0") --> 12.3456E+6
It should not be too difficult to add that functionality to the library! You 're free to try. I've never encountered a situation where I needed it.

- Frank

Edit: I 've also posted this library here: http://www.purebasic.fr/english/viewtop ... 12&t=41582
and changed the ByteType to CharacterType, which makes more sense.

Re: Native Format$() function similar to or better than spri

Posted: Sat Mar 27, 2010 5:42 pm
by skywalk
Hi Frarth,
Dealing with many different number ranges, it is extremely useful to express them in an engineering format that allows a constant width and restricts the exponent to a multiple of 3 for the SI units. ie: e+3 = k, e+6 = M, e+9 = G, e-3 = m, etc.

Here is what I came up with given PureBasic does not output exponents in the StrD() function and does not offer a Format() function.

Edit: Freak pointed out IntQ() handles doubles...but, there are still early limits of IntQ() function failing for numbers >~ 1e21. So, changed to Round() function instead.

Code: Select all

Procedure.s StrDe(x.d, numsd.i=6)
  ; REV:  100405, skywalk
  ;Debug StrDE(1.23456e7, 4)   ; " 12.35e+6" <-- fixed widths
  ;Debug StrDE(-1.23456e7, 4)  ; "-12.35e+6" <-- and Exponent in multiples of 3
  ;Debug StrDE(0, 4)           ; "        0" <-- 0 is simplified, not 0.000e+0  
  ; GIVEN: mystring = StrDE(x, numsd)
  ; IN:
  ;   x = real number to be formatted.
  ;   numsd = integer specifying total number of significant digits.
  ;   "aa.bbbe+3" -> 2 + 3 = 5
  ; RETURN:
  ;   string of x with numsd significant digits using engineering notation.
  ; NOTE:
  ;   This version maintains a constant width for any numeric string
  ;   Does not check for x = Infinity(), but does print NaN instead.
  ;   Double -> ±2.2250738585072013e-308 to ±1.7976931348623157e+308
  Protected.i Exp, Sgn
  If x > 0
    Sgn = ' '
  ElseIf x < 0
    Sgn = '-'
    x * -1
  Else          ; Should fill " 000.000e+0", +1 for 'sign', +1 for '.', +3 for 'e+0'
    ProcedureReturn RSet("0", numsd + 5)
  EndIf
  exp = Round(Log10(X),#PB_Round_Down)
  If exp > 0
    exp / 3 * 3
  Else
    exp = (-exp + 3) / 3 * (-3)
  EndIf
  x = x * Pow(10,-exp)
  If x >= 1000
    x / 1000
    exp + 3
  EndIf
  If x >= 100
    numsd - 3
  ElseIf x >= 10
    numsd - 2
  Else
    numsd - 1
  EndIf
  If numsd < 0
    numsd = 0
  EndIf
  If exp < 0
    ProcedureReturn Chr(sgn) + StrD(x, numsd) + "e" + Str(exp)
  Else
    ProcedureReturn Chr(sgn) + StrD(x, numsd) + "e+" + Str(exp)
  EndIf
EndProcedure

;-{ TEST
Dim T$(49)
Define.i k,i,nsp
Define.s r
Restore StringNumerics
Repeat
  Read.s T$(k)
  If T$(k) <> "#EOF"
    If nsp<Len(T$(k))
      nsp = Len(T$(k))+2
    EndIf
    k = k + 1
  EndIf
Until T$(k) = "#EOF"
ReDim T$(k-1)
Debug LSet("S",nsp) + LSet("StrDe(S,5)",nsp) + LSet("StrD(S,5)",nsp)
For i = 0 To k-1
  Debug LSet(T$(i),nsp) + LSet(StrDe(ValD(T$(i)),5),nsp) + LSet(StrD(ValD(T$(i)),5),64)
Next i

DataSection
StringNumerics:
  ; Append up to 50 examples here...
  ;      S                    
  Data.s "0.1234e22"        ; 
  Data.s "0.1234e16"        ; 
  Data.s "1e11"             ; 
  Data.s "1e10"             ;
  Data.s "1e9"              ; 
  Data.s "1e8"              ; 
  Data.s "1e7"              ; 
  Data.s "999"              ; 
  Data.s "-999"             ; 
  Data.s "0"                ; 
  Data.s "0.456e+00"        ; 
  Data.s "1"                ; 
  Data.s "1.1"              ; 
  Data.s "11"               ; 
  Data.s "111"              ; 
  Data.s "0.0"              ; 
  Data.s "+0e0"             ; 
  Data.s "+0.0e0"           ; 
  Data.s "+0.0e+0"          ; 
  Data.s "1.64e-6"          ; 
  Data.s "-123.456e+03"     ; 
  Data.s "-10.9999"         ; 
  Data.s "0.12345678e-7"    ; 
  Data.s "0.4995e-5"        ; 
  Data.s "0.9995"           ; 
  Data.s "0.1234e2"         ; 
  Data.s "0.12345"          ; 
  Data.s "0.123456"         ; 
  Data.s "#EOF"
EndDataSection
;-}