src/glplib03.c
author Alpar Juttner <alpar@cs.elte.hu>
Mon, 06 Dec 2010 13:09:21 +0100
changeset 1 c445c931472f
permissions -rw-r--r--
Import glpk-4.45

- Generated files and doc/notes are removed
alpar@1
     1
/* glplib03.c (miscellaneous library routines) */
alpar@1
     2
alpar@1
     3
/***********************************************************************
alpar@1
     4
*  This code is part of GLPK (GNU Linear Programming Kit).
alpar@1
     5
*
alpar@1
     6
*  Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
alpar@1
     7
*  2009, 2010 Andrew Makhorin, Department for Applied Informatics,
alpar@1
     8
*  Moscow Aviation Institute, Moscow, Russia. All rights reserved.
alpar@1
     9
*  E-mail: <mao@gnu.org>.
alpar@1
    10
*
alpar@1
    11
*  GLPK is free software: you can redistribute it and/or modify it
alpar@1
    12
*  under the terms of the GNU General Public License as published by
alpar@1
    13
*  the Free Software Foundation, either version 3 of the License, or
alpar@1
    14
*  (at your option) any later version.
alpar@1
    15
*
alpar@1
    16
*  GLPK is distributed in the hope that it will be useful, but WITHOUT
alpar@1
    17
*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
alpar@1
    18
*  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
alpar@1
    19
*  License for more details.
alpar@1
    20
*
alpar@1
    21
*  You should have received a copy of the GNU General Public License
alpar@1
    22
*  along with GLPK. If not, see <http://www.gnu.org/licenses/>.
alpar@1
    23
***********************************************************************/
alpar@1
    24
alpar@1
    25
#include "glpenv.h"
alpar@1
    26
#include "glplib.h"
alpar@1
    27
alpar@1
    28
/***********************************************************************
alpar@1
    29
*  NAME
alpar@1
    30
*
alpar@1
    31
*  str2int - convert character string to value of int type
alpar@1
    32
*
alpar@1
    33
*  SYNOPSIS
alpar@1
    34
*
alpar@1
    35
*  #include "glplib.h"
alpar@1
    36
*  int str2int(const char *str, int *val);
alpar@1
    37
*
alpar@1
    38
*  DESCRIPTION
alpar@1
    39
*
alpar@1
    40
*  The routine str2int converts the character string str to a value of
alpar@1
    41
*  integer type and stores the value into location, which the parameter
alpar@1
    42
*  val points to (in the case of error content of this location is not
alpar@1
    43
*  changed).
alpar@1
    44
*
alpar@1
    45
*  RETURNS
alpar@1
    46
*
alpar@1
    47
*  The routine returns one of the following error codes:
alpar@1
    48
*
alpar@1
    49
*  0 - no error;
alpar@1
    50
*  1 - value out of range;
alpar@1
    51
*  2 - character string is syntactically incorrect. */
alpar@1
    52
alpar@1
    53
int str2int(const char *str, int *_val)
alpar@1
    54
{     int d, k, s, val = 0;
alpar@1
    55
      /* scan optional sign */
alpar@1
    56
      if (str[0] == '+')
alpar@1
    57
         s = +1, k = 1;
alpar@1
    58
      else if (str[0] == '-')
alpar@1
    59
         s = -1, k = 1;
alpar@1
    60
      else
alpar@1
    61
         s = +1, k = 0;
alpar@1
    62
      /* check for the first digit */
alpar@1
    63
      if (!isdigit((unsigned char)str[k])) return 2;
alpar@1
    64
      /* scan digits */
alpar@1
    65
      while (isdigit((unsigned char)str[k]))
alpar@1
    66
      {  d = str[k++] - '0';
alpar@1
    67
         if (s > 0)
alpar@1
    68
         {  if (val > INT_MAX / 10) return 1;
alpar@1
    69
            val *= 10;
alpar@1
    70
            if (val > INT_MAX - d) return 1;
alpar@1
    71
            val += d;
alpar@1
    72
         }
alpar@1
    73
         else
alpar@1
    74
         {  if (val < INT_MIN / 10) return 1;
alpar@1
    75
            val *= 10;
alpar@1
    76
            if (val < INT_MIN + d) return 1;
alpar@1
    77
            val -= d;
alpar@1
    78
         }
alpar@1
    79
      }
alpar@1
    80
      /* check for terminator */
alpar@1
    81
      if (str[k] != '\0') return 2;
alpar@1
    82
      /* conversion has been done */
alpar@1
    83
      *_val = val;
alpar@1
    84
      return 0;
alpar@1
    85
}
alpar@1
    86
