From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Richard Todd Newsgroups: gmane.lisp.guile.user Subject: number->string radix patch (Was Re: First look at Guile Std Library available) Date: Tue, 6 Jan 2004 12:41:16 -0600 Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Message-ID: <20040106184116.GA7618@Richard-Todds-Computer.local> References: <20040103221857.GA518@Richard-Todds-Computer.local> <20040104035022.GA742@Richard-Todds-Computer.local> <3FF88AD5.6010701@vzavenue.net> <87isjr1bkb.fsf@alice.rotty.yi.org> <3FF8EF71.6090802@vzavenue.net> <20040105200131.GA492@Richard-Todds-Computer.local> Reply-To: Richard Todd NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="===============1021600261==" X-Trace: sea.gmane.org 1073415171 24709 80.91.224.253 (6 Jan 2004 18:52:51 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 6 Jan 2004 18:52:51 +0000 (UTC) Cc: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Tue Jan 06 19:52:46 2004 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1AdwJq-0002WX-00 for ; Tue, 06 Jan 2004 19:52:46 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AdxGs-000762-Pa for guile-user@m.gmane.org; Tue, 06 Jan 2004 14:53:46 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1AdxF6-00073f-GW for guile-user@gnu.org; Tue, 06 Jan 2004 14:51:56 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AdxDy-0006XO-Gc for guile-user@gnu.org; Tue, 06 Jan 2004 14:51:17 -0500 Original-Received: from [199.232.41.8] (helo=mx20.gnu.org) by monty-python.gnu.org with esmtp (TLSv1:DES-CBC3-SHA:168) (Exim 4.24) id 1AdxDw-0004Qo-QA for guile-user@gnu.org; Tue, 06 Jan 2004 14:50:44 -0500 Original-Received: from [66.171.156.242] (helo=Richard-Todds-Computer.local) by mx20.gnu.org with esmtp (Exim 4.24) id 1Adw8k-0001a0-9J for guile-user@gnu.org; Tue, 06 Jan 2004 13:41:18 -0500 Original-Received: by Richard-Todds-Computer.local (Postfix, from userid 501) id 9F1E980720; Tue, 6 Jan 2004 12:41:16 -0600 (CST) Original-To: Robert Uhl In-Reply-To: User-Agent: Mutt/1.4i X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.user:2543 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.user:2543 --===============1021600261== Content-Type: multipart/signed; micalg=pgp-sha1; protocol="application/pgp-signature"; boundary="TRYliJ5NKNqkz5bu" Content-Disposition: inline --TRYliJ5NKNqkz5bu Content-Type: multipart/mixed; boundary="+QahgC5+KEYLbs62" Content-Disposition: inline --+QahgC5+KEYLbs62 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-Transfer-Encoding: quoted-printable On Mon, Jan 05, 2004 at 06:36:07PM -0700, Robert Uhl wrote: > Although my one true project is to figure out number->string well enough > to make it Do the Right Thing for decimals in bases other than 10 (I'm a > big fan of duodecimal). I've seen this wish twice from you in the short time I've been watching guile-user, so I took a crack at it. You are right, the algorithm is hard to follow, but I think I worked it out. I only tested it by typing in random numbers and eyeballing the results, so if you don't mind try it out and let me know if you get bad answers. The patch should apply to CVS guile. (supports the full 2 -> 36 radix range that integers enjoyed) (PS I used CAPS for the letters since, as the last two examples show, you need a way to differentiate the 'e' and 'i' from the digits in the number. Should this patch ever make it into guile, maybe all string->number operations should switch to uppercase.) Example: guile> (number->string 35.25 36) "Z.9" guile> (number->string 0.25 2) "0.01" guile> (number->string 255.0625 16) "FF.1" guile> (number->string (/ 1 3) 3) "1/10" guile> (number->string 11.33333333333333333 12) "B.4" guile> (number->string 11.33333333333333333+23i 12) "B.4+1B.0i" guile> (number->string 1.324e44 16) "5.EFE0A14FAFEe24" Richard Todd=20 richardt at vzavenue dot net --+QahgC5+KEYLbs62 Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="radix.patch" Content-Transfer-Encoding: quoted-printable Index: libguile/numbers.c =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/numbers.c,v retrieving revision 1.220 diff -u -r1.220 numbers.c --- libguile/numbers.c 3 Jan 2004 21:38:38 -0000 1.220 +++ libguile/numbers.c 6 Jan 2004 18:13:50 -0000 @@ -91,7 +91,7 @@ /* FLOBUFLEN is the maximum number of characters neccessary for the * printed or scm_string representation of an inexact number. */ -#define FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10) +#define FLOBUFLEN (40+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10) =20 #if defined (SCO) #if ! defined (HAVE_ISNAN) @@ -1848,19 +1848,71 @@ #undef FUNC_NAME =20 /*** NUMBERS -> STRINGS ***/ -int scm_dblprec; -static const double fx[] =3D -{ 0.0, 5e-1, 5e-2, 5e-3, 5e-4, 5e-5, - 5e-6, 5e-7, 5e-8, 5e-9, 5e-10, - 5e-11, 5e-12, 5e-13, 5e-14, 5e-15, - 5e-16, 5e-17, 5e-18, 5e-19, 5e-20}; +#define SCM_MAX_DBL_PREC 60 +#define SCM_MAX_DBL_RADIX 36 + +/* this is an array starting with radix 2, and ending with radix SCM_MAX_D= BL_RADIX */ +static int scm_dblprec[SCM_MAX_DBL_RADIX - 1]; +static double fx_per_radix[SCM_MAX_DBL_RADIX - 1][SCM_MAX_DBL_PREC]; + +static +void init_dblprec(int *prec, int radix) { + /* determine floating point precision by adding successively + smaller increments to 1.0 until it is considered =3D=3D 1.0 */ + double f =3D ((double)1.0)/radix; + double fsum =3D 1.0 + f; + + *prec =3D 0; + while (fsum !=3D 1.0) + { + if (++(*prec) > SCM_MAX_DBL_PREC) + fsum =3D 1.0; + else + { + f /=3D radix; + fsum =3D f + 1.0; + } + } + (*prec) -=3D 1; +} + +static +void init_fx_radix(double *fx_list, int radix) +{ + /* initialize a per-radix list of tolerances. When added + to a number < 1.0, we can determine if we should raund + up and quit converting a number to a string. */ + int i; + fx_list[0] =3D 0.0; + fx_list[1] =3D 0.5; + for( i =3D 2 ; i < SCM_MAX_DBL_PREC; ++i )=20 + fx_list[i] =3D (fx_list[i-1] / radix); +} + +/* use this array as a way to generate a single digit */ +static const char*number_chars=3D"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; =20 static size_t -idbl2str (double f, char *a) +idbl2str (double f, char *a, int radix) { - int efmt, dpt, d, i, wp =3D scm_dblprec; - size_t ch =3D 0; - int exp =3D 0; + int efmt, dpt, d, i, wp; + double *fx; +#ifdef DBL_MIN_10_EXP + double f_cpy; + int exp_cpy; +#endif /* DBL_MIN_10_EXP */ + size_t ch =3D 0; + int exp =3D 0; + + if(radix < 2 ||=20 + radix > SCM_MAX_DBL_RADIX) + { + /* revert to existing behavior */ + radix =3D 10; + } + + wp =3D scm_dblprec[radix-2]; + fx =3D fx_per_radix[radix-2]; =20 if (f =3D=3D 0.0) { @@ -1870,7 +1922,6 @@ if (sgn < 0.0) a[ch++] =3D '-'; #endif - goto zero; /*{a[0]=3D'0'; a[1]=3D'.'; a[2]=3D'0'; return 3;} */ } =20 @@ -1896,10 +1947,15 @@ =20 #ifdef DBL_MIN_10_EXP /* Prevent unnormalized values, as from=20 make-uniform-vector, from causing infinite loops. */ - while (f < 1.0) + /* just do the checking...if it passes, we do the conversion for our + radix again below */ + f_cpy =3D f; + exp_cpy =3D exp; + + while (f_cpy < 1.0) { - f *=3D 10.0; - if (exp-- < DBL_MIN_10_EXP) + f_cpy *=3D 10.0; + if (exp_cpy-- < DBL_MIN_10_EXP) { a[ch++] =3D '#'; a[ch++] =3D '.'; @@ -1907,10 +1963,10 @@ return ch; } } - while (f > 10.0) + while (f_cpy > 10.0) { - f *=3D 0.10; - if (exp++ > DBL_MAX_10_EXP) + f_cpy *=3D 0.10; + if (exp_cpy++ > DBL_MAX_10_EXP) { a[ch++] =3D '#'; a[ch++] =3D '.'; @@ -1918,25 +1974,27 @@ return ch; } } -#else +#endif + while (f < 1.0) { - f *=3D 10.0; + f *=3D radix; exp--; } - while (f > 10.0) + while (f > radix) { - f /=3D 10.0; + f /=3D radix; exp++; } -#endif - if (f + fx[wp] >=3D 10.0) + + if (f + fx[wp] >=3D radix) { f =3D 1.0; exp++; } zero: -#ifdef ENGNOT +#ifdef ENGNOT=20 + /* adding 9999 makes this equivalent to abs(x) % 3 */ dpt =3D (exp + 9999) % 3; exp -=3D dpt++; efmt =3D 1; @@ -1963,15 +2021,15 @@ { d =3D f; f -=3D d; - a[ch++] =3D d + '0'; + a[ch++] =3D number_chars[d]; if (f < fx[wp]) break; if (f + fx[wp] >=3D 1.0) { - a[ch - 1]++; + a[ch - 1] =3D number_chars[d+1];=20 break; } - f *=3D 10.0; + f *=3D radix; if (!(--dpt)) a[ch++] =3D '.'; } @@ -2006,26 +2064,25 @@ exp =3D -exp; a[ch++] =3D '-'; } - for (i =3D 10; i <=3D exp; i *=3D 10); - for (i /=3D 10; i; i /=3D 10) + for (i =3D radix; i <=3D exp; i *=3D radix); + for (i /=3D radix; i; i /=3D radix) { - a[ch++] =3D exp / i + '0'; + a[ch++] =3D number_chars[exp / i]; exp %=3D i; } } return ch; } =20 - static size_t -iflo2str (SCM flt, char *str) +iflo2str (SCM flt, char *str, int radix) { size_t i; if (SCM_REALP (flt)) - i =3D idbl2str (SCM_REAL_VALUE (flt), str); + i =3D idbl2str (SCM_REAL_VALUE (flt), str, radix); else { - i =3D idbl2str (SCM_COMPLEX_REAL (flt), str); + i =3D idbl2str (SCM_COMPLEX_REAL (flt), str, radix); if (SCM_COMPLEX_IMAG (flt) !=3D 0.0) { double imag =3D SCM_COMPLEX_IMAG (flt); @@ -2033,7 +2090,7 @@ NaN. They will provide their own sign. */ if (0 <=3D imag && !xisinf (imag) && !xisnan (imag)) str[i++] =3D '+'; - i +=3D idbl2str (imag, &str[i]); + i +=3D idbl2str (imag, &str[i], radix); str[i++] =3D 'i'; } } @@ -2114,7 +2171,7 @@ else if (SCM_INEXACTP (n)) { char num_buf [FLOBUFLEN]; - return scm_mem2string (num_buf, iflo2str (n, num_buf)); + return scm_mem2string (num_buf, iflo2str (n, num_buf, base)); } else SCM_WRONG_TYPE_ARG (1, n); @@ -2129,7 +2186,7 @@ scm_print_real (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port); + scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port); return !0; } =20 @@ -2138,7 +2195,7 @@ =20 { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port); + scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port); return !0; } =20 @@ -5538,13 +5595,12 @@ #undef FUNC_NAME =20 #endif - void scm_init_numbers () { + int i; abs_most_negative_fixnum =3D scm_i_long2big (- SCM_MOST_NEGATIVE_FIXNUM); scm_permanent_object (abs_most_negative_fixnum); - mpz_init_set_si (z_negative_one, -1); =20 /* It may be possible to tune the performance of some algorithms by using @@ -5559,25 +5615,17 @@ scm_add_feature ("complex"); scm_add_feature ("inexact"); scm_flo0 =3D scm_make_real (0.0); + + /* determine floating point precision */ + for(i=3D2; i <=3D SCM_MAX_DBL_RADIX; ++i) + { + init_dblprec(&scm_dblprec[i-2],i); + init_fx_radix(fx_per_radix[i-2],i); + } #ifdef DBL_DIG - scm_dblprec =3D (DBL_DIG > 20) ? 20 : DBL_DIG; -#else - { /* determine floating point precision */ - double f =3D 0.1; - double fsum =3D 1.0 + f; - while (fsum !=3D 1.0) - { - if (++scm_dblprec > 20) - fsum =3D 1.0; - else - { - f /=3D 10.0; - fsum =3D f + 1.0; - } - } - scm_dblprec =3D scm_dblprec - 1; - } -#endif /* DBL_DIG */ + /* hard code precision for base 10 if the preprocessor tells us to... */ + scm_dblprec[10-2] =3D (DBL_DIG > 20) ? 20 : DBL_DIG; +#endif =20 #ifdef GUILE_DEBUG check_sanity (); --+QahgC5+KEYLbs62-- --TRYliJ5NKNqkz5bu Content-Type: application/pgp-signature Content-Disposition: inline -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.3 (Darwin) iD8DBQE/+wFLa9lhNGIqsRIRAmliAJ4y3/wnY/mtuwyM2TDr8Ax2mfBdzgCdEMOn NhOi7kBt/56aFo9wvzIG6k4= =cAYN -----END PGP SIGNATURE----- --TRYliJ5NKNqkz5bu-- --===============1021600261== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-user mailing list Guile-user@gnu.org http://mail.gnu.org/mailman/listinfo/guile-user --===============1021600261==--