Grouping numbers: 1234 => 12,345

Share your advanced PureBasic knowledge/code with the community.
Post Reply
AND51
Addict
Addict
Posts: 1040
Joined: Sun Oct 15, 2006 8:56 pm
Location: Germany
Contact:
Contact AND51

Grouping numbers: 1234 => 12,345

Post by AND51 »

Code updated for 5.20+

Hello!

I've updated my code which groups high numbers:
100 => 100
1000 => 1.000
-65536 => -65,536
The separator can be chosen at will. This us useful, because of the different languages world-wide. The germans use a dot "." to group the numbers; however, the english use a comma ",".

My procedure supports quads, ASCII+Unicode.

Code: Select all

Procedure.s groupNumber(number.q, separator.s=".")
  If number > -1000 And number < 1000
    ProcedureReturn Str(number)
  EndIf
  Protected number$=RemoveString(Str(number), "-"), start.l=Len(number$)%3, res.s=PeekS(@number$, start), n.l
  For n=start To Len(number$)-start-1 Step 3
    res+separator+PeekS(@number$+n*SizeOf(Character), 3*SizeOf(Character))
  Next
  If start
    If number < 0
      res="-"+res
    EndIf
    ProcedureReturn res
  Else
    If number < 0
      ProcedureReturn "-"+PeekS(@res+Len(separator)*SizeOf(Character))
    Else
      ProcedureReturn PeekS(@res+Len(separator)*SizeOf(Character))
    EndIf
  EndIf
EndProcedure


Debug groupNumber(1234567890)
Debug groupNumber(123456789)
Debug groupNumber(12345678)
Debug groupNumber(1234567)
Debug groupNumber(123456)
Debug groupNumber(12345)
Debug groupNumber(1234)
Debug groupNumber(123)
Debug groupNumber(12)
Debug groupNumber(1)
Debug groupNumber(0)
Debug groupNumber(-1)
Debug groupNumber(-12)
Debug groupNumber(-123)
Debug groupNumber(-1234)
Debug groupNumber(-12345)
Debug groupNumber(-123456)
Debug groupNumber(-1234567)
Debug groupNumber(-12345678)
Debug groupNumber(-123456789)
Debug groupNumber(-1234567890)
Edit: bug, when start=0 *FIXED*


A procedure which is very short (ASCII only) can be found on page 1 of this german forum thread: http://www.purebasic.fr/german/viewtopi ... ight=AND51
Last edited by AND51 on Tue Jan 16, 2007 2:31 pm, edited 1 time in total.
PB 4.30

Code: Select all

onErrorGoto(?Fred)
Top
User avatar
Paul
PureBasic Expert
PureBasic Expert
Posts: 1285
Joined: Fri Apr 25, 2003 4:34 pm
Location: Canada
Contact:
Contact Paul

Post by Paul »

API version that uses system defaults for number formatting...

Code: Select all

Procedure.s FormatNumber(Number.q)
  Buffer.s=Space(255)
  GetNumberFormat_(0,0,StrQ(Number),0,@Buffer,Len(Buffer))
  ProcedureReturn Buffer
EndProcedure

API version if you want to customize the formatting...

Code: Select all

Procedure.s FormatNumber(Number.q)
  Buffer.s=Space(255)
  NF.NUMBERFMT\NumDigits=0   ;number of decimal places to use
  NF\Grouping=3   ;how many numbers before a seperator is used
  NF\lpDecimalSep=@"."   ;decimal seperator character
  NF\lpThousandSep=@","   ;group seperator
  NF\NegativeOrder= 1   ;lookup LOCALE_INEGNUMBER for all options
  GetNumberFormat_(0,0,StrQ(Number),NF,@Buffer,Len(Buffer))
  ProcedureReturn Buffer
EndProcedure
Last edited by Paul on Wed Jan 17, 2007 12:16 am, edited 1 time in total.
Image Image
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

@AND51

this one is not correct :