alpar@1
    87
/***********************************************************************
alpar@1
    88
*  NAME
alpar@1
    89
*
alpar@1
    90
*  str2num - convert character string to value of double type
alpar@1
    91
*
alpar@1
    92
*  SYNOPSIS
alpar@1
    93
*
alpar@1
    94
*  #include "glplib.h"
alpar@1
    95
*  int str2num(const char *str, double *val);
alpar@1
    96
*
alpar@1
    97
*  DESCRIPTION
alpar@1
    98
*
alpar@1
    99
*  The routine str2num converts the character string str to a value of
alpar@1
   100
*  double type and stores the value into location, which the parameter
alpar@1
   101
*  val points to (in the case of error content of this location is not
alpar@1
   102
*  changed).
alpar@1
   103
*
alpar@1
   104
*  RETURNS
alpar@1
   105
*
alpar@1
   106
*  The routine returns one of the following error codes:
alpar@1
   107
*
alpar@1
   108
*  0 - no error;
alpar@1
   109
*  1 - value out of range;
alpar@1
   110
*  2 - character string is syntactically incorrect. */
alpar@1
   111
alpar@1
   112
int str2num(const char *str, double *_val)
alpar@1
   113
{     int k;
alpar@1
   114
      double val;
alpar@1
   115
      /* scan optional sign */
alpar@1
   116
      k = (str[0] == '+' || str[0] == '-' ? 1 : 0);
alpar@1
   117
      /* check for decimal point */
alpar@1
   118
      if (str[k] == '.')
alpar@1
   119
      {  k++;
alpar@1
   120
         /* a digit should follow it */
alpar@1
   121
         if (!isdigit((unsigned char)str[k])) return 2;
alpar@1
   122
         k++;
alpar@1
   123
         goto frac;
alpar@1
   124
      }
alpar@1
   125
      /* integer part should start with a digit */
alpar@1
   126
      if (!isdigit((unsigned char)str[k])) return 2;
alpar@1
   127
      /* scan integer part */
alpar@1
   128
      while (isdigit((unsigned char)str[k])) k++;
alpar@1
   129
      /* check for decimal point */
alpar@1
   130
      if (str[k] == '.') k++;
alpar@1
   131
frac: /* scan optional fraction part */
alpar@1
   132
      while (isdigit((unsigned char)str[k])) k++;
alpar@1
   133
      /* check for decimal exponent */
alpar@1
   134
      if (str[k] == 'E' || str[k] == 'e')
alpar@1
   135
      {  k++;
alpar@1
   136
         /* scan optional sign */
alpar@1
   137
         if (str[k] == '+' || str[k] == '-') k++;
alpar@1
   138
         /* a digit should follow E, E+ or E- */
alpar@1
   139
         if (!isdigit((unsigned char)str[k])) return 2;
alpar@1
   140
      }
alpar@1
   141
      /* scan optional exponent part */
alpar@1
   142
      while (isdigit((unsigned char)str[k])) k++;
alpar@1
   143
      /* check for terminator */
alpar@1
   144
      if (str[k] != '\0') return 2;
alpar@1
   145
      /* perform conversion */
alpar@1
   146
      {  char *endptr;
alpar@1
   147
         val = strtod(str, &endptr);
alpar@1
   148
         if (*endptr != '\0') return 2;
alpar@1
   149
      }
alpar@1
   150
      /* check for overflow */
alpar@1
   151
      if (!(-DBL_MAX <= val && val <= +DBL_MAX)) return 1;
alpar@1
   152
      /* check for underflow */
alpar@1
   153
      if (-DBL_MIN < val && val < +DBL_MIN) val = 0.0;
alpar@1
   154
      /* conversion has been done */
alpar@1
   155
      *_val = val;
alpar@1
   156
      return 0;
alpar@1
   157
}
alpar@1
   158
alpar@1
   159
/***********************************************************************
alpar@1
   160
*  NAME
alpar@1
   161
*
alpar@1
   162
*  strspx - remove all spaces from character string
alpar@1
   163
*
alpar@1
   164
*  SYNOPSIS
alpar@1
   165
*
alpar@1
   166
*  #include "glplib.h"
alpar@1
   167
*  char *strspx(char *str);
alpar@1
   168
*
alpar@1
   169
*  DESCRIPTION
alpar@1
   170
*
alpar@1
   171
*  The routine strspx removes all spaces from the character string str.
alpar@1
   172
*
alpar@1
   173
*  RETURNS
alpar@1
   174
*
alpar@1
   175
*  The routine returns a pointer to the character string.
alpar@1
   176
*
alpar@1
   177
*  EXAMPLES
alpar@1
   178
*
alpar@1
   179
*  strspx("   Errare   humanum   est   ") => "Errarehumanumest"
alpar@1
   180
*
alpar@1
   181
*  strspx("      ")                       => "" */
alpar@1
   182
