Page 1 of 3
Grouping numbers: 1234 => 12,345
Posted: Mon Jan 15, 2007 9:44 pm
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
Posted: Mon Jan 15, 2007 10:18 pm
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
Posted: Mon Jan 15, 2007 11:44 pm
by Flype
@AND51
this one is not correct :
Debug groupNumber(-123456789) ; output: .123.456.789
Posted: Tue Jan 16, 2007 12:35 am
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)
Posted: Tue Jan 16, 2007 9:25 am
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))
Posted: Tue Jan 16, 2007 9:34 am
by Kaeru Gaman
@Flype
nice one.
... it may be irritating if you end Proc-names with an underscore...
Posted: Tue Jan 16, 2007 10:29 am
by Flype
@kaeru
you can rename it as you want
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.
Posted: Tue Jan 16, 2007 11:02 am
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..
Posted: Tue Jan 16, 2007 12:11 pm
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)
Posted: Tue Jan 16, 2007 3:26 pm
by AND51
Thx for this awful amount replies!
@ Paul: You API-example works just on Windows. However, thank you very, very much for that API-example.
@ Flype: I've corrected my mistake.
Posted: Tue Jan 16, 2007 3:37 pm
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
Posted: Tue Jan 16, 2007 3:42 pm
by AND51
> i know you like recursive functions
I feel observed...
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...
Posted: Tue Jan 16, 2007 3:52 pm
by Flype
good luck
Posted: Tue Jan 16, 2007 4:52 pm
by Flype
Posted: Tue Jan 16, 2007 5:07 pm
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...