Debug groupNumber(-123456789) ; output: .123.456.789
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

just for the challenge,

here is my recursive version of the function
this one supports Quad, Ansi, Unicode, MultiChar Separator, GroupBy.

Code: Select all

Procedure.s StrGroup_(tmp.s, sep.s, n.l, res.s)
  If tmp = "-" 
    res = tmp + res
  ElseIf tmp
    If res
      res = sep + res
    EndIf
    ProcedureReturn StrGroup_(Left(tmp, Len(tmp)-n), sep, n, Right(tmp, n) + res)
  EndIf
  ProcedureReturn res
EndProcedure


Macro StrGroup(number, separator = " . ", group = 3)
  StrGroup_(StrQ(number), separator, group, "")
EndMacro

Debug StrGroup(1234567890)
Debug StrGroup(123456789)
Debug StrGroup(12345678)
Debug StrGroup(1234567)
Debug StrGroup(123456)
Debug StrGroup(12345)
Debug StrGroup(1234)
Debug StrGroup(123)
Debug StrGroup(12)
Debug StrGroup(1)
Debug StrGroup(0)
Debug StrGroup(-1)
Debug StrGroup(-12)
Debug StrGroup(-123)
Debug StrGroup(-1234)
Debug StrGroup(-12345)
Debug StrGroup(-123456)
Debug StrGroup(-1234567)
Debug StrGroup(-12345678)
Debug StrGroup(-123456789)
Debug StrGroup(-1234567890)
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
User avatar
Shardik
Addict
Addict
Posts: 2060
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Post by Shardik »

@Paul:

Thank you for your fine API example. But in the second example there is a small mistake. In order to actually use your defined NUMBERFMT structure you have to provide the pointer to this structure instead of Null:

Code: Select all

GetNumberFormat_(0,0,StrQ(Number),@NF,@Buffer,Len(Buffer))
Top
User avatar
Kaeru Gaman
Addict
Addict
Posts: 4826
Joined: Sun Mar 19, 2006 1:57 pm
Location: Germany

Post by Kaeru Gaman »

@Flype

nice one.

... it may be irritating if you end Proc-names with an underscore...
oh... and have a nice day.
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

@kaeru

you can rename it as you want :wink:

i tested the speed of each procs, all are acceptables,
even my recursive one which is fast enough.

i think the best one is the Win32 function because it can also process decimal number.
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
User avatar
Kaeru Gaman
Addict
Addict
Posts: 4826
Joined: Sun Mar 19, 2006 1:57 pm
Location: Germany

Post by Kaeru Gaman »

> i think the best one is the Win32 function because it can also process decimal number.

perhaps you should extend you function to process them, too?

I bet the Linux or Mac user would aprecciate it.. ;)
oh... and have a nice day.
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

Kaeru Gaman wrote:> i think the best one is the Win32 function because it can also process decimal number.

perhaps you should extend you function to process them, too?

I bet the Linux or Mac user would aprecciate it.. ;)

Maybe this one - not much tested (no time) :

Code: Select all

; Supports Double, Quad, Ansi, Unicode, ThousandSep, DecimalSep, Grouping, NumDigits. 

Procedure.s StrNum(NumLeft.s, NumRight.s, ThousandSep.s, DecimalSep.s, Grouping.l, result.s) ; reserved.
  If NumLeft = "-"
    result = NumLeft + result
  ElseIf NumLeft
    If result
      result = ThousandSep + result
    EndIf
    ProcedureReturn StrNum(Left(NumLeft, Len(NumLeft)-Grouping), NumRight, ThousandSep, DecimalSep, Grouping, Right(NumLeft, Grouping) + result)
  EndIf
  If NumRight
    result + DecimalSep + NumRight
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s StrNumQ(Value.q, ThousandSep.s = ",", Grouping.l = 3) ; main.
  ProcedureReturn StrNum(StrQ(Value), "", ThousandSep, "", Grouping, "")