alpar@1
   183
char *strspx(char *str)
alpar@1
   184
{     char *s, *t;
alpar@1
   185
      for (s = t = str; *s; s++) if (*s != ' ') *t++ = *s;
alpar@1
   186
      *t = '\0';
alpar@1
   187
      return str;
alpar@1
   188
}
alpar@1
   189
alpar@1
   190
/***********************************************************************
alpar@1
   191
*  NAME
alpar@1
   192
*
alpar@1
   193
*  strtrim - remove trailing spaces from character string
alpar@1
   194
*
alpar@1
   195
*  SYNOPSIS
alpar@1
   196
*
alpar@1
   197
*  #include "glplib.h"
alpar@1
   198
*  char *strtrim(char *str);
alpar@1
   199
*
alpar@1
   200
*  DESCRIPTION
alpar@1
   201
*
alpar@1
   202
*  The routine strtrim removes trailing spaces from the character
alpar@1
   203
*  string str.
alpar@1
   204
*
alpar@1
   205
*  RETURNS
alpar@1
   206
*
alpar@1
   207
*  The routine returns a pointer to the character string.
alpar@1
   208
*
alpar@1
   209
*  EXAMPLES
alpar@1
   210
*
alpar@1
   211
*  strtrim("Errare humanum est   ") => "Errare humanum est"
alpar@1
   212
*
alpar@1
   213
*  strtrim("      ")                => "" */
alpar@1
   214
alpar@1
   215
char *strtrim(char *str)
alpar@1
   216
{     char *t;
alpar@1
   217
      for (t = strrchr(str, '\0') - 1; t >= str; t--)
alpar@1
   218
      {  if (*t != ' ') break;
alpar@1
   219
         *t = '\0';
alpar@1
   220
      }
alpar@1
   221
      return str;
alpar@1
   222
}
alpar@1
   223
alpar@1
   224
/***********************************************************************
alpar@1
   225
*  NAME
alpar@1
   226
*
alpar@1
   227
*  strrev - reverse character string
alpar@1
   228
*
alpar@1
   229
*  SYNOPSIS
alpar@1
   230
*
alpar@1
   231
*  #include "glplib.h"
alpar@1
   232
*  char *strrev(char *s);
alpar@1
   233
*
alpar@1
   234
*  DESCRIPTION
alpar@1
   235
*
alpar@1
   236
*  The routine strrev changes characters in a character string s to the
alpar@1
   237
*  reverse order, except the terminating null character.
alpar@1
   238
*
alpar@1
   239
*  RETURNS
alpar@1
   240
*
alpar@1
   241
*  The routine returns the pointer s.
alpar@1
   242
*
alpar@1
   243
*  EXAMPLES
alpar@1
   244
*
alpar@1
   245
*  strrev("")                => ""
alpar@1
   246
*
alpar@1
   247
*  strrev("Today is Monday") => "yadnoM si yadoT" */
alpar@1
   248
alpar@1
   249
char *strrev(char *s)
alpar@1
   250
{     int i, j;
alpar@1
   251
      char t;
alpar@1
   252
      for (i = 0, j = strlen(s)-1; i < j; i++, j--)
alpar@1
   253
         t = s[i], s[i] = s[j], s[j] = t;
alpar@1
   254
      return s;
alpar@1
   255
}
alpar@1
   256
alpar@1
   257
/***********************************************************************
alpar@1
   258
*  NAME
alpar@1
   259
*
alpar@1
   260
*  gcd - find greatest common divisor of two integers
alpar@1
   261
*
alpar@1
   262
*  SYNOPSIS
alpar@1
   263
*
alpar@1
   264
*  #include "glplib.h"
alpar@1
   265
*  int gcd(int x, int y);
alpar@1
   266
*
alpar@1
   267
*  RETURNS
alpar@1
   268
*
alpar@1
   269
*  The routine gcd returns gcd(x, y), the greatest common divisor of
alpar@1
   270
*  the two positive integers given.
alpar@1
   271
*
alpar@1
   272
*  ALGORITHM
alpar@1
   273
*
alpar@1
   274
*  The routine gcd is based on Euclid's algorithm.
alpar@1
   275
*
alpar@1
   276
*  REFERENCES
alpar@1
   277
*
alpar@1
   278
*  Don Knuth, The Art of Computer Programming, Vol.2: Seminumerical
alpar@1
   279
*  Algorithms, 3rd Edition, Addison-Wesley, 1997. Section 4.5.2: The
alpar@1
   280
*  Greatest Common Divisor, pp. 333-56. */
alpar@1
   281
alpar@1
   282
int gcd(int x, int y)
alpar@1
   283
{     int r;
alpar@1
   284
      xassert(x > 0 && y > 0);
alpar@1
   285
      while (y > 0)
alpar@1
   286
         r = x % y, x = y, y = r;
alpar@1
   287
      return x;
alpar@1
   288
}
alpar@1
   289
alpar@1
   290
/***********************************************************************
alpar@1
   291
*  NAME
alpar@1
   292
*
alpar@1
   293
*  gcdn - find greatest common divisor of n integers
alpar@1
   294
*
alpar@1
   295
*  SYNOPSIS
alpar@1
   296
*
alpar@1
   297
*  #include "glplib.h"
alpar@1
   298
*  int gcdn(int n, int x[]);
alpar@1
   299
*
alpar@1
   300
*  RETURNS
alpar@1
   301
*
alpar@1
   302
*  The routine gcdn returns gcd(x[1], x[2], ..., x[n]), the greatest
alpar@1
   303
*  common divisor of n positive integers given, n > 0.
alpar@1
   304
*
alpar@1
   305
*  BACKGROUND
alpar@1
   306
*
alpar@1
   307
*  The routine gcdn is based on the following identity:
alpar@1
   308
*
alpar@1
   309
*     gcd(x, y, z) = gcd(gcd(x, y), z).
alpar@1
   310
*
alpar@1
   311
*  REFERENCES
alpar@1
   312
*
alpar@1
   313
*  Don Knuth, The Art of Computer Programming, Vol.2: Seminumerical
alpar@1
   314
*  Algorithms, 3rd Edition, Addison-Wesley, 1997. Section 4.5.2: The
alpar@1
   315
*  Greatest Common Divisor, pp. 333-56. */
alpar@1
   316
alpar@1
   317
int gcdn(int n, int x[])
alpar@1
   318
{     int d, j;
alpar@1
   319
      xassert(n > 0);
alpar@1
   320
      for (j = 1; j <= n; j++)
alpar@1
   321
      {  xassert(x[j] > 0);
alpar@1
   322
         if (j == 1)
alpar@1
   323
            d = x[1];
alpar@1
   324
         else
alpar@1
   325
            d = gcd(d, x[j]);
alpar@1
   326
         if (d == 1) break;
alpar@1
   327
      }
alpar@1
   328
      return d;
alpar@1
   329
}
alpar@1
   330
alpar@1
   331
/***********************************************************************
alpar@1
   332
*  NAME
alpar@1
   333
*
alpar@1
   334
*  lcm - find least common multiple of two integers
alpar@1
   335
*
alpar@1
   336
*  SYNOPSIS
alpar@1
   337
*
alpar@1
   338
*  #include "glplib.h"
alpar@1
   339
*  int lcm(int x, int y);
alpar@1
   340
*
alpar@1
   341
*  RETURNS
alpar@1
   342
*
alpar@1
   343
*  The routine lcm returns lcm(x, y), the least common multiple of the
alpar@1
   344
*  two positive integers given. In case of integer overflow the routine
alpar@1
   345
*  returns zero.
alpar@1
   346
*
alpar@1
   347
*  BACKGROUND
alpar@1
   348
*
alpar@1
   349
*  The routine lcm is based on the following identity:
alpar@1
   350
*
alpar@1
   351
*     lcm(x, y) = (x * y) / gcd(x, y) = x * [y / gcd(x, y)],
alpar@1
   352
*
alpar@1
   353
*  where gcd(x, y) is the greatest common divisor of x and y. */
alpar@1
   354
alpar@1
   355
int lcm(int x, int y)
alpar@1
   356
{     xassert(x > 0);
alpar@1
   357
      xassert(y > 0);
alpar@1
   358
      y /= gcd(x, y);
alpar@1
   359
      if (x > INT_MAX / y) return 0;
alpar@1
   360
      return x * y;
alpar@1
   361
}
alpar@1
   362
alpar@1
   363