EndProcedure

Procedure.s StrNumD(Value.d, ThousandSep.s = ",", DecimalSep.s = ".", Grouping.l = 3, NumDigits.l = 4) ; main.
  ProcedureReturn StrNum(StringField(StrD(Value), 1, "."), StringField(StrD(Value, NumDigits), 2, "."), ThousandSep, DecimalSep, Grouping, "")
EndProcedure

Debug StrNumQ(1234567890)
Debug StrNumQ(123456789)
Debug StrNumQ(12345678)
Debug StrNumQ(1234567)
Debug StrNumQ(123456)
Debug StrNumQ(12345)
Debug StrNumQ(1234)
Debug StrNumQ(123)
Debug StrNumQ(12)
Debug StrNumQ(1)
Debug StrNumQ(0)
Debug StrNumQ(-1)
Debug StrNumQ(-12)
Debug StrNumQ(-123)
Debug StrNumQ(-1234)
Debug StrNumQ(-12345)
Debug StrNumQ(-123456)
Debug StrNumQ(-1234567)
Debug StrNumQ(-12345678)
Debug StrNumQ(-123456789)
Debug StrNumQ(-1234567890)
Debug "=============================="
Debug StrNumD(1234567890.12345)
Debug StrNumD(123456789.12345)
Debug StrNumD(12345678.12345)
Debug StrNumD(1234567.12345)
Debug StrNumD(123456.12345)
Debug StrNumD(12345.12345)
Debug StrNumD(1234.12345)
Debug StrNumD(123.12345)
Debug StrNumD(12.12345)
Debug StrNumD(1.12345)
Debug StrNumD(0.12345)
Debug StrNumD(-1.12345)
Debug StrNumD(-12.12345)
Debug StrNumD(-123.12345)
Debug StrNumD(-1234.12345)
Debug StrNumD(-12345.12345)
Debug StrNumD(-123456.12345)
Debug StrNumD(-1234567.12345)
Debug StrNumD(-12345678.12345)
Debug StrNumD(-123456789.12345)
Debug StrNumD(-1234567890.12345)
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
AND51
Addict
Addict
Posts: 1040
Joined: Sun Oct 15, 2006 8:56 pm
Location: Germany
Contact:
Contact AND51

Post by AND51 »

Thx for this awful amount replies! :shock:

@ Paul: You API-example works just on Windows. However, thank you very, very much for that API-example.

@ Flype: I've corrected my mistake.
Last edited by AND51 on Tue Jan 16, 2007 3:40 pm, edited 1 time in total.
PB 4.30

Code: Select all

onErrorGoto(?Fred)
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

the first quote is for 'Paul' :!: [CORRECTED]


and what do you think about my last recursive function ?
i know you like recursive functions :wink:
Last edited by Flype on Tue Jan 16, 2007 3:50 pm, edited 1 time in total.
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
AND51
Addict
Addict
Posts: 1040
Joined: Sun Oct 15, 2006 8:56 pm
Location: Germany
Contact:
Contact AND51

Post by AND51 »

> i know you like recursive functions
I feel observed... :wink: You're right.

I've just tested your 11-line code, well done! I'm currently working on an own procedure. Recursive or not, I just wanna beat your procedure... :P
PB 4.30

Code: Select all

onErrorGoto(?Fred)
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

good luck :twisted:
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

Optimized - 9 lines.

Code: Select all

removed
Last edited by Flype on Tue Jan 16, 2007 10:30 pm, edited 2 times in total.
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
AND51
Addict
Addict
Posts: 1040
Joined: Sun Oct 15, 2006 8:56 pm
Location: Germany
Contact:
Contact AND51

Post by AND51 »

Can't you put everything into 1 procedure?
If I searched for some group-number-code, I wouldn't use your 2 macros+1 procedure...
PB 4.30

Code: Select all

onErrorGoto(?Fred)
Top
Post Reply

Return to “Tricks 'n' Tips”