/***********************************************************************
alpar@1
   364
*  NAME
alpar@1
   365
*
alpar@1
   366
*  lcmn - find least common multiple of n integers
alpar@1
   367
*
alpar@1
   368
*  SYNOPSIS
alpar@1
   369
*
alpar@1
   370
*  #include "glplib.h"
alpar@1
   371
*  int lcmn(int n, int x[]);
alpar@1
   372
*
alpar@1
   373
*  RETURNS
alpar@1
   374
*
alpar@1
   375
*  The routine lcmn returns lcm(x[1], x[2], ..., x[n]), the least
alpar@1
   376
*  common multiple of n positive integers given, n > 0. In case of
alpar@1
   377
*  integer overflow the routine returns zero.
alpar@1
   378
*
alpar@1
   379
*  BACKGROUND
alpar@1
   380
*
alpar@1
   381
*  The routine lcmn is based on the following identity:
alpar@1
   382
*
alpar@1
   383
*     lcmn(x, y, z) = lcm(lcm(x, y), z),
alpar@1
   384
*
alpar@1
   385
*  where lcm(x, y) is the least common multiple of x and y. */
alpar@1
   386
alpar@1
   387
int lcmn(int n, int x[])
alpar@1
   388
{     int m, j;
alpar@1
   389
      xassert(n > 0);
alpar@1
   390
      for (j = 1; j <= n; j++)
alpar@1
   391
      {  xassert(x[j] > 0);
alpar@1
   392
         if (j == 1)
alpar@1
   393
            m = x[1];
alpar@1
   394
         else
alpar@1
   395
            m = lcm(m, x[j]);
alpar@1
   396
         if (m == 0) break;
alpar@1
   397
      }
alpar@1
   398
      return m;
alpar@1
   399
}
alpar@1
   400
alpar@1
   401
/***********************************************************************
alpar@1
   402
*  NAME
alpar@1
   403
*
alpar@1
   404
*  round2n - round floating-point number to nearest power of two
alpar@1
   405
*
alpar@1
   406
*  SYNOPSIS
alpar@1
   407
*
alpar@1
   408
*  #include "glplib.h"
alpar@1
   409
*  double round2n(double x);
alpar@1
   410
*
alpar@1
   411
*  RETURNS
alpar@1
   412
*
alpar@1
   413
*  Given a positive floating-point value x the routine round2n returns
alpar@1
   414
*  2^n such that |x - 2^n| is minimal.
alpar@1
   415
*
alpar@1
   416
*  EXAMPLES
alpar@1
   417
*
alpar@1
   418
*  round2n(10.1) = 2^3 = 8
alpar@1
   419
*  round2n(15.3) = 2^4 = 16
alpar@1
   420
*  round2n(0.01) = 2^(-7) = 0.0078125
alpar@1
   421
*
alpar@1
   422
*  BACKGROUND
alpar@1
   423
*
alpar@1
   424
*  Let x = f * 2^e, where 0.5 <= f < 1 is a normalized fractional part,
alpar@1
   425
*  e is an integer exponent. Then, obviously, 0.5 * 2^e <= x < 2^e, so
alpar@1
   426
*  if x - 0.5 * 2^e <= 2^e - x, we choose 0.5 * 2^e = 2^(e-1), and 2^e
alpar@1
   427
*  otherwise. The latter condition can be written as 2 * x <= 1.5 * 2^e
alpar@1
   428
*  or 2 * f * 2^e <= 1.5 * 2^e or, finally, f <= 0.75. */
alpar@1
   429
alpar@1
   430
double round2n(double x)
alpar@1
   431
{     int e;
alpar@1
   432
      double f;
alpar@1
   433
      xassert(x > 0.0);
alpar@1
   434
      f = frexp(x, &e);
alpar@1
   435
      return ldexp(1.0, f <= 0.75 ? e-1 : e);
alpar@1
   436
}
alpar@1
   437
alpar@1
   438
/***********************************************************************
alpar@1
   439
*  NAME
alpar@1
   440
*
alpar@1
   441
*  fp2rat - convert floating-point number to rational number
alpar@1
   442
*
alpar@1
   443
*  SYNOPSIS
alpar@1
   444
*
alpar@1
   445
*  #include "glplib.h"
alpar@1
   446
*  int fp2rat(double x, double eps, double *p, double *q);
alpar@1
   447
*
alpar@1
   448
*  DESCRIPTION
alpar@1
   449
*
alpar@1
   450
*  Given a floating-point number 0 <= x < 1 the routine fp2rat finds
alpar@1
   451
*  its "best" rational approximation p / q, where p >= 0 and q > 0 are
alpar@1
   452
*  integer numbers, such that |x - p / q| <= eps.
alpar@1
   453
*
alpar@1
   454
*  RETURNS
alpar@1
   455
*
alpar@1
   456
*  The routine fp2rat returns the number of iterations used to achieve
alpar@1
   457
*  the specified precision eps.
alpar@1
   458
*
alpar@1
   459
*  EXAMPLES
alpar@1
   460
*
alpar@1
   461
*  For x = sqrt(2) - 1 = 0.414213562373095 and eps = 1e-6 the routine
alpar@1
   462
*  gives p = 408 and q = 985, where 408 / 985 = 0.414213197969543.
alpar@1
   463
*
alpar@1
   464
*  BACKGROUND
alpar@1
   465
*
alpar@1
   466
*  It is well known that every positive real number x can be expressed
alpar@1
   467
*  as the following continued fraction:
alpar@1
   468
*
alpar@1
   469
*     x = b[0] + a[1]
alpar@1
   470
*                ------------------------
alpar@1
   471
*                b[1] + a[2]
alpar@1
   472
*                       -----------------
alpar@1
   473
*                       b[2] + a[3]
alpar@1
   474
*                              ----------
alpar@1
   475
*                              b[3] + ...
alpar@1
   476
*
alpar@1
   477
*  where:
alpar@1
   478
*
alpar@1
   479
*     a[k] = 1,                  k = 0, 1, 2, ...
alpar@1
   480
*
alpar@1
   481
*     b[k] = floor(x[k]),        k = 0, 1, 2, ...
alpar@1
   482
*
alpar@1
   483
*     x[0] = x,
alpar@1
   484
*
alpar@1
   485
*     x[k] = 1 / frac(x[k-1]),   k = 1, 2, 3, ...
alpar@1
   486
*
alpar@1
   487
*  To find the "best" rational approximation of x the routine computes
alpar@1
   488
*  partial fractions f[k] by dropping after k terms as follows:
alpar@1
   489
*
alpar@1
   490
*     f[k] = A[k] / B[k],
alpar@1
   491
*
alpar@1
   492
*  where:
alpar@1
   493
*
alpar@1
   494
*     A[-1] = 1,   A[0] = b[0],   B[-1] = 0,   B[0] = 1,
alpar@1
   495
*
alpar@1
   496
*     A[k] = b[k] * A[k-1] + a[k] * A[k-2],
alpar@1
   497
*
alpar@1
   498
*     B[k] = b[k] * B[k-1] + a[k] * B[k-2].
alpar@1
   499
*
alpar@1
   500
*  Once the condition
alpar@1
   501
*
alpar@1
   502
*     |x - f[k]| <= eps
alpar@1
   503
*
alpar@1
   504
*  has been satisfied, the routine reports p = A[k] and q = B[k] as the
alpar@1
   505
*  final answer.
alpar@1
   506
*
alpar@1
   507
*  In the table below here is some statistics obtained for one million
alpar@1
   508
*  random numbers uniformly distributed in the range [0, 1).
alpar@1
   509
*
alpar@1
   510
*      eps      max p   mean p      max q    mean q  max k   mean k
alpar@1
   511
*     -------------------------------------------------------------
alpar@1
   512
*     1e-1          8      1.6          9       3.2    3      1.4
alpar@1
   513
*     1e-2         98      6.2         99      12.4    5      2.4
alpar@1
   514
*     1e-3        997     20.7        998      41.5    8      3.4
alpar@1
   515
*     1e-4       9959     66.6       9960     133.5   10      4.4
alpar@1
   516
*     1e-5      97403    211.7      97404     424.2   13      5.3
alpar@1
   517
*     1e-6     479669    669.9     479670    1342.9   15      6.3
alpar@1
   518
*     1e-7    1579030   2127.3    3962146    4257.8   16      7.3
alpar@1
   519
*     1e-8   26188823   6749.4   26188824   13503.4   19      8.2
alpar@1
   520
*
alpar@1
   521
*  REFERENCES
alpar@1
   522
*
alpar@1
   523
*  W. B. Jones and W. J. Thron, "Continued Fractions: Analytic Theory
alpar@1
   524
*  and Applications," Encyclopedia on Mathematics and Its Applications,
alpar@1
   525
*  Addison-Wesley, 1980. */
alpar@1
   526
alpar@1
   527
int fp2rat(double x, double eps, double *p, double *q)
alpar@1
   528
{     int k;
alpar@1
   529
      double xk, Akm1, Ak, Bkm1, Bk, ak, bk, fk, temp;
alpar@1
   530
      if (!(0.0 <= x && x < 1.0))
alpar@1
   531
         xerror("fp2rat: x = %g; number out of range\n", x);
alpar@1
   532
      for (k = 0; ; k++)
alpar@1
   533
      {  xassert(k <= 100);
alpar@1
   534
         if (k == 0)
alpar@1
   535
         {  /* x[0] = x */
alpar@1
   536
            xk = x;
alpar@1
   537
            /* A[-1] = 1 */
alpar@1
   538
            Akm1 = 1.0;
alpar@1
   539
            /* A[0] = b[0] = floor(x[0]) = 0 */
alpar@1
   540
            Ak = 0.0;
alpar@1
   541
            /* B[-1] = 0 */
alpar@1
   542
            Bkm1 = 0.0;
alpar@1
   543
            /* B[0] = 1 */
alpar@1
   544
            Bk = 1.0;
alpar@1
   545
         }
alpar@1
   546
         else
alpar@1
   547
         {  /* x[k] = 1 / frac(x[k-1]) */
alpar@1
   548
            temp = xk - floor(xk);
alpar@1
   549
            xassert(temp != 0.0);
alpar@1
   550
            xk = 1.0 / temp;
alpar@1
   551
            /* a[k] = 1 */
alpar@1
   552
            ak = 1.0;
alpar@1
   553
            /* b[k] = floor(x[k]) */
alpar@1
   554
            bk = floor(xk);
alpar@1
   555
            /* A[k] = b[k] * A[k-1] + a[k] * A[k-2] */
alpar@1
   556
            temp = bk * Ak + ak * Akm1;
alpar@1
   557
            Akm1 = Ak, Ak = temp;
alpar@1
   558
            /* B[k] = b[k] * B[k-1] + a[k] * B[k-2] */
alpar@1
   559
            temp = bk * Bk + ak * Bkm1;
alpar@1
   560
            Bkm1 = Bk, Bk = temp;
alpar@1
   561
         }
alpar@1
   562
         /* f[k] = A[k] / B[k] */
alpar@1
   563
         fk = Ak / Bk;
alpar@1
   564
#if 0
alpar@1
   565
         print("%.*g / %.*g = %.*g", DBL_DIG, Ak, DBL_DIG, Bk, DBL_DIG,
alpar@1
   566
            fk);
alpar@1
   567
#endif
alpar@1
   568
         if (fabs(x - fk) <= eps) break;
alpar@1
   569
      }
alpar@1
   570
      *p = Ak;
alpar@1
   571
      *q = Bk;
alpar@1
   572
      return k;
alpar@1
   573
}
alpar@1
   574
alpar@1
   575
/***********************************************************************
alpar@1
   576
*  NAME
alpar@1
   577
*
alpar@1
   578
*  jday - convert calendar date to Julian day number
alpar@1
   579
*
alpar@1
   580
*  SYNOPSIS
alpar@1
   581
*
alpar@1
   582
*  #include "glplib.h"
alpar@1
   583
*  int jday(int d, int m, int y);
alpar@1
   584
*
alpar@1
   585
*  DESCRIPTION
alpar@1
   586
*
alpar@1
   587
*  The routine jday converts a calendar date, Gregorian calendar, to
alpar@1
   588
*  corresponding Julian day number j.
alpar@1
   589
*
alpar@1
   590
*  From the given day d, month m, and year y, the Julian day number j
alpar@1
   591
*  is computed without using tables.
alpar@1
   592
*
alpar@1
   593
*  The routine is valid for 1 <= y <= 4000.
alpar@1
   594
*
alpar@1
   595
*  RETURNS
alpar@1
   596
*
alpar@1
   597
*  The routine jday returns the Julian day number, or negative value if
alpar@1
   598
*  the specified date is incorrect.
alpar@1
   599
*
alpar@1
   600
*  REFERENCES
alpar@1
   601
*
alpar@1
   602
*  R. G. Tantzen, Algorithm 199: conversions between calendar date and
alpar@1
   603
*  Julian day number, Communications of the ACM, vol. 6, no. 8, p. 444,
alpar@1
   604
*  Aug. 1963. */
alpar@1
   605
alpar@1
   606
int jday(int d, int m, int y)
alpar@1
   607
{     int c, ya, j, dd;
alpar@1
   608
      if (!(1 <= d && d <= 31 && 1 <= m && m <= 12 && 1 <= y &&
alpar@1
   609
            y <= 4000))
alpar@1
   610
      {  j = -1;
alpar@1
   611
         goto done;
alpar@1
   612
      }
alpar@1
   613
      if (m >= 3) m -= 3; else m += 9, y--;
alpar@1
   614
      c = y / 100;
alpar@1
   615
      ya = y - 100 * c;
alpar@1
   616
      j = (146097 * c) / 4 + (1461 * ya) / 4 + (153 * m + 2) / 5 + d +
alpar@1
   617
         1721119;
alpar@1
   618
      jdate(j, &dd, NULL, NULL);
alpar@1
   619
      if (d != dd) j = -1;
alpar@1
   620
done: return j;
alpar@1
   621
}
alpar@1
   622
alpar@1
   623
/***********************************************************************
alpar@1
   624
*  NAME
alpar@1
   625
*
alpar@1
   626
*  jdate - convert Julian day number to calendar date
alpar@1
   627
*
alpar@1
   628
*  SYNOPSIS
alpar@1
   629
*
alpar@1
   630
*  #include "glplib.h"
alpar@1
   631
*  void jdate(int j, int *d, int *m, int *y);
alpar@1
   632
*
alpar@1
   633
*  DESCRIPTION
alpar@1
   634
*
alpar@1
   635
*  The routine jdate converts a Julian day number j to corresponding
alpar@1
   636
*  calendar date, Gregorian calendar.
alpar@1
   637
*
alpar@1
   638
*  The day d, month m, and year y are computed without using tables and
alpar@1
   639
*  stored in corresponding locations.
alpar@1
   640
*
alpar@1
   641
*  The routine is valid for 1721426 <= j <= 3182395.
alpar@1
   642
*
alpar@1
   643
*  RETURNS
alpar@1
   644
*
alpar@1
   645
*  If the conversion is successful, the routine returns zero, otherwise
alpar@1
   646
*  non-zero.
alpar@1
   647
*
alpar@1
   648
*  REFERENCES
alpar@1
   649
*
alpar@1
   650
*  R. G. Tantzen, Algorithm 199: conversions between calendar date and
alpar@1
   651
*  Julian day number, Communications of the ACM, vol. 6, no. 8, p. 444,
alpar@1
   652
*  Aug. 1963. */
alpar@1
   653
alpar@1
   654
int jdate(int j, int *_d, int *_m, int *_y)
alpar@1
   655
{     int d, m, y, ret = 0;
alpar@1
   656
      if (!(1721426 <= j && j <= 3182395))
alpar@1
   657
      {  ret = 1;
alpar@1
   658
         goto done;
alpar@1
   659
      }
alpar@1
   660
      j -= 1721119;
alpar@1
   661
      y = (4 * j - 1) / 146097;
alpar@1
   662
      j = (4 * j - 1) % 146097;
alpar@1
   663
      d = j / 4;
alpar@1
   664
      j = (4 * d + 3) / 1461;
alpar@1
   665
      d = (4 * d + 3) % 1461;
alpar@1
   666
      d = (d + 4) / 4;
alpar@1
   667
      m = (5 * d - 3) / 153;
alpar@1
   668
      d = (5 * d - 3) % 153;
alpar@1
   669
      d = (d + 5) / 5;
alpar@1
   670
      y = 100 * y + j;
alpar@1
   671
      if (m <= 9) m += 3; else m -= 9, y++;
alpar@1
   672
      if (_d != NULL) *_d = d;
alpar@1
   673
      if (_m != NULL) *_m = m;
alpar@1
   674
      if (_y != NULL) *_y = y;
alpar@1
   675
done: return ret;
alpar@1
   676
}
alpar@1
   677
alpar@1
   678
#if 0
alpar@1
   679
int main(void)
alpar@1
   680
{     int jbeg, jend, j, d, m, y;
alpar@1
   681
      jbeg = jday(1, 1, 1);
alpar@1
   682
      jend = jday(31, 12, 4000);
alpar@1
   683
      for (j = jbeg; j <= jend; j++)
alpar@1
   684
      {  xassert(jdate(j, &d, &m, &y) == 0);
alpar@1
   685
         xassert(jday(d, m, y) == j);
alpar@1
   686
      }
alpar@1
   687
      xprintf("Routines jday and jdate work correctly.\n");
alpar@1
   688
      return 0;
alpar@1
   689
}
alpar@1
   690
#endif
alpar@1
   691
alpar@1
   692
/* eof */