drygdryg/calc
1
0
Fork 0
mirror of https://github.com/lcn2/calc.git synced 2025-08-16 01:03:29 +03:00
Code Issues Packages Projects Releases Wiki Activity

convert ASCII TABs to ASCII SPACEs

Browse Source 
Converted all ASCII tabs to ASCII spaces using a 8 character
tab stop, for all files, except for all Makefiles (plus rpm.mk).
The `git diff -w` reports no changes.
This commit is contained in:
Landon Curt Noll
2024-07-11 22:03:52 -07:00
parent fe9cefe6ef
commit db77e29a23
631 changed files with 90607 additions and 90600 deletions
Download Patch File Download Diff File Expand all files Collapse all files

62
BUGS
View File

@@ -66,13 +66,13 @@ Please include the following information in the new issue:
* Version of calc you are using * Version of calc you are using
If you cannot compile calc, then look at version.c If you cannot compile calc, then look at version.c
and report the #define that start with: and report the #define that start with:
#define MAJOR_VER #define MAJOR_VER
#define MINOR_VER #define MINOR_VER
#define MAJOR_PATCH #define MAJOR_PATCH
#define MINOR_PATCH #define MINOR_PATCH
* If you modified calc from an official patch, * If you modified calc from an official patch,
send us the mods you made send us the mods you made
@@ -88,7 +88,7 @@ Please include the following information in the new issue:
* cd to the calc source directory, and send the contents * cd to the calc source directory, and send the contents
of debug.out.txt produced by this command: of debug.out.txt produced by this command:
make debug make debug
PLEASE attach the debug.out.txt file to your GitHub issue (bug report)!! PLEASE attach the debug.out.txt file to your GitHub issue (bug report)!!
@@ -122,16 +122,16 @@ mis-features in calc:
This works as expected: This works as expected:
if (expr) { if (expr) {
... ...
} }
However this WILL NOT WORK AS EXPECTED: However this WILL NOT WORK AS EXPECTED:
if (expr) if (expr)
{ {
... ...
} }
This needs to be changed. See also "help statement", "help unexpected", This needs to be changed. See also "help statement", "help unexpected",
and "help todo". and "help todo".
@@ -143,28 +143,28 @@ mis-features in calc:
integers to/from files the hard way. It does NOT use blkcpy. The integers to/from files the hard way. It does NOT use blkcpy. The
following code: following code:
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H") i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
b = blk() b = blk()
copy(i, b) copy(i, b)
fd = fopen("file", "w") fd = fopen("file", "w")
copy(b, fd); copy(b, fd);
fclose(fd) fclose(fd)
will write an extra NUL octet to the file. Where as: will write an extra NUL octet to the file. Where as:
read intfile read intfile
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H") i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
be2file(i, "file2") be2file(i, "file2")
will not. will not.
* The numerator is assumed * The numerator is assumed
The numerator value of 1 appears to be assumed. In calc: The numerator value of 1 appears to be assumed. In calc:
/ 2 / 2
will produce a value of 0.5 as if the numerator 1 was given. will produce a value of 0.5 as if the numerator 1 was given.
=-= =-=
@@ -177,7 +177,7 @@ mis-features in calc:
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -185,8 +185,8 @@ mis-features in calc:
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 1994/03/18 14:06:13 ## Under source code control: 1994/03/18 14:06:13
## File existed as early as: 1994 ## File existed as early as: 1994
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

4401
CHANGES
View File

File diff suppressed because it is too large Load Diff

10
CONTRIB-CODE
View File

@@ -49,7 +49,7 @@ See also the calc wishlist by running the calc command:
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -57,8 +57,8 @@ See also the calc wishlist by running the calc command:
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 1997/03/09 16:33:22 ## Under source code control: 1997/03/09 16:33:22
## File existed as early as: 1997 ## File existed as early as: 1997
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

146
COPYING
View File

@@ -1,4 +1,4 @@
calc - arbitrary precision calculator calc - arbitrary precision calculator
This file is Copyrighted This file is Copyrighted
------------------------ ------------------------
@@ -6,11 +6,11 @@ This file is Copyrighted
This file is not covered under version 2.1 of the GNU LGPL. This file is not covered under version 2.1 of the GNU LGPL.
This file is covered under the following Copyright: This file is covered under the following Copyright:
Copyright (C) 1999-2023 Landon Curt Noll Copyright (C) 1999-2023 Landon Curt Noll
All rights reserved. All rights reserved.
Everyone is permitted to copy and distribute verbatim copies Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed. of this license document, but changing it is not allowed.
-=- -=-
@@ -33,21 +33,21 @@ Calc is covered by the GNU Lesser General Public License
A copy of the GNU Lesser General Public License is distributed with A copy of the GNU Lesser General Public License is distributed with
calc under the filename: calc under the filename:
COPYING-LGPL COPYING-LGPL
You may display this file by the calc command: help copying You may display this file by the calc command: help copying
You may display the GNU Lesser General You may display the GNU Lesser General
Public License by the calc command: help copying-lgpl Public License by the calc command: help copying-lgpl
You should have received a copy of the version 2.1 GNU Lesser General You should have received a copy of the version 2.1 GNU Lesser General
Public License with calc; if not, write to the following address: Public License with calc; if not, write to the following address:
Free Software Foundation, Inc. Free Software Foundation, Inc.
51 Franklin Street 51 Franklin Street
Fifth Floor Fifth Floor
Boston, MA 02110-1301 Boston, MA 02110-1301
USA USA
Calc's relationship to the GNU Lesser General Public License Calc's relationship to the GNU Lesser General Public License
------------------------------------------------------------ ------------------------------------------------------------
@@ -55,22 +55,22 @@ Calc's relationship to the GNU Lesser General Public License
In section 0 of the GNU Lesser General Public License, one finds In section 0 of the GNU Lesser General Public License, one finds
the following definition: the following definition:
The "Library", below, refers to any such software library or The "Library", below, refers to any such software library or
work which has been distributed under these terms. work which has been distributed under these terms.
Calc is distributed under the terms of the GNU Lesser Calc is distributed under the terms of the GNU Lesser
General Public License. General Public License.
In the same section 0, one also find the following: In the same section 0, one also find the following:
For a library, complete source code means all the source code For a library, complete source code means all the source code
for all modules it contains, plus any associated interface for all modules it contains, plus any associated interface
definition files, plus the scripts used to control compilation definition files, plus the scripts used to control compilation
and installation of the library. and installation of the library.
There are at least two calc binary link libraries found in calc: There are at least two calc binary link libraries found in calc:
libcalc.a libcustcalc.a libcalc.a libcustcalc.a
Clearly all files that go into the creation of those binary link Clearly all files that go into the creation of those binary link
libraries are covered under the License. libraries are covered under the License.
@@ -78,26 +78,26 @@ Calc's relationship to the GNU Lesser General Public License
The "scripts used to control compilation and installation of the The "scripts used to control compilation and installation of the
of the library" include: of the library" include:
* Makefiles * Makefiles
* source files created by the Makefiles * source files created by the Makefiles
* source code used in the creation of intermediate source files * source code used in the creation of intermediate source files
All of those files are covered under the License. All of those files are covered under the License.
The "associated interface definition files" are those files that: The "associated interface definition files" are those files that:
* show how the calc binary link libraries are used * show how the calc binary link libraries are used
* test the validity of the binary link libraries * test the validity of the binary link libraries
* document routines found in the binary link libraries * document routines found in the binary link libraries
* show how one can interactively use the binary link libraries * show how one can interactively use the binary link libraries
Calc provides an extensive set of files that perform the above Calc provides an extensive set of files that perform the above
functions. functions.
* files under the sample sub-directory * files under the sample sub-directory
* files under the help sub-directory * files under the help sub-directory
* files under the lib sub-directory * files under the lib sub-directory
* the main calc.c file * the main calc.c file
The "complete source code" includes ALL files shipped with calc, The "complete source code" includes ALL files shipped with calc,
except for the exception files explicitly listed in the "Calc except for the exception files explicitly listed in the "Calc
@@ -111,22 +111,22 @@ Calc copyrights and exception files
With the exception of the files listed below, Calc is covered under With the exception of the files listed below, Calc is covered under
the following GNU Lesser General Public License Copyrights: the following GNU Lesser General Public License Copyrights:
Copyright (C) year David I. Bell Copyright (C) year David I. Bell
Copyright (C) year David I. Bell and Landon Curt Noll Copyright (C) year David I. Bell and Landon Curt Noll
Copyright (C) year David I. Bell and Ernest Bowen Copyright (C) year David I. Bell and Ernest Bowen
Copyright (C) year David I. Bell, Landon Curt Noll and Ernest Bowen Copyright (C) year David I. Bell, Landon Curt Noll and Ernest Bowen
Copyright (C) year Landon Curt Noll Copyright (C) year Landon Curt Noll
Copyright (C) year Ernest Bowen and Landon Curt Noll Copyright (C) year Ernest Bowen and Landon Curt Noll
Copyright (C) year Ernest Bowen Copyright (C) year Ernest Bowen
Copyright (C) year Petteri Kettunen and Landon Curt Noll Copyright (C) year Petteri Kettunen and Landon Curt Noll
Copyright (C) year Christoph Zurnieden Copyright (C) year Christoph Zurnieden
Copyright (C) year Landon Curt Noll and Thomas Jones-Low Copyright (C) year Landon Curt Noll and Thomas Jones-Low
Copyright (C) year Klaus Alexander Seistrup and Landon Curt Noll Copyright (C) year Klaus Alexander Seistrup and Landon Curt Noll
These files are not covered under one of the Copyrights listed above: These files are not covered under one of the Copyrights listed above:
sha1.c sha1.h COPYING sha1.c sha1.h COPYING
COPYING-LGPL cal/screen.cal COPYING-LGPL cal/screen.cal
The file COPYING-LGPL, which contains a copy of the version 2.1 The file COPYING-LGPL, which contains a copy of the version 2.1
GNU Lesser General Public License, is itself Copyrighted by the GNU Lesser General Public License, is itself Copyrighted by the
@@ -140,37 +140,37 @@ Calc copyrights and exception files
These files are covered under "The Unlicense": These files are covered under "The Unlicense":
sha1.c sha1.c
sha1.h sha1.h
cal/dotest.cal cal/dotest.cal
cal/screen.cal cal/screen.cal
"The Unlicense" is as follows: "The Unlicense" is as follows:
This is free and unencumbered software released into the public domain. This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any binary, for any purpose, commercial or non-commercial, and by any
means. means.
In jurisdictions that recognize copyright laws, the author or authors In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this relinquishment in perpetuity of all present and future rights to this
software under copyright law. software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE. OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to <http://unlicense.org/> For more information, please refer to <http://unlicense.org/>
In all cases one may use and distribute these exception files freely. In all cases one may use and distribute these exception files freely.
And because one may freely distribute the LGPL covered files, the And because one may freely distribute the LGPL covered files, the
@@ -183,12 +183,12 @@ General Copyleft and License info
For general information on Copylefts, see: For general information on Copylefts, see:
http://www.gnu.org/copyleft/ http://www.gnu.org/copyleft/
For information on GNU Lesser General Public Licenses, see: For information on GNU Lesser General Public Licenses, see:
http://www.gnu.org/copyleft/lesser.html http://www.gnu.org/copyleft/lesser.html
http://www.gnu.org/copyleft/lesser.txt http://www.gnu.org/copyleft/lesser.txt
-=- -=-
@@ -198,10 +198,10 @@ Why calc did not use the GNU General Public License
It has been suggested that one should consider using the GNU General It has been suggested that one should consider using the GNU General
Public License instead of the GNU Lesser General Public License: Public License instead of the GNU Lesser General Public License:
http://www.gnu.org/philosophy/why-not-lgpl.html http://www.gnu.org/philosophy/why-not-lgpl.html
As you can read in the above URL, there are times where a library As you can read in the above URL, there are times where a library
cannot give free software any particular advantage. One of those cannot give free software any particular advantage. One of those
times is when there is significantly similar versions available times is when there is significantly similar versions available
that are not covered under a Copyleft such as the GNU General Public that are not covered under a Copyleft such as the GNU General Public
License. License.

42
HOWTO.INSTALL
View File

@@ -10,7 +10,7 @@ Open up the 'Assets' tag below a given release and download these RPMs:
* calc*.rpm * calc*.rpm
- all that is needed if you just want to use calc - all that is needed if you just want to use calc
If your platform supports rpm and matches one of the "calc*.rpm" files, you If your platform supports rpm and matches one of the "calc*.rpm" files, you
may just install that "calc*.rpm". For exammple on an x86_64 system: may just install that "calc*.rpm". For exammple on an x86_64 system:
@@ -25,7 +25,7 @@ files for use in other programs:
* calc-devel-*.rpm * calc-devel-*.rpm
- calc *.h header and *.a lib files for use in other programs - calc *.h header and *.a lib files for use in other programs
Alternately to the above github link, you might try looking at the RPMs under: Alternately to the above github link, you might try looking at the RPMs under:
@@ -209,10 +209,10 @@ the standard Microsoft Windows developor environment to compile calc.
You should determine if these Makefile variables are reasonable: You should determine if these Makefile variables are reasonable:
INCDIR Where the system include (.h) files are kept. INCDIR Where the system include (.h) files are kept.
BINDIR Where to install calc binary files. BINDIR Where to install calc binary files.
LIBDIR Where to install calc link library (*.a) files. LIBDIR Where to install calc link library (*.a) files.
CALC_SHAREDIR Where to install calc help, .cal, startup, and config files. CALC_SHAREDIR Where to install calc help, .cal, startup, and config files.
You may want to change the default installation locations for You may want to change the default installation locations for
these values, which are based on the 4 values listed above: these values, which are based on the 4 values listed above:
@@ -227,25 +227,25 @@ these values, which are based on the 4 values listed above:
If you want to install calc files under a top level directory, then set the T value: If you want to install calc files under a top level directory, then set the T value:
The calc install is performed under ${T}, the calc build is The calc install is performed under ${T}, the calc build is
performed under /. The purpose for ${T} is to allow someone performed under /. The purpose for ${T} is to allow someone
to install calc somewhere other than into the system area. to install calc somewhere other than into the system area.
For example, if: For example, if:
BINDIR= /usr/bin BINDIR= /usr/bin
LIBDIR= /usr/lib LIBDIR= /usr/lib
CALC_SHAREDIR= /usr/share/calc CALC_SHAREDIR= /usr/share/calc
and if: and if:
T= /var/tmp/testing T= /var/tmp/testing
Then the installation locations will be: Then the installation locations will be:
calc binary files: /var/tmp/testing/usr/bin calc binary files: /var/tmp/testing/usr/bin
calc link library: /var/tmp/testing/usr/lib calc link library: /var/tmp/testing/usr/lib
calc help, .cal ...: /var/tmp/testing/usr/share/calc calc help, .cal ...: /var/tmp/testing/usr/share/calc
... etc ... /var/tmp/testing/... ... etc ... /var/tmp/testing/...
If ${T} is empty, calc is installed under /, which is the same If ${T} is empty, calc is installed under /, which is the same
top of tree for which it was built. If ${T} is non-empty, then top of tree for which it was built. If ${T} is non-empty, then
@@ -341,7 +341,7 @@ before you install:
Calc is distributed with an extensive collection of help files that Calc is distributed with an extensive collection of help files that
are accessible from the command line. The following assume that you are accessible from the command line. The following assume that you
are running calc from the distribution directory or that you have are running calc from the distribution directory or that you have
installed calc. In these examples, the "; " is the calc prompt, not installed calc. In these examples, the "; " is the calc prompt, not
something that you type. something that you type.
For list of help topics: For list of help topics:
@@ -392,7 +392,7 @@ a numner of important make rules and thus fail to properly compile calc.
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -400,8 +400,8 @@ a numner of important make rules and thus fail to properly compile calc.
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 1999/09/27 20:48:44 ## Under source code control: 1999/09/27 20:48:44
## File existed as early as: 1999 ## File existed as early as: 1999
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

472
LIBRARY
View File

@@ -19,9 +19,9 @@ FIRST THINGS FIRST
------------------ ------------------
............................................................................... ...............................................................................
. . . .
. You MUST call libcalc_call_me_first() prior to using libcalc lib functions! . . You MUST call libcalc_call_me_first() prior to using libcalc lib functions! .
. . . .
............................................................................... ...............................................................................
The function libcalc_call_me_first() takes no args and returns void. You The function libcalc_call_me_first() takes no args and returns void. You
@@ -34,16 +34,16 @@ INCLUDE FILES
To use any of these routines in your own programs, you need to include the To use any of these routines in your own programs, you need to include the
appropriate include file. These include files are: appropriate include file. These include files are:
zmath.h (for integer arithmetic) zmath.h (for integer arithmetic)
qmath.h (for rational arithmetic) qmath.h (for rational arithmetic)
cmath.h (for complex number arithmetic) cmath.h (for complex number arithmetic)
You never need to include more than one of the above files, even if you wish You never need to include more than one of the above files, even if you wish
to use more than one type of arithmetic, since qmath.h automatically includes to use more than one type of arithmetic, since qmath.h automatically includes
zmath.h, and cmath.h automatically includes qmath.h. zmath.h, and cmath.h automatically includes qmath.h.
The prototypes for the available routines are listed in the above include The prototypes for the available routines are listed in the above include
files. Some of these routines are meant for internal use, and so aren't files. Some of these routines are meant for internal use, and so aren't
convenient for outside use. So you should read the source for a routine convenient for outside use. So you should read the source for a routine
to see if it really does what you think it does. I won't guarantee that to see if it really does what you think it does. I won't guarantee that
obscure internal routines won't change or disappear in future releases! obscure internal routines won't change or disappear in future releases!
@@ -61,20 +61,20 @@ to define CALC_SRC.
You need to include the following file to get the symbols and variables You need to include the following file to get the symbols and variables
related to error handling: related to error handling:
lib_calc.h lib_calc.h
External programs may want to compile with: External programs may want to compile with:
-I${INCDIR} -L${LIBDIR} -lcalc -I${INCDIR} -L${LIBDIR} -lcalc
If custom functions are also used, they may want to compile with: If custom functions are also used, they may want to compile with:
-I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc -I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc
The CALC_SRC symbol should NOT be defined by default. However if you are The CALC_SRC symbol should NOT be defined by default. However if you are
feeling pedantic you may want to force CALC_SRC to be undefined: feeling pedantic you may want to force CALC_SRC to be undefined:
-UCALC_SRC -UCALC_SRC
as well. as well.
@@ -87,64 +87,64 @@ condition, such as malloc failures, division by zero, or some form of
an internal computation error. The routine is called in the manner of an internal computation error. The routine is called in the manner of
printf, with a format string and optional arguments: printf, with a format string and optional arguments:
void math_error(char *fmt, ...); void math_error(char *fmt, ...);
Your program must handle math errors in one of three ways: Your program must handle math errors in one of three ways:
1) Print the error message and then exit 1) Print the error message and then exit
There is a math_error() function supplied with the calc library. There is a math_error() function supplied with the calc library.
By default, this routine simply prints a message to stderr and By default, this routine simply prints a message to stderr and
then exits. By simply linking in this link library, any calc then exits. By simply linking in this link library, any calc
errors will result in a error message on stderr followed by errors will result in a error message on stderr followed by
an exit. an exit.
2) Use setjmp and longjmp in your program 2) Use setjmp and longjmp in your program
Use setjmp at some appropriate level in your program, and let Use setjmp at some appropriate level in your program, and let
the longjmp in math_error() return to that level and to allow you the longjmp in math_error() return to that level and to allow you
to recover from the error. This is what the calc program does. to recover from the error. This is what the calc program does.
If one sets up calc_matherr_jmpbuf, and then sets If one sets up calc_matherr_jmpbuf, and then sets
calc_use_matherr_jmpbuf to non-zero then math_error() will calc_use_matherr_jmpbuf to non-zero then math_error() will
longjmp back with the return value of calc_use_matherr_jmpbuf. longjmp back with the return value of calc_use_matherr_jmpbuf.
In addition, the last calc error message will be found in In addition, the last calc error message will be found in
calc_err_msg; this error is not printed to stderr. The calc calc_err_msg; this error is not printed to stderr. The calc
error message will not have a trailing newline. error message will not have a trailing newline.
For example: For example:
#include <setjmp.h> #include <setjmp.h>
#include "lib_calc.h" #include "lib_calc.h"
int error; int error;
... ...
if ((error = setjmp(calc_matherr_jmpbuf)) != 0) { if ((error = setjmp(calc_matherr_jmpbuf)) != 0) {
/* report the error */ /* report the error */
printf("Ouch: %s\n", calc_err_msg); printf("Ouch: %s\n", calc_err_msg);
/* reinitialize calc after the longjmp */ /* reinitialize calc after the longjmp */
reinitialize(); reinitialize();
} }
calc_use_matherr_jmpbuf = 1; calc_use_matherr_jmpbuf = 1;
If calc_use_matherr_jmpbuf is non-zero, then the jmp_buf value If calc_use_matherr_jmpbuf is non-zero, then the jmp_buf value
calc_matherr_jmpbuf must be initialized by the setjmp() function calc_matherr_jmpbuf must be initialized by the setjmp() function
or your program will crash. or your program will crash.
3) Supply your own math_error function: 3) Supply your own math_error function:
void math_error(char *fmt, ...); void math_error(char *fmt, ...);
Your math_error() function may exit or transfer control to outside Your math_error() function may exit or transfer control to outside
of the calc library, but it must never return or calc will crash. of the calc library, but it must never return or calc will crash.
External programs can obtain the appropriate calc symbols by compiling with: External programs can obtain the appropriate calc symbols by compiling with:
-I${INCDIR} -L${LIBDIR} -lcalc -I${INCDIR} -L${LIBDIR} -lcalc
------------------------- -------------------------
PARSE/SCAN ERROR HANDLING PARSE/SCAN ERROR HANDLING
@@ -159,15 +159,15 @@ any parse/scan errors. By default, this variable it set to 1 and so
parse/scan errors are printed to stderr. By setting this value to zero, parse/scan errors are printed to stderr. By setting this value to zero,
parse/scan errors are not printed: parse/scan errors are not printed:
#include "lib_calc.h" #include "lib_calc.h"
/* do not print parse/scan errors to stderr */ /* do not print parse/scan errors to stderr */
calc_print_scanerr_msg = 0; calc_print_scanerr_msg = 0;
The last calc math error or calc parse/scan error message is kept The last calc math error or calc parse/scan error message is kept
in the NUL terminated buffer: in the NUL terminated buffer:
char calc_err_msg[MAXERROR+1]; char calc_err_msg[MAXERROR+1];
The value of calc_print_scanerr_msg does not change the use The value of calc_print_scanerr_msg does not change the use
of the calc_err_msg[] buffer. Messages are stored in that of the calc_err_msg[] buffer. Messages are stored in that
@@ -182,54 +182,54 @@ Your program must handle parse/scan errors in one of two ways:
1) exit on error 1) exit on error
If you do not setup the calc_scanerr_jmpbuf, then when calc If you do not setup the calc_scanerr_jmpbuf, then when calc
encounters a parse/scan error, a message will be printed to encounters a parse/scan error, a message will be printed to
stderr and calc will exit. stderr and calc will exit.
2) Use setjmp and longjmp in your program 2) Use setjmp and longjmp in your program
Use setjmp at some appropriate level in your program, and let Use setjmp at some appropriate level in your program, and let
the longjmp in scanerror() return to that level and to allow you the longjmp in scanerror() return to that level and to allow you
to recover from the error. This is what the calc program does. to recover from the error. This is what the calc program does.
If one sets up calc_scanerr_jmpbuf, and then sets If one sets up calc_scanerr_jmpbuf, and then sets
calc_use_scanerr_jmpbuf to non-zero then scanerror() will longjmp calc_use_scanerr_jmpbuf to non-zero then scanerror() will longjmp
back with the return with a non-zero code. In addition, the last back with the return with a non-zero code. In addition, the last
calc error message will be found in calc_err_msg[]; this error is calc error message will be found in calc_err_msg[]; this error is
not printed to stderr. The calc error message will not have a not printed to stderr. The calc error message will not have a
trailing newline. trailing newline.
For example: For example:
#include <setjmp.h> #include <setjmp.h>
#include "lib_calc.h" #include "lib_calc.h"
int scan_error; int scan_error;
... ...
/* delay the printing of the parse/scan error */ /* delay the printing of the parse/scan error */
calc_use_scanerr_jmpbuf = 0; /* this is optional */ calc_use_scanerr_jmpbuf = 0; /* this is optional */
if ((scan_error = setjmp(calc_scanerr_jmpbuf)) != 0) { if ((scan_error = setjmp(calc_scanerr_jmpbuf)) != 0) {
/* report the parse/scan */ /* report the parse/scan */
if (calc_use_scanerr_jmpbuf == 0) { if (calc_use_scanerr_jmpbuf == 0) {
printf("parse error: %s\n", calc_err_msg); printf("parse error: %s\n", calc_err_msg);
} }
/* initialize calc after the longjmp */ /* initialize calc after the longjmp */
initialize(); initialize();
} }
calc_use_scanerr_jmpbuf = 1; calc_use_scanerr_jmpbuf = 1;
If calc_use_scanerr_jmpbuf is non-zero, then the jmp_buf value If calc_use_scanerr_jmpbuf is non-zero, then the jmp_buf value
calc_scanerr_jmpbuf must be initialized by the setjmp() function calc_scanerr_jmpbuf must be initialized by the setjmp() function
or your program will crash. or your program will crash.
External programs can obtain the appropriate calc symbols by compiling with: External programs can obtain the appropriate calc symbols by compiling with:
-I${INCDIR} -L${LIBDIR} -lcalc -I${INCDIR} -L${LIBDIR} -lcalc
--------------------------- ---------------------------
PARSE/SCAN WARNING HANDLING PARSE/SCAN WARNING HANDLING
@@ -239,22 +239,22 @@ Calc parse/scan warning message are printed to stderr by the warning()
function. The routine is called in the manner of printf, with a format function. The routine is called in the manner of printf, with a format
string and optional arguments: string and optional arguments:
void warning(char *fmt, ...); void warning(char *fmt, ...);
The variable, calc_print_scanwarn_msg, controls if calc prints to stderr, The variable, calc_print_scanwarn_msg, controls if calc prints to stderr,
any parse/scan warnings. By default, this variable it set to 1 and so any parse/scan warnings. By default, this variable it set to 1 and so
parse/scan warnings are printed to stderr. By setting this value to zero, parse/scan warnings are printed to stderr. By setting this value to zero,
parse/scan warnings are not printed: parse/scan warnings are not printed:
#include "lib_calc.h" #include "lib_calc.h"
/* do not print parse/scan warnings to stderr */ /* do not print parse/scan warnings to stderr */
calc_print_scanwarn_msg = 0; calc_print_scanwarn_msg = 0;
The last calc calc parse/scan warning message is kept in the NUL The last calc calc parse/scan warning message is kept in the NUL
terminated buffer: terminated buffer:
char calc_warn_msg[MAXERROR+1]; char calc_warn_msg[MAXERROR+1];
The value of calc_print_scanwarn_msg does not change the use The value of calc_print_scanwarn_msg does not change the use
of the calc_warn_msg[] buffer. Messages are stored in that of the calc_warn_msg[] buffer. Messages are stored in that
@@ -264,19 +264,19 @@ Your program must handle parse/scan warnings in one of two ways:
1) print the warning to stderr and continue 1) print the warning to stderr and continue
The warning() from libcalc prints warning messages to The warning() from libcalc prints warning messages to
stderr and returns. The flow of execution is not changed. stderr and returns. The flow of execution is not changed.
This is what calc does by default. This is what calc does by default.
2) Supply your own warning function: 2) Supply your own warning function:
void warning(char *fmt, ...); void warning(char *fmt, ...);
Your warning function should simply return when it is finished. Your warning function should simply return when it is finished.
External programs can obtain the appropriate calc symbols by compiling with: External programs can obtain the appropriate calc symbols by compiling with:
-I${INCDIR} -L${LIBDIR} -lcalc -I${INCDIR} -L${LIBDIR} -lcalc
--------------- ---------------
@@ -308,7 +308,7 @@ output strings with space filling, output formatted strings like printf, and
flush the output. Output from these routines is diverted as described above. flush the output. Output from these routines is diverted as described above.
You can change the default output mode by calling math_setmode, and you can You can change the default output mode by calling math_setmode, and you can
change the default number of digits printed by calling math_setdigits. These change the default number of digits printed by calling math_setdigits. These
routines return the previous values. The possible modes are described in routines return the previous values. The possible modes are described in
zmath.h. zmath.h.
@@ -320,7 +320,7 @@ The arbitrary precision integer routines define a structure called a ZVALUE.
This is defined in zmath.h. A ZVALUE contains a pointer to an array of This is defined in zmath.h. A ZVALUE contains a pointer to an array of
integers, the length of the array, and a sign flag. The array is allocated integers, the length of the array, and a sign flag. The array is allocated
using malloc, so you need to free this array when you are done with a using malloc, so you need to free this array when you are done with a
ZVALUE. To do this, you should call zfree() with the ZVALUE as an argument ZVALUE. To do this, you should call zfree() with the ZVALUE as an argument
and never try to free the array yourself using free(). The reason for this and never try to free the array yourself using free(). The reason for this
is that sometimes the pointer points to a statically allocated arrays which is that sometimes the pointer points to a statically allocated arrays which
should NOT be freed. should NOT be freed.
@@ -329,11 +329,11 @@ The ZVALUE structures are passed to routines by value, and are returned
through pointers. For example, to multiply two small integers together, through pointers. For example, to multiply two small integers together,
you could do the following: you could do the following:
ZVALUE z1, z2, z3; ZVALUE z1, z2, z3;
itoz(3L, &z1); itoz(3L, &z1);
itoz(4L, &z2); itoz(4L, &z2);
zmul(z1, z2, &z3); zmul(z1, z2, &z3);
Use zcopy to copy one ZVALUE to another. There is no sharing of arrays Use zcopy to copy one ZVALUE to another. There is no sharing of arrays
between different ZVALUEs even if they have the same value, so you MUST between different ZVALUEs even if they have the same value, so you MUST
@@ -354,67 +354,67 @@ address to a routine as a destination value, otherwise memory will be
lost. The following shows an example of the correct way to free memory lost. The following shows an example of the correct way to free memory
over a long sequence of operations. over a long sequence of operations.
ZVALUE z1, z2, z3; ZVALUE z1, z2, z3;
z1 = _one_; z1 = _one_;
str2z("12345678987654321", &z2); str2z("12345678987654321", &z2);
zadd(z1, z2, &z3); zadd(z1, z2, &z3);
zfree(z1); zfree(z1);
zfree(z2); zfree(z2);
zsquare(z3, &z1); zsquare(z3, &z1);
zfree(z3); zfree(z3);
itoz(17L, &z2); itoz(17L, &z2);
zsub(z1, z2, &z3); zsub(z1, z2, &z3);
zfree(z1); zfree(z1);
zfree(z2); zfree(z2);
zfree(z3); zfree(z3);
There are some quick checks you can make on integers. For example, whether There are some quick checks you can make on integers. For example, whether
or not they are zero, negative, even, and so on. These are all macros or not they are zero, negative, even, and so on. These are all macros
defined in zmath.h, and should be used instead of checking the parts of the defined in zmath.h, and should be used instead of checking the parts of the
ZVALUE yourself. Examples of such checks are: ZVALUE yourself. Examples of such checks are:
ziseven(z) (number is even) ziseven(z) (number is even)
zisodd(z) (number is odd) zisodd(z) (number is odd)
ziszero(z) (number is zero) ziszero(z) (number is zero)
zisneg(z) (number is negative) zisneg(z) (number is negative)
zispos(z) (number is positive) zispos(z) (number is positive)
zisunit(z) (number is 1 or -1) zisunit(z) (number is 1 or -1)
zisone(z) (number is 1) zisone(z) (number is 1)
zisnegone(z) (number is -1) zisnegone(z) (number is -1)
zistwo(z) (number is 2) zistwo(z) (number is 2)
zisabstwo(z) (number is 2 or -2) zisabstwo(z) (number is 2 or -2)
zisabsleone(z) (number is -1, 0 or 1) zisabsleone(z) (number is -1, 0 or 1)
zislezero(z) (number is <= 0) zislezero(z) (number is <= 0)
zisleone(z) (number is <= 1) zisleone(z) (number is <= 1)
zge16b(z) (number is >= 2^16) zge16b(z) (number is >= 2^16)
zge24b(z) (number is >= 2^24) zge24b(z) (number is >= 2^24)
zge31b(z) (number is >= 2^31) zge31b(z) (number is >= 2^31)
zge32b(z) (number is >= 2^32) zge32b(z) (number is >= 2^32)
zge64b(z) (number is >= 2^64) zge64b(z) (number is >= 2^64)
Typically the largest unsigned long is typedefed to FULL. The following Typically the largest unsigned long is typedefed to FULL. The following
macros are useful in dealing with this data type: macros are useful in dealing with this data type:
MAXFULL (largest positive FULL value) MAXFULL (largest positive FULL value)
MAXUFULL (largest unsigned FULL value) MAXUFULL (largest unsigned FULL value)
zgtmaxfull(z) (number is > MAXFULL) zgtmaxfull(z) (number is > MAXFULL)
zgtmaxufull(z) (number is > MAXUFULL) zgtmaxufull(z) (number is > MAXUFULL)
zgtmaxlong(z) (number is > MAXLONG, largest long value) zgtmaxlong(z) (number is > MAXLONG, largest long value)
zgtmaxulong(z) (number is > MAXULONG, largest unsigned long value) zgtmaxulong(z) (number is > MAXULONG, largest unsigned long value)
If zgtmaxufull(z) is false, then one may quickly convert the absolute If zgtmaxufull(z) is false, then one may quickly convert the absolute
value of number into a full with the macro: value of number into a full with the macro:
ztofull(z) (convert abs(number) to FULL) ztofull(z) (convert abs(number) to FULL)
ztoulong(z) (convert abs(number) to an unsigned long) ztoulong(z) (convert abs(number) to an unsigned long)
ztolong(z) (convert abs(number) to a long) ztolong(z) (convert abs(number) to a long)
If the value is too large for ztofull(), ztoulong() or ztolong(), only If the value is too large for ztofull(), ztoulong() or ztolong(), only
the low order bits converted. the low order bits converted.
There are two types of comparisons you can make on ZVALUEs. This is whether There are two types of comparisons you can make on ZVALUEs. This is whether
or not they are equal, or the ordering on size of the numbers. The zcmp or not they are equal, or the ordering on size of the numbers. The zcmp
function tests whether two ZVALUEs are equal, returning true if they differ. function tests whether two ZVALUEs are equal, returning true if they differ.
The zrel function tests the relative sizes of two ZVALUEs, returning -1 if The zrel function tests the relative sizes of two ZVALUEs, returning -1 if
the first one is smaller, 0 if they are the same, and 1 if the first one the first one is smaller, 0 if they are the same, and 1 if the first one
@@ -422,11 +422,11 @@ is larger.
To determine if z is an integer power of 2, use zispowerof2: To determine if z is an integer power of 2, use zispowerof2:
ZVALUE z; /* value to check if it is a power of */ ZVALUE z; /* value to check if it is a power of */
FULL log2; /* set to log base 2 of z when is_power_of_2 is true */ FULL log2; /* set to log base 2 of z when is_power_of_2 is true */
bool is_power_of_2; bool is_power_of_2;
is_power_of_2 = zispowerof2(z, &log2) is_power_of_2 = zispowerof2(z, &log2)
Returns true if z an integer power of 2: set log2 to log base 2 of z. Returns true if z an integer power of 2: set log2 to log base 2 of z.
Returns false if z is NOT integer power of 2 and leave log2 untouched. Returns false if z is NOT integer power of 2 and leave log2 untouched.
@@ -445,35 +445,35 @@ is always positive. If the NUMBER is an integer, the denominator has the
value 1. value 1.
Unlike ZVALUEs, NUMBERs are passed using pointers, and pointers to them are Unlike ZVALUEs, NUMBERs are passed using pointers, and pointers to them are
returned by functions. So the basic type for using fractions is not really returned by functions. So the basic type for using fractions is not really
(NUMBER), but is (NUMBER *). NUMBERs are allocated using the qalloc routine. (NUMBER), but is (NUMBER *). NUMBERs are allocated using the qalloc routine.
This returns a pointer to a number which has the value 1. Because of the This returns a pointer to a number which has the value 1. Because of the
special property of a ZVALUE of 1, the numerator and denominator of this special property of a ZVALUE of 1, the numerator and denominator of this
returned value can simply be overwritten with new ZVALUEs without needing returned value can simply be overwritten with new ZVALUEs without needing
to free them first. The following illustrates this: to free them first. The following illustrates this:
NUMBER *q; NUMBER *q;
q = qalloc(); q = qalloc();
itoz(55L, &q->num); itoz(55L, &q->num);
A better way to create NUMBERs with particular values is to use the itoq, A better way to create NUMBERs with particular values is to use the itoq,
iitoq, or str2q functions. Using itoq makes a long value into a NUMBER, iitoq, or str2q functions. Using itoq makes a long value into a NUMBER,
using iitoq makes a pair of longs into the numerator and denominator of a using iitoq makes a pair of longs into the numerator and denominator of a
NUMBER (reducing them first if needed), and str2q converts a string representing NUMBER (reducing them first if needed), and str2q converts a string representing
a number into the corresponding NUMBER. The str2q function accepts input in a number into the corresponding NUMBER. The str2q function accepts input in
integral, fractional, real, or exponential formats. Examples of allocating integral, fractional, real, or exponential formats. Examples of allocating
numbers are: numbers are:
NUMBER *q1, *q2, *q3, *q4; NUMBER *q1, *q2, *q3, *q4;
q1 = itoq(66L); q1 = itoq(66L);
q2 = iitoq(2L, 3L); q2 = iitoq(2L, 3L);
q3 = str2q("456.78"); q3 = str2q("456.78");
q4 = utoq((FULL) 1234567890L); q4 = utoq((FULL) 1234567890L);
Also unlike ZVALUEs, NUMBERs are quickly copied. This is because they contain Also unlike ZVALUEs, NUMBERs are quickly copied. This is because they contain
a link count, which is the number of pointers there are to the NUMBER. The a link count, which is the number of pointers there are to the NUMBER. The
qlink macro is used to copy a pointer to a NUMBER, and simply increments qlink macro is used to copy a pointer to a NUMBER, and simply increments
the link count and returns the same pointer. Since it is a macro, the the link count and returns the same pointer. Since it is a macro, the
argument should not be a function call, but a real pointer variable. The argument should not be a function call, but a real pointer variable. The
@@ -486,16 +486,16 @@ the ZVALUEs contained within the NUMBER, and then puts the NUMBER structure
onto a free list for quick reuse. The following is an example of allocating onto a free list for quick reuse. The following is an example of allocating
NUMBERs, copying them, adding them, and finally deleting them again. NUMBERs, copying them, adding them, and finally deleting them again.
NUMBER *q1, *q2, *q3, *q4; NUMBER *q1, *q2, *q3, *q4;
q1 = itoq(111L); q1 = itoq(111L);
q2 = qlink(q1); q2 = qlink(q1);
q3 = qqadd(q1, q2); q3 = qqadd(q1, q2);
q4 = qnum(q2, q3); q4 = qnum(q2, q3);
qfree(q1); qfree(q1);
qfree(q2); qfree(q2);
qfree(q3); qfree(q3);
Because of the passing of pointers and the ability to copy numbers easily, Because of the passing of pointers and the ability to copy numbers easily,
you might wish to use the rational number routines even for integral you might wish to use the rational number routines even for integral
@@ -513,55 +513,55 @@ There are some transcendental functions in the link library, such as sin
and cos. These cannot be evaluated exactly as fractions. Therefore, and cos. These cannot be evaluated exactly as fractions. Therefore,
they accept another argument which tells how accurate you want the result. they accept another argument which tells how accurate you want the result.
This is an "epsilon" value, and the returned value will be within that This is an "epsilon" value, and the returned value will be within that
quantity of the correct value. This is usually an absolute difference, quantity of the correct value. This is usually an absolute difference,
but for some functions (such as exp), this is a relative difference. but for some functions (such as exp), this is a relative difference.
For example, to calculate sin(0.5) to 100 decimal places, you could do: For example, to calculate sin(0.5) to 100 decimal places, you could do:
NUMBER *q, *ans, *epsilon; NUMBER *q, *ans, *epsilon;
q = str2q("0.5"); q = str2q("0.5");
epsilon = str2q("1e-100"); epsilon = str2q("1e-100");
ans = qsin(q, epsilon); ans = qsin(q, epsilon);
There are many convenience macros similar to the ones for ZVALUEs which can There are many convenience macros similar to the ones for ZVALUEs which can
give quick information about NUMBERs. In addition, there are some new ones give quick information about NUMBERs. In addition, there are some new ones
applicable to fractions. These are all defined in qmath.h. Some of these applicable to fractions. These are all defined in qmath.h. Some of these
macros are: macros are:
qiszero(q) (number is zero) qiszero(q) (number is zero)
qisneg(q) (number is negative) qisneg(q) (number is negative)
qispos(q) (number is positive) qispos(q) (number is positive)
qisint(q) (number is an integer) qisint(q) (number is an integer)
qisfrac(q) (number is fractional) qisfrac(q) (number is fractional)
qisunit(q) (number is 1 or -1) qisunit(q) (number is 1 or -1)
qisone(q) (number is 1) qisone(q) (number is 1)
qisnegone(q) (number is -1) qisnegone(q) (number is -1)
qistwo(q) (number is 2) qistwo(q) (number is 2)
qiseven(q) (number is an even integer) qiseven(q) (number is an even integer)
qisodd(q) (number is an odd integer) qisodd(q) (number is an odd integer)
qisreciprocal(q) (number is 1 / an integer and q != 0) qisreciprocal(q) (number is 1 / an integer and q != 0)
The comparisons for NUMBERs are similar to the ones for ZVALUEs. You use the The comparisons for NUMBERs are similar to the ones for ZVALUEs. You use the
qcmp and qrel functions. qcmp and qrel functions.
There are four predefined values for fractions. You should qlink them when There are four predefined values for fractions. You should qlink them when
you want to use them. These are _qzero_, _qone_, _qnegone_, and _qonehalf_. you want to use them. These are _qzero_, _qone_, _qnegone_, and _qonehalf_.
These have the values 0, 1, -1, and 1/2. An example of using them is: These have the values 0, 1, -1, and 1/2. An example of using them is:
NUMBER *q1, *q2; NUMBER *q1, *q2;
q1 = qlink(&_qonehalf_); q1 = qlink(&_qonehalf_);
q2 = qlink(&_qone_); q2 = qlink(&_qone_);
To determine if q is an integer power of 2, use qispowerof2: To determine if q is an integer power of 2, use qispowerof2:
NUMBER *q; /* value to check if it is a power of */ NUMBER *q; /* value to check if it is a power of */
NUMBER *qlog2; /* set to log base 2 of q when is_power_of_2 is true */ NUMBER *qlog2; /* set to log base 2 of q when is_power_of_2 is true */
bool is_power_of_2; bool is_power_of_2;
q = utoq((FULL) 1234567890L); q = utoq((FULL) 1234567890L);
qlog2 = qalloc(); qlog2 = qalloc();
is_power_of_2 = qispowerof2(q, &qlog2); is_power_of_2 = qispowerof2(q, &qlog2);
Returns true if q an integer power of 2: set *qlog2 to log base 2 of q. Returns true if q an integer power of 2: set *qlog2 to log base 2 of q.
Returns false if q is NOT integer power of 2 and leave *qlog2 untouched. Returns false if q is NOT integer power of 2 and leave *qlog2 untouched.
@@ -572,7 +572,7 @@ USING COMPLEX NUMBERS
--------------------- ---------------------
The arbitrary precision complex arithmetic routines define a structure The arbitrary precision complex arithmetic routines define a structure
called COMPLEX. This is defined in cmath.h. This contains two NUMBERs called COMPLEX. This is defined in cmath.h. This contains two NUMBERs
for the real and imaginary parts of a complex number, and a count of the for the real and imaginary parts of a complex number, and a count of the
number of links there are to this COMPLEX number. number of links there are to this COMPLEX number.
@@ -583,19 +583,19 @@ fractional parts using qqtoc. You can copy COMPLEX values using clink
which increments the link count. And you free a COMPLEX value using cfree. which increments the link count. And you free a COMPLEX value using cfree.
The following example illustrates this: The following example illustrates this:
NUMBER *q1, *q2; NUMBER *q1, *q2;
COMPLEX *c1, *c2, *c3; COMPLEX *c1, *c2, *c3;
q1 = itoq(3L); q1 = itoq(3L);
q2 = itoq(4L); q2 = itoq(4L);
c1 = qqtoc(q1, q2); c1 = qqtoc(q1, q2);
qfree(q1); qfree(q1);
qfree(q2); qfree(q2);
c2 = clink(c1); c2 = clink(c1);
c3 = cmul(c1, c2); c3 = cmul(c1, c2);
cfree(c1); cfree(c1);
cfree(c2); cfree(c2);
cfree(c3); cfree(c3);
As a shortcut, when you want to manipulate a COMPLEX value by a real value, As a shortcut, when you want to manipulate a COMPLEX value by a real value,
you can use the caddq, csubq, cmulq, and cdivq routines. These accept one you can use the caddq, csubq, cmulq, and cdivq routines. These accept one
@@ -605,33 +605,33 @@ There is no direct routine to convert a string value into a COMPLEX value.
But you can do this yourself by converting two strings into two NUMBERS, But you can do this yourself by converting two strings into two NUMBERS,
and then using the qqtoc routine. and then using the qqtoc routine.
COMPLEX values are always returned from these routines. To split out the COMPLEX values are always returned from these routines. To split out the
real and imaginary parts into normal NUMBERs, you can simply qlink the real and imaginary parts into normal NUMBERs, you can simply qlink the
two components, as shown in the following example: two components, as shown in the following example:
COMPLEX *c; COMPLEX *c;
NUMBER *rp, *ip; NUMBER *rp, *ip;
c = calloc(); c = calloc();
rp = qlink(c->real); rp = qlink(c->real);
ip = qlink(c->imag); ip = qlink(c->imag);
There are many macros for checking quick things about complex numbers, There are many macros for checking quick things about complex numbers,
similar to the ZVALUE and NUMBER macros. In addition, there are some similar to the ZVALUE and NUMBER macros. In addition, there are some
only used for complex numbers. Examples of macros are: only used for complex numbers. Examples of macros are:
cisreal(c) (number is real) cisreal(c) (number is real)
cisimag(c) (number is pure imaginary) cisimag(c) (number is pure imaginary)
ciszero(c) (number is zero) ciszero(c) (number is zero)
cisnegone(c) (number is -1) cisnegone(c) (number is -1)
cisone(c) (number is 1) cisone(c) (number is 1)
cisrunit(c) (number is 1 or -1) cisrunit(c) (number is 1 or -1)
cisiunit(c) (number is i or -i) cisiunit(c) (number is i or -i)
cisunit(c) (number is 1, -1, i, or -i) cisunit(c) (number is 1, -1, i, or -i)
cistwo(c) (number is 2) cistwo(c) (number is 2)
cisint(c) (number is has integer real and imaginary parts) cisint(c) (number is has integer real and imaginary parts)
ciseven(c) (number is has even real and imaginary parts) ciseven(c) (number is has even real and imaginary parts)
cisodd(c) (number is has odd real and imaginary parts) cisodd(c) (number is has odd real and imaginary parts)
There is only one comparison you can make for COMPLEX values, and that is There is only one comparison you can make for COMPLEX values, and that is
for equality. The ccmp function returns true if two complex numbers differ. for equality. The ccmp function returns true if two complex numbers differ.
@@ -641,13 +641,13 @@ That is, the imaginary part of the COMPLEX is 0. You may convert the
COMPLEX into a new allocated NUMBER that is real part of the COMPLEX value. COMPLEX into a new allocated NUMBER that is real part of the COMPLEX value.
For example: For example:
COMPLEX *c; COMPLEX *c;
NUMBER *q; NUMBER *q;
bool ok_to_free; /* true ==> free COMPLEX value, false ==> do not */ bool ok_to_free; /* true ==> free COMPLEX value, false ==> do not */
if (cisreal(c)) { if (cisreal(c)) {
q = c_to_q(c, ok_to_free); q = c_to_q(c, ok_to_free);
} }
The 2nd argument to c_to_q() determines if the complex argument should be freed The 2nd argument to c_to_q() determines if the complex argument should be freed
or not. Pass a false value as the 2nd arg if you wish to continue to use the or not. Pass a false value as the 2nd arg if you wish to continue to use the
@@ -655,13 +655,13 @@ COMPLEX value.
To convert a NUMBER into a COMPLEX value, use: To convert a NUMBER into a COMPLEX value, use:
COMPLEX *c; COMPLEX *c;
NUMBER *q; NUMBER *q;
c = q_to_c(q); c = q_to_c(q);
There are three predefined values for complex numbers. You should clink There are three predefined values for complex numbers. You should clink
them when you want to use them. They are _czero_, _cone_, and _conei_. them when you want to use them. They are _czero_, _cone_, and _conei_.
These have the values 0, 1, and i. These have the values 0, 1, and i.
---------------- ----------------
@@ -683,7 +683,7 @@ need call libcalc_call_me_last() only once.
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -691,8 +691,8 @@ need call libcalc_call_me_last() only once.
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 1993/07/30 19:44:49 ## Under source code control: 1993/07/30 19:44:49
## File existed as early as: 1993 ## File existed as early as: 1993
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

12
QUESTIONS
View File

@@ -1,7 +1,7 @@
If you have a general question about calc, consider opening If you have a general question about calc, consider opening
a new Github discussion under: a new Github discussion under:
https://github.com/lcn2/calc/discussions https://github.com/lcn2/calc/discussions
Look over the existing discussions to see of your question fits Look over the existing discussions to see of your question fits
under one of those exiting discussions. under one of those exiting discussions.
@@ -30,7 +30,7 @@ Please be patient as we cannot always respond to discussion messages quickly.
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -38,8 +38,8 @@ Please be patient as we cannot always respond to discussion messages quickly.
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 2021/02/10 00:15:05 ## Under source code control: 2021/02/10 00:15:05
## File existed as early as: 2021 ## File existed as early as: 2021
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

14
README.FIRST
View File

@@ -4,7 +4,7 @@ See the HOWTO.INSTALL file for information on how to build and install calc.
To be sure that your version of calc is up to date, check out: To be sure that your version of calc is up to date, check out:
http://www.isthe.com/chongo/tech/comp/calc/calc-download.html http://www.isthe.com/chongo/tech/comp/calc/calc-download.html
We are interested in any/all feedback on recent versions of calc. We are interested in any/all feedback on recent versions of calc.
In particular we would like to hear about: In particular we would like to hear about:
@@ -27,7 +27,7 @@ If you run into problems, see the BUGS file.
Calc is distributed with an extensive collection of help files that Calc is distributed with an extensive collection of help files that
are accessible from the command line. The following assume that you are accessible from the command line. The following assume that you
are running calc from the distribution directory or that you have are running calc from the distribution directory or that you have
installed calc. In these examples, the "; " is the calc prompt, not installed calc. In these examples, the "; " is the calc prompt, not
something that you type in. something that you type in.
For list of help topics: For list of help topics:
@@ -105,7 +105,7 @@ for information about how to ask a question.
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -113,8 +113,8 @@ for information about how to ask a question.
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 1995/10/25 05:27:59 ## Under source code control: 1995/10/25 05:27:59
## File existed as early as: 1995 ## File existed as early as: 1995
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

126
README.RELEASE
View File

@@ -2,15 +2,15 @@ On calc versions and releases
Calc version numbers have 4 levels. For example: Calc version numbers have 4 levels. For example:
++=== top 2 levels: calc builtin functions compatibility ++=== top 2 levels: calc builtin functions compatibility
|| ||
vvvv vvvv
2.14.0.8 2.14.0.8
\\\\\\ \\\\\\
^ \\\\----> top 3 levels: calc important code base change ^ \\\\----> top 3 levels: calc important code base change
| |
+--- top version level: internal representation compatibility +--- top version level: internal representation compatibility
The top version level (e.g., 2) refers to the internal representation The top version level (e.g., 2) refers to the internal representation
of values. Any library or hardware linked/built for calc 2 will be able of values. Any library or hardware linked/built for calc 2 will be able
@@ -35,10 +35,10 @@ a top 3 level release.
The file, "version.h" defines the 4 version levels: The file, "version.h" defines the 4 version levels:
MAJOR_VER /* level 1: major library version */ MAJOR_VER /* level 1: major library version */
MINOR_VER /* level 2: minor library version */ MINOR_VER /* level 2: minor library version */
MAJOR_PATCH /* level 3: major software version level */ MAJOR_PATCH /* level 3: major software version level */
MINOR_PATCH /* level 4: minor software version level */ MINOR_PATCH /* level 4: minor software version level */
The program "ver_calc" will print information about the compiled The program "ver_calc" will print information about the compiled
@@ -46,8 +46,8 @@ calc version as defined "version.h" when "ver_calc" was compiled:
usage: ./ver_calc [-h] [-V] usage: ./ver_calc [-h] [-V]
-h print this message and exit non-zero -h print this message and exit non-zero
-V print 3-level version (def: print 4-level version) -V print 3-level version (def: print 4-level version)
Also "calc -v" will print the calc version as defined "version.h" when Also "calc -v" will print the calc version as defined "version.h" when
"calc" was compiled. "calc" was compiled.
@@ -56,7 +56,7 @@ The master branch:
The public repository of calc source code is: The public repository of calc source code is:
http://github.com/lcn2/calc http://github.com/lcn2/calc
On that GitHub site you may find released version of calc, On that GitHub site you may find released version of calc,
"production", "tested" and "alpha". All commits on the master "production", "tested" and "alpha". All commits on the master
@@ -65,66 +65,66 @@ The master branch:
Any "alpha" commit is likely future code for a future Any "alpha" commit is likely future code for a future
"tested" or "production" version of calc. "tested" or "production" version of calc.
alpha ==> untagged GitHub commit alpha ==> untagged GitHub commit
Any untagged commit to the GitHub master branch should be Any untagged commit to the GitHub master branch should be
considered as alpha code that may make calc unstable. considered as alpha code that may make calc unstable.
While we try to avoid breaking the calc code with commits, While we try to avoid breaking the calc code with commits,
there is a risk that picking up such a change could there is a risk that picking up such a change could
negatively impact the code. negatively impact the code.
NOTE: The calc version found in "version.h", and printed NOTE: The calc version found in "version.h", and printed
by both "ver_calc [-V]" and "calc -v" for an untagged by both "ver_calc [-V]" and "calc -v" for an untagged
commit is the previous "tested" or "production" version commit is the previous "tested" or "production" version
of calc. Any "alpha" changes that remain are code of calc. Any "alpha" changes that remain are code
for some future version of calc. for some future version of calc.
At the last stage of the release process, "version.h" At the last stage of the release process, "version.h"
will be updated as well as the top level version range will be updated as well as the top level version range
listed in "CHANGES". listed in "CHANGES".
tested ==> tagged GitHub pre-release commit tested ==> tagged GitHub pre-release commit
A new version of calc has been released and has recently passed A new version of calc has been released and has recently passed
regression testing on at least to different platforms and chip regression testing on at least to different platforms and chip
architectures. architectures.
The "tested" class was historically called "untested", The "tested" class was historically called "untested",
however this term was misleading as such releases ARE tested. however this term was misleading as such releases ARE tested.
Since 2.14.0.13 we have used the term "tested". Since 2.14.0.13 we have used the term "tested".
All tested releases are tagged with a new version number. All tested releases are tagged with a new version number.
Such releases have GitHub assets such as a source tarball, Such releases have GitHub assets such as a source tarball,
zip file, source rpm, development rpm and binary rpm. See the zip file, source rpm, development rpm and binary rpm. See the
orange "Pre-release" GitHub releases under: orange "Pre-release" GitHub releases under:
https://github.com/lcn2/calc/releases https://github.com/lcn2/calc/releases
At the bottom of a given release is a "> Assets" that may At the bottom of a given release is a "> Assets" that may
be opened to reveal down-loadable files. be opened to reveal down-loadable files.
production ==> tagged GitHub release commit production ==> tagged GitHub release commit
A new version of calc has been released and has undergone A new version of calc has been released and has undergone
extensive testing over time over a number of platforms. extensive testing over time over a number of platforms.
Sometimes a "tested" release that is found work well over Sometimes a "tested" release that is found work well over
a period of time will be re-released with a new version a period of time will be re-released with a new version
number as a "production" release. number as a "production" release.
The latest production GitHub release is marked with green The latest production GitHub release is marked with green
"Latest" label under: "Latest" label under:
https://github.com/lcn2/calc/releases https://github.com/lcn2/calc/releases
A release that has neither an orange "Pre-release" nor A release that has neither an orange "Pre-release" nor
a green "Latest" label is a prior production class release. a green "Latest" label is a prior production class release.
At the bottom of a given release is a "> Assets" that may At the bottom of a given release is a "> Assets" that may
be opened to reveal down-loadable files. be opened to reveal down-loadable files.
Production class code where stability is critical should use a Production class code where stability is critical should use a
"production" release. "production" release.
A historical note and apology: A historical note and apology:
@@ -143,7 +143,7 @@ A historical note and apology:
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -151,8 +151,8 @@ A historical note and apology:
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 2021/12/12 19:36:26 ## Under source code control: 2021/12/12 19:36:26
## File existed as early as: 2021 ## File existed as early as: 2021
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

48
README.WINDOWS
View File

@@ -23,7 +23,7 @@ BTW: While we are unable to use Windows 11, we welcome Windows 11
virtual machine). If you are able to compile Windows 11 natively, virtual machine). If you are able to compile Windows 11 natively,
we would welcome GitHub pull requests showing any needed modifications: we would welcome GitHub pull requests showing any needed modifications:
https://github.com/lcn2/calc/pulls https://github.com/lcn2/calc/pulls
We were given this advice from a Windows 11 developer: We were given this advice from a Windows 11 developer:
@@ -32,9 +32,9 @@ We were given this advice from a Windows 11 developer:
https://cygwin.com/install.html https://cygwin.com/install.html
IMPORTANT: While installing Cygwin, and during Cygwin Setup, be sure to IMPORTANT: While installing Cygwin, and during Cygwin Setup, be sure to
select all the MinGW64 packages relating to gcc. select all the MinGW64 packages relating to gcc.
See the "Compiling with Cygwin" section below. See the "Compiling with Cygwin" section below.
NOTE: Compiling calc under Windows 11 is work in progress. If you run into NOTE: Compiling calc under Windows 11 is work in progress. If you run into
problems, consider the "Compiling with Cygwin" section below. problems, consider the "Compiling with Cygwin" section below.
@@ -79,11 +79,11 @@ compilation steps that GitHub user @Leoongithub recommends:
0. Install the latest version of cygwin (https://cygwin.com/install.html). 0. Install the latest version of cygwin (https://cygwin.com/install.html).
NOTE: In addition to the default packages, you also need to check these NOTE: In addition to the default packages, you also need to check these
three packages: gcc-core, make, and libreadline-devel. The version three packages: gcc-core, make, and libreadline-devel. The version
of these packages does not matter. Just choose the latest version. of these packages does not matter. Just choose the latest version.
NOTE: The addition of "target=Cygwin" to make commands below NOTE: The addition of "target=Cygwin" to make commands below
is done just in case the target is not set properly by make. is done just in case the target is not set properly by make.
1. Change (cd) into the top of the source code directory of calc. 1. Change (cd) into the top of the source code directory of calc.
@@ -92,35 +92,35 @@ compilation steps that GitHub user @Leoongithub recommends:
2. make clobber target=Cygwin 2. make clobber target=Cygwin
NOTE: This helps ensure that you are starting from a so-called "clean slate", NOTE: This helps ensure that you are starting from a so-called "clean slate",
and that you have nothing hanging around from previous attempts to compile. and that you have nothing hanging around from previous attempts to compile.
3. make all target=Cygwin 3. make all target=Cygwin
NOTE: If successful, you should have a calc executable. However that executable NOTE: If successful, you should have a calc executable. However that executable
may not be working properly. Advance to step (4) to test. may not be working properly. Advance to step (4) to test.
4. make chk target=Cygwin 4. make chk target=Cygwin
NOTE: If you want this command be be verbose, try: NOTE: If you want this command be be verbose, try:
make check target=Cygwin make check target=Cygwin
NOTE: This will run calc with the regress.cal regression suite. This step could take NOTE: This will run calc with the regress.cal regression suite. This step could take
for a while to run, depending on the speed/performance of your machine. for a while to run, depending on the speed/performance of your machine.
If all is well (all regression tests pass), you will see at the end: If all is well (all regression tests pass), you will see at the end:
chk OK chk OK
Otherwise you may see calc exit non-zero after it prints some lines with '****' Otherwise you may see calc exit non-zero after it prints some lines with '****'
error messages followed by a line including a final error count of the form: error messages followed by a line including a final error count of the form:
**** 2 error(s) found \/++\/ **** 2 error(s) found \/++\/
If you see some errors that may relate to files and I/O, all may not be lost. If you see some errors that may relate to files and I/O, all may not be lost.
It could simply mean that your Windows environment is not conforming to standard It could simply mean that your Windows environment is not conforming to standard
I/O and file operations. The calc mathematical engine may be just fine. On the I/O and file operations. The calc mathematical engine may be just fine. On the
other hand if you see mathematical related regression test failures, this is other hand if you see mathematical related regression test failures, this is
bad sign that your calc executable under Windows is not usable. bad sign that your calc executable under Windows is not usable.
5. make install target=Cygwin 5. make install target=Cygwin
@@ -136,7 +136,7 @@ We would prefer a Windows 11 solution that does not require a Windows 11
developer to install a Linux virtual machine. Nevertheless, a Windows 11 developer to install a Linux virtual machine. Nevertheless, a Windows 11
user might want to use the Microsoft Windows Subsystem (WSL) for Linux: user might want to use the Microsoft Windows Subsystem (WSL) for Linux:
https://docs.microsoft.com/en-us/windows/wsl/ https://docs.microsoft.com/en-us/windows/wsl/
We have been told that you will need to turn on virtualization We have been told that you will need to turn on virtualization
to use this WSL subsystem. to use this WSL subsystem.
@@ -168,7 +168,7 @@ NOTE: The use of calc under Windows 10 has been deprecated in favor of one
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -176,8 +176,8 @@ NOTE: The use of calc under Windows 10 has been deprecated in favor of one
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 2001/02/25 14:00:05 ## Under source code control: 2001/02/25 14:00:05
## File existed as early as: 2001 ## File existed as early as: 2001
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

12
README.md
View File

@@ -24,7 +24,7 @@ via zsh: calc
Calc is an interactive calculator which provides for easy large Calc is an interactive calculator which provides for easy large
numeric calculations, but which also can be easily programmed numeric calculations, but which also can be easily programmed
for difficult or long calculations. It can accept a command line for difficult or long calculations. It can accept a command line
argument, in which case it executes that single command and exits. argument, in which case it executes that single command and exits.
Otherwise, it enters interactive mode. In this mode, it accepts Otherwise, it enters interactive mode. In this mode, it accepts
commands one at a time, processes them, and displays the answers. commands one at a time, processes them, and displays the answers.
@@ -189,12 +189,12 @@ followed by a function declaration very similar to C.
```sh ```sh
define f2(n) define f2(n)
{ {
local ans; local ans;
ans = 1; ans = 1;
while (n > 1) while (n > 1)
ans *= (n -= 2); ans *= (n -= 2);
return ans; return ans;
} }
``` ```

922
addop.c
View File

File diff suppressed because it is too large Load Diff

64
align32.c
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/11/23 05:18:06 * Under source code control: 1995/11/23 05:18:06
* File existed as early as: 1995 * File existed as early as: 1995
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -42,42 +42,42 @@
#include "have_unused.h" #include "have_unused.h"
#include "banned.h" /* include after system header <> includes */ #include "banned.h" /* include after system header <> includes */
static void buserr(int arg); /* catch alignment errors */ static void buserr(int arg); /* catch alignment errors */
int int
main(void) main(void)
{ {
char byte[2*sizeof(USB32)]; /* mis-alignment buffer */ char byte[2*sizeof(USB32)]; /* mis-alignment buffer */
USB32 *p; /* mis-alignment pointer */ USB32 *p; /* mis-alignment pointer */
unsigned long i; unsigned long i;
#if defined(MUST_ALIGN32) #if defined(MUST_ALIGN32)
/* force alignment */ /* force alignment */
printf("#define MUST_ALIGN32\t%c* forced to align 32 bit values *%c\n", printf("#define MUST_ALIGN32\t%c* forced to align 32 bit values *%c\n",
'/', '/'); '/', '/');
#else #else
/* setup to catch alignment bus errors */ /* setup to catch alignment bus errors */
signal(SIGBUS, buserr); signal(SIGBUS, buserr);
signal(SIGSEGV, buserr); /* some systems will generate SEGV instead! */ signal(SIGSEGV, buserr); /* some systems will generate SEGV instead! */
/* mis-align our long fetches */ /* mis-align our long fetches */
for (i=0; i < sizeof(USB32); ++i) { for (i=0; i < sizeof(USB32); ++i) {
p = (USB32 *)(byte+i); p = (USB32 *)(byte+i);
*p = i; *p = i;
*p += 1; *p += 1;
} }
/* if we got here, then we can mis-align longs */ /* if we got here, then we can mis-align longs */
printf("#undef MUST_ALIGN32\t%c* can mis-align 32 bit values *%c\n", printf("#undef MUST_ALIGN32\t%c* can mis-align 32 bit values *%c\n",
'/', '/'); '/', '/');
#endif #endif
/* exit(0); */ /* exit(0); */
return 0; return 0;
} }
@@ -85,14 +85,14 @@ main(void)
* buserr - catch an alignment error * buserr - catch an alignment error
* *
* given: * given:
* arg to keep ANSI C happy * arg to keep ANSI C happy
*/ */
/*ARGSUSED*/ /*ARGSUSED*/
static void static void
buserr(int UNUSED(arg)) buserr(int UNUSED(arg))
{ {
/* alignment is required */ /* alignment is required */
printf("#define MUST_ALIGN32\t%c* must align 32 bit values *%c\n", printf("#define MUST_ALIGN32\t%c* must align 32 bit values *%c\n",
'/', '/'); '/', '/');
exit(0); exit(0);
} }

10
alloc.h
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:48:29 * Under source code control: 1990/02/15 01:48:29
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -28,7 +28,7 @@
#define INCLUDE_ALLOC_H #define INCLUDE_ALLOC_H
#if defined(CALC_SRC) /* if we are building from the calc source tree */ #if defined(CALC_SRC) /* if we are building from the calc source tree */
# include "have_newstr.h" # include "have_newstr.h"
# include "have_string.h" # include "have_string.h"
# include "have_memmv.h" # include "have_memmv.h"

638
assocfunc.c
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1993/07/20 23:04:27 * Under source code control: 1993/07/20 23:04:27
* File existed as early as: 1993 * File existed as early as: 1993
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -37,13 +37,13 @@
#include "errtbl.h" #include "errtbl.h"
#include "banned.h" /* include after system header <> includes */ #include "banned.h" /* include after system header <> includes */
#define MINHASHSIZE 31 /* minimum size of hash tables */ #define MINHASHSIZE 31 /* minimum size of hash tables */
#define GROWHASHSIZE 50 /* approximate growth for hash tables */ #define GROWHASHSIZE 50 /* approximate growth for hash tables */
#define CHAINLENGTH 10 /* desired number of elements on a hash chain */ #define CHAINLENGTH 10 /* desired number of elements on a hash chain */
#define ELEMSIZE(n) (sizeof(ASSOCELEM) + (sizeof(VALUE) * ((n) - 1))) #define ELEMSIZE(n) (sizeof(ASSOCELEM) + (sizeof(VALUE) * ((n) - 1)))
S_FUNC ASSOCELEM *elemindex(ASSOC *ap, long index); S_FUNC ASSOCELEM *elemindex(ASSOC *ap, long index);
@@ -59,75 +59,75 @@ S_FUNC void assoc_elemfree(ASSOCELEM *ep);
* the index value doesn't exist, a pointer to a NULL value is returned. * the index value doesn't exist, a pointer to a NULL value is returned.
* *
* given: * given:
* ap association to index into * ap association to index into
* create whether to create the index value * create whether to create the index value
* dim dimension of the indexing * dim dimension of the indexing
* indices table of values being indexed by * indices table of values being indexed by
*/ */
VALUE * VALUE *
associndex(ASSOC *ap, bool create, long dim, VALUE *indices) associndex(ASSOC *ap, bool create, long dim, VALUE *indices)
{ {
ASSOCELEM **listhead; ASSOCELEM **listhead;
ASSOCELEM *ep; ASSOCELEM *ep;
STATIC VALUE val; STATIC VALUE val;
QCKHASH hash; QCKHASH hash;
int i; int i;
if (dim < 0) { if (dim < 0) {
math_error("Negative dimension for indexing association"); math_error("Negative dimension for indexing association");
not_reached(); not_reached();
} }
/* /*
* Calculate the hash value to use for this set of indices * Calculate the hash value to use for this set of indices
* so that we can first select the correct hash chain, and * so that we can first select the correct hash chain, and
* also so we can quickly compare each element for a match. * also so we can quickly compare each element for a match.
*/ */
hash = QUICKHASH_BASIS; hash = QUICKHASH_BASIS;
for (i = 0; i < dim; i++) for (i = 0; i < dim; i++)
hash = hashvalue(&indices[i], hash); hash = hashvalue(&indices[i], hash);
/* /*
* Search the correct hash chain for the specified set of indices. * Search the correct hash chain for the specified set of indices.
* If found, return the address of the found element's value. * If found, return the address of the found element's value.
*/ */
listhead = &ap->a_table[hash % ap->a_size]; listhead = &ap->a_table[hash % ap->a_size];
for (ep = *listhead; ep; ep = ep->e_next) { for (ep = *listhead; ep; ep = ep->e_next) {
if ((ep->e_hash != hash) || (ep->e_dim != dim)) if ((ep->e_hash != hash) || (ep->e_dim != dim))
continue; continue;
if (compareindices(ep->e_indices, indices, dim)) if (compareindices(ep->e_indices, indices, dim))
return &ep->e_value; return &ep->e_value;
} }
/* /*
* The set of indices was not found. * The set of indices was not found.
* Either return a pointer to a NULL value for a read reference, * Either return a pointer to a NULL value for a read reference,
* or allocate a new element in the list for a write reference. * or allocate a new element in the list for a write reference.
*/ */
if (!create) { if (!create) {
val.v_type = V_NULL; val.v_type = V_NULL;
val.v_subtype = V_NOSUBTYPE; val.v_subtype = V_NOSUBTYPE;
return &val; return &val;
} }
ep = (ASSOCELEM *) malloc(ELEMSIZE(dim)); ep = (ASSOCELEM *) malloc(ELEMSIZE(dim));
if (ep == NULL) { if (ep == NULL) {
math_error("Cannot allocate association element"); math_error("Cannot allocate association element");
not_reached(); not_reached();
} }
ep->e_dim = dim; ep->e_dim = dim;
ep->e_hash = hash; ep->e_hash = hash;
ep->e_value.v_type = V_NULL; ep->e_value.v_type = V_NULL;
ep->e_value.v_subtype = V_NOSUBTYPE; ep->e_value.v_subtype = V_NOSUBTYPE;
for (i = 0; i < dim; i++) for (i = 0; i < dim; i++)
copyvalue(&indices[i], &ep->e_indices[i]); copyvalue(&indices[i], &ep->e_indices[i]);
ep->e_next = *listhead; ep->e_next = *listhead;
*listhead = ep; *listhead = ep;
ap->a_count++; ap->a_count++;
resize(ap, ap->a_count / CHAINLENGTH); resize(ap, ap->a_count / CHAINLENGTH);
return &ep->e_value; return &ep->e_value;
} }
@@ -139,25 +139,25 @@ associndex(ASSOC *ap, bool create, long dim, VALUE *indices)
int int
assocsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index) assocsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
{ {
ASSOCELEM *ep; ASSOCELEM *ep;
if (i < 0 || j > ap->a_count) { if (i < 0 || j > ap->a_count) {
math_error("This should not happen in assocsearch"); math_error("This should not happen in assocsearch");
not_reached(); not_reached();
} }
while (i < j) { while (i < j) {
ep = elemindex(ap, i); ep = elemindex(ap, i);
if (ep == NULL) { if (ep == NULL) {
math_error("This should not happen in assocsearch"); math_error("This should not happen in assocsearch");
not_reached(); not_reached();
} }
if (acceptvalue(&ep->e_value, vp)) { if (acceptvalue(&ep->e_value, vp)) {
utoz(i, index); utoz(i, index);
return 0; return 0;
} }
i++; i++;
} }
return 1; return 1;
} }
@@ -169,26 +169,26 @@ assocsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
int int
assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index) assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
{ {
ASSOCELEM *ep; ASSOCELEM *ep;
if (i < 0 || j > ap->a_count) { if (i < 0 || j > ap->a_count) {
math_error("This should not happen in assocsearch"); math_error("This should not happen in assocsearch");
not_reached(); not_reached();
} }
j--; j--;
while (j >= i) { while (j >= i) {
ep = elemindex(ap, j); ep = elemindex(ap, j);
if (ep == NULL) { if (ep == NULL) {
math_error("This should not happen in assocsearch"); math_error("This should not happen in assocsearch");
not_reached(); not_reached();
} }
if (acceptvalue(&ep->e_value, vp)) { if (acceptvalue(&ep->e_value, vp)) {
utoz(j, index); utoz(j, index);
return 0; return 0;
} }
j--; j--;
} }
return 1; return 1;
} }
@@ -197,29 +197,29 @@ assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
* double-bracket operation. * double-bracket operation.
* *
* given: * given:
* ap association to index into * ap association to index into
* index index of desired element * index index of desired element
*/ */
S_FUNC ASSOCELEM * S_FUNC ASSOCELEM *
elemindex(ASSOC *ap, long index) elemindex(ASSOC *ap, long index)
{ {
ASSOCELEM *ep; ASSOCELEM *ep;
int i; int i;
if ((index < 0) || (index > ap->a_count)) if ((index < 0) || (index > ap->a_count))
return NULL; return NULL;
/* /*
* This loop should be made more efficient by remembering * This loop should be made more efficient by remembering
* previously requested locations within the association. * previously requested locations within the association.
*/ */
for (i = 0; i < ap->a_size; i++) { for (i = 0; i < ap->a_size; i++) {
for (ep = ap->a_table[i]; ep; ep = ep->e_next) { for (ep = ap->a_table[i]; ep; ep = ep->e_next) {
if (index-- == 0) if (index-- == 0)
return ep; return ep;
} }
} }
return NULL; return NULL;
} }
@@ -228,18 +228,18 @@ elemindex(ASSOC *ap, long index)
* of an association. Returns NULL if there is no such element. * of an association. Returns NULL if there is no such element.
* *
* given: * given:
* ap association to index into * ap association to index into
* index index of desired element * index index of desired element
*/ */
VALUE * VALUE *
assocfindex(ASSOC *ap, long index) assocfindex(ASSOC *ap, long index)
{ {
ASSOCELEM *ep; ASSOCELEM *ep;
ep = elemindex(ap, index); ep = elemindex(ap, index);
if (ep == NULL) if (ep == NULL)
return NULL; return NULL;
return &ep->e_value; return &ep->e_value;
} }
@@ -250,17 +250,17 @@ assocfindex(ASSOC *ap, long index)
LIST * LIST *
associndices(ASSOC *ap, long index) associndices(ASSOC *ap, long index)
{ {
ASSOCELEM *ep; ASSOCELEM *ep;
LIST *lp; LIST *lp;
int i; int i;
ep = elemindex(ap, index); ep = elemindex(ap, index);
if (ep == NULL) if (ep == NULL)
return NULL; return NULL;
lp = listalloc(); lp = listalloc();
for (i = 0; i < ep->e_dim; i++) for (i = 0; i < ep->e_dim; i++)
insertlistlast(lp, &ep->e_indices[i]); insertlistlast(lp, &ep->e_indices[i]);
return lp; return lp;
} }
@@ -271,43 +271,43 @@ associndices(ASSOC *ap, long index)
bool bool
assoccmp(ASSOC *ap1, ASSOC *ap2) assoccmp(ASSOC *ap1, ASSOC *ap2)
{ {
ASSOCELEM **table1; ASSOCELEM **table1;
ASSOCELEM *ep1; ASSOCELEM *ep1;
ASSOCELEM *ep2; ASSOCELEM *ep2;
long size1; long size1;
long size2; long size2;
QCKHASH hash; QCKHASH hash;
long dim; long dim;
if (ap1 == ap2) if (ap1 == ap2)
return false; return false;
if (ap1->a_count != ap2->a_count) if (ap1->a_count != ap2->a_count)
return true; return true;
table1 = ap1->a_table; table1 = ap1->a_table;
size1 = ap1->a_size; size1 = ap1->a_size;
size2 = ap2->a_size; size2 = ap2->a_size;
while (size1-- > 0) { while (size1-- > 0) {
for (ep1 = *table1++; ep1; ep1 = ep1->e_next) { for (ep1 = *table1++; ep1; ep1 = ep1->e_next) {
hash = ep1->e_hash; hash = ep1->e_hash;
dim = ep1->e_dim; dim = ep1->e_dim;
for (ep2 = ap2->a_table[hash % size2]; ; for (ep2 = ap2->a_table[hash % size2]; ;
ep2 = ep2->e_next) { ep2 = ep2->e_next) {
if (ep2 == NULL) if (ep2 == NULL)
return true; return true;
if (ep2->e_hash != hash) if (ep2->e_hash != hash)
continue; continue;
if (ep2->e_dim != dim) if (ep2->e_dim != dim)
continue; continue;
if (compareindices(ep1->e_indices, if (compareindices(ep1->e_indices,
ep2->e_indices, dim)) ep2->e_indices, dim))
break; break;
} }
if (comparevalue(&ep1->e_value, &ep2->e_value)) if (comparevalue(&ep1->e_value, &ep2->e_value))
return true; return true;
} }
} }
return false; return false;
} }
@@ -317,39 +317,39 @@ assoccmp(ASSOC *ap1, ASSOC *ap2)
ASSOC * ASSOC *
assoccopy(ASSOC *oldap) assoccopy(ASSOC *oldap)
{ {
ASSOC *ap; ASSOC *ap;
ASSOCELEM *oldep; ASSOCELEM *oldep;
ASSOCELEM *ep; ASSOCELEM *ep;
ASSOCELEM **listhead; ASSOCELEM **listhead;
int oldhi; int oldhi;
int i; int i;
ap = assocalloc(oldap->a_count / CHAINLENGTH); ap = assocalloc(oldap->a_count / CHAINLENGTH);
ap->a_count = oldap->a_count; ap->a_count = oldap->a_count;
for (oldhi = 0; oldhi < oldap->a_size; oldhi++) { for (oldhi = 0; oldhi < oldap->a_size; oldhi++) {
for (oldep = oldap->a_table[oldhi]; oldep; for (oldep = oldap->a_table[oldhi]; oldep;
oldep = oldep->e_next) { oldep = oldep->e_next) {
ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim)); ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim));
if (ep == NULL) { if (ep == NULL) {
math_error("Cannot allocate " math_error("Cannot allocate "
"association element"); "association element");
not_reached(); not_reached();
} }
ep->e_dim = oldep->e_dim; ep->e_dim = oldep->e_dim;
ep->e_hash = oldep->e_hash; ep->e_hash = oldep->e_hash;
ep->e_value.v_type = V_NULL; ep->e_value.v_type = V_NULL;
ep->e_value.v_subtype = V_NOSUBTYPE; ep->e_value.v_subtype = V_NOSUBTYPE;
for (i = 0; i < ep->e_dim; i++) for (i = 0; i < ep->e_dim; i++)
copyvalue(&oldep->e_indices[i], copyvalue(&oldep->e_indices[i],
&ep->e_indices[i]); &ep->e_indices[i]);
copyvalue(&oldep->e_value, &ep->e_value); copyvalue(&oldep->e_value, &ep->e_value);
listhead = &ap->a_table[ep->e_hash % ap->a_size]; listhead = &ap->a_table[ep->e_hash % ap->a_size];
ep->e_next = *listhead; ep->e_next = *listhead;
*listhead = ep; *listhead = ep;
} }
} }
return ap; return ap;
} }
@@ -361,41 +361,41 @@ assoccopy(ASSOC *oldap)
S_FUNC void S_FUNC void
resize(ASSOC *ap, long newsize) resize(ASSOC *ap, long newsize)
{ {
ASSOCELEM **oldtable; ASSOCELEM **oldtable;
ASSOCELEM **newtable; ASSOCELEM **newtable;
ASSOCELEM **oldlist; ASSOCELEM **oldlist;
ASSOCELEM **newlist; ASSOCELEM **newlist;
ASSOCELEM *ep; ASSOCELEM *ep;
int i; int i;
if (newsize < ap->a_size + GROWHASHSIZE) if (newsize < ap->a_size + GROWHASHSIZE)
return; return;
newsize = (long) next_prime((FULL)newsize); newsize = (long) next_prime((FULL)newsize);
newtable = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * newsize); newtable = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * newsize);
if (newtable == NULL) { if (newtable == NULL) {
math_error("No memory to grow association"); math_error("No memory to grow association");
not_reached(); not_reached();
} }
for (i = 0; i < newsize; i++) for (i = 0; i < newsize; i++)
newtable[i] = NULL; newtable[i] = NULL;
oldtable = ap->a_table; oldtable = ap->a_table;
oldlist = oldtable; oldlist = oldtable;
for (i = 0; i < ap->a_size; i++) { for (i = 0; i < ap->a_size; i++) {
while (*oldlist) { while (*oldlist) {
ep = *oldlist; ep = *oldlist;
*oldlist = ep->e_next; *oldlist = ep->e_next;
newlist = &newtable[ep->e_hash % newsize]; newlist = &newtable[ep->e_hash % newsize];
ep->e_next = *newlist; ep->e_next = *newlist;
*newlist = ep; *newlist = ep;
} }
oldlist++; oldlist++;
} }
ap->a_table = newtable; ap->a_table = newtable;
ap->a_size = newsize; ap->a_size = newsize;
free((char *) oldtable); free((char *) oldtable);
} }
@@ -405,14 +405,14 @@ resize(ASSOC *ap, long newsize)
S_FUNC void S_FUNC void
assoc_elemfree(ASSOCELEM *ep) assoc_elemfree(ASSOCELEM *ep)
{ {
int i; int i;
for (i = 0; i < ep->e_dim; i++) for (i = 0; i < ep->e_dim; i++)
freevalue(&ep->e_indices[i]); freevalue(&ep->e_indices[i]);
freevalue(&ep->e_value); freevalue(&ep->e_value);
ep->e_dim = 0; ep->e_dim = 0;
ep->e_next = NULL; ep->e_next = NULL;
free((char *) ep); free((char *) ep);
} }
@@ -423,27 +423,27 @@ assoc_elemfree(ASSOCELEM *ep)
ASSOC * ASSOC *
assocalloc(long initsize) assocalloc(long initsize)
{ {
register ASSOC *ap; register ASSOC *ap;
int i; int i;
if (initsize < MINHASHSIZE) if (initsize < MINHASHSIZE)
initsize = MINHASHSIZE; initsize = MINHASHSIZE;
ap = (ASSOC *) malloc(sizeof(ASSOC)); ap = (ASSOC *) malloc(sizeof(ASSOC));
if (ap == NULL) { if (ap == NULL) {
math_error("No memory for association"); math_error("No memory for association");
not_reached(); not_reached();
} }
ap->a_count = 0; ap->a_count = 0;
ap->a_size = initsize; ap->a_size = initsize;
ap->a_table = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * initsize); ap->a_table = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * initsize);
if (ap->a_table == NULL) { if (ap->a_table == NULL) {
free((char *) ap); free((char *) ap);
math_error("No memory for association"); math_error("No memory for association");
not_reached(); not_reached();
} }
for (i = 0; i < initsize; i++) for (i = 0; i < initsize; i++)
ap->a_table[i] = NULL; ap->a_table[i] = NULL;
return ap; return ap;
} }
@@ -453,25 +453,25 @@ assocalloc(long initsize)
void void
assocfree(ASSOC *ap) assocfree(ASSOC *ap)
{ {
ASSOCELEM **listhead; ASSOCELEM **listhead;
ASSOCELEM *ep; ASSOCELEM *ep;
ASSOCELEM *nextep; ASSOCELEM *nextep;
int i; int i;
listhead = ap->a_table; listhead = ap->a_table;
for (i = 0; i < ap->a_size; i++) { for (i = 0; i < ap->a_size; i++) {
nextep = *listhead; nextep = *listhead;
*listhead = NULL; *listhead = NULL;
while (nextep) { while (nextep) {
ep = nextep; ep = nextep;
nextep = ep->e_next; nextep = ep->e_next;
assoc_elemfree(ep); assoc_elemfree(ep);
} }
listhead++; listhead++;
} }
free((char *) ap->a_table); free((char *) ap->a_table);
ap->a_table = NULL; ap->a_table = NULL;
free((char *) ap); free((char *) ap);
} }
@@ -482,39 +482,39 @@ assocfree(ASSOC *ap)
void void
assocprint(ASSOC *ap, long max_print) assocprint(ASSOC *ap, long max_print)
{ {
ASSOCELEM *ep; ASSOCELEM *ep;
long index; long index;
long i; long i;
int savemode; int savemode;
if (max_print <= 0) { if (max_print <= 0) {
math_fmt("assoc (%ld element%s)", ap->a_count, math_fmt("assoc (%ld element%s)", ap->a_count,
((ap->a_count == 1) ? "" : "s")); ((ap->a_count == 1) ? "" : "s"));
return; return;
} }
math_fmt("\n assoc (%ld element%s):\n", ap->a_count, math_fmt("\n assoc (%ld element%s):\n", ap->a_count,
((ap->a_count == 1) ? "" : "s")); ((ap->a_count == 1) ? "" : "s"));
for (index = 0; ((index < max_print) && (index < ap->a_count)); for (index = 0; ((index < max_print) && (index < ap->a_count));
index++) { index++) {
ep = elemindex(ap, index); ep = elemindex(ap, index);
if (ep == NULL) if (ep == NULL)
continue; continue;
math_str(" ["); math_str(" [");
for (i = 0; i < ep->e_dim; i++) { for (i = 0; i < ep->e_dim; i++) {
if (i) if (i)
math_chr(','); math_chr(',');
savemode = math_setmode(MODE_FRAC); savemode = math_setmode(MODE_FRAC);
printvalue(&ep->e_indices[i], printvalue(&ep->e_indices[i],
(PRINT_SHORT | PRINT_UNAMBIG)); (PRINT_SHORT | PRINT_UNAMBIG));
math_setmode(savemode); math_setmode(savemode);
} }
math_str("] = "); math_str("] = ");
printvalue(&ep->e_value, PRINT_SHORT | PRINT_UNAMBIG); printvalue(&ep->e_value, PRINT_SHORT | PRINT_UNAMBIG);
math_chr('\n'); math_chr('\n');
} }
if (max_print < ap->a_count) if (max_print < ap->a_count)
math_str(" ...\n"); math_str(" ...\n");
} }
@@ -525,15 +525,15 @@ assocprint(ASSOC *ap, long max_print)
S_FUNC bool S_FUNC bool
compareindices(VALUE *v1, VALUE *v2, long dim) compareindices(VALUE *v1, VALUE *v2, long dim)
{ {
int i; int i;
for (i = 0; i < dim; i++) for (i = 0; i < dim; i++)
if (v1[i].v_type != v2[i].v_type) if (v1[i].v_type != v2[i].v_type)
return false; return false;
while (dim-- > 0) while (dim-- > 0)
if (comparevalue(v1++, v2++)) if (comparevalue(v1++, v2++))
return false; return false;
return true; return true;
} }

10
attribute.h
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2022/01/21 22:51:25 * Under source code control: 2022/01/21 22:51:25
* File existed as early as: 2022 * File existed as early as: 2022
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */

38
banned.h
View File

@@ -27,18 +27,18 @@
* function may lead to a fatal compiler complication. * function may lead to a fatal compiler complication.
* If that happens, consider compiling as: * If that happens, consider compiling as:
* *
* make clobber all chk CCBAN=-DUNBAN * make clobber all chk CCBAN=-DUNBAN
* *
* as see if this is a work-a-round. * as see if this is a work-a-round.
* *
* If YOU discover a need for the -DUNBAN work-a-round, PLEASE tell us! * If YOU discover a need for the -DUNBAN work-a-round, PLEASE tell us!
* Please send us a bug report. See the file: * Please send us a bug report. See the file:
* *
* BUGS * BUGS
* *
* or the URL: * or the URL:
* *
* http://www.isthe.com/chongo/tech/comp/calc/calc-bugrept.html * http://www.isthe.com/chongo/tech/comp/calc/calc-bugrept.html
* *
* for how to send us such a bug report. * for how to send us such a bug report.
* *
@@ -50,7 +50,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -58,11 +58,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2021/03/06 21:07:31 * Under source code control: 2021/03/06 21:07:31
* File existed as early as: 2021 * File existed as early as: 2021
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -82,7 +82,7 @@
/* /*
* In the spirit of: * In the spirit of:
* *
* https://github.com/git/git/blob/master/banned.h * https://github.com/git/git/blob/master/banned.h
* *
* we will ban the use of certain unsafe functions by turning * we will ban the use of certain unsafe functions by turning
* then into function calls that do not exist. * then into function calls that do not exist.
@@ -157,22 +157,22 @@
/* /*
* XXX - As of 2021, functions such as: * XXX - As of 2021, functions such as:
* *
* gmtime_s * gmtime_s
* localtime_s * localtime_s
* ctime_s * ctime_s
* asctime_s * asctime_s
* *
* are not universal. We cannot yet ban the following * are not universal. We cannot yet ban the following
* functions because we do not have a portable AND * functions because we do not have a portable AND
* widely available alternative. Therefore we just * widely available alternative. Therefore we just
* have to be extra careful when using: * have to be extra careful when using:
* *
* gmtime * gmtime
* localtime * localtime
* ctime * ctime
* ctime_r * ctime_r
* asctime * asctime
* asctime_r * asctime_r
*/ */
#endif /* !UNBAN */ #endif /* !UNBAN */

1672
blkcpy.c
View File

File diff suppressed because it is too large Load Diff

8
blkcpy.h
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,10 +19,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1997/04/18 20:41:25 * Under source code control: 1997/04/18 20:41:25
* File existed as early as: 1997 * File existed as early as: 1997
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */

878
block.c
View File

File diff suppressed because it is too large Load Diff

194
block.h
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,11 +19,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1997/02/21 05:03:39 * Under source code control: 1997/02/21 05:03:39
* File existed as early as: 1997 * File existed as early as: 1997
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -41,114 +41,114 @@
* *
* Block functions and operations: * Block functions and operations:
* *
* x[i] * x[i]
* (i-1)th octet * (i-1)th octet
* *
* blk(len [, blkchunk]) * blk(len [, blkchunk])
* unnamed block * unnamed block
* len > 0 * len > 0
* blkchunk defaults to BLK_CHUNKSIZE * blkchunk defaults to BLK_CHUNKSIZE
* *
* blk(name, [len [, blkchunk]]) * blk(name, [len [, blkchunk]])
* named block * named block
* len > 0 * len > 0
* blkchunk defaults to BLK_CHUNKSIZE * blkchunk defaults to BLK_CHUNKSIZE
* *
* blkfree(x) * blkfree(x)
* Reduce storage down to 0 octets. * Reduce storage down to 0 octets.
* *
* size(x) * size(x)
* The length of data stored in the block. * The length of data stored in the block.
* *
* sizeof(x) == blk->maxsize * sizeof(x) == blk->maxsize
* Allocation size in memory * Allocation size in memory
* *
* isblk(x) * isblk(x)
* returns 0 is x is not a BLOCK, 1 if x is an * returns 0 is x is not a BLOCK, 1 if x is an
* unnamed block, 2 if x is a named BLOCK * unnamed block, 2 if x is a named BLOCK
* *
* blkread(x, size, count, fd [, offset]) * blkread(x, size, count, fd [, offset])
* blkwrite(x, size, count, fd [, offset]) * blkwrite(x, size, count, fd [, offset])
* returns number of items written * returns number of items written
* offset is restricted in value by block type * offset is restricted in value by block type
* *
* blkset(x, val, length [, offset]) * blkset(x, val, length [, offset])
* only the lower octet of val is used * only the lower octet of val is used
* offset is restricted in value by block type * offset is restricted in value by block type
* *
* blkchr(x, val, length [, offset]) * blkchr(x, val, length [, offset])
* only the lower octet of val is used * only the lower octet of val is used
* offset is restricted in value by block type * offset is restricted in value by block type
* *
* blkcpy(dest, src, length [, dest_offset [, src_offset]]) * blkcpy(dest, src, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x) * 0 <= length <= blksize(x)
* offset's are restricted in value by block type * offset's are restricted in value by block type
* dest may not == src * dest may not == src
* *
* blkmove(dest, src, length [, dest_offset [, src_offset]]) * blkmove(dest, src, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x) * 0 <= length <= blksize(x)
* offset's are restricted in value by block type * offset's are restricted in value by block type
* overlapping moves are handled correctly * overlapping moves are handled correctly
* *
* blkccpy(dest, src, stopval, length [, dest_offset [, src_offset]]) * blkccpy(dest, src, stopval, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x) * 0 <= length <= blksize(x)
* offset's are restricted in value by block type * offset's are restricted in value by block type
* *
* blkcmp(dest, src, length [, dest_offset [, src_offset]]) * blkcmp(dest, src, length [, dest_offset [, src_offset]])
* 0 <= length <= blksize(x) * 0 <= length <= blksize(x)
* offset's are restricted in value by block type * offset's are restricted in value by block type
* *
* blkswap(x, a, b) * blkswap(x, a, b)
* swaps groups of 'a' octets within each 'b' octets * swaps groups of 'a' octets within each 'b' octets
* b == a is a noop * b == a is a noop
* b = a*k for some integer k >= 1 * b = a*k for some integer k >= 1
* *
* scatter(src, dest1, dest2 [, dest3 ] ...) * scatter(src, dest1, dest2 [, dest3 ] ...)
* copy successive octets from src into dest1, dest2, ... * copy successive octets from src into dest1, dest2, ...
* restarting with dest1 after end of list * restarting with dest1 after end of list
* stops at end of src * stops at end of src
* *
* gather(dest, src1, src2 [, src3 ] ...) * gather(dest, src1, src2 [, src3 ] ...)
* copy first octet from src1, src2, ... * copy first octet from src1, src2, ...
* copy next octet from src1, src2, ... * copy next octet from src1, src2, ...
* ... * ...
* copy last octet from src1, src2, ... * copy last octet from src1, src2, ...
* copy 0 when there is no more data from a given source * copy 0 when there is no more data from a given source
* *
* blkseek(x, offset, {"in","out"}) * blkseek(x, offset, {"in","out"})
* some seeks may not be allowed by block type * some seeks may not be allowed by block type
* *
* config("blkmaxprint", count) * config("blkmaxprint", count)
* number of octets of a block to print, 0 means all * number of octets of a block to print, 0 means all
* *
* config("blkverbose", boolean) * config("blkverbose", boolean)
* true => print all lines, false => skip dup lines * true => print all lines, false => skip dup lines
* *
* config("blkbase", "base") * config("blkbase", "base")
* output block base = { "hex", "octal", "char", "binary", "raw" } * output block base = { "hex", "octal", "char", "binary", "raw" }
* binary is base 2, raw is just octet values * binary is base 2, raw is just octet values
* *
* config("blkfmt", "style") * config("blkfmt", "style")
* style of output = { * style of output = {
* "line", lines in blkbase with no spaces between octets * "line", lines in blkbase with no spaces between octets
* "string", as one long line with no spaces between octets * "string", as one long line with no spaces between octets
* "od_style", position, spaces between octets * "od_style", position, spaces between octets
* "hd_style"} position, spaces between octets, chars on end * "hd_style"} position, spaces between octets, chars on end
*/ */
struct block { struct block {
LEN blkchunk; /* allocation chunk size */ LEN blkchunk; /* allocation chunk size */
LEN maxsize; /* octets actually malloced for this block */ LEN maxsize; /* octets actually malloced for this block */
LEN datalen; /* octets of data held this block */ LEN datalen; /* octets of data held this block */
USB8 *data; /* pointer to the 1st octet of the allocated data */ USB8 *data; /* pointer to the 1st octet of the allocated data */
}; };
typedef struct block BLOCK; typedef struct block BLOCK;
struct nblock { struct nblock {
char *name; char *name;
int subtype; int subtype;
int id; int id;
BLOCK *blk; BLOCK *blk;
}; };
typedef struct nblock NBLOCK; typedef struct nblock NBLOCK;
@@ -156,26 +156,26 @@ typedef struct nblock NBLOCK;
/* /*
* block debug * block debug
*/ */
EXTERN int blk_debug; /* 0 => debug off */ EXTERN int blk_debug; /* 0 => debug off */
/* /*
* block defaults * block defaults
*/ */
#define BLK_CHUNKSIZE 256 /* default allocation chunk size for blocks */ #define BLK_CHUNKSIZE 256 /* default allocation chunk size for blocks */
#define BLK_DEF_MAXPRINT 256 /* default octets to print */ #define BLK_DEF_MAXPRINT 256 /* default octets to print */
#define BLK_BASE_HEX 0 /* output octets in a block in hex */ #define BLK_BASE_HEX 0 /* output octets in a block in hex */
#define BLK_BASE_OCT 1 /* output octets in a block in octal */ #define BLK_BASE_OCT 1 /* output octets in a block in octal */
#define BLK_BASE_CHAR 2 /* output octets in a block in characters */ #define BLK_BASE_CHAR 2 /* output octets in a block in characters */
#define BLK_BASE_BINARY 3 /* output octets in a block in base 2 chars */ #define BLK_BASE_BINARY 3 /* output octets in a block in base 2 chars */
#define BLK_BASE_RAW 4 /* output octets in a block in raw binary */ #define BLK_BASE_RAW 4 /* output octets in a block in raw binary */
#define BLK_FMT_HD_STYLE 0 /* output in base with chars on end of line */ #define BLK_FMT_HD_STYLE 0 /* output in base with chars on end of line */
#define BLK_FMT_LINE 1 /* output is lines of up to 79 chars */ #define BLK_FMT_LINE 1 /* output is lines of up to 79 chars */
#define BLK_FMT_STRING 2 /* output is one long string */ #define BLK_FMT_STRING 2 /* output is one long string */
#define BLK_FMT_OD_STYLE 3 /* output in base with chars */ #define BLK_FMT_OD_STYLE 3 /* output in base with chars */
/* /*

12
bool.h
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,11 +19,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2023/07/19 17:58:42 * Under source code control: 2023/07/19 17:58:42
* File existed as early as: 2023 * File existed as early as: 2023
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -42,7 +42,7 @@
#if !defined(HAVE_STDBOOL_H) #if !defined(HAVE_STDBOOL_H)
/* fake a <stdbool.h> header file */ /* fake a <stdbool.h> header file */
typedef unsigned char bool; /* fake boolean typedef */ typedef unsigned char bool; /* fake boolean typedef */
#undef true #undef true
#define true ((bool)(1)) #define true ((bool)(1))
#undef false #undef false

942
byteswap.c
View File

File diff suppressed because it is too large Load Diff

126
byteswap.h
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/10/11 04:44:01 * Under source code control: 1995/10/11 04:44:01
* File existed as early as: 1995 * File existed as early as: 1995
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -29,7 +29,7 @@
#define INCLUDE_BYTESWAP_H #define INCLUDE_BYTESWAP_H
#if defined(CALC_SRC) /* if we are building from the calc source tree */ #if defined(CALC_SRC) /* if we are building from the calc source tree */
# include "longbits.h" # include "longbits.h"
#else #else
# include <calc/longbits.h> # include <calc/longbits.h>
@@ -39,42 +39,42 @@
/* /*
* SWAP_B8_IN_B16 - swap 8 bits in 16 bits * SWAP_B8_IN_B16 - swap 8 bits in 16 bits
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 16 bit value to swap * src - pointer to a 16 bit value to swap
* *
* This macro will either switch to the opposite byte sex (Big Endian vs. * This macro will either switch to the opposite byte sex (Big Endian vs.
* Little Endian) a 16 bit value. * Little Endian) a 16 bit value.
*/ */
#define SWAP_B8_IN_B16(dest, src) ( \ #define SWAP_B8_IN_B16(dest, src) ( \
*((USB16*)(dest)) = \ *((USB16*)(dest)) = \
(((*((USB16*)(src))) << 8) | ((*((USB16*)(src))) >> 8)) \ (((*((USB16*)(src))) << 8) | ((*((USB16*)(src))) >> 8)) \
) )
/* /*
* SWAP_B16_IN_B32 - swap 16 bits in 32 bits * SWAP_B16_IN_B32 - swap 16 bits in 32 bits
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 32 bit value to swap * src - pointer to a 32 bit value to swap
*/ */
#define SWAP_B16_IN_B32(dest, src) ( \ #define SWAP_B16_IN_B32(dest, src) ( \
*((USB32*)(dest)) = \ *((USB32*)(dest)) = \
(((*((USB32*)(src))) << 16) | ((*((USB32*)(src))) >> 16)) \ (((*((USB32*)(src))) << 16) | ((*((USB32*)(src))) >> 16)) \
) )
/* /*
* SWAP_B8_IN_B32 - swap 8 & 16 bits in 32 bits * SWAP_B8_IN_B32 - swap 8 & 16 bits in 32 bits
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 32 bit value to swap * src - pointer to a 32 bit value to swap
* *
* This macro will either switch to the opposite byte sex (Big Endian vs. * This macro will either switch to the opposite byte sex (Big Endian vs.
* Little Endian) a 32 bit value. * Little Endian) a 32 bit value.
*/ */
#define SWAP_B8_IN_B32(dest, src) ( \ #define SWAP_B8_IN_B32(dest, src) ( \
SWAP_B16_IN_B32(dest, src), \ SWAP_B16_IN_B32(dest, src), \
(*((USB32*)(dest)) = \ (*((USB32*)(dest)) = \
((((*((USB32*)(dest))) & (USB32)0xff00ff00) >> 8) | \ ((((*((USB32*)(dest))) & (USB32)0xff00ff00) >> 8) | \
(((*((USB32*)(dest))) & (USB32)0x00ff00ff) << 8))) \ (((*((USB32*)(dest))) & (USB32)0x00ff00ff) << 8))) \
) )
#if defined(HAVE_B64) #if defined(HAVE_B64)
@@ -82,41 +82,41 @@
/* /*
* SWAP_B32_IN_B64 - swap 32 bits in 64 bits * SWAP_B32_IN_B64 - swap 32 bits in 64 bits
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 64 bit value to swap * src - pointer to a 64 bit value to swap
*/ */
#define SWAP_B32_IN_B64(dest, src) ( \ #define SWAP_B32_IN_B64(dest, src) ( \
*((USB64*)(dest)) = \ *((USB64*)(dest)) = \
(((*((USB64*)(src))) << 32) | ((*((USB64*)(src))) >> 32)) \ (((*((USB64*)(src))) << 32) | ((*((USB64*)(src))) >> 32)) \
) )
/* /*
* SWAP_B16_IN_B64 - swap 16 & 32 bits in 64 bits * SWAP_B16_IN_B64 - swap 16 & 32 bits in 64 bits
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 64 bit value to swap * src - pointer to a 64 bit value to swap
*/ */
#define SWAP_B16_IN_B64(dest, src) ( \ #define SWAP_B16_IN_B64(dest, src) ( \
SWAP_B32_IN_B64(dest, src), \ SWAP_B32_IN_B64(dest, src), \
(*((USB64*)(dest)) = \ (*((USB64*)(dest)) = \
((((*((USB64*)(dest))) & (USB64)0xffff0000ffff0000) >> 16) | \ ((((*((USB64*)(dest))) & (USB64)0xffff0000ffff0000) >> 16) | \
(((*((USB64*)(dest))) & (USB64)0x0000ffff0000ffff) << 16))) \ (((*((USB64*)(dest))) & (USB64)0x0000ffff0000ffff) << 16))) \
) )
/* /*
* SWAP_B8_IN_B64 - swap 16 & 32 bits in 64 bits * SWAP_B8_IN_B64 - swap 16 & 32 bits in 64 bits
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 64 bit value to swap * src - pointer to a 64 bit value to swap
* *
* This macro will either switch to the opposite byte sex (Big Endian vs. * This macro will either switch to the opposite byte sex (Big Endian vs.
* Little Endian) a 64 bit value. * Little Endian) a 64 bit value.
*/ */
#define SWAP_B8_IN_B64(dest, src) ( \ #define SWAP_B8_IN_B64(dest, src) ( \
SWAP_B16_IN_B64(dest, src), \ SWAP_B16_IN_B64(dest, src), \
(*((USB64*)(dest)) = \ (*((USB64*)(dest)) = \
((((*((USB64*)(dest))) & (USB64)0xff00ff00ff00ff00) >> 8) | \ ((((*((USB64*)(dest))) & (USB64)0xff00ff00ff00ff00) >> 8) | \
(((*((USB64*)(dest))) & (USB64)0x00ff00ff00ff00ff) << 8))) \ (((*((USB64*)(dest))) & (USB64)0x00ff00ff00ff00ff) << 8))) \
) )
#else /* HAVE_B64 */ #else /* HAVE_B64 */
@@ -124,52 +124,52 @@
/* /*
* SWAP_B32_IN_B64 - swap 32 bits in 64 bits (simulated by 2 32 bit values) * SWAP_B32_IN_B64 - swap 32 bits in 64 bits (simulated by 2 32 bit values)
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 64 bit value to swap * src - pointer to a 64 bit value to swap
*/ */
#define SWAP_B32_IN_B64(dest, src) ( \ #define SWAP_B32_IN_B64(dest, src) ( \
((USB32*)(dest))[1] = ((USB32*)(dest))[0], \ ((USB32*)(dest))[1] = ((USB32*)(dest))[0], \
((USB32*)(dest))[0] = ((USB32*)(dest))[1] \ ((USB32*)(dest))[0] = ((USB32*)(dest))[1] \
) )
/* /*
* SWAP_B16_IN_B64 - swap 16 & 32 bits in 64 bits (simulated by 2 32 bit vals) * SWAP_B16_IN_B64 - swap 16 & 32 bits in 64 bits (simulated by 2 32 bit vals)
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 64 bit value to swap * src - pointer to a 64 bit value to swap
*/ */
#define SWAP_B16_IN_B64(dest, src) ( \ #define SWAP_B16_IN_B64(dest, src) ( \
SWAP_B16_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \ SWAP_B16_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \
SWAP_B16_IN_B32(((USB32*)dest), ((USB32*)src)+1) \ SWAP_B16_IN_B32(((USB32*)dest), ((USB32*)src)+1) \
) )
/* /*
* SWAP_B8_IN_B64 - swap 16 & 32 bits in 64 bits (simulated by 2 32 bit vals) * SWAP_B8_IN_B64 - swap 16 & 32 bits in 64 bits (simulated by 2 32 bit vals)
* *
* dest - pointer to where the swapped src will be put * dest - pointer to where the swapped src will be put
* src - pointer to a 64 bit value to swap * src - pointer to a 64 bit value to swap
* *
* This macro will either switch to the opposite byte sex (Big Endian vs. * This macro will either switch to the opposite byte sex (Big Endian vs.
* Little Endian) a 64 bit value. * Little Endian) a 64 bit value.
*/ */
#define SWAP_B8_IN_B64(dest, src) ( \ #define SWAP_B8_IN_B64(dest, src) ( \
SWAP_B8_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \ SWAP_B8_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \
SWAP_B8_IN_B32(((USB32*)dest), ((USB32*)src)+1) \ SWAP_B8_IN_B32(((USB32*)dest), ((USB32*)src)+1) \
) )
#endif /* HAVE_B64 */ #endif /* HAVE_B64 */
#if LONG_BITS == 64 #if LONG_BITS == 64
#define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B64(dest, src) #define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B64(dest, src)
#define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B64(dest, src) #define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B64(dest, src)
#define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B64(dest, src) #define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B64(dest, src)
#else /* LONG_BITS == 64 */ #else /* LONG_BITS == 64 */
#define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B32(dest, src) #define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B32(dest, src)
#define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B32(dest, src) #define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B32(dest, src)
#define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B32(dest, src) #define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B32(dest, src)
#endif /* LONG_BITS == 64 */ #endif /* LONG_BITS == 64 */

472
cal/README
View File

@@ -26,9 +26,9 @@ Executing the resource file will cause several functions to be defined.
Executing the lucas function: Executing the lucas function:
; lucas(149,60) ; lucas(149,60)
1 1
; lucas(146,61) ; lucas(146,61)
0 0
shows that 149*2^60-1 is prime whereas 146*2^61-1 is not. shows that 149*2^60-1 is prime whereas 146*2^61-1 is not.
@@ -41,8 +41,8 @@ be useful!
=-= =-=
By convention, a resource file only defines and/or initializes functions, By convention, a resource file only defines and/or initializes functions,
objects and variables. (The regress.cal and testxxx.cal regression test objects and variables. (The regress.cal and testxxx.cal regression test
suite is an exception.) Also by convention, an additional usage message suite is an exception.) Also by convention, an additional usage message
regarding important object and functions is printed. regarding important object and functions is printed.
If a resource file needs to load another resource file, it should use If a resource file needs to load another resource file, it should use
@@ -62,21 +62,21 @@ Zero value of config("resource_debug") means that no such information
is displayed. For other values, the non-zero bits which currently is displayed. For other values, the non-zero bits which currently
have meanings are as follows: have meanings are as follows:
n Meaning of bit n of config("resource_debug") n Meaning of bit n of config("resource_debug")
0 When a function is defined, redefined or undefined at 0 When a function is defined, redefined or undefined at
interactive level, a message saying what has been done interactive level, a message saying what has been done
is displayed. is displayed.
1 When a function is defined, redefined or undefined during 1 When a function is defined, redefined or undefined during
the reading of a file, a message saying what has been done the reading of a file, a message saying what has been done
is displayed. is displayed.
2 Show func will display more information about a functions 2 Show func will display more information about a functions
arguments as well as more argument summary information. arguments as well as more argument summary information.
3 During execution, allow calc standard resource files 3 During execution, allow calc standard resource files
to output additional debugging information. to output additional debugging information.
The value for config("resource_debug") in both oldstd and newstd is 3, The value for config("resource_debug") in both oldstd and newstd is 3,
but if calc is invoked with the -d flag, its initial value is zero. but if calc is invoked with the -d flag, its initial value is zero.
@@ -87,27 +87,27 @@ either interactively or during the reading of a file.
Sometimes the information printed is not enough. In addition to the Sometimes the information printed is not enough. In addition to the
standard information, one might want to print: standard information, one might want to print:
* useful obj definitions * useful obj definitions
* functions with optional args * functions with optional args
* functions with optional args where the param() interface is used * functions with optional args where the param() interface is used
For these cases we suggest that you place at the bottom of your code For these cases we suggest that you place at the bottom of your code
something that prints extra information if config("resource_debug") has something that prints extra information if config("resource_debug") has
either of the bottom 2 bits set: either of the bottom 2 bits set:
if (config("resource_debug") & 3) { if (config("resource_debug") & 3) {
print "obj xyz defined"; print "obj xyz defined";
print "funcA([val1 [, val2]]) defined"; print "funcA([val1 [, val2]]) defined";
print "funcB(size, mass, ...) defined"; print "funcB(size, mass, ...) defined";
} }
If your the resource file needs to output special debugging information, If your the resource file needs to output special debugging information,
we recommend that you check for bit 3 of the config("resource_debug") we recommend that you check for bit 3 of the config("resource_debug")
before printing the debug statement: before printing the debug statement:
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "DEBUG: This a sample debug statement"; print "DEBUG: This a sample debug statement";
} }
=-= =-=
@@ -146,11 +146,11 @@ alg_config.cal
Here is a suggested way to use this resource file: Here is a suggested way to use this resource file:
; read alg_config ; read alg_config
; config("user_debug",2),; ; config("user_debug",2),;
; best_mul2(); best_sq2(); best_pow2(); ; best_mul2(); best_sq2(); best_pow2();
; best_mul2(); best_sq2(); best_pow2(); ; best_mul2(); best_sq2(); best_pow2();
; best_mul2(); best_sq2(); best_pow2(); ; best_mul2(); best_sq2(); best_pow2();
NOTE: It is perfectly normal for the optimal value returned to differ NOTE: It is perfectly normal for the optimal value returned to differ
slightly from run to run. Slight variations due to inaccuracy in slightly from run to run. Slight variations due to inaccuracy in
@@ -161,9 +161,9 @@ alg_config.cal
config("mul2"), config("sq2"), and config("pow2"). For example one config("mul2"), config("sq2"), and config("pow2"). For example one
can place into ~/.calcrc these lines: can place into ~/.calcrc these lines:
config("mul2", 1780),; config("mul2", 1780),;
config("sq2", 3388),; config("sq2", 3388),;
config("pow2", 176),; config("pow2", 176),;
to automatically and silently change these config values. to automatically and silently change these config values.
See help/config and CALCRC in help/environment for more information. See help/config and CALCRC in help/environment for more information.
@@ -174,7 +174,7 @@ beer.cal
This calc resource is calc's contribution to the 99 Bottles of Beer This calc resource is calc's contribution to the 99 Bottles of Beer
web page: web page:
http://www.ionet.net/~timtroyr/funhouse/beer.html#calc http://www.ionet.net/~timtroyr/funhouse/beer.html#calc
NOTE: This resource produces a lot of output. :-) NOTE: This resource produces a lot of output. :-)
@@ -186,8 +186,8 @@ bernoulli.cal
Calculate the nth Bernoulli number. Calculate the nth Bernoulli number.
NOTE: There is now a bernoulli() builtin function. This file is NOTE: There is now a bernoulli() builtin function. This file is
left here for backward compatibility and now simply returns left here for backward compatibility and now simply returns
the builtin function. the builtin function.
bernpoly.cal bernpoly.cal
@@ -272,53 +272,53 @@ comma.cal
str_comma(x, [group, [decimal]]) str_comma(x, [group, [decimal]])
Convert x into a string. Convert x into a string.
If group is given and is a string, group will be used as If group is given and is a string, group will be used as
the 3-digit group separator, otherwise the default 3-digit the 3-digit group separator, otherwise the default 3-digit
group separator will be used. group separator will be used.
If decimal is given and is a string, group will be used as If decimal is given and is a string, group will be used as
the integer-fraction separator, otherwise the default the integer-fraction separator, otherwise the default
integer-fraction separator will be used. integer-fraction separator will be used.
The decimal and group arguments are optional. The decimal and group arguments are optional.
set_default_group_separator(group) set_default_group_separator(group)
Change the default 3-digit group separator if group is a string, Change the default 3-digit group separator if group is a string,
otherwise the default 3-digit group separator will not be otherwise the default 3-digit group separator will not be
changed. Return the old 3-digit group separator. changed. Return the old 3-digit group separator.
set_default_decimal_separator(decimal) set_default_decimal_separator(decimal)
Change the default 3-digit group separator if decimal is a Change the default 3-digit group separator if decimal is a
string, otherwise the default integer-fraction separator string, otherwise the default integer-fraction separator
will not be changed. Return the old integer-fraction separator. will not be changed. Return the old integer-fraction separator.
print_comma(x, [group, [decimal]]) print_comma(x, [group, [decimal]])
Print the value produced by str_comma(x, [group, [decimal]]) Print the value produced by str_comma(x, [group, [decimal]])
followed by a newline. followed by a newline.
If the str_comma() does not return a string, nothing is printed. If the str_comma() does not return a string, nothing is printed.
The decimal and group arguments are optional. The decimal and group arguments are optional.
The value produced by str_comma() is returned. The value produced by str_comma() is returned.
fprint_comma(fd, x, [group, [decimal]]) fprint_comma(fd, x, [group, [decimal]])
Print the value produced by str_comma(x, [group, [decimal]]), Print the value produced by str_comma(x, [group, [decimal]]),
without a trailing newline, on file fd. without a trailing newline, on file fd.
If the str_comma() does not return a string, nothing is printed. If the str_comma() does not return a string, nothing is printed.
If fd is not an open file, nothing is printed. If fd is not an open file, nothing is printed.
The decimal and group arguments are optional. The decimal and group arguments are optional.
The value produced by str_comma() is returned. The value produced by str_comma() is returned.
deg.cal deg.cal
@@ -362,30 +362,30 @@ dotest.cal
dotest_file dotest_file
Search along CALCPATH for dotest_file, which contains lines that Search along CALCPATH for dotest_file, which contains lines that
should evaluate to 1. Comment lines and empty lines are ignored. should evaluate to 1. Comment lines and empty lines are ignored.
Comment lines should use ## instead of the multi like /* ... */ Comment lines should use ## instead of the multi like /* ... */
because lines are evaluated one line at a time. because lines are evaluated one line at a time.
dotest_code dotest_code
Assign the code number that is to be printed at the start of Assign the code number that is to be printed at the start of
each non-error line and after **** in each error line. each non-error line and after **** in each error line.
The default code number is 999. The default code number is 999.
dotest_maxcond dotest_maxcond
The maximum number of error conditions that may be detected. The maximum number of error conditions that may be detected.
An error condition is not a sign of a problem, in some cases An error condition is not a sign of a problem, in some cases
a line deliberately forces an error condition. A value of -1, a line deliberately forces an error condition. A value of -1,
the default, implies a maximum of 2147483647. the default, implies a maximum of 2147483647.
Global variables and functions must be declared ahead of time because Global variables and functions must be declared ahead of time because
the dotest scope of evaluation is a line at a time. For example: the dotest scope of evaluation is a line at a time. For example:
read dotest.cal read dotest.cal
read set8700.cal read set8700.cal
dotest("set8700.line"); dotest("set8700.line");
ellip.cal ellip.cal
@@ -403,7 +403,7 @@ factorial.cal
See: See:
http://en.wikipedia.org/wiki/Factorial http://en.wikipedia.org/wiki/Factorial
for information on the factorial. This function depends on the script for information on the factorial. This function depends on the script
toomcook.cal. toomcook.cal.
@@ -416,7 +416,7 @@ factorial.cal
the next lower prime is taking as the end point b. The end point b must the next lower prime is taking as the end point b. The end point b must
not exceed 4294967291. See: not exceed 4294967291. See:
http://en.wikipedia.org/wiki/Primorial http://en.wikipedia.org/wiki/Primorial
for information on the primorial. for information on the primorial.
@@ -566,54 +566,54 @@ fnv_util.cal
find_fnv_prime(bits) find_fnv_prime(bits)
If bits == null(), this function will attempt to prompt stdin If bits == null(), this function will attempt to prompt stdin
for a value and provide commends on the value of bits. for a value and provide commends on the value of bits.
given: given:
bits number of bits in the hash, null() ==> prompt for value bits number of bits in the hash, null() ==> prompt for value
returns: returns:
0 ==> no FNV prime found 0 ==> no FNV prime found
>0 ==> FNV prime >0 ==> FNV prime
deprecated_fnv0(bits, fnv_prime, string) deprecated_fnv0(bits, fnv_prime, string)
If fnv_prime == null(), this function will try to compute the FNV prime If fnv_prime == null(), this function will try to compute the FNV prime
for a hash of size bits. for a hash of size bits.
given: given:
bits number of bits in FNV hash bits number of bits in FNV hash
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
string string to hash string string to hash
returns: returns:
FNV-0 hash, for size bytes, of string FNV-0 hash, for size bytes, of string
NOTE: This function does NOT attempt to determine that fnv_prime is prime. NOTE: This function does NOT attempt to determine that fnv_prime is prime.
fnv_offset_basis(bits, fnv_prime) fnv_offset_basis(bits, fnv_prime)
given: given:
bits number of bits in FNV hash bits number of bits in FNV hash
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
returns: returns:
FNV offset basis for a hash size of bits and an FNV prime of fnv_prime FNV offset basis for a hash size of bits and an FNV prime of fnv_prime
NOTE: This function does NOT attempt to determine that fnv_prime is prime. NOTE: This function does NOT attempt to determine that fnv_prime is prime.
fnv1a_style_hash(bits, fnv_prime, prev_hash, string) fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
given: given:
bits number of bits in FNV hash bits number of bits in FNV hash
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
prev_hash previous hash value, null() ==> generate FNV offset basis prev_hash previous hash value, null() ==> generate FNV offset basis
string string to hash string string to hash
returns: returns:
"FNV-style" hash of bits "FNV-style" hash of bits
NOTE: This function does NOT attempt to determine that fnv_prime is prime. NOTE: This function does NOT attempt to determine that fnv_prime is prime.
gvec.cal gvec.cal
@@ -626,8 +626,8 @@ hello.cal
Calc's contribution to the Hello World! page: Calc's contribution to the Hello World! page:
http://www.latech.edu/~acm/HelloWorld.shtml http://www.latech.edu/~acm/HelloWorld.shtml
http://www.latech.edu/~acm/helloworld/calc.html http://www.latech.edu/~acm/helloworld/calc.html
NOTE: This resource produces a lot of output. :-) NOTE: This resource produces a lot of output. :-)
@@ -671,27 +671,27 @@ intfile.cal
file2be(filename) file2be(filename)
Read filename and return an integer that is built from the Read filename and return an integer that is built from the
octets in that file in Big Endian order. The first octets octets in that file in Big Endian order. The first octets
of the file become the most significant bits of the integer. of the file become the most significant bits of the integer.
file2le(filename) file2le(filename)
Read filename and return an integer that is built from the Read filename and return an integer that is built from the
octets in that file in Little Endian order. The first octets octets in that file in Little Endian order. The first octets
of the file become the most significant bits of the integer. of the file become the most significant bits of the integer.
be2file(v, filename) be2file(v, filename)
Write the absolute value of v into filename in Big Endian order. Write the absolute value of v into filename in Big Endian order.
The v argument must be on integer. The most significant bits The v argument must be on integer. The most significant bits
of the integer become the first octets of the file. of the integer become the first octets of the file.
le2file(v, filename) le2file(v, filename)
Write the absolute value of v into filename in Little Endian order. Write the absolute value of v into filename in Little Endian order.
The v argument must be on integer. The least significant bits The v argument must be on integer. The least significant bits
of the integer become the last octets of the file. of the integer become the last octets of the file.
intnum.cal intnum.cal
@@ -733,9 +733,9 @@ intnum.cal
; define f(x){return sin(x);} ; define f(x){return sin(x);}
f(x) defined f(x) defined
; quadts(0,pi()) - 2 ; quadts(0,pi()) - 2
0.00000000000000000000 0.00000000000000000000
; quadgl(0,pi()) - 2 ; quadgl(0,pi()) - 2
0.00000000000000000000 0.00000000000000000000
Sometimes rounding errors accumulate, it might be a good idea to crank up Sometimes rounding errors accumulate, it might be a good idea to crank up
the working precision a notch or two. the working precision a notch or two.
@@ -743,39 +743,39 @@ intnum.cal
; define f(x){ return exp(-x^2);} ; define f(x){ return exp(-x^2);}
f(x) redefined f(x) redefined
; quadts(0,pinf()) - pi() ; quadts(0,pinf()) - pi()
0.00000000000000000000 0.00000000000000000000
; quadgl(0,pinf()) - pi() ; quadgl(0,pinf()) - pi()
0.00000000000000000001 0.00000000000000000001
; define f(x){ return exp(-x^2);} ; define f(x){ return exp(-x^2);}
f(x) redefined f(x) redefined
; quadgl(ninf(),pinf()) - sqrt(pi()) ; quadgl(ninf(),pinf()) - sqrt(pi())
0.00000000000000000000 0.00000000000000000000
; quadts(ninf(),pinf()) - sqrt(pi()) ; quadts(ninf(),pinf()) - sqrt(pi())
-0.00000000000000000000 -0.00000000000000000000
Using the "points" parameter is a bit tricky Using the "points" parameter is a bit tricky
; define f(x){ return 1/x; } ; define f(x){ return 1/x; }
f(x) redefined f(x) redefined
; quadts(1,1,mat[3]={1i,-1,-1i}) - 2i*pi() ; quadts(1,1,mat[3]={1i,-1,-1i}) - 2i*pi()
0.00000000000000000001i 0.00000000000000000001i
; quadgl(1,1,mat[3]={1i,-1,-1i}) - 2i*pi() ; quadgl(1,1,mat[3]={1i,-1,-1i}) - 2i*pi()
0.00000000000000000001i 0.00000000000000000001i
The make* functions make it a bit simpler The make* functions make it a bit simpler
; quadts(1,1,makepoints(1i,-1,-1i)) - 2i*pi() ; quadts(1,1,makepoints(1i,-1,-1i)) - 2i*pi()
0.00000000000000000001i 0.00000000000000000001i
; quadgl(1,1,makepoints(1i,-1,-1i)) - 2i*pi() ; quadgl(1,1,makepoints(1i,-1,-1i)) - 2i*pi()
0.00000000000000000001i 0.00000000000000000001i
; define f(x){ return abs(sin(x));} ; define f(x){ return abs(sin(x));}
f(x) redefined f(x) redefined
; quadts(0,2*pi(),makepoints(pi())) - 4 ; quadts(0,2*pi(),makepoints(pi())) - 4
0.00000000000000000000 0.00000000000000000000
; quadgl(0,2*pi(),makepoints(pi())) - 4 ; quadgl(0,2*pi(),makepoints(pi())) - 4
0.00000000000000000000 0.00000000000000000000
The quad*core functions do not offer anything fancy but the third parameter The quad*core functions do not offer anything fancy but the third parameter
controls the so called "order" which is just the number of nodes computed. controls the so called "order" which is just the number of nodes computed.
@@ -785,34 +785,34 @@ intnum.cal
; define f(x){ return exp(x);} ; define f(x){ return exp(x);}
f(x) redefined f(x) redefined
; s=usertime();quadglcore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadglcore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
0.00000000000000000001 0.00000000000000000001
2.632164 2.632164
; s=usertime();quadglcore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadglcore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
0.00000000000000000001 0.00000000000000000001
0.016001 0.016001
; quadgldeletenodes() ; quadgldeletenodes()
; s=usertime();quadglcore(-3,3,14)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadglcore(-3,3,14)- (exp(3)-exp(-3));e=usertime();e-s
-0.00000000000000000000 -0.00000000000000000000
0.024001 0.024001
; s=usertime();quadglcore(-3,3,14)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadglcore(-3,3,14)- (exp(3)-exp(-3));e=usertime();e-s
-0.00000000000000000000 -0.00000000000000000000
0 0
It is not much but can sum up. The tanh-sinh algorithm is not optimizable It is not much but can sum up. The tanh-sinh algorithm is not optimizable
as much as the Gauss-Legendre algorithm but is per se much faster. as much as the Gauss-Legendre algorithm but is per se much faster.
; s=usertime();quadtscore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadtscore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
-0.00000000000000000001 -0.00000000000000000001
0.128008 0.128008
; s=usertime();quadtscore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadtscore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
-0.00000000000000000001 -0.00000000000000000001
0.036002 0.036002
; s=usertime();quadtscore(-3,3,49)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadtscore(-3,3,49)- (exp(3)-exp(-3));e=usertime();e-s
-0.00000000000000000000 -0.00000000000000000000
0.036002 0.036002
; s=usertime();quadtscore(-3,3,49)- (exp(3)-exp(-3));e=usertime();e-s ; s=usertime();quadtscore(-3,3,49)- (exp(3)-exp(-3));e=usertime();e-s
-0.00000000000000000000 -0.00000000000000000000
0.01200 0.01200
lambertw.cal lambertw.cal
@@ -885,7 +885,7 @@ lucas.cal
prove that h*2^n-1 is prime or not prime. prove that h*2^n-1 is prime or not prime.
NOTE: Some call this term u(0). The function gen_u0(h, n, v1) NOTE: Some call this term u(0). The function gen_u0(h, n, v1)
simply calls gen_u2(h, n, v1) for such people. :-) simply calls gen_u2(h, n, v1) for such people. :-)
gen_v1(h, v) gen_v1(h, v)
@@ -925,7 +925,7 @@ mfactor.cal
By default, start_k == 1, rept_loop = 10000 and p_elim = 17. By default, start_k == 1, rept_loop = 10000 and p_elim = 17.
The p_elim == 17 overhead takes ~3 minutes on an 200 MHz r4k CPU and The p_elim == 17 overhead takes ~3 minutes on an 200 MHz r4k CPU and
requires about ~13 Megs of memory. The p_elim == 13 overhead requires about ~13 Megs of memory. The p_elim == 13 overhead
takes about 3 seconds and requires ~1.5 Megs of memory. takes about 3 seconds and requires ~1.5 Megs of memory.
The value p_elim == 17 is best for long factorizations. It is the The value p_elim == 17 is best for long factorizations. It is the
@@ -1014,19 +1014,19 @@ palindrome.cal
Important functions are: Important functions are:
Find the next / previous palindrome: Find the next / previous palindrome:
nextpal(val) nextpal(val)
prevpal(val) prevpal(val)
Test if a value is a palindrome: Test if a value is a palindrome:
ispal(val) ispal(val)
Find the next / previous palindrome that is a (highly probable) prime: Find the next / previous palindrome that is a (highly probable) prime:
nextprimepal(val) nextprimepal(val)
prevprimepal(val) prevprimepal(val)
pell.cal pell.cal
@@ -1073,7 +1073,7 @@ pollard.cal
poly.cal poly.cal
Calculate with polynomials of one variable. There are many functions. Calculate with polynomials of one variable. There are many functions.
Read the documentation in the resource file. Read the documentation in the resource file.
@@ -1117,7 +1117,7 @@ quat.cal
quat_scale(a, b) quat_scale(a, b)
quat_shift(a, b) quat_shift(a, b)
Calculate using quaternions of the form: a + bi + cj + dk. In these Calculate using quaternions of the form: a + bi + cj + dk. In these
functions, quaternions are manipulated in the form: s + v, where functions, quaternions are manipulated in the form: s + v, where
s is a scalar and v is a vector of size 3. s is a scalar and v is a vector of size 3.
@@ -1199,17 +1199,17 @@ regress.cal
screen.cal screen.cal
up up
CUU /* same as up */ CUU /* same as up */
down = CUD down = CUD
CUD /* same as down */ CUD /* same as down */
forward forward
CUF /* same as forward */ CUF /* same as forward */
back = CUB back = CUB
CUB /* same as back */ CUB /* same as back */
save save
SCP /* same as save */ SCP /* same as save */
restore restore
RCP /* same as restore */ RCP /* same as restore */
cls cls
home home
eraseline eraseline
@@ -1246,8 +1246,8 @@ screen.cal
For example: For example:
read screen read screen
print green:"This is green. ":red:"This is red.":black print green:"This is green. ":red:"This is red.":black
seedrandom.cal seedrandom.cal
@@ -1255,13 +1255,13 @@ seedrandom.cal
seedrandom(seed1, seed2, bitsize [,trials]) seedrandom(seed1, seed2, bitsize [,trials])
Given: Given:
seed1 - a large random value (at least 10^20 and perhaps < 10^93) seed1 - a large random value (at least 10^20 and perhaps < 10^93)
seed2 - a large random value (at least 10^20 and perhaps < 10^93) seed2 - a large random value (at least 10^20 and perhaps < 10^93)
size - min Blum modulus as a power of 2 (at least 100, perhaps > 1024) size - min Blum modulus as a power of 2 (at least 100, perhaps > 1024)
trials - number of ptest() trials (default 25) (optional arg) trials - number of ptest() trials (default 25) (optional arg)
Returns: Returns:
the previous random state the previous random state
Seed the cryptographically strong Blum generator. This functions allows Seed the cryptographically strong Blum generator. This functions allows
one to use the raw srandom() without the burden of finding appropriate one to use the raw srandom() without the burden of finding appropriate
@@ -1299,7 +1299,7 @@ specialfunctions.cal
Calculates the value of the beta function. See: Calculates the value of the beta function. See:
https://en.wikipedia.org/wiki/Beta_function https://en.wikipedia.org/wiki/Beta_function
http://mathworld.wolfram.com/BetaFunction.html http://mathworld.wolfram.com/BetaFunction.html
http://dlmf.nist.gov/5.12 http://dlmf.nist.gov/5.12
@@ -1310,7 +1310,7 @@ specialfunctions.cal
Calculates the value of the regularized incomplete beta function. See: Calculates the value of the regularized incomplete beta function. See:
https://en.wikipedia.org/wiki/Beta_function https://en.wikipedia.org/wiki/Beta_function
http://mathworld.wolfram.com/RegularizedBetaFunction.html http://mathworld.wolfram.com/RegularizedBetaFunction.html
http://dlmf.nist.gov/8.17 http://dlmf.nist.gov/8.17
@@ -1322,7 +1322,7 @@ specialfunctions.cal
Calculates the value of the exponential integral Ei(z) function at z. Calculates the value of the exponential integral Ei(z) function at z.
See: See:
http://en.wikipedia.org/wiki/Exponential_integral http://en.wikipedia.org/wiki/Exponential_integral
http://www.cs.utah.edu/~vpegorar/research/2011_JGT/ http://www.cs.utah.edu/~vpegorar/research/2011_JGT/
for information on the exponential integral Ei(z) function. for information on the exponential integral Ei(z) function.
@@ -1332,7 +1332,7 @@ specialfunctions.cal
Calculates the value of the error function at z. See: Calculates the value of the error function at z. See:
http://en.wikipedia.org/wiki/Error_function http://en.wikipedia.org/wiki/Error_function
for information on the error function function. for information on the error function function.
@@ -1341,7 +1341,7 @@ specialfunctions.cal
Calculates the value of the complementary error function at z. See: Calculates the value of the complementary error function at z. See:
http://en.wikipedia.org/wiki/Error_function http://en.wikipedia.org/wiki/Error_function
for information on the complementary error function function. for information on the complementary error function function.
@@ -1350,7 +1350,7 @@ specialfunctions.cal
Calculates the value of the imaginary error function at z. See: Calculates the value of the imaginary error function at z. See:
http://en.wikipedia.org/wiki/Error_function http://en.wikipedia.org/wiki/Error_function
for information on the imaginary error function function. for information on the imaginary error function function.
@@ -1359,7 +1359,7 @@ specialfunctions.cal
Calculates the inverse of the error function at x. See: Calculates the inverse of the error function at x. See:
http://en.wikipedia.org/wiki/Error_function http://en.wikipedia.org/wiki/Error_function
for information on the inverse of the error function function. for information on the inverse of the error function function.
@@ -1368,7 +1368,7 @@ specialfunctions.cal
Calculates the value of the complex error function at z. See: Calculates the value of the complex error function at z. See:
http://en.wikipedia.org/wiki/Faddeeva_function http://en.wikipedia.org/wiki/Faddeeva_function
for information on the complex error function function. for information on the complex error function function.
@@ -1377,7 +1377,7 @@ specialfunctions.cal
Calculates the value of the Euler gamma function at z. See: Calculates the value of the Euler gamma function at z. See:
http://en.wikipedia.org/wiki/Gamma_function http://en.wikipedia.org/wiki/Gamma_function
http://dlmf.nist.gov/5 http://dlmf.nist.gov/5
for information on the Euler gamma function. for information on the Euler gamma function.
@@ -1388,7 +1388,7 @@ specialfunctions.cal
Calculates the value of the lower incomplete gamma function for Calculates the value of the lower incomplete gamma function for
arbitrary a, z. See: arbitrary a, z. See:
http://en.wikipedia.org/wiki/Incomplete_gamma_function http://en.wikipedia.org/wiki/Incomplete_gamma_function
for information on the lower incomplete gamma function. for information on the lower incomplete gamma function.
@@ -1397,7 +1397,7 @@ specialfunctions.cal
Calculates the value of the regularized lower incomplete gamma Calculates the value of the regularized lower incomplete gamma
function for a, z with a not in -N. See: function for a, z with a not in -N. See:
http://en.wikipedia.org/wiki/Incomplete_gamma_function http://en.wikipedia.org/wiki/Incomplete_gamma_function
for information on the regularized lower incomplete gamma function. for information on the regularized lower incomplete gamma function.
@@ -1406,7 +1406,7 @@ specialfunctions.cal
Calculates the value of the regularized upper incomplete gamma Calculates the value of the regularized upper incomplete gamma
function for a, z with a not in -N. See: function for a, z with a not in -N. See:
http://en.wikipedia.org/wiki/Incomplete_gamma_function http://en.wikipedia.org/wiki/Incomplete_gamma_function
for information on the regularized upper incomplete gamma function. for information on the regularized upper incomplete gamma function.
@@ -1420,7 +1420,7 @@ specialfunctions.cal
Calculates partial values of the harmonic series up to limit. See: Calculates partial values of the harmonic series up to limit. See:
http://en.wikipedia.org/wiki/Harmonic_series_(mathematics) http://en.wikipedia.org/wiki/Harmonic_series_(mathematics)
http://mathworld.wolfram.com/HarmonicSeries.html http://mathworld.wolfram.com/HarmonicSeries.html
for information on the harmonic series. for information on the harmonic series.
@@ -1430,7 +1430,7 @@ specialfunctions.cal
Calculates the natural logarithm of the beta function. See: Calculates the natural logarithm of the beta function. See:
https://en.wikipedia.org/wiki/Beta_function https://en.wikipedia.org/wiki/Beta_function
http://mathworld.wolfram.com/BetaFunction.html http://mathworld.wolfram.com/BetaFunction.html
http://dlmf.nist.gov/5.12 http://dlmf.nist.gov/5.12
@@ -1441,7 +1441,7 @@ specialfunctions.cal
Calculates the value of the logarithm of the Euler gamma function Calculates the value of the logarithm of the Euler gamma function
at z. See: at z. See:
http://en.wikipedia.org/wiki/Gamma_function http://en.wikipedia.org/wiki/Gamma_function
http://dlmf.nist.gov/5.15 http://dlmf.nist.gov/5.15
for information on the derivatives of the the Euler gamma function. for information on the derivatives of the the Euler gamma function.
@@ -1452,7 +1452,7 @@ specialfunctions.cal
Calculates the value of the m-th derivative of the Euler gamma Calculates the value of the m-th derivative of the Euler gamma
function at z. See: function at z. See:
http://en.wikipedia.org/wiki/Polygamma http://en.wikipedia.org/wiki/Polygamma
http://dlmf.nist.gov/5 http://dlmf.nist.gov/5
for information on the n-th derivative of the Euler gamma function. This for information on the n-th derivative of the Euler gamma function. This
@@ -1464,7 +1464,7 @@ specialfunctions.cal
Calculates the value of the first derivative of the Euler gamma Calculates the value of the first derivative of the Euler gamma
function at z. See: function at z. See:
http://en.wikipedia.org/wiki/Digamma_function http://en.wikipedia.org/wiki/Digamma_function
http://dlmf.nist.gov/5 http://dlmf.nist.gov/5
for information on the first derivative of the Euler gamma function. for information on the first derivative of the Euler gamma function.
@@ -1474,7 +1474,7 @@ specialfunctions.cal
Calculates the value of the Riemann Zeta function at s. See: Calculates the value of the Riemann Zeta function at s. See:
http://en.wikipedia.org/wiki/Riemann_zeta_function http://en.wikipedia.org/wiki/Riemann_zeta_function
http://dlmf.nist.gov/25.2 http://dlmf.nist.gov/25.2
for information on the Riemann zeta function. This function depends for information on the Riemann zeta function. This function depends
@@ -1492,7 +1492,7 @@ splitbits.cal
The number of elements in the returned list is: The number of elements in the returned list is:
ceil((highbit(x) + 1) / b) ceil((highbit(x) + 1) / b)
If x == 0, then a list of 1 element containing 0 is returned. If x == 0, then a list of 1 element containing 0 is returned.
@@ -1502,17 +1502,17 @@ splitbits.cal
the integer converted as if the integer was a two's compliment the integer converted as if the integer was a two's compliment
value. For example: value. For example:
; L = splitbits(-1, 8); ; L = splitbits(-1, 8);
; print L[[0]] ; print L[[0]]
255 255
; L = splitbits(-2, 8); ; L = splitbits(-2, 8);
; print L[[0]] ; print L[[0]]
254 254
; L = splitbits(-3, 8); ; L = splitbits(-3, 8);
; print L[[0]] ; print L[[0]]
253 253
The first element of the list contains the lowest order bits The first element of the list contains the lowest order bits
of x. The last element of the list contains the highest number of x. The last element of the list contains the highest number
@@ -1520,19 +1520,19 @@ splitbits.cal
For example: For example:
; x = 2^23209-1 ; x = 2^23209-1
; L = splitbits(x, 16); ; L = splitbits(x, 16);
; print size(L), L[[0]] ; print size(L), L[[0]]
; print istype(2, 3i), istype(2, "2"), istype(2, null()) ; print istype(2, 3i), istype(2, "2"), istype(2, null())
0 0 0 0 0 0
; mat a[2] ; mat a[2]
; b = list(1,2,3) ; b = list(1,2,3)
; c = assoc() ; c = assoc()
; obj chongo {was, here} d; ; obj chongo {was, here} d;
; print istype(a,b), istype(b,c), istype(c,d) ; print istype(a,b), istype(b,c), istype(c,d)
0 0 0 0 0 0
statistics.cal statistics.cal
@@ -1596,8 +1596,8 @@ strings.cal
functions in calc. functions in calc.
WARNING: If the remaining functions in this calc resource file become WARNING: If the remaining functions in this calc resource file become
calc builtin functions, then strings.cal may be removed in calc builtin functions, then strings.cal may be removed in
a future release. a future release.
sumsq.cal sumsq.cal
@@ -1627,7 +1627,7 @@ sumtimes.cal
the list or matrix to use. The doalltimes() function will run the list or matrix to use. The doalltimes() function will run
all of the sumtimes tests. For example: all of the sumtimes tests. For example:
doalltimes(1e6); doalltimes(1e6);
surd.cal surd.cal
@@ -1883,17 +1883,17 @@ test8900.special.cal
This function tests a number of calc resource functions contributed This function tests a number of calc resource functions contributed
by Christoph Zurnieden. These include: by Christoph Zurnieden. These include:
bernpoly.cal bernpoly.cal
brentsolve.cal brentsolve.cal
constants.cal constants.cal
factorial2.cal factorial2.cal
factorial.cal factorial.cal
lambertw.cal lambertw.cal
lnseries.cal lnseries.cal
specialfunctions.cal specialfunctions.cal
statistics.cal statistics.cal
toomcook.cal toomcook.cal
zeta2.cal zeta2.cal
test9300.frem.cal test9300.frem.cal
@@ -1920,14 +1920,14 @@ toomcook.cal
Toom-Cook multiplication algorithm. Multiply two integers a,b by Toom-Cook multiplication algorithm. Multiply two integers a,b by
way of the Toom-Cook algorithm. See: way of the Toom-Cook algorithm. See:
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
toomcook3square(a) toomcook3square(a)
toomcook4square(a) toomcook4square(a)
Square the integer a by way of the Toom-Cook algorithm. See: Square the integer a by way of the Toom-Cook algorithm. See:
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
The function toomCook4(a,b) calls the function toomCook3(a,b) which The function toomCook4(a,b) calls the function toomCook3(a,b) which
calls built-in multiplication at a specific cut-off point. The calls built-in multiplication at a specific cut-off point. The
@@ -1981,7 +1981,7 @@ zeta2.cal
Calculate the value of the Hurwitz Zeta function. See: Calculate the value of the Hurwitz Zeta function. See:
http://en.wikipedia.org/wiki/Hurwitz_zeta_function http://en.wikipedia.org/wiki/Hurwitz_zeta_function
http://dlmf.nist.gov/25.11 http://dlmf.nist.gov/25.11
for information on this special zeta function. for information on this special zeta function.
@@ -1997,7 +1997,7 @@ zeta2.cal
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -2005,8 +2005,8 @@ zeta2.cal
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 1990/02/15 01:50:32 ## Under source code control: 1990/02/15 01:50:32
## File existed as early as: before 1990 ## File existed as early as: before 1990
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/

1512
cal/alg_config.cal
View File

File diff suppressed because it is too large Load Diff

32
cal/beer.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/11/13 13:21:05 * Under source code control: 1996/11/13 13:21:05
* File existed as early as: 1996 * File existed as early as: 1996
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -30,17 +30,17 @@
for (i=99; i > 0;) { for (i=99; i > 0;) {
/* current wall state */ /* current wall state */
some_bottles = (i != 1) ? "bottles" : "bottle"; some_bottles = (i != 1) ? "bottles" : "bottle";
print i, some_bottles, "of beer on the wall,",; print i, some_bottles, "of beer on the wall,",;
print i, some_bottles, "of beer!"; print i, some_bottles, "of beer!";
/* glug, glug */ /* glug, glug */
--i; --i;
print "Take one down and pass it around,",; print "Take one down and pass it around,",;
/* new wall state */ /* new wall state */
less = (i > 0) ? i : "no"; less = (i > 0) ? i : "no";
bottles = (i!=1) ? "bottles" : "bottle"; bottles = (i!=1) ? "bottles" : "bottle";
print less, bottles, "of beer on the wall!\n"; print less, bottles, "of beer on the wall!\n";
} }

78
cal/bernoulli.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1991/09/30 11:18:41 * Under source code control: 1991/09/30 11:18:41
* File existed as early as: 1991 * File existed as early as: 1991
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -30,16 +30,16 @@
* *
* The non-builtin code used the following symbolic formula to calculate B(n): * The non-builtin code used the following symbolic formula to calculate B(n):
* *
* (b+1)^(n+1) - b^(n+1) = 0 * (b+1)^(n+1) - b^(n+1) = 0
* *
* where b is a dummy value, and each power b^i gets replaced by B(i). * where b is a dummy value, and each power b^i gets replaced by B(i).
* For example, for n = 3: * For example, for n = 3:
* *
* (b+1)^4 - b^4 = 0 * (b+1)^4 - b^4 = 0
* b^4 + 4*b^3 + 6*b^2 + 4*b + 1 - b^4 = 0 * b^4 + 4*b^3 + 6*b^2 + 4*b + 1 - b^4 = 0
* 4*b^3 + 6*b^2 + 4*b + 1 = 0 * 4*b^3 + 6*b^2 + 4*b + 1 = 0
* 4*B(3) + 6*B(2) + 4*B(1) + 1 = 0 * 4*B(3) + 6*B(2) + 4*B(1) + 1 = 0
* B(3) = -(6*B(2) + 4*B(1) + 1) / 4 * B(3) = -(6*B(2) + 4*B(1) + 1) / 4
* *
* The combinatorial factors in the expansion of the above formula are * The combinatorial factors in the expansion of the above formula are
* calculated interactively, and we use the fact that B(2i+1) = 0 if i > 0. * calculated interactively, and we use the fact that B(2i+1) = 0 if i > 0.
@@ -56,38 +56,38 @@ static mat Bn[1001];
define B(n) define B(n)
{ {
/* /*
local nn, np1, i, sum, mulval, divval, combval; local nn, np1, i, sum, mulval, divval, combval;
if (!isint(n) || (n < 0)) if (!isint(n) || (n < 0))
quit "Non-negative integer required for Bernoulli"; quit "Non-negative integer required for Bernoulli";
if (n == 0) if (n == 0)
return 1; return 1;
if (n == 1) if (n == 1)
return -1/2; return -1/2;
if (isodd(n)) if (isodd(n))
return 0; return 0;
if (n > 1000) if (n > 1000)
quit "Very large Bernoulli"; quit "Very large Bernoulli";
if (n <= Bnmax) if (n <= Bnmax)
return Bn[n]; return Bn[n];
for (nn = Bnmax + 2; nn <= n; nn+=2) { for (nn = Bnmax + 2; nn <= n; nn+=2) {
np1 = nn + 1; np1 = nn + 1;
mulval = np1; mulval = np1;
divval = 1; divval = 1;
combval = 1; combval = 1;
sum = 1 - np1 / 2; sum = 1 - np1 / 2;
for (i = 2; i < np1; i+=2) { for (i = 2; i < np1; i+=2) {
combval = combval * mulval-- / divval++; combval = combval * mulval-- / divval++;
combval = combval * mulval-- / divval++; combval = combval * mulval-- / divval++;
sum += combval * Bn[i]; sum += combval * Bn[i];
} }
Bn[nn] = -sum / np1; Bn[nn] = -sum / np1;
} }
Bnmax = n; Bnmax = n;
return Bn[n]; return Bn[n];
*/ */
return bernoulli(n); return bernoulli(n);
} }

4
cal/bernpoly.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */

38
cal/bigprime.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,29 +17,29 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1991/05/22 21:56:32 * Under source code control: 1991/05/22 21:56:32
* File existed as early as: 1991 * File existed as early as: 1991
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
define bigprime(a, m, p) define bigprime(a, m, p)
{ {
local n1, n; local n1, n;
n1 = 2^m * p; n1 = 2^m * p;
for (;;) { for (;;) {
m++; m++;
n1 += n1; n1 += n1;
n = n1 + 1; n = n1 + 1;
if (isodd(m)) if (isodd(m))
continue; continue;
print m; print m;
if (pmod(a, n1 / 2, n) != n1) if (pmod(a, n1 / 2, n) != n1)
continue; continue;
if (pmod(a, n1 / p, n) == 1) if (pmod(a, n1 / p, n) == 1)
continue; continue;
print " " : n; print " " : n;
} }
} }

92
cal/bindings
View File

@@ -8,7 +8,7 @@
# #
# Calc is distributed in the hope that it will be useful, but WITHOUT # Calc is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
# Public License for more details. # Public License for more details.
# #
# A copy of version 2.1 of the GNU Lesser General Public License is # A copy of version 2.1 of the GNU Lesser General Public License is
@@ -16,56 +16,56 @@
# received a copy with calc; if not, write to Free Software Foundation, Inc. # received a copy with calc; if not, write to Free Software Foundation, Inc.
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
# #
# Under source code control: 1993/05/02 20:09:19 # Under source code control: 1993/05/02 20:09:19
# File existed as early as: 1993 # File existed as early as: 1993
# #
# Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ # Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
# NOTE: This facility is ignored if calc was compiled with GNU-readline. # NOTE: This facility is ignored if calc was compiled with GNU-readline.
# In that case, the standard readline mechanisms (see readline(3)) # In that case, the standard readline mechanisms (see readline(3))
# are used in place of those found below. # are used in place of those found below.
map base-map map base-map
default insert-char default insert-char
^@ set-mark ^@ set-mark
^A start-of-line ^A start-of-line
^B backward-char ^B backward-char
^D delete-char ^D delete-char
^E end-of-line ^E end-of-line
^F forward-char ^F forward-char
^H backward-kill-char ^H backward-kill-char
^J new-line ^J new-line
^K kill-line ^K kill-line
^L refresh-line ^L refresh-line
^M new-line ^M new-line
^N forward-history ^N forward-history
^O save-line ^O save-line
^P backward-history ^P backward-history
^R reverse-search ^R reverse-search
^T swap-chars ^T swap-chars
^U flush-input ^U flush-input
^V quote-char ^V quote-char
^W kill-region ^W kill-region
^Y yank ^Y yank
^? backward-kill-char ^? backward-kill-char
^[ ignore-char esc-map ^[ ignore-char esc-map
map esc-map map esc-map
default ignore-char base-map default ignore-char base-map
G start-of-line G start-of-line
H backward-history H backward-history
P forward-history P forward-history
K backward-char K backward-char
M forward-char M forward-char
O end-of-line O end-of-line
S delete-char S delete-char
g goto-line g goto-line
s backward-word s backward-word
t forward-word t forward-word
d forward-kill-word d forward-kill-word
u uppercase-word u uppercase-word
l lowercase-word l lowercase-word
h list-history h list-history
^[ flush-input ^[ flush-input
[ arrow-key [ arrow-key

4
cal/brentsolve.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */

186
cal/chi.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2001/03/27 14:10:11 * Under source code control: 2001/03/27 14:10:11
* File existed as early as: 2001 * File existed as early as: 2001
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -29,20 +29,20 @@
* Z(x) * Z(x)
* *
* From Handbook of Mathematical Functions * From Handbook of Mathematical Functions
* 10th printing, Dec 1972 with corrections * 10th printing, Dec 1972 with corrections
* National Bureau of Standards * National Bureau of Standards
* *
* Section 26.2.1, p931. * Section 26.2.1, p931.
*/ */
define Z(x, eps_term) define Z(x, eps_term)
{ {
local eps; /* error term */ local eps; /* error term */
/* obtain the error term */ /* obtain the error term */
if (isnull(eps_term)) { if (isnull(eps_term)) {
eps = epsilon(); eps = epsilon();
} else { } else {
eps = eps_term; eps = eps_term;
} }
/* compute Z(x) value */ /* compute Z(x) value */
@@ -56,46 +56,46 @@ define Z(x, eps_term)
* NOTE: If eps is omitted, the stored epsilon value is used. * NOTE: If eps is omitted, the stored epsilon value is used.
* *
* From Handbook of Mathematical Functions * From Handbook of Mathematical Functions
* 10th printing, Dec 1972 with corrections * 10th printing, Dec 1972 with corrections
* National Bureau of Standards * National Bureau of Standards
* *
* 26.2.11, p932: * 26.2.11, p932:
* *
* P(x) = 1/2 + Z(x) * sum(n=0; n < infinity){x^(2*n+1)/(1*3*5*...(2*n+1)}; * P(x) = 1/2 + Z(x) * sum(n=0; n < infinity){x^(2*n+1)/(1*3*5*...(2*n+1)};
* *
* We continue the fraction until it is less than epsilon error term. * We continue the fraction until it is less than epsilon error term.
* *
* Also note 26.2.5: * Also note 26.2.5:
* *
* P(x) + Q(x) = 1 * P(x) + Q(x) = 1
*/ */
define P(x, eps_term) define P(x, eps_term)
{ {
local eps; /* error term */ local eps; /* error term */
local s; /* sum */ local s; /* sum */
local x2; /* x^2 */ local x2; /* x^2 */
local x_term; /* x^(2*r+1) */ local x_term; /* x^(2*r+1) */
local odd_prod; /* 1*3*5* ... */ local odd_prod; /* 1*3*5* ... */
local odd_term; /* next odd value to multiply into odd_prod */ local odd_term; /* next odd value to multiply into odd_prod */
local term; /* the recent term added to the sum */ local term; /* the recent term added to the sum */
/* obtain the error term */ /* obtain the error term */
if (isnull(eps_term)) { if (isnull(eps_term)) {
eps = epsilon(); eps = epsilon();
} else { } else {
eps = eps_term; eps = eps_term;
} }
/* firewall */ /* firewall */
if (x <= 0) { if (x <= 0) {
if (x == 0) { if (x == 0) {
return 0; /* hack */ return 0; /* hack */
} else { } else {
quit "Q(x[,eps]) 1st argument must be >= 0"; quit "Q(x[,eps]) 1st argument must be >= 0";
} }
} }
if (eps <= 0) { if (eps <= 0) {
quit "Q(x[,eps]) 2nd argument must be > 0"; quit "Q(x[,eps]) 2nd argument must be > 0";
} }
/* /*
@@ -103,17 +103,17 @@ define P(x, eps_term)
*/ */
x2 = x*x; x2 = x*x;
x_term = x; x_term = x;
s = x_term; /* 1st term */ s = x_term; /* 1st term */
odd_term = 1; odd_term = 1;
odd_prod = 1; odd_prod = 1;
do { do {
/* compute the term */ /* compute the term */
odd_term += 2; odd_term += 2;
odd_prod *= odd_term; odd_prod *= odd_term;
x_term *= x2; x_term *= x2;
term = x_term / odd_prod; term = x_term / odd_prod;
s += term; s += term;
} while (term >= eps); } while (term >= eps);
@@ -133,68 +133,68 @@ define P(x, eps_term)
* a sufficiently small error term as the degrees gets large (>100). * a sufficiently small error term as the degrees gets large (>100).
* *
* NOTE: This function does not work well with odd degrees of freedom. * NOTE: This function does not work well with odd degrees of freedom.
* Can somebody help / find a bug / provide a better method of * Can somebody help / find a bug / provide a better method of
* this odd degrees of freedom case? * this odd degrees of freedom case?
* *
* NOTE: This function works well with even degrees of freedom. However * NOTE: This function works well with even degrees of freedom. However
* when the even degrees gets large (say, as you approach 100), you * when the even degrees gets large (say, as you approach 100), you
* need to increase your error term. * need to increase your error term.
* *
* From Handbook of Mathematical Functions * From Handbook of Mathematical Functions
* 10th printing, Dec 1972 with corrections * 10th printing, Dec 1972 with corrections
* National Bureau of Standards * National Bureau of Standards
* *
* Section 26.4.4, p941: * Section 26.4.4, p941:
* *
* For odd v: * For odd v:
* *
* Q(chi_sq, v) = 2*Q(chi) + 2*Z(chi) * ( * Q(chi_sq, v) = 2*Q(chi) + 2*Z(chi) * (
* sum(r=1, r<=(r-1)/2) {(chi_sq^r/chi) / (1*3*5*...(2*r-1)}); * sum(r=1, r<=(r-1)/2) {(chi_sq^r/chi) / (1*3*5*...(2*r-1)});
* *
* chi = sqrt(chi_sq) * chi = sqrt(chi_sq)
* *
* NOTE: Q(x) = 1-P(x) * NOTE: Q(x) = 1-P(x)
* *
* Section 26.4.5, p941. * Section 26.4.5, p941.
* *
* For even v: * For even v:
* *
* Q(chi_sq, v) = sqrt(2*pi()) * Z(chi) * ( 1 + * Q(chi_sq, v) = sqrt(2*pi()) * Z(chi) * ( 1 +
* sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } ); * sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } );
* *
* chi = sqrt(chi_sq) * chi = sqrt(chi_sq)
* *
* Observe that: * Observe that:
* *
* Z(x) = exp(-x*x/2) / sqrt(2*pi()); (Section 26.2.1, p931) * Z(x) = exp(-x*x/2) / sqrt(2*pi()); (Section 26.2.1, p931)
* *
* and thus: * and thus:
* *
* sqrt(2*pi()) * Z(chi) = * sqrt(2*pi()) * Z(chi) =
* sqrt(2*pi()) * Z(sqrt(chi_sq)) = * sqrt(2*pi()) * Z(sqrt(chi_sq)) =
* sqrt(2*pi()) * exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) / sqrt(2*pi()) = * sqrt(2*pi()) * exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) / sqrt(2*pi()) =
* exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) = * exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) =
* exp(-sqrt(-chi_sq/2) * exp(-sqrt(-chi_sq/2)
* *
* So: * So:
* *
* Q(chi_sq, v) = exp(-sqrt(-chi_sq/2) * ( 1 + sum(....){...} ); * Q(chi_sq, v) = exp(-sqrt(-chi_sq/2) * ( 1 + sum(....){...} );
*/ */
define chi_prob(chi_sq, v, eps_term) define chi_prob(chi_sq, v, eps_term)
{ {
local eps; /* error term */ local eps; /* error term */
local r; /* index in finite sum */ local r; /* index in finite sum */
local r_lim; /* limit value for r */ local r_lim; /* limit value for r */
local s; /* sum */ local s; /* sum */
local d; /* denominator (2*4*6*... or 1*3*5...) */ local d; /* denominator (2*4*6*... or 1*3*5...) */
local chi_term; /* chi_sq^r */ local chi_term; /* chi_sq^r */
local ret; /* return value */ local ret; /* return value */
/* obtain the error term */ /* obtain the error term */
if (isnull(eps_term)) { if (isnull(eps_term)) {
eps = epsilon(); eps = epsilon();
} else { } else {
eps = eps_term; eps = eps_term;
} }
/* /*
@@ -202,45 +202,45 @@ define chi_prob(chi_sq, v, eps_term)
*/ */
if (isodd(v)) { if (isodd(v)) {
local chi; /* sqrt(chi_sq) */ local chi; /* sqrt(chi_sq) */
/* setup for sum */ /* setup for sum */
s = 1; s = 1;
d = 1; d = 1;
chi = sqrt(abs(chi_sq), eps); chi = sqrt(abs(chi_sq), eps);
chi_term = chi; chi_term = chi;
r_lim = (v-1)/2; r_lim = (v-1)/2;
/* compute sum(r=1, r=((v-1)/2)) {(chi_sq^r/chi) / (1*3*5...*(2r-1))} */ /* compute sum(r=1, r=((v-1)/2)) {(chi_sq^r/chi) / (1*3*5...*(2r-1))} */
for (r=2; r <= r_lim; ++r) { for (r=2; r <= r_lim; ++r) {
chi_term *= chi_sq; chi_term *= chi_sq;
d *= (2*r)-1; d *= (2*r)-1;
s += chi_term/d; s += chi_term/d;
} }
/* apply term and factor, Q(x) = 1-P(x) */ /* apply term and factor, Q(x) = 1-P(x) */
ret = 2*(1-P(chi)) + 2*Z(chi)*s; ret = 2*(1-P(chi)) + 2*Z(chi)*s;
/* /*
* even degrees of freedom * even degrees of freedom
*/ */
} else { } else {
/* setup for sum */ /* setup for sum */
s =1; s =1;
d = 1; d = 1;
chi_term = 1; chi_term = 1;
r_lim = (v-2)/2; r_lim = (v-2)/2;
/* compute sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } */ /* compute sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } */
for (r=1; r <= r_lim; ++r) { for (r=1; r <= r_lim; ++r) {
chi_term *= chi_sq; chi_term *= chi_sq;
d *= r*2; d *= r*2;
s += chi_term/d; s += chi_term/d;
} }
/* apply factor - see observation in the main comment above */ /* apply factor - see observation in the main comment above */
ret = exp(-chi_sq/2, eps) * s; ret = exp(-chi_sq/2, eps) * s;
} }
return ret; return ret;

160
cal/chrem.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,33 +19,33 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1992/09/26 01:00:47 * Under source code control: 1992/09/26 01:00:47
* File existed as early as: 1992 * File existed as early as: 1992
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* When possible, chrem finds solutions for x of a set of congruence * When possible, chrem finds solutions for x of a set of congruence
* of the form: * of the form:
* *
* x = r1 (mod m1) * x = r1 (mod m1)
* x = r2 (mod m2) * x = r2 (mod m2)
* ... * ...
* *
* where the residues r1, r2, ... and the moduli m1, m2, ... are * where the residues r1, r2, ... and the moduli m1, m2, ... are
* given integers. The Chinese remainder theorem states that if * given integers. The Chinese remainder theorem states that if
* m1, m2, ... are relatively prime in pairs, the above congruence * m1, m2, ... are relatively prime in pairs, the above congruence
* have a unique solution modulo m1 * m2 * ... If m1, m2, ... * have a unique solution modulo m1 * m2 * ... If m1, m2, ...
* are not relatively prime in pairs, it is possible that no solution * are not relatively prime in pairs, it is possible that no solution
* exists. If solutions exist, the general solution is expressible as: * exists. If solutions exist, the general solution is expressible as:
* *
* x = r (mod m) * x = r (mod m)
* *
* where m = lcm(m1,m2,...), and if m > 0, 0 <= r < m. This * where m = lcm(m1,m2,...), and if m > 0, 0 <= r < m. This
* solution may be interpreted as: * solution may be interpreted as:
* *
* x = r + k * m [[NOTE 1]] * x = r + k * m [[NOTE 1]]
* *
* where k is an arbitrary integer. * where k is an arbitrary integer.
* *
@@ -53,19 +53,19 @@
* *
* usage: * usage:
* *
* chrem(r1,m1 [,r2,m2, ...]) * chrem(r1,m1 [,r2,m2, ...])
* *
* r1, r2, ... remainder integers or null values * r1, r2, ... remainder integers or null values
* m1, m2, ... moduli integers * m1, m2, ... moduli integers
* *
* chrem(r_list, [m_list]) * chrem(r_list, [m_list])
* *
* r_list list (r1,r2, ...) * r_list list (r1,r2, ...)
* m_list list (m1,m2, ...) * m_list list (m1,m2, ...)
* *
* If m_list is omitted, then 'defaultmlist' is used. * If m_list is omitted, then 'defaultmlist' is used.
* This default list is a global value that may be changed * This default list is a global value that may be changed
* by the user. Initially it is the first 8 primes. * by the user. Initially it is the first 8 primes.
* *
* If a remainder is null(), then the corresponding congruence is * If a remainder is null(), then the corresponding congruence is
* ignored. This is useful when working with a fixed list of moduli. * ignored. This is useful when working with a fixed list of moduli.
@@ -75,17 +75,17 @@
* *
* The moduli may be any integers, not necessarily relatively prime in * The moduli may be any integers, not necessarily relatively prime in
* pairs (as required for the Chinese remainder theorem). Any moduli * pairs (as required for the Chinese remainder theorem). Any moduli
* may be zero; x = r (mod 0) has the meaning of x = r. * may be zero; x = r (mod 0) has the meaning of x = r.
* *
* returns: * returns:
* *
* If args were integer pairs: * If args were integer pairs:
* *
* r ('r' is defined above, see [[NOTE 1]]) * r ('r' is defined above, see [[NOTE 1]])
* *
* If 1 or 2 list args were given: * If 1 or 2 list args were given:
* *
* (r, m) ('r' and 'm' are defined above, see [[NOTE 1]]) * (r, m) ('r' and 'm' are defined above, see [[NOTE 1]])
* *
* NOTE: In all cases, null() is returned if there is no solution. * NOTE: In all cases, null() is returned if there is no solution.
* *
@@ -95,20 +95,20 @@
* *
* Sun-Tsu, 1st century A.D. * Sun-Tsu, 1st century A.D.
* *
* To find a number for which the reminders after division by 3, 5, 7 * To find a number for which the reminders after division by 3, 5, 7
* are 2, 3, 2, respectively: * are 2, 3, 2, respectively:
* *
* chrem(2,3,3,5,2,7) ---> 23 * chrem(2,3,3,5,2,7) ---> 23
* *
* Fibonacci, 13th century A.D. * Fibonacci, 13th century A.D.
* *
* To find a number divisible by 7 which leaves remainder 1 when * To find a number divisible by 7 which leaves remainder 1 when
* divided by 2, 3, 4, 5, or 6: * divided by 2, 3, 4, 5, or 6:
* *
* *
* chrem(list(0,1,1,1,1,1),list(7,2,3,4,5,6)) ---> (301,420) * chrem(list(0,1,1,1,1,1),list(7,2,3,4,5,6)) ---> (301,420)
* *
* i.e., any value that is 301 mod 420. * i.e., any value that is 301 mod 420.
*/ */
@@ -116,10 +116,10 @@ static defaultmlist = list(2,3,5,7,11,13,17,19); /* The first eight primes */
define chrem() define chrem()
{ {
local argc; /* number of args given */ local argc; /* number of args given */
local rlist; /* reminder list - ri */ local rlist; /* reminder list - ri */
local mlist; /* modulus list - mi */ local mlist; /* modulus list - mi */
local list_args; /* true => args given are lists, not r1,m1, ... */ local list_args; /* true => args given are lists, not r1,m1, ... */
local m,z,r,y,d,t,x,u,i; local m,z,r,y,d,t,x,u,i;
/* /*
@@ -127,25 +127,25 @@ define chrem()
*/ */
argc = param(0); argc = param(0);
if (argc == 0) { if (argc == 0) {
quit "usage: chrem(r1,m1 [,r2,m2 ...]) or chrem(r_list, m_list)"; quit "usage: chrem(r1,m1 [,r2,m2 ...]) or chrem(r_list, m_list)";
} }
list_args = islist(param(1)); list_args = islist(param(1));
if (list_args) { if (list_args) {
rlist = param(1); rlist = param(1);
mlist = (argc == 1) ? defaultmlist : param(2); mlist = (argc == 1) ? defaultmlist : param(2);
if (size(rlist) > size(mlist)) { if (size(rlist) > size(mlist)) {
quit "too many residues"; quit "too many residues";
} }
} else { } else {
if (argc % 2 == 1) { if (argc % 2 == 1) {
quit "odd number integers given"; quit "odd number integers given";
} }
rlist = list(); rlist = list();
mlist = list(); mlist = list();
for (i=1; i <= argc; i+=2) { for (i=1; i <= argc; i+=2) {
push(rlist, param(i)); push(rlist, param(i));
push(mlist, param(i+1)); push(mlist, param(i+1));
} }
} }
/* /*
@@ -154,46 +154,46 @@ define chrem()
m = 1; m = 1;
z = 0; z = 0;
while (size(rlist)) { while (size(rlist)) {
r=pop(rlist); r=pop(rlist);
y=abs(pop(mlist)); y=abs(pop(mlist));
if (r==null()) if (r==null())
continue; continue;
if (m) { if (m) {
if (y) { if (y) {
d = t = z - r; d = t = z - r;
m = lcm(x=m, y); m = lcm(x=m, y);
while (d % y) { while (d % y) {
u = x; u = x;
x %= y; x %= y;
swap(x,y); swap(x,y);
if (y==0) if (y==0)
return; return;
z += (t *= -u/y); z += (t *= -u/y);
} }
} else { } else {
if ((r % m) != (z % m)) if ((r % m) != (z % m))
return; return;
else { else {
m = 0; m = 0;
z = r; z = r;
} }
} }
} else if (((y) && (r % y != z % y)) || (r != z)) } else if (((y) && (r % y != z % y)) || (r != z))
return; return;
} }
if (m) { if (m) {
z %= m; z %= m;
if (z < 0) if (z < 0)
z += m; z += m;
} }
/* /*
* return information as required * return information as required
*/ */
if (list_args) { if (list_args) {
return list(z,m); return list(z,m);
} else { } else {
return z; return z;
} }
} }

260
cal/comma.cal
View File

@@ -7,53 +7,53 @@
* *
* str_comma(x, [group, [decimal]]) * str_comma(x, [group, [decimal]])
* *
* Convert x into a string. * Convert x into a string.
* *
* If group is given and is a string, group will be used as * If group is given and is a string, group will be used as
* the 3-digit group separator, otherwise the default 3-digit * the 3-digit group separator, otherwise the default 3-digit
* group separator will be used. * group separator will be used.
* *
* If decimal is given and is a string, group will be used as * If decimal is given and is a string, group will be used as
* the integer-fraction separator, otherwise the default * the integer-fraction separator, otherwise the default
* integer-fraction separator will be used. * integer-fraction separator will be used.
* *
* The decimal and group arguments are optional. * The decimal and group arguments are optional.
* *
* set_default_group_separator(group) * set_default_group_separator(group)
* *
* Change the default 3-digit group separator if group is a string, * Change the default 3-digit group separator if group is a string,
* otherwise the default 3-digit group separator will not be * otherwise the default 3-digit group separator will not be
* changed. Return the old 3-digit group separator. * changed. Return the old 3-digit group separator.
* *
* set_default_decimal_separator(decimal) * set_default_decimal_separator(decimal)
* *
* Change the default 3-digit group separator if decimal is a * Change the default 3-digit group separator if decimal is a
* string, otherwise the default integer-fraction separator * string, otherwise the default integer-fraction separator
* will not be changed. Return the old integer-fraction separator. * will not be changed. Return the old integer-fraction separator.
* *
* print_comma(x, [group, [decimal]]) * print_comma(x, [group, [decimal]])
* *
* Print the value produced by str_comma(x, [group, [decimal]]) * Print the value produced by str_comma(x, [group, [decimal]])
* followed by a newline. * followed by a newline.
* *
* If the str_comma() does not return a string, nothing is printed. * If the str_comma() does not return a string, nothing is printed.
* *
* The decimal and group arguments are optional. * The decimal and group arguments are optional.
* *
* The value produced by str_comma() is returned. * The value produced by str_comma() is returned.
* *
* fprint_comma(fd, x, [group, [decimal]]) * fprint_comma(fd, x, [group, [decimal]])
* *
* Print the value produced by str_comma(x, [group, [decimal]]), * Print the value produced by str_comma(x, [group, [decimal]]),
* without a trailing newline, on file fd. * without a trailing newline, on file fd.
* *
* If the str_comma() does not return a string, nothing is printed. * If the str_comma() does not return a string, nothing is printed.
* *
* If fd is not an open file, nothing is printed. * If fd is not an open file, nothing is printed.
* *
* The decimal and group arguments are optional. * The decimal and group arguments are optional.
* *
* The value produced by str_comma() is returned. * The value produced by str_comma() is returned.
* *
* Copyright (C) 2022 Landon Curt Noll * Copyright (C) 2022 Landon Curt Noll
* *
@@ -78,8 +78,8 @@
*/ */
static default_group_separator = ","; /* default 3-digit group separator */ static default_group_separator = ","; /* default 3-digit group separator */
static default_decimal_separator = "."; /* default integer-fraction separator */ static default_decimal_separator = "."; /* default integer-fraction separator */
/* /*
@@ -92,9 +92,9 @@ static default_decimal_separator = "."; /* default integer-fraction separator */
* *
* For example: * For example:
* *
* string = str_comma(x); * string = str_comma(x);
* string = str_comma(x), " ", "."); * string = str_comma(x), " ", ".");
* string = str_comma(x), ".", ","); * string = str_comma(x), ".", ",");
* *
* Internally the function calls: * Internally the function calls:
* *
@@ -109,37 +109,37 @@ static default_decimal_separator = "."; /* default integer-fraction separator */
* *
* given: * given:
* *
* x number to convert * x number to convert
* *
* optional args: * optional args:
* *
* group use this 3-digit group separator * group use this 3-digit group separator
* decimal use this integer-fraction separator * decimal use this integer-fraction separator
* *
* returns: * returns:
* *
* string containing the base 10 digits with group and decimal separators, OR * string containing the base 10 digits with group and decimal separators, OR
* null() if x is not a number, OR * null() if x is not a number, OR
* null() if group is neither null() (not given) nor a string, OR * null() if group is neither null() (not given) nor a string, OR
* null() if group is null() (not given) AND default_group_separator is not a string, OR * null() if group is null() (not given) AND default_group_separator is not a string, OR
* null() if decimal is neither null() (not given) nor a string, OR * null() if decimal is neither null() (not given) nor a string, OR
* null() if decimal is null() (not given) AND default_decimal_separator is not a string. * null() if decimal is null() (not given) AND default_decimal_separator is not a string.
*/ */
define str_comma(x, group, decimal) define str_comma(x, group, decimal)
{ {
local group_separator; /* 3-digit group separator */ local group_separator; /* 3-digit group separator */
local decimal_separator; /* separator between decimal integer and decimal fraction */ local decimal_separator; /* separator between decimal integer and decimal fraction */
local sign_str; /* leading - if x < 0 or empty if x >= 0 */ local sign_str; /* leading - if x < 0 or empty if x >= 0 */
local integer; /* integer part of absolute value of x */ local integer; /* integer part of absolute value of x */
local int_str; /* integer as a string */ local int_str; /* integer as a string */
local int_len; /* number of digits in int_str */ local int_len; /* number of digits in int_str */
local first_group_len; /* length of 1st group before the 1st 3-digit group separator */ local first_group_len; /* length of 1st group before the 1st 3-digit group separator */
local fraction; /* factional part of absolute value of x */ local fraction; /* factional part of absolute value of x */
local frac_str; /* fraction as a string */ local frac_str; /* fraction as a string */
local frac_len; /* number of digits in frac_str including leading 0. */ local frac_len; /* number of digits in frac_str including leading 0. */
local ret; /* string to return */ local ret; /* string to return */
local config_leadzero; /* config("leadzero") to restore */ local config_leadzero; /* config("leadzero") to restore */
local config_tilde; /* config("tilde") to restore */ local config_tilde; /* config("tilde") to restore */
local i; local i;
/* /*
@@ -148,28 +148,28 @@ define str_comma(x, group, decimal)
* Return null() if args or conditions are bogus. * Return null() if args or conditions are bogus.
*/ */
if (!isreal(x)) { if (!isreal(x)) {
return null(); return null();
} }
group_separator = isnull(group) ? default_group_separator : group; group_separator = isnull(group) ? default_group_separator : group;
decimal_separator = isnull(decimal) ? default_decimal_separator : decimal; decimal_separator = isnull(decimal) ? default_decimal_separator : decimal;
if (!isstr(group_separator)) { if (!isstr(group_separator)) {
return null(); return null();
} }
if (!isstr(decimal_separator)) { if (!isstr(decimal_separator)) {
return null(); return null();
} }
/* /*
* split number * split number
*/ */
if (x < 0) { if (x < 0) {
sign_str = "-"; sign_str = "-";
integer = int(-x); integer = int(-x);
fraction = frac(-x); fraction = frac(-x);
} else { } else {
sign_str = ""; sign_str = "";
integer = int(x); integer = int(x);
fraction = frac(x); fraction = frac(x);
} }
ret = sign_str; ret = sign_str;
@@ -199,32 +199,32 @@ define str_comma(x, group, decimal)
* case: integer is 3 or fewer digits * case: integer is 3 or fewer digits
*/ */
if (integer < 1000) { if (integer < 1000) {
ret += int_str; ret += int_str;
/* /*
* case: integer is 4 or more digits * case: integer is 4 or more digits
*/ */
} else { } else {
/* /*
* form a decimal string using group separators * form a decimal string using group separators
*/ */
/* /*
* form the initial leading digits before 1st group separator * form the initial leading digits before 1st group separator
*/ */
first_group_len = int_len % 3; first_group_len = int_len % 3;
if (first_group_len == 0) { if (first_group_len == 0) {
first_group_len = 3; first_group_len = 3;
} }
ret += substr(int_str, 1, first_group_len); ret += substr(int_str, 1, first_group_len);
/* /*
* until end of digits, print group separator followed by 3 more digits * until end of digits, print group separator followed by 3 more digits
*/ */
for (i = first_group_len+1; i < int_len; i += 3) { for (i = first_group_len+1; i < int_len; i += 3) {
ret += group_separator + substr(int_str, i, 3); ret += group_separator + substr(int_str, i, 3);
} }
} }
/* /*
@@ -236,24 +236,24 @@ define str_comma(x, group, decimal)
*/ */
if (fraction == 0) { if (fraction == 0) {
/* no fraction, nothing more to do */ /* no fraction, nothing more to do */
/* /*
* case: x is not an integer * case: x is not an integer
*/ */
} else { } else {
/* /*
* add integer-fraction separator * add integer-fraction separator
*/ */
ret += decimal_separator; ret += decimal_separator;
/* /*
* add remaining digits * add remaining digits
* *
* Skip over the leading 0. in frac_str * Skip over the leading 0. in frac_str
*/ */
ret += substr(frac_str, 2, frac_len-1); ret += substr(frac_str, 2, frac_len-1);
} }
/* /*
@@ -269,19 +269,19 @@ define str_comma(x, group, decimal)
* If group is not a string, then the default 3-digit group separator * If group is not a string, then the default 3-digit group separator
* is not changed. Thus, this will only return the default 3-digit group separator: * is not changed. Thus, this will only return the default 3-digit group separator:
* *
* set_default_group_separator(null()); * set_default_group_separator(null());
* *
* given: * given:
* *
* group 3-digit group separator * group 3-digit group separator
* *
* returns: * returns:
* *
* previous 3-digit group separator value * previous 3-digit group separator value
*/ */
define set_default_group_separator(group) define set_default_group_separator(group)
{ {
local old_default_group_separator; /* previous default 3-digit group separator to return */ local old_default_group_separator; /* previous default 3-digit group separator to return */
/* /*
* save current 3-digit group separator * save current 3-digit group separator
@@ -292,7 +292,7 @@ define set_default_group_separator(group)
* change 3-digit group separator if group is a string * change 3-digit group separator if group is a string
*/ */
if (isstr(group)) { if (isstr(group)) {
default_group_separator = group; default_group_separator = group;
} }
return old_default_group_separator; return old_default_group_separator;
} }
@@ -304,19 +304,19 @@ define set_default_group_separator(group)
* If decimal is not a string, then the default integer-fraction separator * If decimal is not a string, then the default integer-fraction separator
* is not changed. Thus, this will only return the integer-fraction separator: * is not changed. Thus, this will only return the integer-fraction separator:
* *
* set_default_decimal_separator(null()); * set_default_decimal_separator(null());
* *
* given: * given:
* *
* decimal separator between decimal integer and decimal fraction (def: ".") * decimal separator between decimal integer and decimal fraction (def: ".")
* *
* returns: * returns:
* *
* previous integer-fraction separator value * previous integer-fraction separator value
*/ */
define set_default_decimal_separator(decimal) define set_default_decimal_separator(decimal)
{ {
local old_default_decimal_separator; /* previous default integer-fraction separator */ local old_default_decimal_separator; /* previous default integer-fraction separator */
/* /*
* save current integer-fraction separator * save current integer-fraction separator
@@ -327,7 +327,7 @@ define set_default_decimal_separator(decimal)
* change 3-digit decimal integer-fraction if decimal is a string * change 3-digit decimal integer-fraction if decimal is a string
*/ */
if (isstr(decimal)) { if (isstr(decimal)) {
default_decimal_separator = decimal; default_decimal_separator = decimal;
} }
return old_default_decimal_separator; return old_default_decimal_separator;
} }
@@ -339,34 +339,34 @@ define set_default_decimal_separator(decimal)
* This function prints the result of str_comma(x, group, decimal) followed by a newline. * This function prints the result of str_comma(x, group, decimal) followed by a newline.
* For example: * For example:
* *
* print_comma(x); * print_comma(x);
* print_comma(x), " ", "."); * print_comma(x), " ", ".");
* print_comma(x), ".", ","); * print_comma(x), ".", ",");
* *
* If str_comma() does not return a string, this function prints nothing. * If str_comma() does not return a string, this function prints nothing.
* *
* NOTE: To print without a newline, use fprint_comma(fd, x, group, decimal). * NOTE: To print without a newline, use fprint_comma(fd, x, group, decimal).
* *
* given: * given:
* x number to convert * x number to convert
* *
* optional args: * optional args:
* *
* group use this 3-digit group separator * group use this 3-digit group separator
* decimal use this integer-fraction separator * decimal use this integer-fraction separator
* *
* returns: * returns:
* *
* string containing the base 10 digits with group and decimal separators, OR * string containing the base 10 digits with group and decimal separators, OR
* null() if x is not a number, OR * null() if x is not a number, OR
* null() if group is neither null() (not given) nor a string, OR * null() if group is neither null() (not given) nor a string, OR
* null() if group is null() (not given) AND default_group_separator is not a string, OR * null() if group is null() (not given) AND default_group_separator is not a string, OR
* null() if decimal is neither null() (not given) nor a string, OR * null() if decimal is neither null() (not given) nor a string, OR
* null() if decimal is null() (not given) AND default_decimal_separator is not a string. * null() if decimal is null() (not given) AND default_decimal_separator is not a string.
*/ */
define print_comma(x, group, decimal) define print_comma(x, group, decimal)
{ {
local ret; /* base 10 string with 3-digit group and integer-fraction separators */ local ret; /* base 10 string with 3-digit group and integer-fraction separators */
/* /*
* convert to string * convert to string
@@ -377,7 +377,7 @@ define print_comma(x, group, decimal)
* print converted string * print converted string
*/ */
if (isstr(ret)) { if (isstr(ret)) {
printf("%s\n", ret); printf("%s\n", ret);
} }
return ret; return ret;
} }
@@ -389,9 +389,9 @@ define print_comma(x, group, decimal)
* This function prints the result of str_comma(x, group, decimal) on an open file, without a trailing newline. * This function prints the result of str_comma(x, group, decimal) on an open file, without a trailing newline.
* For example: * For example:
* *
* fprint_comma(files(1), x); * fprint_comma(files(1), x);
* fprint_comma(fd, x), " ", "."); * fprint_comma(fd, x), " ", ".");
* fprint_comma(files(2), x), ".", ","); * fprint_comma(files(2), x), ".", ",");
* *
* If str_comma() does not return a string, this function prints nothing. * If str_comma() does not return a string, this function prints nothing.
* *
@@ -400,26 +400,26 @@ define print_comma(x, group, decimal)
* NOTE: To print with a newline, use print_comma(x, group, decimal). * NOTE: To print with a newline, use print_comma(x, group, decimal).
* *
* given: * given:
* fd open file * fd open file
* x number to convert * x number to convert
* *
* optional args: * optional args:
* *
* group use this 3-digit group separator * group use this 3-digit group separator
* decimal use this integer-fraction separator * decimal use this integer-fraction separator
* *
* returns: * returns:
* *
* string containing the base 10 digits with group and integer-fraction separators, OR * string containing the base 10 digits with group and integer-fraction separators, OR
* null() if x is not a number, OR * null() if x is not a number, OR
* null() if group is neither null() (not given) nor a string, OR * null() if group is neither null() (not given) nor a string, OR
* null() if group is null() (not given) AND default_group_separator is not a string, OR * null() if group is null() (not given) AND default_group_separator is not a string, OR
* null() if decimal is neither null() (not given) nor a string, OR * null() if decimal is neither null() (not given) nor a string, OR
* null() if decimal is null() (not given) AND default_decimal_separator is not a string. * null() if decimal is null() (not given) AND default_decimal_separator is not a string.
*/ */
define fprint_comma(fd, x, group, decimal) define fprint_comma(fd, x, group, decimal)
{ {
local ret; /* base 10 string with 3-digit group and integer-fraction separators */ local ret; /* base 10 string with 3-digit group and integer-fraction separators */
/* /*
* convert to string * convert to string
@@ -430,8 +430,8 @@ define fprint_comma(fd, x, group, decimal)
* print converted string * print converted string
*/ */
if (isstr(ret) && isfile(fd)) { if (isstr(ret) && isfile(fd)) {
fprintf(fd, "%s", ret); fprintf(fd, "%s", ret);
fflush(fd); fflush(fd);
} }
return ret; return ret;
} }

4
cal/constants.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */

128
cal/deg.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:33 * Under source code control: 1990/02/15 01:50:33
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -28,105 +28,105 @@ obj deg {deg, min, sec};
define deg(deg, min, sec) define deg(deg, min, sec)
{ {
local ans; local ans;
if (isnull(sec)) if (isnull(sec))
sec = 0; sec = 0;
if (isnull(min)) if (isnull(min))
min = 0; min = 0;
obj deg ans; obj deg ans;
ans.deg = deg; ans.deg = deg;
ans.min = min; ans.min = min;
ans.sec = sec; ans.sec = sec;
fixdeg(ans); fixdeg(ans);
return ans; return ans;
} }
define deg_add(a, b) define deg_add(a, b)
{ {
local obj deg ans; local obj deg ans;
ans.deg = 0; ans.deg = 0;
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
if (istype(a, ans)) { if (istype(a, ans)) {
ans.deg += a.deg; ans.deg += a.deg;
ans.min += a.min; ans.min += a.min;
ans.sec += a.sec; ans.sec += a.sec;
} else } else
ans.deg += a; ans.deg += a;
if (istype(b, ans)) { if (istype(b, ans)) {
ans.deg += b.deg; ans.deg += b.deg;
ans.min += b.min; ans.min += b.min;
ans.sec += b.sec; ans.sec += b.sec;
} else } else
ans.deg += b; ans.deg += b;
fixdeg(ans); fixdeg(ans);
return ans; return ans;
} }
define deg_neg(a) define deg_neg(a)
{ {
local obj deg ans; local obj deg ans;
ans.deg = -a.deg; ans.deg = -a.deg;
ans.min = -a.min; ans.min = -a.min;
ans.sec = -a.sec; ans.sec = -a.sec;
return ans; return ans;
} }
define deg_sub(a, b) define deg_sub(a, b)
{ {
return a - b; return a - b;
} }
define deg_mul(a, b) define deg_mul(a, b)
{ {
local obj deg ans; local obj deg ans;
if (istype(a, ans) && istype(b, ans)) if (istype(a, ans) && istype(b, ans))
quit "Cannot multiply degrees together"; quit "Cannot multiply degrees together";
if (istype(a, ans)) { if (istype(a, ans)) {
ans.deg = a.deg * b; ans.deg = a.deg * b;
ans.min = a.min * b; ans.min = a.min * b;
ans.sec = a.sec * b; ans.sec = a.sec * b;
} else { } else {
ans.deg = b.deg * a; ans.deg = b.deg * a;
ans.min = b.min * a; ans.min = b.min * a;
ans.sec = b.sec * a; ans.sec = b.sec * a;
} }
fixdeg(ans); fixdeg(ans);
return ans; return ans;
} }
define deg_print(a) define deg_print(a)
{ {
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :; print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
} }
define deg_abs(a) define deg_abs(a)
{ {
return a.deg + a.min / 60 + a.sec / 3600; return a.deg + a.min / 60 + a.sec / 3600;
} }
define fixdeg(a) define fixdeg(a)
{ {
a.min += frac(a.deg) * 60; a.min += frac(a.deg) * 60;
a.deg = int(a.deg); a.deg = int(a.deg);
a.sec += frac(a.min) * 60; a.sec += frac(a.min) * 60;
a.min = int(a.min); a.min = int(a.min);
a.min += a.sec // 60; a.min += a.sec // 60;
a.sec %= 60; a.sec %= 60;
a.deg += a.min // 60; a.deg += a.min // 60;
a.min %= 60; a.min %= 60;
a.deg %= 360; a.deg %= 360;
} }
if (config("resource_debug") & 3) { if (config("resource_debug") & 3) {

176
cal/dms.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:33 * Under source code control: 1990/02/15 01:50:33
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -28,14 +28,14 @@ obj dms {deg, min, sec};
define dms(deg, min, sec) define dms(deg, min, sec)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* default missing args to 0 */ /* default missing args to 0 */
if (isnull(sec)) { if (isnull(sec)) {
sec = 0; sec = 0;
} }
if (isnull(min)) { if (isnull(min)) {
min = 0; min = 0;
} }
/* load object */ /* load object */
@@ -51,30 +51,30 @@ define dms(deg, min, sec)
define dms_add(a, b) define dms_add(a, b)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* initialize value to 1st arg */ /* initialize value to 1st arg */
if (istype(a, ans)) { if (istype(a, ans)) {
/* 1st arg is dms object, load it */ /* 1st arg is dms object, load it */
ans.deg = a.deg; ans.deg = a.deg;
ans.min = a.min; ans.min = a.min;
ans.sec = a.sec; ans.sec = a.sec;
} else { } else {
/* 1st arg is not dms, assume scalar degrees */ /* 1st arg is not dms, assume scalar degrees */
ans.deg = a; ans.deg = a;
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
} }
/* add value of 2nd arg */ /* add value of 2nd arg */
if (istype(b, ans)) { if (istype(b, ans)) {
/* 2nd arg is dms object, add it */ /* 2nd arg is dms object, add it */
ans.deg += b.deg; ans.deg += b.deg;
ans.min += b.min; ans.min += b.min;
ans.sec += b.sec; ans.sec += b.sec;
} else { } else {
/* 2nd arg is not dms, add scalar degrees */ /* 2nd arg is not dms, add scalar degrees */
ans.deg += b; ans.deg += b;
} }
/* return normalized result */ /* return normalized result */
@@ -85,19 +85,19 @@ define dms_add(a, b)
define dms_neg(a) define dms_neg(a)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* negate argument */ /* negate argument */
if (istype(a, ans)) { if (istype(a, ans)) {
/* 1st arg is dms object, load it */ /* 1st arg is dms object, load it */
ans.deg = -a.deg; ans.deg = -a.deg;
ans.min = -a.min; ans.min = -a.min;
ans.sec = -a.sec; ans.sec = -a.sec;
} else { } else {
/* 2nd arg is not dms, negate scalar degrees */ /* 2nd arg is not dms, negate scalar degrees */
ans.deg = -a; ans.deg = -a;
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
} }
/* return normalized result */ /* return normalized result */
@@ -108,30 +108,30 @@ define dms_neg(a)
define dms_sub(a, b) define dms_sub(a, b)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* initialize value to 1st arg */ /* initialize value to 1st arg */
if (istype(a, ans)) { if (istype(a, ans)) {
/* 1st arg is dms object, load it */ /* 1st arg is dms object, load it */
ans.deg = a.deg; ans.deg = a.deg;
ans.min = a.min; ans.min = a.min;
ans.sec = a.sec; ans.sec = a.sec;
} else { } else {
/* 1st arg is not dms, assume scalar degrees */ /* 1st arg is not dms, assume scalar degrees */
ans.deg = a; ans.deg = a;
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
} }
/* subtract value of 2nd arg */ /* subtract value of 2nd arg */
if (istype(b, ans)) { if (istype(b, ans)) {
/* 2nd arg is dms object, subtract it */ /* 2nd arg is dms object, subtract it */
ans.deg -= b.deg; ans.deg -= b.deg;
ans.min -= b.min; ans.min -= b.min;
ans.sec -= b.sec; ans.sec -= b.sec;
} else { } else {
/* 2nd arg is not dms, subtract scalar degrees */ /* 2nd arg is not dms, subtract scalar degrees */
ans.deg -= b; ans.deg -= b;
} }
/* return normalized result */ /* return normalized result */
@@ -142,23 +142,23 @@ define dms_sub(a, b)
define dms_mul(a, b) define dms_mul(a, b)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* dms object multiplication */ /* dms object multiplication */
if (istype(a, ans) && istype(b, ans)) { if (istype(a, ans) && istype(b, ans)) {
ans.deg = dms_abs(a) * dms_abs(b); ans.deg = dms_abs(a) * dms_abs(b);
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
/* scalar multiplication */ /* scalar multiplication */
} else if (istype(a, ans)) { } else if (istype(a, ans)) {
ans.deg = a.deg * b; ans.deg = a.deg * b;
ans.min = a.min * b; ans.min = a.min * b;
ans.sec = a.sec * b; ans.sec = a.sec * b;
} else { } else {
ans.deg = b.deg * a; ans.deg = b.deg * a;
ans.min = b.min * a; ans.min = b.min * a;
ans.sec = b.sec * a; ans.sec = b.sec * a;
} }
/* return normalized result */ /* return normalized result */
@@ -169,11 +169,11 @@ define dms_mul(a, b)
define dms_print(a) define dms_print(a)
{ {
local obj dms ans; /* temp object for dms type testing */ local obj dms ans; /* temp object for dms type testing */
/* firewall - arg must be a dms object */ /* firewall - arg must be a dms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "dms_print called with non dms object"; quit "dms_print called with non dms object";
} }
/* print in dms form */ /* print in dms form */
@@ -183,12 +183,12 @@ define dms_print(a)
define dms_abs(a) define dms_abs(a)
{ {
local obj dms ans; /* temp object for dms type testing */ local obj dms ans; /* temp object for dms type testing */
local deg; /* return scalar value */ local deg; /* return scalar value */
/* firewall - just absolute value non dms objects */ /* firewall - just absolute value non dms objects */
if (! istype(a, ans)) { if (! istype(a, ans)) {
return abs(a); return abs(a);
} }
/* compute degrees */ /* compute degrees */
@@ -201,12 +201,12 @@ define dms_abs(a)
define dms_norm(a) define dms_norm(a)
{ {
local obj dms ans; /* temp object for dms type testing */ local obj dms ans; /* temp object for dms type testing */
local deg; /* degrees */ local deg; /* degrees */
/* firewall - arg must be a dms object */ /* firewall - arg must be a dms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "dms_norm called with non dms object"; quit "dms_norm called with non dms object";
} }
/* square degrees (norm is the square of absolute value */ /* square degrees (norm is the square of absolute value */
@@ -219,18 +219,18 @@ define dms_norm(a)
define dms_test(a) define dms_test(a)
{ {
local obj dms ans; /* temp value */ local obj dms ans; /* temp value */
/* firewall - arg must be a dms object */ /* firewall - arg must be a dms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "dms_test called with non dms object"; quit "dms_test called with non dms object";
} }
/* return false of non-zero */ /* return false of non-zero */
ans = fixdms(a); ans = fixdms(a);
if (ans.deg == 0 && ans.min == 0 && ans.sec == 0) { if (ans.deg == 0 && ans.min == 0 && ans.sec == 0) {
/* false */ /* false */
return 0; return 0;
} }
/* true */ /* true */
return 1; return 1;
@@ -239,11 +239,11 @@ define dms_test(a)
define dms_int(a) define dms_int(a)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* firewall - arg must be a dms object */ /* firewall - arg must be a dms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "dms_int called with non dms object"; quit "dms_int called with non dms object";
} }
/* normalize the argument */ /* normalize the argument */
@@ -259,11 +259,11 @@ define dms_int(a)
define dms_frac(a) define dms_frac(a)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* firewall - arg must be a dms object */ /* firewall - arg must be a dms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "dms_frac called with non dms object"; quit "dms_frac called with non dms object";
} }
/* normalize the argument */ /* normalize the argument */
@@ -281,7 +281,7 @@ define dms_frac(a)
define dms_rel(a,b) define dms_rel(a,b)
{ {
local abs_a, abs_b; /* scalars of the arguments */ local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */ /* compute scalars of the arguments */
abs_a = dms_abs(a); abs_a = dms_abs(a);
@@ -294,7 +294,7 @@ define dms_rel(a,b)
define dms_cmp(a,b) define dms_cmp(a,b)
{ {
local abs_a, abs_b; /* scalars of the arguments */ local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */ /* compute scalars of the arguments */
abs_a = dms_abs(a); abs_a = dms_abs(a);
@@ -307,16 +307,16 @@ define dms_cmp(a,b)
define dms_inc(a) define dms_inc(a)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* increment a dms object */ /* increment a dms object */
if (istype(a, ans)) { if (istype(a, ans)) {
ans = a; ans = a;
++ans.sec; ++ans.sec;
/* return normalized result */ /* return normalized result */
ans = fixdms(ans); ans = fixdms(ans);
return ans; return ans;
} }
/* increment a scalar */ /* increment a scalar */
@@ -326,16 +326,16 @@ define dms_inc(a)
define dms_dec(a) define dms_dec(a)
{ {
local obj dms ans; /* return value */ local obj dms ans; /* return value */
/* decrement a dms object */ /* decrement a dms object */
if (istype(a, ans)) { if (istype(a, ans)) {
ans = a; ans = a;
--ans.sec; --ans.sec;
/* return normalized result */ /* return normalized result */
ans = fixdms(ans); ans = fixdms(ans);
return ans; return ans;
} }
/* decrement a scalar */ /* decrement a scalar */
@@ -345,11 +345,11 @@ define dms_dec(a)
define fixdms(a) define fixdms(a)
{ {
local obj dms ans; /* temp value */ local obj dms ans; /* temp value */
/* firewall */ /* firewall */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "attempt to fix a non dms object"; quit "attempt to fix a non dms object";
} }
/* use builtin d2dms function */ /* use builtin d2dms function */

158
cal/dotest.cal
View File

@@ -7,7 +7,7 @@
* This file is not covered under version 2.1 of the GNU LGPL. * This file is not covered under version 2.1 of the GNU LGPL.
* This file is covered under "The unlicense": * This file is covered under "The unlicense":
* *
* https://unlicense.org * https://unlicense.org
* *
* In particular: * In particular:
* *
@@ -36,8 +36,8 @@
* *
* For more information, please refer to <http://unlicense.org/> * For more information, please refer to <http://unlicense.org/>
* *
* Under source dotest_code control: 2006/03/08 05:54:09 * Under source dotest_code control: 2006/03/08 05:54:09
* File existed as early as: 2006 * File existed as early as: 2006
*/ */
@@ -45,29 +45,29 @@
* dotest - perform tests from dotest_testline file * dotest - perform tests from dotest_testline file
* *
* given: * given:
* dotest_file filename containing single test lines * dotest_file filename containing single test lines
* dotest_code regress.cal test number to use (def: 0) * dotest_code regress.cal test number to use (def: 0)
* dotest_maxcond max error conditions allowed (def: <0 ==> 2^31-1) * dotest_maxcond max error conditions allowed (def: <0 ==> 2^31-1)
* *
* returns: * returns:
* number of line test failures * number of line test failures
* *
* NOTE: All variables used by the dotest() function start with "dotest_". * NOTE: All variables used by the dotest() function start with "dotest_".
* The dotest_file and dotest_read should not use any variable * The dotest_file and dotest_read should not use any variable
* that starts with "dotest_". * that starts with "dotest_".
*/ */
define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1) define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
{ {
local dotest_f_file; /* open file containing test lines */ local dotest_f_file; /* open file containing test lines */
local dotest_testline; /* test line */ local dotest_testline; /* test line */
local dotest_testeval; /* eval value from dotest_testline test line */ local dotest_testeval; /* eval value from dotest_testline test line */
local dotest_tmperrcnt; /* temp error count after line test */ local dotest_tmperrcnt; /* temp error count after line test */
local dotest_errcnt; /* total number of errors */ local dotest_errcnt; /* total number of errors */
local dotest_failcnt; /* number of line tests failed */ local dotest_failcnt; /* number of line tests failed */
local dotest_testnum; /* number of test lines evaluated */ local dotest_testnum; /* number of test lines evaluated */
local dotest_linenum; /* test line number */ local dotest_linenum; /* test line number */
local dotest_old_errmax; /* value of errmax() prior to calling */ local dotest_old_errmax; /* value of errmax() prior to calling */
local dotest_old_errcount; /* value of errcount() prior to calling */ local dotest_old_errcount; /* value of errcount() prior to calling */
/* /*
* preserve calling stats * preserve calling stats
@@ -87,9 +87,9 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
* setup error accounting for dotest * setup error accounting for dotest
*/ */
if (dotest_maxcond >= 0 && dotest_maxcond < 2147483647) { if (dotest_maxcond >= 0 && dotest_maxcond < 2147483647) {
errmax(dotest_maxcond + dotest_old_errcount + 1),; errmax(dotest_maxcond + dotest_old_errcount + 1),;
} else { } else {
errmax(2147483647),; errmax(2147483647),;
} }
/* /*
@@ -98,9 +98,9 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
printf("%d-: opening line file: %d", dotest_code, dotest_file); printf("%d-: opening line file: %d", dotest_code, dotest_file);
dotest_f_file = fpathopen(dotest_file, "r"); dotest_f_file = fpathopen(dotest_file, "r");
if (!isfile(dotest_f_file)) { if (!isfile(dotest_f_file)) {
printf("**** Unable to file or open file \"%s\"\n", printf("**** Unable to file or open file \"%s\"\n",
dotest_file); dotest_file);
quit; quit;
} }
printf('%d: testing "%s"\n', dotest_code, dotest_file); printf('%d: testing "%s"\n', dotest_code, dotest_file);
@@ -109,73 +109,73 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
*/ */
for (;;) { for (;;) {
/* get the next test line */ /* get the next test line */
dotest_testline = fgets(dotest_f_file); dotest_testline = fgets(dotest_f_file);
++dotest_linenum; ++dotest_linenum;
if (iserror(dotest_testline)) { if (iserror(dotest_testline)) {
quit "**** Error while reading file"; quit "**** Error while reading file";
} else if (isnull(dotest_testline)) { } else if (isnull(dotest_testline)) {
/* EOF - end of test file */ /* EOF - end of test file */
break; break;
} }
/* skip empty lines */ /* skip empty lines */
if (dotest_testline == "\n") { if (dotest_testline == "\n") {
continue; continue;
} }
/* evaluate the test line */ /* evaluate the test line */
dotest_testeval = eval(dotest_testline); dotest_testeval = eval(dotest_testline);
/* ignore white space or comment lines */ /* ignore white space or comment lines */
if (isnull(dotest_testeval)) { if (isnull(dotest_testeval)) {
continue; continue;
} }
/* look for test line parse errors */ /* look for test line parse errors */
if (iserror(dotest_testeval)) { if (iserror(dotest_testeval)) {
printf("**** evaluation error: "); printf("**** evaluation error: ");
++dotest_failcnt; ++dotest_failcnt;
/* look for test line dotest_failcnt */ /* look for test line dotest_failcnt */
} else if (dotest_testeval != 1) { } else if (dotest_testeval != 1) {
printf("**** did not return 1: "); printf("**** did not return 1: ");
++dotest_failcnt; ++dotest_failcnt;
} }
/* show the test line we just performed */ /* show the test line we just performed */
printf("%d-%d: %s", dotest_code, dotest_linenum, dotest_testline); printf("%d-%d: %s", dotest_code, dotest_linenum, dotest_testline);
/* error accounting */ /* error accounting */
dotest_tmperrcnt = errcount() - dotest_errcnt; dotest_tmperrcnt = errcount() - dotest_errcnt;
if (dotest_tmperrcnt > 0) { if (dotest_tmperrcnt > 0) {
/* report any other errors */ /* report any other errors */
if (dotest_tmperrcnt > 1) { if (dotest_tmperrcnt > 1) {
printf("%d-%d: NOTE: %d error conditions(s): %s\n", printf("%d-%d: NOTE: %d error conditions(s): %s\n",
dotest_code, dotest_linenum, dotest_tmperrcnt); dotest_code, dotest_linenum, dotest_tmperrcnt);
} }
/* report the calc error string */ /* report the calc error string */
printf("%d-%d: NOTE: last error string: %s\n", printf("%d-%d: NOTE: last error string: %s\n",
dotest_code, dotest_linenum, strerror()); dotest_code, dotest_linenum, strerror());
/* new error count level */ /* new error count level */
dotest_errcnt = errcount(); dotest_errcnt = errcount();
if (dotest_maxcond >= 0 && if (dotest_maxcond >= 0 &&
dotest_old_errcount-dotest_errcnt > dotest_maxcond) { dotest_old_errcount-dotest_errcnt > dotest_maxcond) {
printf("%d-%d: total error conditions: %d > %d\n", printf("%d-%d: total error conditions: %d > %d\n",
dotest_code, dotest_linenum, dotest_code, dotest_linenum,
dotest_maxcond, dotest_old_errcount-dotest_errcnt); dotest_maxcond, dotest_old_errcount-dotest_errcnt);
} }
} }
} }
/* /*
* test the close of the line file * test the close of the line file
*/ */
printf("%d-: detected %d error condition(s), many of which may be OK\n", printf("%d-: detected %d error condition(s), many of which may be OK\n",
dotest_code, dotest_old_errcount-dotest_errcnt); dotest_code, dotest_old_errcount-dotest_errcnt);
printf("%d-: closing line file: %d\n", dotest_code, dotest_file); printf("%d-: closing line file: %d\n", dotest_code, dotest_file);
fclose(dotest_f_file); fclose(dotest_f_file);
@@ -183,11 +183,11 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
* test line file accounting * test line file accounting
*/ */
if (dotest_failcnt > 0) { if (dotest_failcnt > 0) {
printf("**** %d-: %d test failure(s) in %d line(s)\n", printf("**** %d-: %d test failure(s) in %d line(s)\n",
dotest_code, dotest_failcnt, dotest_linenum); dotest_code, dotest_failcnt, dotest_linenum);
} else { } else {
printf("%d-: no failure(s) in %d line(s)\n", printf("%d-: no failure(s) in %d line(s)\n",
dotest_code, dotest_linenum); dotest_code, dotest_linenum);
} }
/* /*

178
cal/ellip.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,16 +17,16 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:33 * Under source code control: 1990/02/15 01:50:33
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* Attempt to factor numbers using elliptic functions: * Attempt to factor numbers using elliptic functions:
* *
* y^2 = x^3 + a*x + b (mod ellip_N). * y^2 = x^3 + a*x + b (mod ellip_N).
* *
* Many points (x,y) (mod ellip_N) are found that solve the above equation, * Many points (x,y) (mod ellip_N) are found that solve the above equation,
* starting from a trivial solution and 'multiplying' that point together * starting from a trivial solution and 'multiplying' that point together
@@ -47,13 +47,13 @@
* Theory and Cryptography" by Neal Koblitz for a good explanation. * Theory and Cryptography" by Neal Koblitz for a good explanation.
* *
* efactor(iN, ia, B, force) * efactor(iN, ia, B, force)
* iN is the number to be factored. * iN is the number to be factored.
* ia is the initial value of a in the equation, and each successive * ia is the initial value of a in the equation, and each successive
* value of a is an independent attempt at factoring (default 1). * value of a is an independent attempt at factoring (default 1).
* B is the limit of the primes that make up the high power that the * B is the limit of the primes that make up the high power that the
* point is raised to for each factoring attempt (default 100). * point is raised to for each factoring attempt (default 100).
* force is a flag to attempt to factor numbers even if they are * force is a flag to attempt to factor numbers even if they are
* thought to already be prime (default false). * thought to already be prime (default false).
* *
* Making B larger makes the power the point being raised to contain more * Making B larger makes the power the point being raised to contain more
* prime factors, thus increasing the chance that the order of the point * prime factors, thus increasing the chance that the order of the point
@@ -77,114 +77,114 @@
* of the powers so far. * of the powers so far.
* *
* If a factor is found, it is returned and is also saved in the global * If a factor is found, it is returned and is also saved in the global
* variable f. The number being factored is also saved in the global * variable f. The number being factored is also saved in the global
* variable ellip_N. * variable ellip_N.
*/ */
obj point {x, y}; obj point {x, y};
global ellip_N; /* number to factor */ global ellip_N; /* number to factor */
global ellip_a; /* first coefficient */ global ellip_a; /* first coefficient */
global ellip_b; /* second coefficient */ global ellip_b; /* second coefficient */
global ellip_f; /* found factor */ global ellip_f; /* found factor */
define efactor(iN, ia, B, force) define efactor(iN, ia, B, force)
{ {
local C, x, p; local C, x, p;
if (!force && ptest(iN, 50)) if (!force && ptest(iN, 50))
return 1; return 1;
if (isnull(B)) if (isnull(B))
B = 100; B = 100;
if (isnull(ia)) if (isnull(ia))
ia = 1; ia = 1;
obj point x; obj point x;
ellip_a = ia; ellip_a = ia;
ellip_b = -ia; ellip_b = -ia;
ellip_N = iN; ellip_N = iN;
C = isqrt(ellip_N); C = isqrt(ellip_N);
C = 2 * C + 2 * isqrt(C) + 1; C = 2 * C + 2 * isqrt(C) + 1;
ellip_f = 0; ellip_f = 0;
while (ellip_f == 0) { while (ellip_f == 0) {
print "A =", ellip_a; print "A =", ellip_a;
x.x = 1; x.x = 1;
x.y = 1; x.y = 1;
print 2, x; print 2, x;
x = x ^ (2 ^ (highbit(C) + 1)); x = x ^ (2 ^ (highbit(C) + 1));
for (p = 3; ((p < B) && (ellip_f == 0)); p += 2) { for (p = 3; ((p < B) && (ellip_f == 0)); p += 2) {
if (!ptest(p, 1)) if (!ptest(p, 1))
continue; continue;
print p, x; print p, x;
x = x ^ (p ^ ((highbit(C) // highbit(p)) + 1)); x = x ^ (p ^ ((highbit(C) // highbit(p)) + 1));
} }
ellip_a++; ellip_a++;
ellip_b--; ellip_b--;
} }
return ellip_f; return ellip_f;
} }
define point_print(p) define point_print(p)
{ {
print "(" : p.x : "," : p.y : ")" :; print "(" : p.x : "," : p.y : ")" :;
} }
define point_mul(p1, p2) define point_mul(p1, p2)
{ {
local r, m; local r, m;
if (p2 == 1) if (p2 == 1)
return p1; return p1;
if (p1 == p2) if (p1 == p2)
return point_square(`p1); return point_square(`p1);
obj point r; obj point r;
m = (minv(p2.x - p1.x, ellip_N) * (p2.y - p1.y)) % ellip_N; m = (minv(p2.x - p1.x, ellip_N) * (p2.y - p1.y)) % ellip_N;
if (m == 0) { if (m == 0) {
if (ellip_f == 0) if (ellip_f == 0)
ellip_f = gcd(p2.x - p1.x, ellip_N); ellip_f = gcd(p2.x - p1.x, ellip_N);
r.x = 1; r.x = 1;
r.y = 1; r.y = 1;
return r; return r;
} }
r.x = (m^2 - p1.x - p2.x) % ellip_N; r.x = (m^2 - p1.x - p2.x) % ellip_N;
r.y = ((m * (p1.x - r.x)) - p1.y) % ellip_N; r.y = ((m * (p1.x - r.x)) - p1.y) % ellip_N;
return r; return r;
} }
define point_square(p) define point_square(p)
{ {
local r, m; local r, m;
obj point r; obj point r;
m = ((3 * p.x^2 + ellip_a) * minv(p.y << 1, ellip_N)) % ellip_N; m = ((3 * p.x^2 + ellip_a) * minv(p.y << 1, ellip_N)) % ellip_N;
if (m == 0) { if (m == 0) {
if (ellip_f == 0) if (ellip_f == 0)
ellip_f = gcd(p.y << 1, ellip_N); ellip_f = gcd(p.y << 1, ellip_N);
r.x = 1; r.x = 1;
r.y = 1; r.y = 1;
return r; return r;
} }
r.x = (m^2 - p.x - p.x) % ellip_N; r.x = (m^2 - p.x - p.x) % ellip_N;
r.y = ((m * (p.x - r.x)) - p.y) % ellip_N; r.y = ((m * (p.x - r.x)) - p.y) % ellip_N;
return r; return r;
} }
define point_pow(p, pow) define point_pow(p, pow)
{ {
local bit, r, t; local bit, r, t;
r = 1; r = 1;
if (isodd(pow)) if (isodd(pow))
r = p; r = p;
t = p; t = p;
for (bit = 2; ((bit <= pow) && (ellip_f == 0)); bit <<= 1) { for (bit = 2; ((bit <= pow) && (ellip_f == 0)); bit <<= 1) {
t = point_square(`t); t = point_square(`t);
if (bit & pow) if (bit & pow)
r = point_mul(`t, `r); r = point_mul(`t, `r);
} }
return r; return r;
} }

4
cal/factorial.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */

64
cal/factorial2.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */
@@ -56,7 +56,7 @@ define __CZ__factor_factorial(n,start){
if(start){ if(start){
if(!isint(start) && start < 0 && start > n) if(!isint(start) && start < 0 && start > n)
return newerror("__CZ__factor_factorial(n,start): value of " return newerror("__CZ__factor_factorial(n,start): value of "
"parameter 'start' out of range"); "parameter 'start' out of range");
if(start == n && isprime(n)){ if(start == n && isprime(n)){
prime_list = mat[1 , 2]; prime_list = mat[1 , 2];
prime_list[0,0] = n; prime_list[0,0] = n;
@@ -64,7 +64,7 @@ define __CZ__factor_factorial(n,start){
} }
else if(!isprime(start) && nextprime(start) >n) else if(!isprime(start) && nextprime(start) >n)
return newerror("__CZ__factor_factorial(n,start): value of parameter " return newerror("__CZ__factor_factorial(n,start): value of parameter "
"'start' out of range"); "'start' out of range");
else{ else{
if(!isprime(start)) prime = nextprime(start); if(!isprime(start)) prime = nextprime(start);
else prime = start; else prime = start;
@@ -168,34 +168,34 @@ define __CZ__add_factored_factorials(matrix_2n,matrix_n){
timings timings
this comb comb-this rel. k/n this comb comb-this rel. k/n
; benchmark_binomial(10,13) ; benchmark_binomial(10,13)
n=2^13 k=2^10 0.064004 0.016001 + 0.76923076923076923077 n=2^13 k=2^10 0.064004 0.016001 + 0.76923076923076923077
n=2^13 k=2^11 0.064004 0.048003 + 0.84615384615384615385 n=2^13 k=2^11 0.064004 0.048003 + 0.84615384615384615385
n=2^13 k=2^12 0.068004 0.124008 - 0.92307692307692307692 n=2^13 k=2^12 0.068004 0.124008 - 0.92307692307692307692
; benchmark_binomial(10,15) ; benchmark_binomial(10,15)
n=2^15 k=2^10 0.216014 0.024001 + 0.66666666666666666667 n=2^15 k=2^10 0.216014 0.024001 + 0.66666666666666666667
n=2^15 k=2^11 0.220014 0.064004 + 0.73333333333333333333 n=2^15 k=2^11 0.220014 0.064004 + 0.73333333333333333333
n=2^15 k=2^12 0.228014 0.212014 + 0.8 n=2^15 k=2^12 0.228014 0.212014 + 0.8
n=2^15 k=2^13 0.216013 0.664042 - 0.86666666666666666667 n=2^15 k=2^13 0.216013 0.664042 - 0.86666666666666666667
n=2^15 k=2^14 0.240015 1.868117 - 0.93333333333333333333 n=2^15 k=2^14 0.240015 1.868117 - 0.93333333333333333333
; benchmark_binomial(11,15) ; benchmark_binomial(11,15)
n=2^15 k=2^11 0.216014 0.068004 + 0.73333333333333333333 n=2^15 k=2^11 0.216014 0.068004 + 0.73333333333333333333
n=2^15 k=2^12 0.236015 0.212013 + 0.8 n=2^15 k=2^12 0.236015 0.212013 + 0.8
n=2^15 k=2^13 0.216013 0.656041 - 0.86666666666666666667 n=2^15 k=2^13 0.216013 0.656041 - 0.86666666666666666667
n=2^15 k=2^14 0.244016 1.872117 - 0.93333333333333333333 n=2^15 k=2^14 0.244016 1.872117 - 0.93333333333333333333
; benchmark_binomial(11,18) ; benchmark_binomial(11,18)
n=2^18 k=2^11 1.652103 0.100006 + 0.61111111111111111111 n=2^18 k=2^11 1.652103 0.100006 + 0.61111111111111111111
n=2^18 k=2^12 1.608101 0.336021 + 0.66666666666666666667 n=2^18 k=2^12 1.608101 0.336021 + 0.66666666666666666667
n=2^18 k=2^13 1.700106 1.140071 + 0.72222222222222222222 n=2^18 k=2^13 1.700106 1.140071 + 0.72222222222222222222
n=2^18 k=2^14 1.756109 3.924245 - 0.77777777777777777778 n=2^18 k=2^14 1.756109 3.924245 - 0.77777777777777777778
n=2^18 k=2^15 2.036127 13.156822 - 0.83333333333333333333 n=2^18 k=2^15 2.036127 13.156822 - 0.83333333333333333333
n=2^18 k=2^16 2.172135 41.974624 - 0.88888888888888888889 n=2^18 k=2^16 2.172135 41.974624 - 0.88888888888888888889
n=2^18 k=2^17 2.528158 121.523594 - 0.94444444444444444444 n=2^18 k=2^17 2.528158 121.523594 - 0.94444444444444444444
; benchmark_binomial(15,25) ; benchmark_binomial(15,25)
n=2^25 k=2^15 303.790985 38.266392 + 0.6 n=2^25 k=2^15 303.790985 38.266392 + 0.6
; benchmark_binomial(17,25) ; benchmark_binomial(17,25)
n=2^25 k=2^17 319.127944 529.025062 - 0.68 n=2^25 k=2^17 319.127944 529.025062 - 0.68
*/ */
define benchmark_binomial(s,limit){ define benchmark_binomial(s,limit){
@@ -207,7 +207,7 @@ define benchmark_binomial(s,limit){
T1 = end-start; T1 = end-start;
start=usertime();B=comb(N,K);end=usertime(); start=usertime();B=comb(N,K);end=usertime();
T2 = end-start; T2 = end-start;
print "n=2^"limit,"k=2^"k," ",T1," ",T2,T1<T2?"-":"+"," "k/limit; print "n=2^"limit,"k=2^"k," ",T1," ",T2,T1<T2?"-":"+"," "k/limit;
if(A!=B){ if(A!=B){
print "false"; print "false";
break; break;
@@ -225,11 +225,11 @@ define __CZ__multiply_factored_factorial(matrix,stop){
if(!ismat(matrix)) if(!ismat(matrix))
return newerror("__CZ__multiply_factored_factorial(matrix): " return newerror("__CZ__multiply_factored_factorial(matrix): "
"argument matrix not a matrix "); "argument matrix not a matrix ");
if(!matrix[0,0]) if(!matrix[0,0])
return return
newerror("__CZ__multiply_factored_factorial(matrix): " newerror("__CZ__multiply_factored_factorial(matrix): "
"matrix[0,0] is null/0"); "matrix[0,0] is null/0");
if(!isnull(stop)) if(!isnull(stop))
pix = stop; pix = stop;
@@ -328,7 +328,7 @@ define binomial(n,k){
do { do {
prime_list[K ,0] = prime; prime_list[K ,0] = prime;
diff = __CZ__prime_divisors(n,prime)- diff = __CZ__prime_divisors(n,prime)-
( __CZ__prime_divisors(n-k,prime)+__CZ__prime_divisors(k,prime)); ( __CZ__prime_divisors(n-k,prime)+__CZ__prime_divisors(k,prime));
if(diff != 0) if(diff != 0)
prime_list[K++,1] = diff; prime_list[K++,1] = diff;
prime = nextprime(prime); prime = nextprime(prime);
@@ -376,7 +376,7 @@ define bigcatalan(n){
/* /*
df(-111) = -1/3472059605858239446587523014902616804783337112829102414124928 df(-111) = -1/3472059605858239446587523014902616804783337112829102414124928
7753332469144201839599609375 7753332469144201839599609375
df(-3+1i) = 0.12532538977287649201-0.0502372106177184607i df(-3+1i) = 0.12532538977287649201-0.0502372106177184607i
df(2n + 1) = (2*n)!/(n!*2^n) df(2n + 1) = (2*n)!/(n!*2^n)
@@ -427,7 +427,7 @@ define doublefactorial(n){
*/ */
eps=epsilon(epsilon()*1e-2); eps=epsilon(epsilon()*1e-2);
ret = 2^(n/2-1/4 * cos(pi()* n)+1/4) * pi()^(1/4 * ret = 2^(n/2-1/4 * cos(pi()* n)+1/4) * pi()^(1/4 *
cos(pi()* n)-1/4)* gamma(n/2+1); cos(pi()* n)-1/4)* gamma(n/2+1);
epsilon(eps); epsilon(eps);
return ret; return ret;
} }

338
cal/fnv_tool.cal
View File

@@ -3,10 +3,10 @@
* *
* This file provides the following functions: * This file provides the following functions:
* *
* find_fnv_prime(bits) * find_fnv_prime(bits)
* deprecated_fnv0(bits, fnv_prime, string) * deprecated_fnv0(bits, fnv_prime, string)
* fnv_offset_basis(bits, fnv_prime) * fnv_offset_basis(bits, fnv_prime)
* fnv1a_style_hash(bits, fnv_prime, prev_hash, string) * fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
* *
* See the individual function for details on args and return value. * See the individual function for details on args and return value.
* *
@@ -22,8 +22,8 @@
* *
* For more information on the FNV hash see: * For more information on the FNV hash see:
* *
* https://en.wikipedia.org/wiki/Fowler-Noll-Vo_hash_function * https://en.wikipedia.org/wiki/Fowler-Noll-Vo_hash_function
* http://www.isthe.com/chongo/tech/comp/fnv/index.html * http://www.isthe.com/chongo/tech/comp/fnv/index.html
* *
* IMPORTANT NOTE: * IMPORTANT NOTE:
* *
@@ -36,40 +36,40 @@
* *
* Let integer n > 0 be the number if bits in the FNV hash. Then: * Let integer n > 0 be the number if bits in the FNV hash. Then:
* *
* t = floor((5+n)/12) * t = floor((5+n)/12)
* *
* The FNV prime, for the given n bits is the smallest prime of the form: * The FNV prime, for the given n bits is the smallest prime of the form:
* *
* p = 256^t + 2^8 + b * p = 256^t + 2^8 + b
* *
* such that: * such that:
* *
* 0 < b < 2^8 * 0 < b < 2^8
* The number of one-bits in b must be 4 or 5 * The number of one-bits in b must be 4 or 5
* p mod (2^40 - 2^24 - 1) > (2^24 + 2^8 + 2^7) * p mod (2^40 - 2^24 - 1) > (2^24 + 2^8 + 2^7)
* *
* If you force n to not be a power of 2, for example: * If you force n to not be a power of 2, for example:
* *
* n = 44 * n = 44
* *
* you will find that the FNV prime for 44 bits is: * you will find that the FNV prime for 44 bits is:
* *
* p44 = 4294967597 * p44 = 4294967597
* = 0x10000012d * = 0x10000012d
* = 0b100000000000000000000000100101101 * = 0b100000000000000000000000100101101
* = 2^32 + 301 = 2^32 + 2^8 + 2^5 + 2^3 + 2^2 + 2^0 * = 2^32 + 301 = 2^32 + 2^8 + 2^5 + 2^3 + 2^2 + 2^0
* *
* However a hash size of 44 bits is not a true FNV hash, it is only a "FNV-style" hash. * However a hash size of 44 bits is not a true FNV hash, it is only a "FNV-style" hash.
* *
* NOTE: We disallow n <= 31 because there are no FNV primes that small. * NOTE: We disallow n <= 31 because there are no FNV primes that small.
* *
* NOTE: For n that is a power of 2 and n > 1024, you will find that * NOTE: For n that is a power of 2 and n > 1024, you will find that
* that FNV primes become so rare that that one may not find a suitable * that FNV primes become so rare that that one may not find a suitable
* FNV prime. For n = powers of 2 >= 2048 and <= 1048576, * FNV prime. For n = powers of 2 >= 2048 and <= 1048576,
* there is NO FNV primes. * there is NO FNV primes.
* *
* As for as hashing goes, large values of n, even if an * As for as hashing goes, large values of n, even if an
* FNV hash may be found, are unlikely to be truly useful. :-) * FNV hash may be found, are unlikely to be truly useful. :-)
*/ */
/* /*
* Copyright (c) 2023 by Landon Curt Noll. All Rights Reserved. * Copyright (c) 2023 by Landon Curt Noll. All Rights Reserved.
@@ -105,86 +105,86 @@
* for a value and provide commends on the value of bits. * for a value and provide commends on the value of bits.
* *
* given: * given:
* bits number of bits in the hash, null() ==> prompt for value * bits number of bits in the hash, null() ==> prompt for value
* *
* returns: * returns:
* 0 ==> no FNV prime found * 0 ==> no FNV prime found
* >0 ==> FNV prime * >0 ==> FNV prime
*/ */
define find_fnv_prime(bits) define find_fnv_prime(bits)
{ {
local b; /* lower octet of the potential FNV prime: [1,255] */ local b; /* lower octet of the potential FNV prime: [1,255] */
local p; /* value to test as an FNV prime */ local p; /* value to test as an FNV prime */
local t; /* power of 256 part of the FNV prime */ local t; /* power of 256 part of the FNV prime */
local one_bits; /* number of 1 bits in b */ local one_bits; /* number of 1 bits in b */
local p_minus_b; /* potential FNV prime less b */ local p_minus_b; /* potential FNV prime less b */
local interactive; /* true ==> interactive mode and print commentary */ local interactive; /* true ==> interactive mode and print commentary */
/* /*
* case: no arg, prompt for bits and print commentary * case: no arg, prompt for bits and print commentary
*/ */
interactive = 0; /* assume non-interactive mode */ interactive = 0; /* assume non-interactive mode */
if (isnull(bits)) { if (isnull(bits)) {
/* /*
* must be attached to an interactive terminal * must be attached to an interactive terminal
*/ */
if (!isatty(files(0))) { if (!isatty(files(0))) {
print "# FATAL: stdin is not a tty: not attached to an interactive terminal"; print "# FATAL: stdin is not a tty: not attached to an interactive terminal";
return 0; return 0;
} }
interactive = 1; /* set interactive mode */ interactive = 1; /* set interactive mode */
/* /*
* prompt for the number of bits * prompt for the number of bits
*/ */
do { do {
local strscanf_ret; /* return from strscanf_ret */ local strscanf_ret; /* return from strscanf_ret */
local input; /* value read after prompt */ local input; /* value read after prompt */
/* /*
* prompt and obtain the input * prompt and obtain the input
*/ */
input = prompt("Enter hash size in bits: "); input = prompt("Enter hash size in bits: ");
strscanf_ret = strscanf(input, "%i", bits); strscanf_ret = strscanf(input, "%i", bits);
print "input =", input; print "input =", input;
print "bits =", bits; print "bits =", bits;
if (!isint(bits) || bits <= 0) { if (!isint(bits) || bits <= 0) {
print; print;
print "# NOTE: must enter a integer > 0, try again"; print "# NOTE: must enter a integer > 0, try again";
print; print;
} }
} while (!isint(bits) || bits <= 0); } while (!isint(bits) || bits <= 0);
} }
/* /*
* firewall - bits must be non-negative integer * firewall - bits must be non-negative integer
*/ */
if (!isint(bits) || bits < 0) { if (!isint(bits) || bits < 0) {
if (interactive) { if (interactive) {
print "# FATAL: bits must be non-negative integer"; print "# FATAL: bits must be non-negative integer";
} }
return 0; return 0;
} }
/* /*
* provide commentary on the choice of bits if we are interactive * provide commentary on the choice of bits if we are interactive
*/ */
if (interactive) { if (interactive) {
if (popcnt(bits) == 1) { if (popcnt(bits) == 1) {
if (bits > 1024) { if (bits > 1024) {
print "# WARNING: FNV primes for bit size powers of 2 > 1024 are extremely rare."; print "# WARNING: FNV primes for bit size powers of 2 > 1024 are extremely rare.";
print "# WARNING: There are no FNV primes for bit size powers of 2 >= 2048 and <= 1048576."; print "# WARNING: There are no FNV primes for bit size powers of 2 >= 2048 and <= 1048576.";
} }
print "n =", bits; print "n =", bits;
} else { } else {
if (bits < 32) { if (bits < 32) {
print "# WARNING: bits < 32 is not recommended because there isn't enough bits to be worth hashing"; print "# WARNING: bits < 32 is not recommended because there isn't enough bits to be worth hashing";
} }
print "# WARNING: because bits is not a power of 2, we can only form an \"FNV-style hash\": not a true FNV hash."; print "# WARNING: because bits is not a power of 2, we can only form an \"FNV-style hash\": not a true FNV hash.";
print "# WARNING: A \"FNV-style hash\" may not have the desired hash properties of a true FNV hash."; print "# WARNING: A \"FNV-style hash\" may not have the desired hash properties of a true FNV hash.";
print "n =", bits; print "n =", bits;
} }
} }
/* /*
@@ -198,28 +198,28 @@ define find_fnv_prime(bits)
*/ */
for (b=1; b < 256; ++b) { for (b=1; b < 256; ++b) {
/* /*
* reject b unless the of one-bits in bottom octet of p is 4 or 5 * reject b unless the of one-bits in bottom octet of p is 4 or 5
*/ */
one_bits = popcnt(b); one_bits = popcnt(b);
if (one_bits != 4 && one_bits != 5) { if (one_bits != 4 && one_bits != 5) {
continue; continue;
} }
/* /*
* reject p if p mod (2^40 - 2^24 - 1) <= (2^24 + 2^8 + 2^7) * reject p if p mod (2^40 - 2^24 - 1) <= (2^24 + 2^8 + 2^7)
*/ */
p = p_minus_b + b; p = p_minus_b + b;
if ((p % (2^40 - 2^24 - 1)) <= (2^24 + 2^8 + 2^7)) { if ((p % (2^40 - 2^24 - 1)) <= (2^24 + 2^8 + 2^7)) {
continue; continue;
} }
/* /*
* accept potential p value that is prime * accept potential p value that is prime
*/ */
if (ptest(p) == 1) { if (ptest(p) == 1) {
return p; return p;
} }
} }
/* /*
@@ -227,29 +227,29 @@ define find_fnv_prime(bits)
*/ */
if (b >= 256) { if (b >= 256) {
/* /*
* examine results if interactive * examine results if interactive
*/ */
if (interactive) { if (interactive) {
print "# FATAL: There is no a suitable FNV prime for bits =", bits; print "# FATAL: There is no a suitable FNV prime for bits =", bits;
quit "find_fnv_prime: FATAL: FNV prime search failed"; quit "find_fnv_prime: FATAL: FNV prime search failed";
} }
/* /*
* return 0 to indicate no FNV prime found * return 0 to indicate no FNV prime found
*/ */
return 0; return 0;
} }
/* /*
* provide FNV commentary if interactive * provide FNV commentary if interactive
*/ */
if (interactive) { if (interactive) {
print "t =", t; print "t =", t;
print "b =", b; print "b =", b;
print "# NOTE: p = 256^":t, "+ 2^8 +", b; print "# NOTE: p = 256^":t, "+ 2^8 +", b;
print; print;
print "p =", p; print "p =", p;
} }
/* /*
@@ -266,44 +266,44 @@ define find_fnv_prime(bits)
* for a hash of size bits. * for a hash of size bits.
* *
* given: * given:
* bits number of bits in FNV hash * bits number of bits in FNV hash
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible * fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
* string string to hash * string string to hash
* *
* returns: * returns:
* FNV-0 hash, for size bytes, of string * FNV-0 hash, for size bytes, of string
* *
* NOTE: This function does NOT attempt to determine that fnv_prime is prime. * NOTE: This function does NOT attempt to determine that fnv_prime is prime.
*/ */
define deprecated_fnv0(bits, fnv_prime, string) define deprecated_fnv0(bits, fnv_prime, string)
{ {
local hash; /* FNV hash value */ local hash; /* FNV hash value */
local len; /* length of string */ local len; /* length of string */
local base; /* base of FNV hash: 2^bits */ local base; /* base of FNV hash: 2^bits */
local i; local i;
/* /*
* firewall * firewall
*/ */
if (!isint(bits) || bits <= 0) { if (!isint(bits) || bits <= 0) {
quit "deprecated_fnv0: FATAL: bits arg must be an integer > 0"; quit "deprecated_fnv0: FATAL: bits arg must be an integer > 0";
} }
if (!isstr(string)) { if (!isstr(string)) {
quit "deprecated_fnv0: FATAL: string arg must be a string"; quit "deprecated_fnv0: FATAL: string arg must be a string";
} }
/* /*
* fnv_prime == null() means to try and generate the FNV prime * fnv_prime == null() means to try and generate the FNV prime
*/ */
if (isnull(fnv_prime)) { if (isnull(fnv_prime)) {
/* try to generate an FNV prime */ /* try to generate an FNV prime */
fnv_prime = find_fnv_prime(bits); fnv_prime = find_fnv_prime(bits);
if (fnv_prime == 0) { if (fnv_prime == 0) {
quit "deprecated_fnv0: FATAL: no FNV prime exists for the given hash size in bits"; quit "deprecated_fnv0: FATAL: no FNV prime exists for the given hash size in bits";
} }
} }
if (!isint(fnv_prime) || fnv_prime <= 0) { if (!isint(fnv_prime) || fnv_prime <= 0) {
quit "deprecated_fnv0: FATAL: fnv_prime arg must be an integer > 0 and should be prime"; quit "deprecated_fnv0: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
} }
/* /*
@@ -313,7 +313,7 @@ define deprecated_fnv0(bits, fnv_prime, string)
base = 2^bits; base = 2^bits;
hash = 0; hash = 0;
for (i=0; i < len; ++i) { for (i=0; i < len; ++i) {
hash = xor((hash * fnv_prime) % base, ord(string[i])); hash = xor((hash * fnv_prime) % base, ord(string[i]));
} }
return hash; return hash;
} }
@@ -323,18 +323,18 @@ define deprecated_fnv0(bits, fnv_prime, string)
* fnv_offset_basis - generate and FNV offset basis * fnv_offset_basis - generate and FNV offset basis
* *
* given: * given:
* bits number of bits in FNV hash * bits number of bits in FNV hash
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible * fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
* *
* returns: * returns:
* FNV offset basis for a hash size of bits and an FNV prime of fnv_prime * FNV offset basis for a hash size of bits and an FNV prime of fnv_prime
* *
* NOTE: This function does NOT attempt to determine that fnv_prime is prime. * NOTE: This function does NOT attempt to determine that fnv_prime is prime.
*/ */
define define
fnv_offset_basis(bits, fnv_prime) fnv_offset_basis(bits, fnv_prime)
{ {
local fnv0_hash = 0; /* FNV-0 hash value */ local fnv0_hash = 0; /* FNV-0 hash value */
/* string to generate a FNV offset basis - do not change this value */ /* string to generate a FNV offset basis - do not change this value */
static chongo_was_here = "chongo <Landon Curt Noll> /\\../\\"; static chongo_was_here = "chongo <Landon Curt Noll> /\\../\\";
@@ -343,21 +343,21 @@ fnv_offset_basis(bits, fnv_prime)
* firewall * firewall
*/ */
if (!isint(bits) || bits <= 0) { if (!isint(bits) || bits <= 0) {
quit "fnv_offset_basis: FATAL: bits arg must be an integer > 0"; quit "fnv_offset_basis: FATAL: bits arg must be an integer > 0";
} }
/* /*
* fnv_prime == null() means to try and generate the FNV prime * fnv_prime == null() means to try and generate the FNV prime
*/ */
if (isnull(fnv_prime)) { if (isnull(fnv_prime)) {
/* try to generate an FNV prime */ /* try to generate an FNV prime */
fnv_prime = find_fnv_prime(bits); fnv_prime = find_fnv_prime(bits);
if (fnv_prime == 0) { if (fnv_prime == 0) {
quit "fnv_offset_basis: FATAL: no FNV prime exists for the given hash size in bits"; quit "fnv_offset_basis: FATAL: no FNV prime exists for the given hash size in bits";
} }
} }
if (!isint(fnv_prime) || fnv_prime <= 0) { if (!isint(fnv_prime) || fnv_prime <= 0) {
quit "fnv_offset_basis: FATAL: fnv_prime arg must be an integer > 0 and should be prime"; quit "fnv_offset_basis: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
} }
/* /*
@@ -374,10 +374,10 @@ fnv_offset_basis(bits, fnv_prime)
* These functions, if given non-standard values, will produce bogus results. * These functions, if given non-standard values, will produce bogus results.
* To produce a true FNV-1a hash: * To produce a true FNV-1a hash:
* *
* bits must be a power of 2 * bits must be a power of 2
* 32 <= bits * 32 <= bits
* fnv_prime == find_fnv_prime(bits) OR fnv_prime == null() * fnv_prime == find_fnv_prime(bits) OR fnv_prime == null()
* prev_hash == previous FNV hash OR prev_hash == null() * prev_hash == previous FNV hash OR prev_hash == null()
* *
* If fnv_prime == null(), this function will try to compute the FNV prime * If fnv_prime == null(), this function will try to compute the FNV prime
* for a hash of size bits. * for a hash of size bits.
@@ -388,64 +388,64 @@ fnv_offset_basis(bits, fnv_prime)
* One may chain "FNV-style" hashes by replacing the offset_basis with * One may chain "FNV-style" hashes by replacing the offset_basis with
* the hash state of the previous hash. For the first hash: * the hash state of the previous hash. For the first hash:
* *
* fnv_prime = find_fnv_prime(bits) * fnv_prime = find_fnv_prime(bits)
* hash_val = fnv_style_hash(bits, fnv_prime, null(), string_a); * hash_val = fnv_style_hash(bits, fnv_prime, null(), string_a);
* *
* then: * then:
* *
* hash_val = fnv_style_hash(bits, fnv_prime, hash_val, string_b); * hash_val = fnv_style_hash(bits, fnv_prime, hash_val, string_b);
* *
* This will produce the same as the string_a concatenated with string_b: * This will produce the same as the string_a concatenated with string_b:
* *
* hash_val = fnv_style_hash(bits, null(), null(), string_a + string_b); * hash_val = fnv_style_hash(bits, null(), null(), string_a + string_b);
* *
* NOTE: Because string_a and string_b are strings, the expression: * NOTE: Because string_a and string_b are strings, the expression:
* *
* string_a + string_b * string_a + string_b
* *
* is string_a concatenated with string_b. * is string_a concatenated with string_b.
* *
* given: * given:
* bits number of bits in FNV hash * bits number of bits in FNV hash
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible * fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
* prev_hash previous hash value, null() ==> generate FNV offset basis * prev_hash previous hash value, null() ==> generate FNV offset basis
* string string to hash * string string to hash
* *
* returns: * returns:
* "FNV-style" hash of bits * "FNV-style" hash of bits
* *
* NOTE: This function does NOT attempt to determine that fnv_prime is prime. * NOTE: This function does NOT attempt to determine that fnv_prime is prime.
*/ */
define define
fnv1a_style_hash(bits, fnv_prime, prev_hash, string) fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
{ {
local hash = 0; /* FNV hash value */ local hash = 0; /* FNV hash value */
local len; /* length of string */ local len; /* length of string */
local base; /* base of FNV hash: 2^bits */ local base; /* base of FNV hash: 2^bits */
local i; local i;
/* /*
* firewall * firewall
*/ */
if (!isint(bits) || bits <= 0) { if (!isint(bits) || bits <= 0) {
quit "fnv1a_style_hash: FATAL: bits arg must be an integer > 0"; quit "fnv1a_style_hash: FATAL: bits arg must be an integer > 0";
} }
if (!isstr(string)) { if (!isstr(string)) {
quit "fnv1a_style_hash: FATAL: string arg must be a string"; quit "fnv1a_style_hash: FATAL: string arg must be a string";
} }
/* /*
* fnv_prime == null() means to try and generate the FNV prime * fnv_prime == null() means to try and generate the FNV prime
*/ */
if (isnull(fnv_prime)) { if (isnull(fnv_prime)) {
/* try to generate an FNV prime */ /* try to generate an FNV prime */
fnv_prime = find_fnv_prime(bits); fnv_prime = find_fnv_prime(bits);
if (fnv_prime == 0) { if (fnv_prime == 0) {
quit "fnv1a_style_hash: FATAL: no FNV prime exists for the given hash size in bits"; quit "fnv1a_style_hash: FATAL: no FNV prime exists for the given hash size in bits";
} }
} }
if (!isint(fnv_prime) || fnv_prime <= 0) { if (!isint(fnv_prime) || fnv_prime <= 0) {
quit "fnv1a_style_hash: FATAL: fnv_prime arg must be an integer > 0 and should be prime"; quit "fnv1a_style_hash: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
} }
/* /*
@@ -453,11 +453,11 @@ fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
*/ */
if (isnull(prev_hash)) { if (isnull(prev_hash)) {
/* generate the FNV offset basis for a hash of size bits */ /* generate the FNV offset basis for a hash of size bits */
prev_hash = fnv_offset_basis(bits, fnv_prime); prev_hash = fnv_offset_basis(bits, fnv_prime);
} }
if (!isint(prev_hash) || prev_hash < 0) { if (!isint(prev_hash) || prev_hash < 0) {
quit "fnv1a_style_hash: FATAL: prev_hash arg must be an integer => 0"; quit "fnv1a_style_hash: FATAL: prev_hash arg must be an integer => 0";
} }
/* /*
@@ -467,7 +467,7 @@ fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
base = 2^bits; base = 2^bits;
hash = prev_hash; hash = prev_hash;
for (i=0; i < len; ++i) { for (i=0; i < len; ++i) {
hash = xor((hash * fnv_prime) % base, ord(string[i])); hash = xor((hash * fnv_prime) % base, ord(string[i]));
} }
return hash; return hash;
} }

68
cal/gvec.cal
View File

@@ -17,37 +17,37 @@
define gvec(function, vector) define gvec(function, vector)
{ {
local xlen,y,foo; local xlen,y,foo;
local precx = 1e-50; /* default for now */ local precx = 1e-50; /* default for now */
local argc = param(0)-1; local argc = param(0)-1;
local old_tilde; /* previous config("tilde") */ local old_tilde; /* previous config("tilde") */
/* /*
* parse args * parse args
*/ */
local plist = mat[argc]; local plist = mat[argc];
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "plist=", plist; print "plist=", plist;
print "argc=", argc; print "argc=", argc;
} }
for(local i = 0; i< argc; i++) { for(local i = 0; i< argc; i++) {
local ii = i + 2; local ii = i + 2;
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "ii=", ii; print "ii=", ii;
print "param(" : ii : "}=", param(ii); print "param(" : ii : "}=", param(ii);
print "size(param(" : ii : ")=", size(param(ii)); print "size(param(" : ii : ")=", size(param(ii));
} }
plist[i] = size(param(ii)); plist[i] = size(param(ii));
} }
local slist=sort(plist); local slist=sort(plist);
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "plist=", plist; print "plist=", plist;
} }
local argm = argc-1; local argm = argc-1;
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "argm=", argm; print "argm=", argm;
} }
if (slist[0] != slist[argm]) { if (slist[0] != slist[argm]) {
quit "lengths don't match"; quit "lengths don't match";
} }
xlen = size(vector); xlen = size(vector);
y = mat[xlen]; y = mat[xlen];
@@ -67,32 +67,32 @@ define gvec(function, vector)
*/ */
if (isdefined(function)) { if (isdefined(function)) {
/* yep, it's a function, either builtin or user-defined */ /* yep, it's a function, either builtin or user-defined */
for (local j=0; j<xlen; j++) { for (local j=0; j<xlen; j++) {
/* build the function call */ /* build the function call */
foo = strcat(function, "("); foo = strcat(function, "(");
for (local jj = 0; jj<argc; jj++) { for (local jj = 0; jj<argc; jj++) {
foo = strcat(foo , str(param(jj+2)[j]), ","); foo = strcat(foo , str(param(jj+2)[j]), ",");
} }
foo = strcat(foo, str(precx), ")"); foo = strcat(foo, str(precx), ")");
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "foo=", foo; print "foo=", foo;
} }
y[j] = eval(foo); y[j] = eval(foo);
} }
/* /*
* it is an operator -- multi-argument operator makes no sense * it is an operator -- multi-argument operator makes no sense
*/ */
} else { } else {
if (argc > 1) { if (argc > 1) {
quit "Error: operator can accept only one argument"; quit "Error: operator can accept only one argument";
} }
for (j=0; j<xlen; j++) { for (j=0; j<xlen; j++) {
foo = strcat(str(vector[j]), function); foo = strcat(str(vector[j]), function);
y[j] = eval(foo); y[j] = eval(foo);
} }
} }
/* restore tilde mode if needed */ /* restore tilde mode if needed */

10
cal/hello.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/11/13 13:25:43 * Under source code control: 1996/11/13 13:25:43
* File existed as early as: 1996 * File existed as early as: 1996
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*

176
cal/hms.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2010/09/01 17:14:55 * Under source code control: 2010/09/01 17:14:55
* File existed as early as: 2010 * File existed as early as: 2010
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -28,14 +28,14 @@ obj hms {hour, min, sec};
define hms(hour, min, sec) define hms(hour, min, sec)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* default missing args to 0 */ /* default missing args to 0 */
if (isnull(sec)) { if (isnull(sec)) {
sec = 0; sec = 0;
} }
if (isnull(min)) { if (isnull(min)) {
min = 0; min = 0;
} }
/* load object */ /* load object */
@@ -51,30 +51,30 @@ define hms(hour, min, sec)
define hms_add(a, b) define hms_add(a, b)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* initialize value to 1st arg */ /* initialize value to 1st arg */
if (istype(a, ans)) { if (istype(a, ans)) {
/* 1st arg is hms object, load it */ /* 1st arg is hms object, load it */
ans.hour = a.hour; ans.hour = a.hour;
ans.min = a.min; ans.min = a.min;
ans.sec = a.sec; ans.sec = a.sec;
} else { } else {
/* 1st arg is not hms, assume scalar hours */ /* 1st arg is not hms, assume scalar hours */
ans.hour = a; ans.hour = a;
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
} }
/* add value of 2nd arg */ /* add value of 2nd arg */
if (istype(b, ans)) { if (istype(b, ans)) {
/* 2nd arg is hms object, add it */ /* 2nd arg is hms object, add it */
ans.hour += b.hour; ans.hour += b.hour;
ans.min += b.min; ans.min += b.min;
ans.sec += b.sec; ans.sec += b.sec;
} else { } else {
/* 2nd arg is not hms, add scalar hours */ /* 2nd arg is not hms, add scalar hours */
ans.hour += b; ans.hour += b;
} }
/* return normalized result */ /* return normalized result */
@@ -85,19 +85,19 @@ define hms_add(a, b)
define hms_neg(a) define hms_neg(a)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* negate argument */ /* negate argument */
if (istype(a, ans)) { if (istype(a, ans)) {
/* 1st arg is hms object, load it */ /* 1st arg is hms object, load it */
ans.hour = -a.hour; ans.hour = -a.hour;
ans.min = -a.min; ans.min = -a.min;
ans.sec = -a.sec; ans.sec = -a.sec;
} else { } else {
/* 2nd arg is not hms, negate scalar hours */ /* 2nd arg is not hms, negate scalar hours */
ans.hour = -a; ans.hour = -a;
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
} }
/* return normalized result */ /* return normalized result */
@@ -108,30 +108,30 @@ define hms_neg(a)
define hms_sub(a, b) define hms_sub(a, b)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* initialize value to 1st arg */ /* initialize value to 1st arg */
if (istype(a, ans)) { if (istype(a, ans)) {
/* 1st arg is hms object, load it */ /* 1st arg is hms object, load it */
ans.hour = a.hour; ans.hour = a.hour;
ans.min = a.min; ans.min = a.min;
ans.sec = a.sec; ans.sec = a.sec;
} else { } else {
/* 1st arg is not hms, assume scalar hours */ /* 1st arg is not hms, assume scalar hours */
ans.hour = a; ans.hour = a;
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
} }
/* subtract value of 2nd arg */ /* subtract value of 2nd arg */
if (istype(b, ans)) { if (istype(b, ans)) {
/* 2nd arg is hms object, subtract it */ /* 2nd arg is hms object, subtract it */
ans.hour -= b.hour; ans.hour -= b.hour;
ans.min -= b.min; ans.min -= b.min;
ans.sec -= b.sec; ans.sec -= b.sec;
} else { } else {
/* 2nd arg is not hms, subtract scalar hours */ /* 2nd arg is not hms, subtract scalar hours */
ans.hour -= b; ans.hour -= b;
} }
/* return normalized result */ /* return normalized result */
@@ -142,23 +142,23 @@ define hms_sub(a, b)
define hms_mul(a, b) define hms_mul(a, b)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* hms object multiplication */ /* hms object multiplication */
if (istype(a, ans) && istype(b, ans)) { if (istype(a, ans) && istype(b, ans)) {
ans.hour = hms_abs(a) * hms_abs(b); ans.hour = hms_abs(a) * hms_abs(b);
ans.min = 0; ans.min = 0;
ans.sec = 0; ans.sec = 0;
/* scalar multiplication */ /* scalar multiplication */
} else if (istype(a, ans)) { } else if (istype(a, ans)) {
ans.hour = a.hour * b; ans.hour = a.hour * b;
ans.min = a.min * b; ans.min = a.min * b;
ans.sec = a.sec * b; ans.sec = a.sec * b;
} else { } else {
ans.hour = b.hour * a; ans.hour = b.hour * a;
ans.min = b.min * a; ans.min = b.min * a;
ans.sec = b.sec * a; ans.sec = b.sec * a;
} }
/* return normalized result */ /* return normalized result */
@@ -169,11 +169,11 @@ define hms_mul(a, b)
define hms_print(a) define hms_print(a)
{ {
local obj hms ans; /* temp object for hms type testing */ local obj hms ans; /* temp object for hms type testing */
/* firewall - arg must be a hms object */ /* firewall - arg must be a hms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "hms_print called with non hms object"; quit "hms_print called with non hms object";
} }
/* print in hms form */ /* print in hms form */
@@ -183,12 +183,12 @@ define hms_print(a)
define hms_abs(a) define hms_abs(a)
{ {
local obj hms ans; /* temp object for hms type testing */ local obj hms ans; /* temp object for hms type testing */
local hour; /* return scalar value */ local hour; /* return scalar value */
/* firewall - just absolute value non hms objects */ /* firewall - just absolute value non hms objects */
if (! istype(a, ans)) { if (! istype(a, ans)) {
return abs(a); return abs(a);
} }
/* compute hours */ /* compute hours */
@@ -201,12 +201,12 @@ define hms_abs(a)
define hms_norm(a) define hms_norm(a)
{ {
local obj hms ans; /* temp object for hms type testing */ local obj hms ans; /* temp object for hms type testing */
local hour; /* hours */ local hour; /* hours */
/* firewall - arg must be a hms object */ /* firewall - arg must be a hms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "hms_norm called with non hms object"; quit "hms_norm called with non hms object";
} }
/* square hours (norm is the square of absolute value */ /* square hours (norm is the square of absolute value */
@@ -219,18 +219,18 @@ define hms_norm(a)
define hms_test(a) define hms_test(a)
{ {
local obj hms ans; /* temp value */ local obj hms ans; /* temp value */
/* firewall - arg must be a hms object */ /* firewall - arg must be a hms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "hms_test called with non hms object"; quit "hms_test called with non hms object";
} }
/* return false of non-zero */ /* return false of non-zero */
ans = fixhms(a); ans = fixhms(a);
if (ans.hour == 0 && ans.min == 0 && ans.sec == 0) { if (ans.hour == 0 && ans.min == 0 && ans.sec == 0) {
/* false */ /* false */
return 0; return 0;
} }
/* true */ /* true */
return 1; return 1;
@@ -239,11 +239,11 @@ define hms_test(a)
define hms_int(a) define hms_int(a)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* firewall - arg must be a hms object */ /* firewall - arg must be a hms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "hms_int called with non hms object"; quit "hms_int called with non hms object";
} }
/* normalize the argument */ /* normalize the argument */
@@ -259,11 +259,11 @@ define hms_int(a)
define hms_frac(a) define hms_frac(a)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* firewall - arg must be a hms object */ /* firewall - arg must be a hms object */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "hms_frac called with non hms object"; quit "hms_frac called with non hms object";
} }
/* normalize the argument */ /* normalize the argument */
@@ -281,7 +281,7 @@ define hms_frac(a)
define hms_rel(a,b) define hms_rel(a,b)
{ {
local abs_a, abs_b; /* scalars of the arguments */ local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */ /* compute scalars of the arguments */
abs_a = hms_abs(a); abs_a = hms_abs(a);
@@ -294,7 +294,7 @@ define hms_rel(a,b)
define hms_cmp(a,b) define hms_cmp(a,b)
{ {
local abs_a, abs_b; /* scalars of the arguments */ local abs_a, abs_b; /* scalars of the arguments */
/* compute scalars of the arguments */ /* compute scalars of the arguments */
abs_a = hms_abs(a); abs_a = hms_abs(a);
@@ -307,16 +307,16 @@ define hms_cmp(a,b)
define hms_inc(a) define hms_inc(a)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* increment a hms object */ /* increment a hms object */
if (istype(a, ans)) { if (istype(a, ans)) {
ans = a; ans = a;
++ans.sec; ++ans.sec;
/* return normalized result */ /* return normalized result */
ans = fixhms(ans); ans = fixhms(ans);
return ans; return ans;
} }
/* increment a scalar */ /* increment a scalar */
@@ -326,16 +326,16 @@ define hms_inc(a)
define hms_dec(a) define hms_dec(a)
{ {
local obj hms ans; /* return value */ local obj hms ans; /* return value */
/* decrement a hms object */ /* decrement a hms object */
if (istype(a, ans)) { if (istype(a, ans)) {
ans = a; ans = a;
--ans.sec; --ans.sec;
/* return normalized result */ /* return normalized result */
ans = fixhms(ans); ans = fixhms(ans);
return ans; return ans;
} }
/* decrement a scalar */ /* decrement a scalar */
@@ -345,11 +345,11 @@ define hms_dec(a)
define fixhms(a) define fixhms(a)
{ {
local obj hms ans; /* temp value */ local obj hms ans; /* temp value */
/* firewall */ /* firewall */
if (! istype(a, ans)) { if (! istype(a, ans)) {
quit "attempt to fix a non hms object"; quit "attempt to fix a non hms object";
} }
/* use builtin h2hms function */ /* use builtin h2hms function */

18
cal/infinities.cal
View File

@@ -26,9 +26,9 @@ resource_debug_level = config("resource_debug", 0);
define isinfinite(x) define isinfinite(x)
{ {
if (isstr(x)) { if (isstr(x)) {
if (strncmp(x, "cinf", 4) == 0 if (strncmp(x, "cinf", 4) == 0
|| strncmp(x, "pinf", 4) == 0 || strncmp(x, "ninf", 4) == 0) || strncmp(x, "pinf", 4) == 0 || strncmp(x, "ninf", 4) == 0)
return 1; return 1;
} }
return 0; return 0;
} }
@@ -36,8 +36,8 @@ define isinfinite(x)
define iscinf(x) define iscinf(x)
{ {
if (isstr(x)) { if (isstr(x)) {
if (strncmp(x, "cinf", 4) == 0) if (strncmp(x, "cinf", 4) == 0)
return 1; return 1;
} }
return 0; return 0;
} }
@@ -45,8 +45,8 @@ define iscinf(x)
define ispinf(x) define ispinf(x)
{ {
if (isstr(x)) { if (isstr(x)) {
if (strncmp(x, "pinf", 4) == 0) if (strncmp(x, "pinf", 4) == 0)
return 1; return 1;
} }
return 0; return 0;
} }
@@ -54,8 +54,8 @@ define ispinf(x)
define isninf(x) define isninf(x)
{ {
if (isstr(x)) { if (isstr(x)) {
if (strncmp(x, "ninf", 4) == 0) if (strncmp(x, "ninf", 4) == 0)
return 1; return 1;
} }
return 0; return 0;
} }

68
cal/intfile.cal
View File

@@ -27,9 +27,9 @@
/* /*
* NOTE: Because leading HALF values are trimmed from integer, a file * NOTE: Because leading HALF values are trimmed from integer, a file
* that begins with lots of 0 bits (in the case of big Endian) * that begins with lots of 0 bits (in the case of big Endian)
* or that ends with lots of 0 bits (in the case of little Endian) * or that ends with lots of 0 bits (in the case of little Endian)
* will be changed when the subsequent integer is written back. * will be changed when the subsequent integer is written back.
*/ */
@@ -37,16 +37,16 @@
* file2be - convert a file into an big Endian integer * file2be - convert a file into an big Endian integer
* *
* given: * given:
* filename filename to read * filename filename to read
* *
* returns: * returns:
* integer read from its contents on big Endian order * integer read from its contents on big Endian order
*/ */
define file2be(filename) define file2be(filename)
{ {
local fd; /* open file */ local fd; /* open file */
local ret; /* integer to return */ local ret; /* integer to return */
local c; /* character read from the file */ local c; /* character read from the file */
local i; local i;
/* /*
@@ -62,8 +62,8 @@ define file2be(filename)
*/ */
ret = 0; ret = 0;
while (! isnull(c = fgetc(fd))) { while (! isnull(c = fgetc(fd))) {
ret <<= 8; ret <<= 8;
ret += ord(c); ret += ord(c);
} }
/* /*
@@ -78,17 +78,17 @@ define file2be(filename)
* file2le - convert a file into an little Endian integer * file2le - convert a file into an little Endian integer
* *
* given: * given:
* filename filename to read * filename filename to read
* *
* returns: * returns:
* integer read from its contents on little Endian order * integer read from its contents on little Endian order
*/ */
define file2le(filename) define file2le(filename)
{ {
local fd; /* open file */ local fd; /* open file */
local ret; /* integer to return */ local ret; /* integer to return */
local c; /* character read from the file */ local c; /* character read from the file */
local shft; /* bit shift for the c value */ local shft; /* bit shift for the c value */
local i; local i;
/* /*
@@ -105,8 +105,8 @@ define file2le(filename)
ret = 0; ret = 0;
shft = 0; shft = 0;
while (! isnull(c = fgetc(fd))) { while (! isnull(c = fgetc(fd))) {
ret |= (ord(c) << shft); ret |= (ord(c) << shft);
shft += 8; shft += 8;
} }
/* /*
@@ -121,25 +121,25 @@ define file2le(filename)
* be2file - convert a big Endian integer into a file * be2file - convert a big Endian integer into a file
* *
* given: * given:
* v integer to write to the file * v integer to write to the file
* filename filename to write * filename filename to write
* *
* returns: * returns:
* The number of octets written to the file. * The number of octets written to the file.
* *
* NOTE: The absolute value of the integer is written to the file. * NOTE: The absolute value of the integer is written to the file.
*/ */
define be2file(v, filename) define be2file(v, filename)
{ {
local fd; /* open file */ local fd; /* open file */
local octlen; /* length of v in octets */ local octlen; /* length of v in octets */
local i; local i;
/* /*
* firewall * firewall
*/ */
if (!isint(v)) { if (!isint(v)) {
quit "be2file: 1st arg not an integer"; quit "be2file: 1st arg not an integer";
} }
v = abs(v); v = abs(v);
@@ -156,7 +156,7 @@ define be2file(v, filename)
*/ */
octlen = int((highbit(v)+8) / 8); octlen = int((highbit(v)+8) / 8);
for (i=octlen-1; i >= 0; --i) { for (i=octlen-1; i >= 0; --i) {
fputc(fd, char(v >> (i*8))); fputc(fd, char(v >> (i*8)));
} }
/* /*
@@ -171,24 +171,24 @@ define be2file(v, filename)
* le2file - convert a little Endian integer into a file * le2file - convert a little Endian integer into a file
* *
* given: * given:
* v integer to write to the file * v integer to write to the file
* filename filename to write * filename filename to write
* *
* returns: * returns:
* The number of octets written to the file. * The number of octets written to the file.
* *
* NOTE: The absolute value of the integer is written to the file. * NOTE: The absolute value of the integer is written to the file.
*/ */
define le2file(v, filename) define le2file(v, filename)
{ {
local fd; /* open file */ local fd; /* open file */
local cnt; /* octets written */ local cnt; /* octets written */
/* /*
* firewall * firewall
*/ */
if (!isint(v)) { if (!isint(v)) {
quit "be2file: 1st arg not an integer"; quit "be2file: 1st arg not an integer";
} }
v = abs(v); v = abs(v);
@@ -205,9 +205,9 @@ define le2file(v, filename)
*/ */
cnt = 0; cnt = 0;
while (v > 0) { while (v > 0) {
fputc(fd, char(v)); fputc(fd, char(v));
v >>= 8; v >>= 8;
++cnt; ++cnt;
} }
/* /*

788
cal/intnum.cal
View File

@@ -43,7 +43,7 @@ define quadtscomputenodes(order, expo, eps)
local t cht sht chp sum k PI places; local t cht sht chp sum k PI places;
local h t0 x w; local h t0 x w;
if (__CZ__tanhsinh_order == order && __CZ__tanhsinh_prec == eps) if (__CZ__tanhsinh_order == order && __CZ__tanhsinh_prec == eps)
return 1; return 1;
__CZ__tanhsinh_order = order; __CZ__tanhsinh_order = order;
__CZ__tanhsinh_prec = eps; __CZ__tanhsinh_prec = eps;
__CZ__tanhsinh_x = list(); __CZ__tanhsinh_x = list();
@@ -68,34 +68,34 @@ define quadtscomputenodes(order, expo, eps)
*/ */
/* make use of x(-t) = -x(t), w(-t) = w(t) */ /* make use of x(-t) = -x(t), w(-t) = w(t) */
for (k = 0; k < 20 * order + 1; k++) { for (k = 0; k < 20 * order + 1; k++) {
/* /*
* x = tanh(pi/2 * sinh(t)) * x = tanh(pi/2 * sinh(t))
* w = pi/2 * cosh(t) / cosh(pi/2 * sinh(t))^2 * w = pi/2 * cosh(t) / cosh(pi/2 * sinh(t))^2
*/ */
t = bround(t0 + k * h, places); t = bround(t0 + k * h, places);
cht = bround(cosh(t), places); cht = bround(cosh(t), places);
sht = bround(sinh(t), places); sht = bround(sinh(t), places);
chp = bround(cosh(0.5 * PI * sht), places); chp = bround(cosh(0.5 * PI * sht), places);
x = bround(tanh(0.5 * PI * sht), places); x = bround(tanh(0.5 * PI * sht), places);
w = bround((PI * h * cht) / (2 * chp ^ 2), places); w = bround((PI * h * cht) / (2 * chp ^ 2), places);
/* /*
* c = bround(exp(a-b),places); * c = bround(exp(a-b),places);
* d = bround(1/c,places); * d = bround(1/c,places);
* co =bround( (c+d)/2,places); * co =bround( (c+d)/2,places);
* si =bround( (c-d)/2,places); * si =bround( (c-d)/2,places);
* x = bround(si / co,places); * x = bround(si / co,places);
* w = bround((a+b) / co^2,places); * w = bround((a+b) / co^2,places);
*/ */
if (abs(x - 1) <= eps) if (abs(x - 1) <= eps)
break; break;
append(__CZ__tanhsinh_x, x); append(__CZ__tanhsinh_x, x);
append(__CZ__tanhsinh_w, w); append(__CZ__tanhsinh_w, w);
/* /*
* a *= udelta; * a *= udelta;
* b *= urdelta; * b *= urdelta;
*/ */
} }
/* Normalize the weights to make them add up to 2 (two) */ /* Normalize the weights to make them add up to 2 (two) */
@@ -119,100 +119,100 @@ define quadtscore(a, b, n)
places = highbit(1 + int (1 / epsilon())) +1; places = highbit(1 + int (1 / epsilon())) +1;
m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2; m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2;
if (!isnull(n)) { if (!isnull(n)) {
order = n; order = n;
m = ilog(order / 3, 2) + 1; m = ilog(order / 3, 2) + 1;
} else } else
order = 3 * 2 ^ (m - 1); order = 3 * 2 ^ (m - 1);
quadtscomputenodes(order, m, epsilon()); quadtscomputenodes(order, m, epsilon());
sizel = size(__CZ__tanhsinh_w); sizel = size(__CZ__tanhsinh_w);
if (isinfinite(a) || isinfinite(b)) { if (isinfinite(a) || isinfinite(b)) {
/* /*
* x * x
* t = ------------ * t = ------------
* 2 * 2
* sqrt(1 - y ) * sqrt(1 - y )
*/ */
if (isninf(a) && ispinf(b)) { if (isninf(a) && ispinf(b)) {
for (k = 0; k < sizel; k++) { for (k = 0; k < sizel; k++) {
x1 = __CZ__tanhsinh_x[k]; x1 = __CZ__tanhsinh_x[k];
x2 = -__CZ__tanhsinh_x[k]; x2 = -__CZ__tanhsinh_x[k];
w1 = __CZ__tanhsinh_w[k]; w1 = __CZ__tanhsinh_w[k];
x = bround(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places); x = bround(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places);
xm = bround(x2 * (1 - x2 ^ 2) ^ (-1 / 2), places); xm = bround(x2 * (1 - x2 ^ 2) ^ (-1 / 2), places);
w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)), w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)),
places); places);
w2 = bround(w1 * (((1 - x2 ^ 2) ^ (-1 / 2)) / (1 - x2 ^ 2)), w2 = bround(w1 * (((1 - x2 ^ 2) ^ (-1 / 2)) / (1 - x2 ^ 2)),
places); places);
sum += bround(w * f(x), places); sum += bround(w * f(x), places);
sum += bround(w2 * f(xm), places); sum += bround(w2 * f(xm), places);
} }
}
/*
* 1
* t = - - + b + 1
* x
*/
else if (isninf(a) && !iscinf(b)) {
for (k = 0; k < sizel; k++) {
x1 = __CZ__tanhsinh_x[k];
x2 = -__CZ__tanhsinh_x[k];
w1 = __CZ__tanhsinh_w[k];
x = bround((b + 1) - (2 / (x1 + 1)), places);
xm = bround((b + 1) - (2 / (x2 + 1)), places);
w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places);
w2 = bround(w1 * (1 / 2 * (2 / (x2 + 1)) ^ 2), places);
sum += bround(w * f(x), places);
sum += bround(w2 * f(xm), places);
}
}
/*
* 1
* t = - + a - 1
* x
*/
else if (!iscinf(a) && ispinf(b)) {
for (k = 0; k < sizel; k++) {
x1 = __CZ__tanhsinh_x[k];
x2 = -__CZ__tanhsinh_x[k];
w1 = __CZ__tanhsinh_w[k];
x = bround((a - 1) + (2 / (x1 + 1)), places);
xm = bround((a - 1) + (2 / (x2 + 1)), places);
w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places);
w2 = bround(w1 * (((1 / 2) * (2 / (x2 + 1)) ^ 2)), places);
sum += bround(w * f(x), places);
sum += bround(w2 * f(xm), places);
}
} else if (isninf(a) || isninf(b)) {
/*TODO: swap(a,b) and negate(w)? Lookup! */
return newerror("quadtscore: reverse limits?");
} else {
return
newerror("quadtscore: complex infinity not yet implemented");
} }
ret = sum; /*
* 1
* t = - - + b + 1
* x
*/
else if (isninf(a) && !iscinf(b)) {
for (k = 0; k < sizel; k++) {
x1 = __CZ__tanhsinh_x[k];
x2 = -__CZ__tanhsinh_x[k];
w1 = __CZ__tanhsinh_w[k];
x = bround((b + 1) - (2 / (x1 + 1)), places);
xm = bround((b + 1) - (2 / (x2 + 1)), places);
w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places);
w2 = bround(w1 * (1 / 2 * (2 / (x2 + 1)) ^ 2), places);
sum += bround(w * f(x), places);
sum += bround(w2 * f(xm), places);
}
}
/*
* 1
* t = - + a - 1
* x
*/
else if (!iscinf(a) && ispinf(b)) {
for (k = 0; k < sizel; k++) {
x1 = __CZ__tanhsinh_x[k];
x2 = -__CZ__tanhsinh_x[k];
w1 = __CZ__tanhsinh_w[k];
x = bround((a - 1) + (2 / (x1 + 1)), places);
xm = bround((a - 1) + (2 / (x2 + 1)), places);
w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places);
w2 = bround(w1 * (((1 / 2) * (2 / (x2 + 1)) ^ 2)), places);
sum += bround(w * f(x), places);
sum += bround(w2 * f(xm), places);
}
} else if (isninf(a) || isninf(b)) {
/*TODO: swap(a,b) and negate(w)? Lookup! */
return newerror("quadtscore: reverse limits?");
} else {
return
newerror("quadtscore: complex infinity not yet implemented");
}
ret = sum;
} else { } else {
/* Avoid rounding errors */ /* Avoid rounding errors */
if (a == -1 && b == 1) { if (a == -1 && b == 1) {
c = 1; c = 1;
d = 0; d = 0;
} else { } else {
c = (b - a) / 2; c = (b - a) / 2;
d = (b + a) / 2; d = (b + a) / 2;
} }
sum = 0; sum = 0;
for (k = 0; k < sizel; k++) { for (k = 0; k < sizel; k++) {
sum += sum +=
bround(__CZ__tanhsinh_w[k] * f(c * __CZ__tanhsinh_x[k] + d), bround(__CZ__tanhsinh_w[k] * f(c * __CZ__tanhsinh_x[k] + d),
places); places);
sum += sum +=
bround(__CZ__tanhsinh_w[k] * f(c * -__CZ__tanhsinh_x[k] + d), bround(__CZ__tanhsinh_w[k] * f(c * -__CZ__tanhsinh_x[k] + d),
places); places);
} }
ret = c * sum; ret = c * sum;
} }
epsilon(eps); epsilon(eps);
return ret; return ret;
@@ -225,97 +225,97 @@ define quadts(a, b, points)
local k sp results epsbits nsect interval length segment slope C ; local k sp results epsbits nsect interval length segment slope C ;
local x1 x2 y1 y2 sum D1 D2 D3 D4; local x1 x2 y1 y2 sum D1 D2 D3 D4;
if (param(0) < 2) if (param(0) < 2)
return newerror("quadts: not enough arguments"); return newerror("quadts: not enough arguments");
epsbits = highbit(1 + int (1 / epsilon())) +1; epsbits = highbit(1 + int (1 / epsilon())) +1;
if (param(0) < 3 || isnull(points)) { if (param(0) < 3 || isnull(points)) {
/* return as given */ /* return as given */
return quadtscore(a, b); return quadtscore(a, b);
} else { } else {
if ((isinfinite(a) || isinfinite(b)) if ((isinfinite(a) || isinfinite(b))
&& (!ismat(points) && !islist(points))) && (!ismat(points) && !islist(points)))
return return
newerror(strcat newerror(strcat
("quadts: segments of infinite length ", ("quadts: segments of infinite length ",
"are not yet supported")); "are not yet supported"));
if (ismat(points) || islist(points)) { if (ismat(points) || islist(points)) {
sp = size(points); sp = size(points);
if (sp == 0) if (sp == 0)
return return
newerror(strcat newerror(strcat
("quadts: variable 'points` must be a list or ", ("quadts: variable 'points` must be a list or ",
"1d-matrix of a length > 0")); "1d-matrix of a length > 0"));
/* check if all points are numbers */ /* check if all points are numbers */
for (k = 0; k < sp; k++) { for (k = 0; k < sp; k++) {
if (!isnum(points[k])) if (!isnum(points[k]))
return return
newerror(strcat newerror(strcat
("quadts: elements of 'points` must be", ("quadts: elements of 'points` must be",
" numbers only")); " numbers only"));
} }
/* We have n-1 intervals and a and b, hence n-1 + 2 results */ /* We have n-1 intervals and a and b, hence n-1 + 2 results */
results = mat[sp + 1]; results = mat[sp + 1];
if (a != points[0]) { if (a != points[0]) {
results[0] = quadtscore(a, points[0]); results[0] = quadtscore(a, points[0]);
} else { } else {
results[0] = 0; results[0] = 0;
} }
if (sp == 1) { if (sp == 1) {
if (b != points[0]) { if (b != points[0]) {
results[1] = quadtscore(points[0], b); results[1] = quadtscore(points[0], b);
} else { } else {
results[1] = 0; results[1] = 0;
} }
} else { } else {
for (k = 1; k < sp; k++) { for (k = 1; k < sp; k++) {
results[k] = quadtscore(points[k - 1], points[k]); results[k] = quadtscore(points[k - 1], points[k]);
} }
if (b != points[k - 1]) { if (b != points[k - 1]) {
results[k] = quadtscore(points[k - 1], b); results[k] = quadtscore(points[k - 1], b);
} else { } else {
results[k] = 0; results[k] = 0;
} }
} }
} else { } else {
if (!isint(points) || points <= 0) if (!isint(points) || points <= 0)
return newerror(strcat("quadts: variable 'points` must be a ", return newerror(strcat("quadts: variable 'points` must be a ",
"list or a positive integer")); "list or a positive integer"));
/* Taking "points" as the number of equally spaced intervals */ /* Taking "points" as the number of equally spaced intervals */
results = mat[points + 1]; results = mat[points + 1];
/* It is easy if a,b lie on the real line */ /* It is easy if a,b lie on the real line */
if (isreal(a) && isreal(b)) { if (isreal(a) && isreal(b)) {
length = abs(a - b); length = abs(a - b);
segment = length / points; segment = length / points;
for (k = 1; k <= points; k++) { for (k = 1; k <= points; k++) {
results[k - 1] = results[k - 1] =
quadtscore(a + (k - 1) * segment, a + k * segment); quadtscore(a + (k - 1) * segment, a + k * segment);
} }
} else { } else {
/* We have at least one complex limit but treat "points" still /* We have at least one complex limit but treat "points" still
* as the number of equally spaced intervals on a straight line * as the number of equally spaced intervals on a straight line
* connecting a and b. Computing the segments here is a bit * connecting a and b. Computing the segments here is a bit
* more complicated but not much, it should have been taught in * more complicated but not much, it should have been taught in
* high school. * high school.
* Other contours by way of a list of points */ * Other contours by way of a list of points */
slope = (im(b) - im(a)) / (re(b) - re(a)); slope = (im(b) - im(a)) / (re(b) - re(a));
C = (im(a) + slope) * re(a); C = (im(a) + slope) * re(a);
length = abs(re(a) - re(b)); length = abs(re(a) - re(b));
segment = length / points; segment = length / points;
/* y = mx+C where m is the slope, x is the real part and y the /* y = mx+C where m is the slope, x is the real part and y the
* imaginary part */ * imaginary part */
if(re(a)>re(b))swap(a,b); if(re(a)>re(b))swap(a,b);
for (k = re(a); k <= (re(b)); k+=segment) { for (k = re(a); k <= (re(b)); k+=segment) {
x1 = slope*(k) + C; x1 = slope*(k) + C;
results[k] = quadtscore(k + x1 * 1i); results[k] = quadtscore(k + x1 * 1i);
} }
} /* else of isreal */ } /* else of isreal */
} /* else of ismat|islist */ } /* else of ismat|islist */
} /* else of isnull(points) */ } /* else of isnull(points) */
/* With a bit of undeserved luck we have a result by now. */ /* With a bit of undeserved luck we have a result by now. */
sp = size(results); sp = size(results);
for (k = 0; k < sp; k++) { for (k = 0; k < sp; k++) {
sum += results[k]; sum += results[k];
} }
return sum; return sum;
} }
@@ -330,7 +330,7 @@ define quadglcomputenodes(N)
local places k l x w t1 t2 t3 t4 t5 r tmp; local places k l x w t1 t2 t3 t4 t5 r tmp;
if (__CZ__gl_order == N && __CZ__gl_prec == epsilon()) if (__CZ__gl_order == N && __CZ__gl_prec == epsilon())
return; return;
__CZ__gl_x = mat[N]; __CZ__gl_x = mat[N];
__CZ__gl_w = mat[N]; __CZ__gl_w = mat[N];
@@ -344,28 +344,28 @@ define quadglcomputenodes(N)
* Trick shamelessly stolen from D. Bailey et .al (program "arprec") * Trick shamelessly stolen from D. Bailey et .al (program "arprec")
*/ */
for (k = 1; k <= N//2; k++) { for (k = 1; k <= N//2; k++) {
r = bround(cos(pi() * (k - .25) / (N + .5)), places); r = bround(cos(pi() * (k - .25) / (N + .5)), places);
while (1) { while (1) {
t1 = 1, t2 = 0; t1 = 1, t2 = 0;
for (l = 1; l <= N; l++) { for (l = 1; l <= N; l++) {
t3 = t2; t3 = t2;
t2 = t1; t2 = t1;
t1 = bround(((2 * l - 1) * r * t2 - (l - 1) * t3) / l, places); t1 = bround(((2 * l - 1) * r * t2 - (l - 1) * t3) / l, places);
} }
t4 = bround(N * (r * t1 - t2) / ((r ^ 2) - 1), places); t4 = bround(N * (r * t1 - t2) / ((r ^ 2) - 1), places);
t5 = r; t5 = r;
tmp = t1 / t4; tmp = t1 / t4;
r = r - tmp; r = r - tmp;
if (abs(tmp) <= epsilon()) if (abs(tmp) <= epsilon())
break; break;
} }
x = r; x = r;
w = bround(2 / ((1 - r ^ 2) * t4 ^ 2), places); w = bround(2 / ((1 - r ^ 2) * t4 ^ 2), places);
__CZ__gl_x[k - 1] = x; __CZ__gl_x[k - 1] = x;
__CZ__gl_w[k - 1] = w; __CZ__gl_w[k - 1] = w;
__CZ__gl_x[N - k] = -__CZ__gl_x[k - 1]; __CZ__gl_x[N - k] = -__CZ__gl_x[k - 1];
__CZ__gl_w[N - k] = __CZ__gl_w[k - 1]; __CZ__gl_w[N - k] = __CZ__gl_w[k - 1];
} }
return; return;
} }
@@ -386,64 +386,64 @@ define quadglcore(a, b, n)
eps = epsilon(epsilon() * 1e-2); eps = epsilon(epsilon() * 1e-2);
places = highbit(1 + int (1 / epsilon())) +1; places = highbit(1 + int (1 / epsilon())) +1;
if (!isnull(n)) if (!isnull(n))
order = n; order = n;
else { else {
m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2; m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2;
order = 3 * 2 ^ (m - 1); order = 3 * 2 ^ (m - 1);
} }
quadglcomputenodes(order, 1); quadglcomputenodes(order, 1);
if (isinfinite(a) || isinfinite(b)) { if (isinfinite(a) || isinfinite(b)) {
if (isninf(a) && ispinf(b)) { if (isninf(a) && ispinf(b)) {
for (k = 0; k < order; k++) { for (k = 0; k < order; k++) {
x1 = __CZ__gl_x[k]; x1 = __CZ__gl_x[k];
w1 = __CZ__gl_w[k]; w1 = __CZ__gl_w[k];
x = bround(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places); x = bround(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places);
w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)), w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)),
places); places);
sum += bround(w * f(x), places); sum += bround(w * f(x), places);
} }
} else if (isninf(a) && !iscinf(b)) { } else if (isninf(a) && !iscinf(b)) {
for (k = 0; k < order; k++) { for (k = 0; k < order; k++) {
x1 = __CZ__gl_x[k]; x1 = __CZ__gl_x[k];
w1 = __CZ__gl_w[k]; w1 = __CZ__gl_w[k];
x = bround((b + 1) - (2 / (x1 + 1)), places); x = bround((b + 1) - (2 / (x1 + 1)), places);
w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places); w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places);
sum += bround(w * f(x), places); sum += bround(w * f(x), places);
} }
} else if (!iscinf(a) && ispinf(b)) { } else if (!iscinf(a) && ispinf(b)) {
for (k = 0; k < order; k++) { for (k = 0; k < order; k++) {
x1 = __CZ__gl_x[k]; x1 = __CZ__gl_x[k];
w1 = __CZ__gl_w[k]; w1 = __CZ__gl_w[k];
x = bround((a - 1) + (2 / (x1 + 1)), places); x = bround((a - 1) + (2 / (x1 + 1)), places);
w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places); w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places);
sum += bround(w * f(x), places); sum += bround(w * f(x), places);
} }
} else if (isninf(a) || isninf(b)) { } else if (isninf(a) || isninf(b)) {
/*TODO: swap(a,b) and negate(w)? Lookup! */ /*TODO: swap(a,b) and negate(w)? Lookup! */
return newerror("quadglcore: reverse limits?"); return newerror("quadglcore: reverse limits?");
} else } else
return return
newerror("quadglcore: complex infinity not yet implemented"); newerror("quadglcore: complex infinity not yet implemented");
ret = sum; ret = sum;
} else { } else {
/* Avoid rounding errors */ /* Avoid rounding errors */
if (a == -1 && b == 1) { if (a == -1 && b == 1) {
c = 1; c = 1;
d = 0; d = 0;
} else { } else {
c = (b - a) / 2; c = (b - a) / 2;
d = (b + a) / 2; d = (b + a) / 2;
} }
sum = 0; sum = 0;
for (k = 0; k < order; k++) { for (k = 0; k < order; k++) {
sum += bround(__CZ__gl_w[k] * f(c * __CZ__gl_x[k] + d), places); sum += bround(__CZ__gl_w[k] * f(c * __CZ__gl_x[k] + d), places);
} }
ret = c * sum; ret = c * sum;
} }
epsilon(eps); epsilon(eps);
return ret; return ret;
@@ -452,97 +452,97 @@ define quadglcore(a, b, n)
define quadgl(a, b, points) define quadgl(a, b, points)
{ {
local k sp results epsbits nsect interval length segment slope C x1 y1 x2 local k sp results epsbits nsect interval length segment slope C x1 y1 x2
y2; y2;
local sum D1 D2 D3 D4; local sum D1 D2 D3 D4;
if (param(0) < 2) if (param(0) < 2)
return newerror("quadgl: not enough arguments"); return newerror("quadgl: not enough arguments");
epsbits = highbit(1 + int (1 / epsilon())) +1; epsbits = highbit(1 + int (1 / epsilon())) +1;
if (isnull(points)) { if (isnull(points)) {
/* return as given */ /* return as given */
return quadglcore(a, b); return quadglcore(a, b);
} else { } else {
/* But if we could half the time needed to execute a single operation /* But if we could half the time needed to execute a single operation
* we could do all of it in just twice that time. */ * we could do all of it in just twice that time. */
if (isinfinite(a) || isinfinite(b) if (isinfinite(a) || isinfinite(b)
&& (!ismat(points) && !islist(points))) && (!ismat(points) && !islist(points)))
return return
newerror(strcat newerror(strcat
("quadgl: multiple segments of infinite length ", ("quadgl: multiple segments of infinite length ",
"are not yet supported")); "are not yet supported"));
if (ismat(points) || islist(points)) { if (ismat(points) || islist(points)) {
sp = size(points); sp = size(points);
if (sp == 0) if (sp == 0)
return return
newerror(strcat newerror(strcat
("quadgl: variable 'points` must be a list or ", ("quadgl: variable 'points` must be a list or ",
"1d-matrix of a length > 0")); "1d-matrix of a length > 0"));
/* check if all points are numbers */ /* check if all points are numbers */
for (k = 0; k < sp; k++) { for (k = 0; k < sp; k++) {
if (!isnum(points[k])) if (!isnum(points[k]))
return return
newerror(strcat newerror(strcat
("quadgl: elements of 'points` must be ", ("quadgl: elements of 'points` must be ",
"numbers only")); "numbers only"));
} }
/* We have n-1 intervals and a and b, hence n-1 + 2 results */ /* We have n-1 intervals and a and b, hence n-1 + 2 results */
results = mat[sp + 1]; results = mat[sp + 1];
if (a != points[0]) { if (a != points[0]) {
results[0] = quadglcore(a, points[0]); results[0] = quadglcore(a, points[0]);
} else { } else {
results[0] = 0; results[0] = 0;
} }
if (sp == 1) { if (sp == 1) {
if (b != points[0]) { if (b != points[0]) {
results[1] = quadglcore(points[0], b); results[1] = quadglcore(points[0], b);
} else { } else {
results[1] = 0; results[1] = 0;
} }
} else { } else {
for (k = 1; k < sp; k++) { for (k = 1; k < sp; k++) {
results[k] = quadglcore(points[k - 1], points[k]); results[k] = quadglcore(points[k - 1], points[k]);
} }
if (b != points[k - 1]) { if (b != points[k - 1]) {
results[k] = quadglcore(points[k - 1], b); results[k] = quadglcore(points[k - 1], b);
} else { } else {
results[k] = 0; results[k] = 0;
} }
} }
} else { } else {
if (!isint(points) || points <= 0) if (!isint(points) || points <= 0)
return newerror(strcat("quadgl: variable 'points` must be a ", return newerror(strcat("quadgl: variable 'points` must be a ",
"list or a positive integer")); "list or a positive integer"));
/* Taking "points" as the number of equally spaced intervals */ /* Taking "points" as the number of equally spaced intervals */
results = mat[points + 1]; results = mat[points + 1];
/* It is easy if a,b lie on the real line */ /* It is easy if a,b lie on the real line */
if (isreal(a) && isreal(b)) { if (isreal(a) && isreal(b)) {
length = abs(a - b); length = abs(a - b);
segment = length / points; segment = length / points;
for (k = 1; k <= points; k++) { for (k = 1; k <= points; k++) {
results[k - 1] = results[k - 1] =
quadglcore(a + (k - 1) * segment, a + k * segment); quadglcore(a + (k - 1) * segment, a + k * segment);
} }
} else { } else {
/* Other contours by way of a list of points */ /* Other contours by way of a list of points */
slope = (im(b) - im(a)) / (re(b) - re(a)); slope = (im(b) - im(a)) / (re(b) - re(a));
C = (im(a) + slope) * re(a); C = (im(a) + slope) * re(a);
length = abs(re(a) - re(b)); length = abs(re(a) - re(b));
segment = length / points; segment = length / points;
/* y = mx+C where m is the slope, x is the real part and y the /* y = mx+C where m is the slope, x is the real part and y the
* imaginary part */ * imaginary part */
if(re(a)>re(b))swap(a,b); if(re(a)>re(b))swap(a,b);
for (k = re(a); k <= (re(b)); k+=segment) { for (k = re(a); k <= (re(b)); k+=segment) {
x1 = slope*(k) + C; x1 = slope*(k) + C;
results[k] = quadglcore(k + x1 * 1i); results[k] = quadglcore(k + x1 * 1i);
} }
} /* else of isreal */ } /* else of isreal */
} /* else of ismat|islist */ } /* else of ismat|islist */
} /* else of isnull(points) */ } /* else of isnull(points) */
/* With a bit of undeserved luck we have a result by now. */ /* With a bit of undeserved luck we have a result by now. */
sp = size(results); sp = size(results);
for (k = 0; k < sp; k++) { for (k = 0; k < sp; k++) {
sum += results[k]; sum += results[k];
} }
return sum; return sum;
} }
@@ -550,49 +550,49 @@ define quadgl(a, b, points)
define quad(a, b, points = -1, method = "tanhsinh") define quad(a, b, points = -1, method = "tanhsinh")
{ {
if (isnull(a) || isnull(b) || param(0) < 2) if (isnull(a) || isnull(b) || param(0) < 2)
return newerror("quad: both limits must be given"); return newerror("quad: both limits must be given");
if (isstr(a)) { if (isstr(a)) {
if (strncmp(a, "cinf", 1) == 0) if (strncmp(a, "cinf", 1) == 0)
return return
newerror(strcat newerror(strcat
("quad: complex infinity not yet supported, use", ("quad: complex infinity not yet supported, use",
" 'pinf' or 'ninf' respectively")); " 'pinf' or 'ninf' respectively"));
} }
if (isstr(b)) { if (isstr(b)) {
if (strncmp(b, "cinf", 1) == 0) if (strncmp(b, "cinf", 1) == 0)
return return
newerror(strcat newerror(strcat
("quad: complex infinity not yet supported, use", ("quad: complex infinity not yet supported, use",
" 'pinf' or 'ninf' respectively")); " 'pinf' or 'ninf' respectively"));
} }
if (param(0) == 3) { if (param(0) == 3) {
if (isstr(points)) if (isstr(points))
method = points; method = points;
} }
if (strncmp(method, "tanhsinh", 1) == 0) { if (strncmp(method, "tanhsinh", 1) == 0) {
if (!isstr(points)) { if (!isstr(points)) {
if (points == -1) { if (points == -1) {
return quadts(a, b); return quadts(a, b);
} else { } else {
return quadts(a, b, points); return quadts(a, b, points);
} }
} else { } else {
return quadts(a, b); return quadts(a, b);
} }
} }
if (strncmp(method, "gausslegendre", 1) == 0) { if (strncmp(method, "gausslegendre", 1) == 0) {
if (!isstr(points)) { if (!isstr(points)) {
if (points == -1) { if (points == -1) {
return quadgl(a, b); return quadgl(a, b);
} else { } else {
return quadgl(a, b, points); return quadgl(a, b, points);
} }
} else { } else {
return quadgl(a, b); return quadgl(a, b);
} }
} }
} }
@@ -602,33 +602,33 @@ define makerange(start, end, steps)
local segment; local segment;
steps = int (steps); steps = int (steps);
if (steps < 1) { if (steps < 1) {
return newerror("makerange: number of steps must be > 0"); return newerror("makerange: number of steps must be > 0");
} }
if (!isnum(start) || !isnum(end)) { if (!isnum(start) || !isnum(end)) {
return newerror("makerange: only numbers are supported yet"); return newerror("makerange: only numbers are supported yet");
} }
if (isreal(start) && isreal(end)) { if (isreal(start) && isreal(end)) {
step = (end - start) / (steps); step = (end - start) / (steps);
print step; print step;
ret = mat[steps + 1]; ret = mat[steps + 1];
for (k = 0; k <= steps; k++) { for (k = 0; k <= steps; k++) {
ret[k] = k * step + start; ret[k] = k * step + start;
} }
} else { } else {
ret = mat[steps + 1]; ret = mat[steps + 1];
if (re(start) > re(end)) { if (re(start) > re(end)) {
swap(start, end); swap(start, end);
} }
slope = (im(end) - im(start)) / (re(end) - re(start)); slope = (im(end) - im(start)) / (re(end) - re(start));
C = im(start) - slope * re(start); C = im(start) - slope * re(start);
length = abs(re(start) - re(end)); length = abs(re(start) - re(end));
segment = length / (steps); segment = length / (steps);
for (k = re(start), l = 0; k <= (re(end)); k += segment, l++) { for (k = re(start), l = 0; k <= (re(end)); k += segment, l++) {
x1 = slope * (k) + C; x1 = slope * (k) + C;
ret[l] = k + x1 * 1i; ret[l] = k + x1 * 1i;
} }
} }
return ret; return ret;
@@ -638,23 +638,23 @@ define makecircle(radius, center, points)
{ {
local ret k a b twopi centerx centery; local ret k a b twopi centerx centery;
if (!isint(points) || points < 2) { if (!isint(points) || points < 2) {
return return
newerror("makecircle: number of points is not a positive integer"); newerror("makecircle: number of points is not a positive integer");
} }
if (!isnum(center)) { if (!isnum(center)) {
return newerror("makecircle: center does not lie on the complex plane"); return newerror("makecircle: center does not lie on the complex plane");
} }
if (!isreal(radius) || radius <= 0) { if (!isreal(radius) || radius <= 0) {
return newerror("makecircle: radius is not a real > 0"); return newerror("makecircle: radius is not a real > 0");
} }
ret = mat[points]; ret = mat[points];
twopi = 2 * pi(); twopi = 2 * pi();
centerx = re(center); centerx = re(center);
centery = im(center); centery = im(center);
for (k = 0; k < points; k++) { for (k = 0; k < points; k++) {
a = centerx + radius * cos(twopi * k / points); a = centerx + radius * cos(twopi * k / points);
b = centery + radius * sin(twopi * k / points); b = centery + radius * sin(twopi * k / points);
ret[k] = a + b * 1i; ret[k] = a + b * 1i;
} }
return ret; return ret;
} }
@@ -663,32 +663,32 @@ define makeellipse(angle, a, b, center, points)
{ {
local ret k x y twopi centerx centery; local ret k x y twopi centerx centery;
if (!isint(points) || points < 2) { if (!isint(points) || points < 2) {
return return
newerror("makeellipse: number of points is not a positive integer"); newerror("makeellipse: number of points is not a positive integer");
} }
if (!isnum(center)) { if (!isnum(center)) {
return return
newerror("makeellipse: center does not lie on the complex plane"); newerror("makeellipse: center does not lie on the complex plane");
} }
if (!isreal(a) || a <= 0) { if (!isreal(a) || a <= 0) {
return newerror("makecircle: a is not a real > 0"); return newerror("makecircle: a is not a real > 0");
} }
if (!isreal(b) || b <= 0) { if (!isreal(b) || b <= 0) {
return newerror("makecircle: b is not a real > 0"); return newerror("makecircle: b is not a real > 0");
} }
if (!isreal(angle)) { if (!isreal(angle)) {
return newerror("makecircle: angle is not a real"); return newerror("makecircle: angle is not a real");
} }
ret = mat[points]; ret = mat[points];
twopi = 2 * pi(); twopi = 2 * pi();
centerx = re(center); centerx = re(center);
centery = im(center); centery = im(center);
for (k = 0; k < points; k++) { for (k = 0; k < points; k++) {
x = centerx + a * cos(twopi * k / points) * cos(angle) x = centerx + a * cos(twopi * k / points) * cos(angle)
- b * sin(twopi * k / points) * sin(angle); - b * sin(twopi * k / points) * sin(angle);
y = centerx + a * cos(twopi * k / points) * sin(angle) y = centerx + a * cos(twopi * k / points) * sin(angle)
+ b * sin(twopi * k / points) * cos(angle); + b * sin(twopi * k / points) * cos(angle);
ret[k] = x + y * 1i; ret[k] = x + y * 1i;
} }
return ret; return ret;
} }
@@ -698,13 +698,13 @@ define makepoints()
local ret k; local ret k;
ret = mat[param(0)]; ret = mat[param(0)];
for (k = 0; k < param(0); k++) { for (k = 0; k < param(0); k++) {
if (!isnum(param(k + 1))) { if (!isnum(param(k + 1))) {
return return
newerror(strcat newerror(strcat
("makepoints: parameter number \"", str(k + 1), ("makepoints: parameter number \"", str(k + 1),
"\" is not a number")); "\" is not a number"));
} }
ret[k] = param(k + 1); ret[k] = param(k + 1);
} }
return ret; return ret;
} }

34
cal/lambertw.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */
@@ -109,10 +109,10 @@ define lambertw_series_print(){
The exact branch must be given explicitly, e.g.: The exact branch must be given explicitly, e.g.:
; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,0) ; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,0)
-0.14758879113205794065490184399030194122136720202792- -0.14758879113205794065490184399030194122136720202792-
0.00000000000000000000000000000000000000000000000000i 0.00000000000000000000000000000000000000000000000000i
; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,1) ; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,1)
0.00000000000000000000000000000000000000000000000000- 0.00000000000000000000000000000000000000000000000000-
0.00000000000000000000000000000000000000000000000000i 0.00000000000000000000000000000000000000000000000000i
*/ */
define lambertw_series(z,eps,branch,terms){ define lambertw_series(z,eps,branch,terms){
@@ -210,34 +210,34 @@ define lambertw(z,branch){
sufficient precision itself (M below was calculated by Mathematica and also sufficient precision itself (M below was calculated by Mathematica and also
with the series above with epsilon(1e-200)): with the series above with epsilon(1e-200)):
; epsilon(1e-50) ; epsilon(1e-50)
0.00000000000000000001 0.00000000000000000001
; display(50) ; display(50)
20 20
; M=-0.9999999999999999999999997668356018402875796636464119050387 ; M=-0.9999999999999999999999997668356018402875796636464119050387
; lambertw(-exp(-1)+1e-50,0)-M ; lambertw(-exp(-1)+1e-50,0)-M
-0.00000000000000000000000002678416515423276355643684 -0.00000000000000000000000002678416515423276355643684
; epsilon(1e-60) ; epsilon(1e-60)
0.0000000000000000000000000000000000000000000000000 0.0000000000000000000000000000000000000000000000000
; A=-exp(-1)+1e-50 ; A=-exp(-1)+1e-50
; epsilon(1e-50) ; epsilon(1e-50)
0.00000000000000000000000000000000000000000000000000 0.00000000000000000000000000000000000000000000000000
; lambertw(A,0)-M ; lambertw(A,0)-M
-0.00000000000000000000000000000000000231185460220585 -0.00000000000000000000000000000000000231185460220585
; lambertw_series(A,epsilon(),0)-M ; lambertw_series(A,epsilon(),0)-M
-0.00000000000000000000000000000000000132145133161626 -0.00000000000000000000000000000000000132145133161626
; epsilon(1e-100) ; epsilon(1e-100)
0.00000000000000000000000000000000000000000000000001 0.00000000000000000000000000000000000000000000000001
; A=-exp(-1)+1e-50 ; A=-exp(-1)+1e-50
; epsilon(1e-65) ; epsilon(1e-65)
0.00000000000000000000000000000000000000000000000000 0.00000000000000000000000000000000000000000000000000
; lambertw_series(A,epsilon(),0)-M ; lambertw_series(A,epsilon(),0)-M
0.00000000000000000000000000000000000000000000000000 0.00000000000000000000000000000000000000000000000000
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M ; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
-0.00000000000000000000000000000000000000002959444084 -0.00000000000000000000000000000000000000002959444084
; epsilon(1e-74) ; epsilon(1e-74)
0.00000000000000000000000000000000000000000000000000 0.00000000000000000000000000000000000000000000000000
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M ; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
-0.00000000000000000000000000000000000000000000000006 -0.00000000000000000000000000000000000000000000000006
*/ */
closeness = abs(z-branchpoint); closeness = abs(z-branchpoint);
if( closeness< 1){ if( closeness< 1){

22
cal/linear.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,23 +17,23 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2005/12/12 06:41:50 * Under source code control: 2005/12/12 06:41:50
* File existed as early as: 2005 * File existed as early as: 2005
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* linear - perform a simple two point 2D linear interpolation * linear - perform a simple two point 2D linear interpolation
* *
* given: * given:
* x0, y0 first known point on the line * x0, y0 first known point on the line
* x1, y1 second known point on the line * x1, y1 second known point on the line
* x a given point to interpolate on * x a given point to interpolate on
* *
* returns: * returns:
* y such that (x,y) is on the line defined by (x0,y0) and (x1,y1) * y such that (x,y) is on the line defined by (x0,y0) and (x1,y1)
* *
* NOTE: The line cannot be vertical. So x0 != y0. * NOTE: The line cannot be vertical. So x0 != y0.
*/ */
@@ -41,10 +41,10 @@ define linear(x0, y0, x1, y1, x)
{ {
/* firewall */ /* firewall */
if (!isnum(x0) || ! isnum(y0) || !isnum(x1) || ! isnum(y1) || !isnum(x)) { if (!isnum(x0) || ! isnum(y0) || !isnum(x1) || ! isnum(y1) || !isnum(x)) {
quit "non-numeric argument passed to linear"; quit "non-numeric argument passed to linear";
} }
if (x0 == x1) { if (x0 == x1) {
quit "linear given a line with an infinite slope"; quit "linear given a line with an infinite slope";
} }
/* return y = y0 + (delta_Y/delta_X) * (x - x0) */ /* return y = y0 + (delta_Y/delta_X) * (x - x0) */

4
cal/lnseries.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */

1918
cal/lucas.cal
View File

File diff suppressed because it is too large Load Diff

616
cal/lucas_chk.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1991/01/11 05:41:43 * Under source code control: 1991/01/11 05:41:43
* File existed as early as: 1991 * File existed as early as: 1991
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -31,260 +31,260 @@
* *
* These values were taken from: * These values were taken from:
* *
* "Prime numbers and Computer Methods for Factorization", by Hans Riesel, * "Prime numbers and Computer Methods for Factorization", by Hans Riesel,
* Birkhauser, 1985, pp 384-387. * Birkhauser, 1985, pp 384-387.
* *
* This routine assumes that the file "lucas.cal" has been loaded. * This routine assumes that the file "lucas.cal" has been loaded.
* *
* NOTE: There are several errors in Riesel's table that have been corrected * NOTE: There are several errors in Riesel's table that have been corrected
* in this file: * in this file:
* *
* 193*2^87-1 is prime * 193*2^87-1 is prime
* 193*2^97-1 is NOT prime * 193*2^97-1 is NOT prime
* 199*2^211-1 is prime * 199*2^211-1 is prime
* 199*2^221-1 is NOT prime * 199*2^221-1 is NOT prime
*/ */
static prime_cnt = 1145; /* number of primes in the list */ static prime_cnt = 1145; /* number of primes in the list */
/* h = prime parameters */ /* h = prime parameters */
static mat h_p[prime_cnt] = { static mat h_p[prime_cnt] = {
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* element 0 */ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* element 0 */
1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 7, 7, 7, 7, 5, 5, 5, 5, 5, 5, 7, 7, 7, 7,
7, 7, 7, 7, 9, 9, 9, 9, 9, 9, 7, 7, 7, 7, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 11, 11, 11, 11, 11, 11, 11, 9, 9, 9, 11, 11, 11, 11, 11, 11, 11,
11, 11, 11, 13, 13, 13, 13, 13, 13, 15, 11, 11, 11, 13, 13, 13, 13, 13, 13, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, /* 100 */ 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, /* 100 */
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 17, 17, 17, 17, 17, 17, 17, 17, 15, 15, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
17, 17, 19, 19, 19, 19, 19, 19, 19, 19, 17, 17, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
19, 19, 21, 21, 21, 21, 21, 21, 21, 21, 19, 19, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 23, 23, 21, 21, 21, 21, 21, 21, 21, 21, 23, 23,
23, 23, 23, 23, 23, 23, 23, 25, 25, 25, 23, 23, 23, 23, 23, 23, 23, 25, 25, 25,
25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
25, 25, 25, 27, 27, 27, 27, 27, 27, 27, /* 200 */ 25, 25, 25, 27, 27, 27, 27, 27, 27, 27, /* 200 */
27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
27, 27, 27, 27, 27, 27, 27, 29, 29, 29, 27, 27, 27, 27, 27, 27, 27, 29, 29, 29,
29, 29, 31, 31, 31, 31, 31, 31, 31, 31, 29, 29, 31, 31, 31, 31, 31, 31, 31, 31,
31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31,
33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
33, 33, 33, 33, 35, 35, 35, 35, 35, 35, 33, 33, 33, 33, 35, 35, 35, 35, 35, 35,
35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
35, 37, 39, 39, 39, 39, 39, 39, 39, 39, 35, 37, 39, 39, 39, 39, 39, 39, 39, 39,
39, 41, 41, 41, 41, 41, 41, 41, 41, 41, /* 300 */ 39, 41, 41, 41, 41, 41, 41, 41, 41, 41, /* 300 */
41, 41, 41, 41, 43, 43, 43, 43, 43, 45, 41, 41, 41, 41, 43, 43, 43, 43, 43, 45,
45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
45, 45, 45, 45, 45, 47, 47, 47, 47, 49, 45, 45, 45, 45, 45, 47, 47, 47, 47, 49,
49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49, 49,
49, 49, 49, 49, 49, 49, 51, 51, 51, 51, 49, 49, 49, 49, 49, 49, 51, 51, 51, 51,
51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51,
51, 53, 53, 53, 53, 53, 53, 53, 53, 53, 51, 53, 53, 53, 53, 53, 53, 53, 53, 53,
53, 55, 55, 55, 55, 55, 55, 55, 55, 55, /* 400 */ 53, 55, 55, 55, 55, 55, 55, 55, 55, 55, /* 400 */
55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55,
57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57, 57,
57, 57, 57, 57, 57, 57, 57, 57, 59, 59, 57, 57, 57, 57, 57, 57, 57, 57, 59, 59,
59, 59, 59, 59, 61, 61, 61, 61, 61, 61, 59, 59, 59, 59, 61, 61, 61, 61, 61, 61,
61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61, 61,
61, 63, 63, 63, 63, 63, 63, 63, 63, 63, 61, 63, 63, 63, 63, 63, 63, 63, 63, 63,
63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, 63,
63, 63, 63, 63, 65, 65, 65, 65, 65, 65, 63, 63, 63, 63, 65, 65, 65, 65, 65, 65,
65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65, 65,
65, 65, 67, 67, 67, 67, 67, 67, 67, 67, /* 500 */ 65, 65, 67, 67, 67, 67, 67, 67, 67, 67, /* 500 */
69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
69, 69, 71, 71, 71, 73, 73, 73, 73, 73, 69, 69, 71, 71, 71, 73, 73, 73, 73, 73,
73, 75, 75, 75, 75, 75, 75, 75, 75, 75, 73, 75, 75, 75, 75, 75, 75, 75, 75, 75,
75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, 75,
75, 75, 75, 75, 75, 75, 75, 77, 77, 77, 75, 75, 75, 75, 75, 75, 75, 77, 77, 77,
77, 77, 77, 77, 77, 77, 77, 77, 77, 79, 77, 77, 77, 77, 77, 77, 77, 77, 77, 79,
79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
81, 81, 81, 81, 81, 81, 81, 81, 81, 81, /* 600 */ 81, 81, 81, 81, 81, 81, 81, 81, 81, 81, /* 600 */
81, 81, 81, 83, 83, 83, 83, 83, 83, 83, 81, 81, 81, 83, 83, 83, 83, 83, 83, 83,
83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, 83,
83, 83, 83, 83, 83, 85, 85, 85, 85, 85, 83, 83, 83, 83, 83, 85, 85, 85, 85, 85,
85, 85, 85, 85, 87, 87, 87, 87, 87, 87, 85, 85, 85, 85, 87, 87, 87, 87, 87, 87,
87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87,
87, 87, 87, 87, 87, 87, 89, 89, 89, 89, 87, 87, 87, 87, 87, 87, 89, 89, 89, 89,
89, 89, 89, 89, 89, 91, 91, 91, 91, 91, 89, 89, 89, 89, 89, 91, 91, 91, 91, 91,
91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
91, 91, 91, 91, 91, 91, 91, 93, 93, 93, 91, 91, 91, 91, 91, 91, 91, 93, 93, 93,
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, /* 700 */ 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, /* 700 */
93, 93, 93, 93, 93, 95, 95, 95, 95, 95, 93, 93, 93, 93, 93, 95, 95, 95, 95, 95,
95, 95, 95, 95, 95, 97, 97, 97, 97, 97, 95, 95, 95, 95, 95, 97, 97, 97, 97, 97,
99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
99, 99, 99, 99, 99, 99, 101, 101, 101, 101, 99, 99, 99, 99, 99, 99, 101, 101, 101, 101,
103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103,
103, 103, 103, 105, 105, 105, 105, 105, 105, 105, 103, 103, 103, 105, 105, 105, 105, 105, 105, 105,
105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
105, 105, 107, 107, 107, 107, 107, 107, 107, 107, 105, 105, 107, 107, 107, 107, 107, 107, 107, 107,
107, 107, 107, 107, 107, 107, 109, 109, 109, 109, 107, 107, 107, 107, 107, 107, 109, 109, 109, 109,
109, 113, 113, 113, 113, 113, 113, 113, 113, 113, /* 800 */ 109, 113, 113, 113, 113, 113, 113, 113, 113, 113, /* 800 */
113, 115, 115, 115, 115, 115, 115, 115, 115, 115, 113, 115, 115, 115, 115, 115, 115, 115, 115, 115,
115, 115, 115, 115, 115, 115, 115, 119, 119, 119, 115, 115, 115, 115, 115, 115, 115, 119, 119, 119,
119, 119, 119, 119, 119, 121, 121, 121, 121, 121, 119, 119, 119, 119, 119, 121, 121, 121, 121, 121,
121, 121, 121, 121, 121, 121, 121, 125, 125, 125, 121, 121, 121, 121, 121, 121, 121, 125, 125, 125,
125, 125, 125, 127, 127, 131, 131, 131, 131, 131, 125, 125, 125, 127, 127, 131, 131, 131, 131, 131,
131, 131, 131, 131, 131, 133, 133, 133, 133, 133, 131, 131, 131, 131, 131, 133, 133, 133, 133, 133,
133, 133, 133, 133, 133, 133, 133, 133, 137, 137, 133, 133, 133, 133, 133, 133, 133, 133, 137, 137,
137, 137, 139, 139, 139, 139, 139, 139, 139, 139, 137, 137, 139, 139, 139, 139, 139, 139, 139, 139,
139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139, 139,
139, 139, 139, 139, 139, 139, 139, 139, 139, 143, /* 900 */ 139, 139, 139, 139, 139, 139, 139, 139, 139, 143, /* 900 */
143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143,
143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143, 143,
143, 143, 143, 145, 145, 145, 145, 145, 145, 145, 143, 143, 143, 145, 145, 145, 145, 145, 145, 145,
145, 145, 145, 145, 149, 149, 149, 149, 149, 149, 145, 145, 145, 145, 149, 149, 149, 149, 149, 149,
149, 151, 151, 151, 155, 155, 155, 155, 155, 155, 149, 151, 151, 151, 155, 155, 155, 155, 155, 155,
155, 155, 155, 155, 155, 155, 157, 157, 157, 157, 155, 155, 155, 155, 155, 155, 157, 157, 157, 157,
157, 157, 157, 157, 157, 161, 161, 161, 161, 161, 157, 157, 157, 157, 157, 161, 161, 161, 161, 161,
161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161, 161,
163, 163, 163, 163, 167, 167, 167, 167, 167, 167, 163, 163, 163, 163, 167, 167, 167, 167, 167, 167,
167, 167, 167, 167, 167, 167, 169, 169, 169, 169, /* 1000 */ 167, 167, 167, 167, 167, 167, 169, 169, 169, 169, /* 1000 */
169, 169, 169, 169, 169, 169, 169, 169, 173, 173, 169, 169, 169, 169, 169, 169, 169, 169, 173, 173,
173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, 173,
173, 173, 173, 173, 175, 175, 175, 175, 175, 175, 173, 173, 173, 173, 175, 175, 175, 175, 175, 175,
175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175, 175,
179, 179, 179, 181, 181, 181, 181, 181, 181, 181, 179, 179, 179, 181, 181, 181, 181, 181, 181, 181,
181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181, 181,
181, 181, 181, 181, 181, 181, 181, 181, 185, 185, 181, 181, 181, 181, 181, 181, 181, 181, 185, 185,
185, 185, 185, 185, 185, 185, 185, 185, 187, 187, 185, 185, 185, 185, 185, 185, 185, 185, 187, 187,
187, 187, 187, 191, 193, 193, 193, 193, 193, 193, 187, 187, 187, 191, 193, 193, 193, 193, 193, 193,
193, 197, 197, 197, 197, 197, 197, 197, 197, 197, /* 1100 */ 193, 197, 197, 197, 197, 197, 197, 197, 197, 197, /* 1100 */
197, 197, 197, 197, 197, 197, 197, 197, 197, 199, 197, 197, 197, 197, 197, 197, 197, 197, 197, 199,
199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
199, 199, 199, 199, 199 199, 199, 199, 199, 199
}; };
/* n (exponent) prime parameters */ /* n (exponent) prime parameters */
static mat n_p[prime_cnt] = { static mat n_p[prime_cnt] = {
2, 3, 5, 7, 13, 17, 19, 31, 61, 89, /* element 0 */ 2, 3, 5, 7, 13, 17, 19, 31, 61, 89, /* element 0 */
107, 127, 521, 607, 1, 2, 3, 4, 6, 7, 107, 127, 521, 607, 1, 2, 3, 4, 6, 7,
11, 18, 34, 38, 43, 55, 64, 76, 94, 103, 11, 18, 34, 38, 43, 55, 64, 76, 94, 103,
143, 206, 216, 306, 324, 391, 458, 470, 827, 2, 143, 206, 216, 306, 324, 391, 458, 470, 827, 2,
4, 8, 10, 12, 14, 18, 32, 48, 54, 72, 4, 8, 10, 12, 14, 18, 32, 48, 54, 72,
148, 184, 248, 270, 274, 420, 1, 5, 9, 17, 148, 184, 248, 270, 274, 420, 1, 5, 9, 17,
21, 29, 45, 177, 1, 3, 7, 13, 15, 21, 21, 29, 45, 177, 1, 3, 7, 13, 15, 21,
43, 63, 99, 109, 159, 211, 309, 343, 415, 469, 43, 63, 99, 109, 159, 211, 309, 343, 415, 469,
781, 871, 939, 2, 26, 50, 54, 126, 134, 246, 781, 871, 939, 2, 26, 50, 54, 126, 134, 246,
354, 362, 950, 3, 7, 23, 287, 291, 795, 1, 354, 362, 950, 3, 7, 23, 287, 291, 795, 1,
2, 4, 5, 10, 14, 17, 31, 41, 73, 80, /* 100 */ 2, 4, 5, 10, 14, 17, 31, 41, 73, 80, /* 100 */
82, 116, 125, 145, 157, 172, 202, 224, 266, 289, 82, 116, 125, 145, 157, 172, 202, 224, 266, 289,
293, 463, 2, 4, 6, 16, 20, 36, 54, 60, 293, 463, 2, 4, 6, 16, 20, 36, 54, 60,
96, 124, 150, 252, 356, 460, 612, 654, 664, 698, 96, 124, 150, 252, 356, 460, 612, 654, 664, 698,
702, 972, 1, 3, 5, 21, 41, 49, 89, 133, 702, 972, 1, 3, 5, 21, 41, 49, 89, 133,
141, 165, 189, 293, 305, 395, 651, 665, 771, 801, 141, 165, 189, 293, 305, 395, 651, 665, 771, 801,
923, 953, 1, 2, 3, 7, 10, 13, 18, 27, 923, 953, 1, 2, 3, 7, 10, 13, 18, 27,
37, 51, 74, 157, 271, 458, 530, 891, 4, 6, 37, 51, 74, 157, 271, 458, 530, 891, 4, 6,
12, 46, 72, 244, 264, 544, 888, 3, 9, 11, 12, 46, 72, 244, 264, 544, 888, 3, 9, 11,
17, 23, 35, 39, 75, 105, 107, 155, 215, 335, 17, 23, 35, 39, 75, 105, 107, 155, 215, 335,
635, 651, 687, 1, 2, 4, 5, 8, 10, 14, /* 200 */ 635, 651, 687, 1, 2, 4, 5, 8, 10, 14, /* 200 */
28, 37, 38, 70, 121, 122, 160, 170, 253, 329, 28, 37, 38, 70, 121, 122, 160, 170, 253, 329,
362, 454, 485, 500, 574, 892, 962, 4, 16, 76, 362, 454, 485, 500, 574, 892, 962, 4, 16, 76,
148, 184, 1, 5, 7, 11, 13, 23, 33, 35, 148, 184, 1, 5, 7, 11, 13, 23, 33, 35,
37, 47, 115, 205, 235, 271, 409, 739, 837, 887, 37, 47, 115, 205, 235, 271, 409, 739, 837, 887,
2, 3, 6, 8, 10, 22, 35, 42, 43, 46, 2, 3, 6, 8, 10, 22, 35, 42, 43, 46,
56, 91, 102, 106, 142, 190, 208, 266, 330, 360, 56, 91, 102, 106, 142, 190, 208, 266, 330, 360,
382, 462, 503, 815, 2, 6, 10, 20, 44, 114, 382, 462, 503, 815, 2, 6, 10, 20, 44, 114,
146, 156, 174, 260, 306, 380, 654, 686, 702, 814, 146, 156, 174, 260, 306, 380, 654, 686, 702, 814,
906, 1, 3, 24, 105, 153, 188, 605, 795, 813, 906, 1, 3, 24, 105, 153, 188, 605, 795, 813,
839, 2, 10, 14, 18, 50, 114, 122, 294, 362, /* 300 */ 839, 2, 10, 14, 18, 50, 114, 122, 294, 362, /* 300 */
554, 582, 638, 758, 7, 31, 67, 251, 767, 1, 554, 582, 638, 758, 7, 31, 67, 251, 767, 1,
2, 3, 4, 5, 6, 8, 9, 14, 15, 16, 2, 3, 4, 5, 6, 8, 9, 14, 15, 16,
22, 28, 29, 36, 37, 54, 59, 85, 93, 117, 22, 28, 29, 36, 37, 54, 59, 85, 93, 117,
119, 161, 189, 193, 256, 308, 322, 327, 411, 466, 119, 161, 189, 193, 256, 308, 322, 327, 411, 466,
577, 591, 902, 928, 946, 4, 14, 70, 78, 1, 577, 591, 902, 928, 946, 4, 14, 70, 78, 1,
5, 7, 9, 13, 15, 29, 33, 39, 55, 81, 5, 7, 9, 13, 15, 29, 33, 39, 55, 81,
95, 205, 279, 581, 807, 813, 1, 9, 10, 19, 95, 205, 279, 581, 807, 813, 1, 9, 10, 19,
22, 57, 69, 97, 141, 169, 171, 195, 238, 735, 22, 57, 69, 97, 141, 169, 171, 195, 238, 735,
885, 2, 6, 8, 42, 50, 62, 362, 488, 642, 885, 2, 6, 8, 42, 50, 62, 362, 488, 642,
846, 1, 3, 5, 7, 15, 33, 41, 57, 69, /* 400 */ 846, 1, 3, 5, 7, 15, 33, 41, 57, 69, /* 400 */
75, 77, 131, 133, 153, 247, 305, 351, 409, 471, 75, 77, 131, 133, 153, 247, 305, 351, 409, 471,
1, 2, 4, 5, 8, 10, 20, 22, 25, 26, 1, 2, 4, 5, 8, 10, 20, 22, 25, 26,
32, 44, 62, 77, 158, 317, 500, 713, 12, 16, 32, 44, 62, 77, 158, 317, 500, 713, 12, 16,
72, 160, 256, 916, 3, 5, 9, 13, 17, 19, 72, 160, 256, 916, 3, 5, 9, 13, 17, 19,
25, 39, 63, 67, 75, 119, 147, 225, 419, 715, 25, 39, 63, 67, 75, 119, 147, 225, 419, 715,
895, 2, 3, 8, 11, 14, 16, 28, 32, 39, 895, 2, 3, 8, 11, 14, 16, 28, 32, 39,
66, 68, 91, 98, 116, 126, 164, 191, 298, 323, 66, 68, 91, 98, 116, 126, 164, 191, 298, 323,
443, 714, 758, 759, 4, 6, 12, 22, 28, 52, 443, 714, 758, 759, 4, 6, 12, 22, 28, 52,
78, 94, 124, 162, 174, 192, 204, 304, 376, 808, 78, 94, 124, 162, 174, 192, 204, 304, 376, 808,
930, 972, 5, 9, 21, 45, 65, 77, 273, 677, /* 500 */ 930, 972, 5, 9, 21, 45, 65, 77, 273, 677, /* 500 */
1, 4, 5, 7, 9, 11, 13, 17, 19, 23, 1, 4, 5, 7, 9, 11, 13, 17, 19, 23,
29, 37, 49, 61, 79, 99, 121, 133, 141, 164, 29, 37, 49, 61, 79, 99, 121, 133, 141, 164,
173, 181, 185, 193, 233, 299, 313, 351, 377, 540, 173, 181, 185, 193, 233, 299, 313, 351, 377, 540,
569, 909, 2, 14, 410, 7, 11, 19, 71, 79, 569, 909, 2, 14, 410, 7, 11, 19, 71, 79,
131, 1, 3, 5, 6, 18, 19, 20, 22, 28, 131, 1, 3, 5, 6, 18, 19, 20, 22, 28,
29, 39, 43, 49, 75, 85, 92, 111, 126, 136, 29, 39, 43, 49, 75, 85, 92, 111, 126, 136,
159, 162, 237, 349, 381, 767, 969, 2, 4, 14, 159, 162, 237, 349, 381, 767, 969, 2, 4, 14,
26, 58, 60, 64, 100, 122, 212, 566, 638, 1, 26, 58, 60, 64, 100, 122, 212, 566, 638, 1,
3, 7, 15, 43, 57, 61, 75, 145, 217, 247, 3, 7, 15, 43, 57, 61, 75, 145, 217, 247,
3, 5, 11, 17, 21, 27, 81, 101, 107, 327, /* 600 */ 3, 5, 11, 17, 21, 27, 81, 101, 107, 327, /* 600 */
383, 387, 941, 2, 4, 8, 10, 14, 18, 22, 383, 387, 941, 2, 4, 8, 10, 14, 18, 22,
24, 26, 28, 36, 42, 58, 64, 78, 158, 198, 24, 26, 28, 36, 42, 58, 64, 78, 158, 198,
206, 424, 550, 676, 904, 5, 11, 71, 113, 115, 206, 424, 550, 676, 904, 5, 11, 71, 113, 115,
355, 473, 563, 883, 1, 2, 8, 9, 10, 12, 355, 473, 563, 883, 1, 2, 8, 9, 10, 12,
22, 29, 32, 50, 57, 69, 81, 122, 138, 200, 22, 29, 32, 50, 57, 69, 81, 122, 138, 200,
296, 514, 656, 682, 778, 881, 4, 8, 12, 24, 296, 514, 656, 682, 778, 881, 4, 8, 12, 24,
48, 52, 64, 84, 96, 1, 3, 9, 13, 15, 48, 52, 64, 84, 96, 1, 3, 9, 13, 15,
17, 19, 23, 47, 57, 67, 73, 77, 81, 83, 17, 19, 23, 47, 57, 67, 73, 77, 81, 83,
191, 301, 321, 435, 867, 869, 917, 3, 4, 7, 191, 301, 321, 435, 867, 869, 917, 3, 4, 7,
10, 15, 18, 19, 24, 27, 39, 60, 84, 111, /* 700 */ 10, 15, 18, 19, 24, 27, 39, 60, 84, 111, /* 700 */
171, 192, 222, 639, 954, 2, 6, 26, 32, 66, 171, 192, 222, 639, 954, 2, 6, 26, 32, 66,
128, 170, 288, 320, 470, 1, 9, 45, 177, 585, 128, 170, 288, 320, 470, 1, 9, 45, 177, 585,
1, 4, 5, 7, 8, 11, 19, 25, 28, 35, 1, 4, 5, 7, 8, 11, 19, 25, 28, 35,
65, 79, 212, 271, 361, 461, 10, 18, 54, 70, 65, 79, 212, 271, 361, 461, 10, 18, 54, 70,
3, 7, 11, 19, 63, 75, 95, 127, 155, 163, 3, 7, 11, 19, 63, 75, 95, 127, 155, 163,
171, 283, 563, 2, 3, 5, 6, 8, 9, 25, 171, 283, 563, 2, 3, 5, 6, 8, 9, 25,
32, 65, 113, 119, 155, 177, 299, 335, 426, 462, 32, 65, 113, 119, 155, 177, 299, 335, 426, 462,
617, 896, 10, 12, 18, 24, 28, 40, 90, 132, 617, 896, 10, 12, 18, 24, 28, 40, 90, 132,
214, 238, 322, 532, 858, 940, 9, 149, 177, 419, 214, 238, 322, 532, 858, 940, 9, 149, 177, 419,
617, 8, 14, 74, 80, 274, 334, 590, 608, 614, /* 800 */ 617, 8, 14, 74, 80, 274, 334, 590, 608, 614, /* 800 */
650, 1, 3, 11, 13, 19, 21, 31, 49, 59, 650, 1, 3, 11, 13, 19, 21, 31, 49, 59,
69, 73, 115, 129, 397, 623, 769, 12, 16, 52, 69, 73, 115, 129, 397, 623, 769, 12, 16, 52,
160, 192, 216, 376, 436, 1, 3, 21, 27, 37, 160, 192, 216, 376, 436, 1, 3, 21, 27, 37,
43, 91, 117, 141, 163, 373, 421, 2, 4, 44, 43, 91, 117, 141, 163, 373, 421, 2, 4, 44,
182, 496, 904, 25, 113, 2, 14, 34, 38, 42, 182, 496, 904, 25, 113, 2, 14, 34, 38, 42,
78, 90, 178, 778, 974, 3, 11, 15, 19, 31, 78, 90, 178, 778, 974, 3, 11, 15, 19, 31,
59, 75, 103, 163, 235, 375, 615, 767, 2, 18, 59, 75, 103, 163, 235, 375, 615, 767, 2, 18,
38, 62, 1, 5, 7, 9, 15, 19, 21, 35, 38, 62, 1, 5, 7, 9, 15, 19, 21, 35,
37, 39, 41, 49, 69, 111, 115, 141, 159, 181, 37, 39, 41, 49, 69, 111, 115, 141, 159, 181,
201, 217, 487, 567, 677, 765, 811, 841, 917, 2, /* 900 */ 201, 217, 487, 567, 677, 765, 811, 841, 917, 2, /* 900 */
4, 6, 8, 12, 18, 26, 32, 34, 36, 42, 4, 6, 8, 12, 18, 26, 32, 34, 36, 42,
60, 78, 82, 84, 88, 154, 174, 208, 256, 366, 60, 78, 82, 84, 88, 154, 174, 208, 256, 366,
448, 478, 746, 5, 13, 15, 31, 77, 151, 181, 448, 478, 746, 5, 13, 15, 31, 77, 151, 181,
245, 445, 447, 883, 4, 16, 48, 60, 240, 256, 245, 445, 447, 883, 4, 16, 48, 60, 240, 256,
304, 5, 221, 641, 2, 8, 14, 16, 44, 46, 304, 5, 221, 641, 2, 8, 14, 16, 44, 46,
82, 172, 196, 254, 556, 806, 1, 5, 33, 121, 82, 172, 196, 254, 556, 806, 1, 5, 33, 121,
125, 305, 445, 473, 513, 2, 6, 18, 22, 34, 125, 305, 445, 473, 513, 2, 6, 18, 22, 34,
54, 98, 122, 146, 222, 306, 422, 654, 682, 862, 54, 98, 122, 146, 222, 306, 422, 654, 682, 862,
3, 31, 63, 303, 4, 6, 8, 10, 16, 32, 3, 31, 63, 303, 4, 6, 8, 10, 16, 32,
38, 42, 52, 456, 576, 668, 1, 5, 11, 17, /* 1000 */ 38, 42, 52, 456, 576, 668, 1, 5, 11, 17, /* 1000 */
67, 137, 157, 203, 209, 227, 263, 917, 2, 4, 67, 137, 157, 203, 209, 227, 263, 917, 2, 4,
6, 16, 32, 50, 76, 80, 96, 104, 162, 212, 6, 16, 32, 50, 76, 80, 96, 104, 162, 212,
230, 260, 480, 612, 1, 3, 9, 21, 23, 41, 230, 260, 480, 612, 1, 3, 9, 21, 23, 41,
47, 57, 69, 83, 193, 249, 291, 421, 433, 997, 47, 57, 69, 83, 193, 249, 291, 421, 433, 997,
8, 68, 108, 3, 5, 7, 9, 11, 17, 23, 8, 68, 108, 3, 5, 7, 9, 11, 17, 23,
31, 35, 43, 47, 83, 85, 99, 101, 195, 267, 31, 35, 43, 47, 83, 85, 99, 101, 195, 267,
281, 363, 391, 519, 623, 653, 673, 701, 2, 6, 281, 363, 391, 519, 623, 653, 673, 701, 2, 6,
10, 18, 26, 40, 46, 78, 230, 542, 1, 17, 10, 18, 26, 40, 46, 78, 230, 542, 1, 17,
21, 53, 253, 226, 3, 15, 27, 63, 87, 135, 21, 53, 253, 226, 3, 15, 27, 63, 87, 135,
543, 2, 16, 20, 22, 40, 82, 112, 178, 230, /* 1100 */ 543, 2, 16, 20, 22, 40, 82, 112, 178, 230, /* 1100 */
302, 304, 328, 374, 442, 472, 500, 580, 694, 1, 302, 304, 328, 374, 442, 472, 500, 580, 694, 1,
5, 7, 15, 19, 23, 25, 27, 43, 65, 99, 5, 7, 15, 19, 23, 25, 27, 43, 65, 99,
125, 141, 165, 201, 211, 331, 369, 389, 445, 461, 125, 141, 165, 201, 211, 331, 369, 389, 445, 461,
463, 467, 513, 583, 835 463, 467, 513, 583, 835
}; };
@@ -299,82 +299,82 @@ read -once "lucas.cal";
* when n_p is below a given limit. * when n_p is below a given limit.
* *
* input: * input:
* high_n skip tests on n_p[i] > high_n * high_n skip tests on n_p[i] > high_n
* [quiet] if given and != 0, then do not print individual test results * [quiet] if given and != 0, then do not print individual test results
* *
* returns: * returns:
* 1 all is OK * 1 all is OK
* 0 something went wrong * 0 something went wrong
*/ */
define define
lucas_chk(high_n, quiet) lucas_chk(high_n, quiet)
{ {
local i; /* index */ local i; /* index */
local result; /* 0 => non-prime, 1 => prime, -1 => bad test */ local result; /* 0 => non-prime, 1 => prime, -1 => bad test */
local error; /* number of errors and bad tests found */ local error; /* number of errors and bad tests found */
/* /*
* firewall * firewall
*/ */
if (!isint(high_n)) { if (!isint(high_n)) {
ldebug("test_lucas", "high_n is non-int"); ldebug("test_lucas", "high_n is non-int");
quit "FATAL: bad args: high_n must be an integer"; quit "FATAL: bad args: high_n must be an integer";
} }
if (param(0) == 1) { if (param(0) == 1) {
quiet = 0; quiet = 0;
} }
/* /*
* scan thru the above prime table * scan thru the above prime table
*/ */
error = 0; error = 0;
for (i=0; i < prime_cnt; ++i) { for (i=0; i < prime_cnt; ++i) {
/* skip primes where h>=2^n */ /* skip primes where h>=2^n */
if (highbit(h_p[i]) >= n_p[i]) { if (highbit(h_p[i]) >= n_p[i]) {
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "h>=2^n skip:", h_p[i]:"*2^":n_p[i]:"-1"; print "h>=2^n skip:", h_p[i]:"*2^":n_p[i]:"-1";
} }
continue; continue;
} }
/* test the prime if it is small enough */ /* test the prime if it is small enough */
if (n_p[i] <= high_n) { if (n_p[i] <= high_n) {
/* test the table value */ /* test the table value */
result = lucas(h_p[i], n_p[i]); result = lucas(h_p[i], n_p[i]);
/* report the test */ /* report the test */
if (result == 0) { if (result == 0) {
print "ERROR, bad primality test of",\ print "ERROR, bad primality test of",\
h_p[i]:"*2^":n_p[i]:"-1"; h_p[i]:"*2^":n_p[i]:"-1";
++error; ++error;
} else if (result == 1) { } else if (result == 1) {
if (quiet == 0) { if (quiet == 0) {
print h_p[i]:"*2^":n_p[i]:"-1 is prime"; print h_p[i]:"*2^":n_p[i]:"-1 is prime";
} }
} else if (result == -1) { } else if (result == -1) {
print "ERROR, failed to compute v(1) for",\ print "ERROR, failed to compute v(1) for",\
h_p[i]:"*2^":n_p[i]:"-1"; h_p[i]:"*2^":n_p[i]:"-1";
++error; ++error;
} else { } else {
print "ERROR, bogus return value:", result; print "ERROR, bogus return value:", result;
++error; ++error;
} }
} }
} }
/* return the full status */ /* return the full status */
if (error == 0) { if (error == 0) {
if (quiet == 0) { if (quiet == 0) {
print "lucas_chk(":high_n:") passed"; print "lucas_chk(":high_n:") passed";
} }
return 1; return 1;
} else if (error == 1) { } else if (error == 1) {
print "lucas_chk(":high_n:") failed", error, "test"; print "lucas_chk(":high_n:") failed", error, "test";
return 0; return 0;
} else { } else {
print "lucas_chk(":high_n:") failed", error, "tests"; print "lucas_chk(":high_n:") failed", error, "tests";
return 0; return 0;
} }
} }

42
cal/mersenne.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,10 +19,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1991/05/22 21:56:36 * Under source code control: 1991/05/22 21:56:36
* File existed as early as: 1991 * File existed as early as: 1991
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -32,26 +32,26 @@
define mersenne(p) define mersenne(p)
{ {
local u, i, p_mask; local u, i, p_mask;
/* firewall */ /* firewall */
if (! isint(p)) if (! isint(p))
quit "p is not an integer"; quit "p is not an integer";
/* two is a special case */ /* two is a special case */
if (p == 2) if (p == 2)
return 1; return 1;
/* if p is not prime, then 2^p-1 is not prime */ /* if p is not prime, then 2^p-1 is not prime */
if (! ptest(p,1)) if (! ptest(p,1))
return 0; return 0;
/* lltest: u(i+1) = u(i)^2 - 2 mod 2^p-1 */ /* lltest: u(i+1) = u(i)^2 - 2 mod 2^p-1 */
u = 4; u = 4;
for (i = 2; i < p; ++i) { for (i = 2; i < p; ++i) {
u = hnrmod(u^2 - 2, 1, p, -1); u = hnrmod(u^2 - 2, 1, p, -1);
} }
/* 2^p-1 is prime iff u(p) = 0 mod 2^p-1 */ /* 2^p-1 is prime iff u(p) = 0 mod 2^p-1 */
return (u == 0); return (u == 0);
} }

412
cal/mfactor.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/07/06 06:09:40 * Under source code control: 1996/07/06 06:09:40
* File existed as early as: 1996 * File existed as early as: 1996
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -29,12 +29,12 @@
* *
* We will assume that mfactor is called with p_elim == 17. * We will assume that mfactor is called with p_elim == 17.
* *
* n = (the Mersenne exponent we are testing) * n = (the Mersenne exponent we are testing)
* Q = 4*2*3*5*7*11*13*17 (4 * pfact(of some reasonable integer)) * Q = 4*2*3*5*7*11*13*17 (4 * pfact(of some reasonable integer))
* *
* We first determine all values of h mod Q such that: * We first determine all values of h mod Q such that:
* *
* gcd(h*n+1, Q) == 1 and h*n+1 == +/-1 mod 8 * gcd(h*n+1, Q) == 1 and h*n+1 == +/-1 mod 8
* *
* There will be 2*1*2*4*6*10*12*16 such values of h. * There will be 2*1*2*4*6*10*12*16 such values of h.
* *
@@ -45,59 +45,59 @@
* *
* We need only test factors of the form: * We need only test factors of the form:
* *
* (Q*g*n + hx) + 1 * (Q*g*n + hx) + 1
* *
* where: * where:
* *
* g is an integer >= 0 * g is an integer >= 0
* hx is computed from hset[] difference value described above * hx is computed from hset[] difference value described above
* *
* Note that (Q*g*n + hx) is always even and that hx is a multiple * Note that (Q*g*n + hx) is always even and that hx is a multiple
* of n. Thus the typical factor form: * of n. Thus the typical factor form:
* *
* 2*k*n + 1 * 2*k*n + 1
* *
* implies that: * implies that:
* *
* k = (Q*g + hx/n)/2 * k = (Q*g + hx/n)/2
* *
* This allows us to quickly eliminate factor values that are divisible * This allows us to quickly eliminate factor values that are divisible
* by 2, 3, 5, 7, 11, 13 or 17. (well <= p value found below) * by 2, 3, 5, 7, 11, 13 or 17. (well <= p value found below)
* *
* The following loop shows how test_factor is advanced to higher test * The following loop shows how test_factor is advanced to higher test
* values using hset[]. Here, hcount is the number of elements in hset[]. * values using hset[]. Here, hcount is the number of elements in hset[].
* It can be shown that hset[0] == 0. We add hset[hcount] to the hset[] * It can be shown that hset[0] == 0. We add hset[hcount] to the hset[]
* array for looping control convenience. * array for looping control convenience.
* *
* (* increase test_factor thru other possible test values *) * (* increase test_factor thru other possible test values *)
* test_factor = 0; * test_factor = 0;
* hindx = 0; * hindx = 0;
* do { * do {
* while (++hindx <= hcount) { * while (++hindx <= hcount) {
* test_factor += hset[hindx]; * test_factor += hset[hindx];
* } * }
* hindx = 0; * hindx = 0;
* } while (test_factor < some_limit); * } while (test_factor < some_limit);
* *
* The test, mfactor(67, 1, 10000) took on an 200 MHz r4k (user CPU seconds): * The test, mfactor(67, 1, 10000) took on an 200 MHz r4k (user CPU seconds):
* *
* 210.83 (prior to use of hset[]) * 210.83 (prior to use of hset[])
* 78.35 (hset[] for p_elim = 7) * 78.35 (hset[] for p_elim = 7)
* 73.87 (hset[] for p_elim = 11) * 73.87 (hset[] for p_elim = 11)
* 73.92 (hset[] for p_elim = 13) * 73.92 (hset[] for p_elim = 13)
* 234.16 (hset[] for p_elim = 17) * 234.16 (hset[] for p_elim = 17)
* p_elim == 19 requires over 190 Megs of memory * p_elim == 19 requires over 190 Megs of memory
* *
* Over a long period of time, the call to load_hset() becomes insignificant. * Over a long period of time, the call to load_hset() becomes insignificant.
* If we look at the user CPU seconds from the first 10000 cycle to the * If we look at the user CPU seconds from the first 10000 cycle to the
* end of the test we find: * end of the test we find:
* *
* 205.00 (prior to use of hset[]) * 205.00 (prior to use of hset[])
* 75.89 (hset[] for p_elim = 7) * 75.89 (hset[] for p_elim = 7)
* 73.74 (hset[] for p_elim = 11) * 73.74 (hset[] for p_elim = 11)
* 70.61 (hset[] for p_elim = 13) * 70.61 (hset[] for p_elim = 13)
* 57.78 (hset[] for p_elim = 17) * 57.78 (hset[] for p_elim = 17)
* p_elim == 19 rejected because of memory size * p_elim == 19 rejected because of memory size
* *
* The p_elim == 17 overhead takes ~3 minutes on an 200 MHz r4k CPU and * The p_elim == 17 overhead takes ~3 minutes on an 200 MHz r4k CPU and
* requires about ~13 Megs of memory. The p_elim == 13 overhead * requires about ~13 Megs of memory. The p_elim == 13 overhead
@@ -108,8 +108,8 @@
* for p_elim == 13. * for p_elim == 13.
* *
* NOTE: The values above are prior to optimizations where hset[] was * NOTE: The values above are prior to optimizations where hset[] was
* multiplied by n plus other optimizations. Thus, the CPU * multiplied by n plus other optimizations. Thus, the CPU
* times you may get will not likely match the above values. * times you may get will not likely match the above values.
*/ */
@@ -118,198 +118,198 @@
* *
* Mersenne numbers are numbers of the form: * Mersenne numbers are numbers of the form:
* *
* 2^n-1 for integer n > 0 * 2^n-1 for integer n > 0
* *
* We know that factors of a Mersenne number are of the form: * We know that factors of a Mersenne number are of the form:
* *
* 2*k*n+1 and +/- 1 mod 8 * 2*k*n+1 and +/- 1 mod 8
* *
* We make use of the hset[] difference array to eliminate factor * We make use of the hset[] difference array to eliminate factor
* candidates that would otherwise be divisible by 2, 3, 5, 7 ... p_elim. * candidates that would otherwise be divisible by 2, 3, 5, 7 ... p_elim.
* *
* given: * given:
* n attempt to factor M(n) = 2^n-1 * n attempt to factor M(n) = 2^n-1
* start_k the value k in 2*k*n+1 to start the search (def: 1) * start_k the value k in 2*k*n+1 to start the search (def: 1)
* rept_loop loop cycle reporting (def: 10000) * rept_loop loop cycle reporting (def: 10000)
* p_elim largest prime to eliminate from test factors (def: 17) * p_elim largest prime to eliminate from test factors (def: 17)
* *
* returns: * returns:
* factor of (2^n)-1 * factor of (2^n)-1
* *
* NOTE: The p_elim argument is optional and defaults to 17. A p_elim value * NOTE: The p_elim argument is optional and defaults to 17. A p_elim value
* of 17 is faster than 13 for even medium length runs. However 13 * of 17 is faster than 13 for even medium length runs. However 13
* uses less memory and has a shorter startup time. * uses less memory and has a shorter startup time.
*/ */
define mfactor(n, start_k, rept_loop, p_elim) define mfactor(n, start_k, rept_loop, p_elim)
{ {
local Q; /* 4*pfact(p_elim), hset[] cycle size */ local Q; /* 4*pfact(p_elim), hset[] cycle size */
local hcount; /* elements in the hset[] difference array */ local hcount; /* elements in the hset[] difference array */
local loop; /* report loop count */ local loop; /* report loop count */
local q; /* test factor of 2^n-1 */ local q; /* test factor of 2^n-1 */
local g; /* g as in test candidate form: (Q*g*hset[i])*n + 1 */ local g; /* g as in test candidate form: (Q*g*hset[i])*n + 1 */
local hindx; /* hset[] index */ local hindx; /* hset[] index */
local i; local i;
local tmp; local tmp;
local tmp2; local tmp2;
/* /*
* firewall * firewall
*/ */
if (!isint(n) || n <= 0) { if (!isint(n) || n <= 0) {
quit "n must be an integer > 0"; quit "n must be an integer > 0";
} }
if (!isint(start_k)) { if (!isint(start_k)) {
start_k = 1; start_k = 1;
} else if (!isint(start_k) || start_k <= 0) { } else if (!isint(start_k) || start_k <= 0) {
quit "start_k must be an integer > 0"; quit "start_k must be an integer > 0";
} }
if (!isint(rept_loop)) { if (!isint(rept_loop)) {
rept_loop = 10000; rept_loop = 10000;
} }
if (rept_loop < 1) { if (rept_loop < 1) {
quit "rept_loop must be an integer > 0"; quit "rept_loop must be an integer > 0";
} }
if (!isint(p_elim)) { if (!isint(p_elim)) {
p_elim = 17; p_elim = 17;
} }
if (p_elim < 3) { if (p_elim < 3) {
quit "p_elim must be an integer > 2 (try 13 or 17)"; quit "p_elim must be an integer > 2 (try 13 or 17)";
} }
/* /*
* declare our global values * declare our global values
*/ */
Q = 4*pfact(p_elim); Q = 4*pfact(p_elim);
hcount = 2; hcount = 2;
/* allocate the h difference array */ /* allocate the h difference array */
for (i=2; i <= p_elim; i = nextcand(i)) { for (i=2; i <= p_elim; i = nextcand(i)) {
hcount *= (i-1); hcount *= (i-1);
} }
local mat hset[hcount+1]; local mat hset[hcount+1];
/* /*
* load the hset[] difference array * load the hset[] difference array
*/ */
{ {
local x; /* h*n+1 mod 8 */ local x; /* h*n+1 mod 8 */
local h; /* potential h value */ local h; /* potential h value */
local last_h; /* previous valid h value */ local last_h; /* previous valid h value */
last_h = 0; last_h = 0;
for (i=0,h=0; h < Q; ++h) { for (i=0,h=0; h < Q; ++h) {
if (gcd(h*n+1,Q) == 1) { if (gcd(h*n+1,Q) == 1) {
x = (h*n+1) % 8; x = (h*n+1) % 8;
if (x == 1 || x == 7) { if (x == 1 || x == 7) {
hset[i++] = (h-last_h) * n; hset[i++] = (h-last_h) * n;
last_h = h; last_h = h;
} }
} }
} }
hset[hcount] = Q*n - last_h*n; hset[hcount] = Q*n - last_h*n;
} }
/* /*
* setup * setup
* *
* determine the next g and hset[] index (hindx) values such that: * determine the next g and hset[] index (hindx) values such that:
* *
* 2*start_k <= (Q*g + hset[hindx]) * 2*start_k <= (Q*g + hset[hindx])
* *
* and (Q*g + hset[hindx]) is a minimum and where: * and (Q*g + hset[hindx]) is a minimum and where:
* *
* Q = (4 * pfact(of some reasonable integer)) * Q = (4 * pfact(of some reasonable integer))
* g = (some integer) (hset[] cycle number) * g = (some integer) (hset[] cycle number)
* *
* We also compute 'q', the next test candidate. * We also compute 'q', the next test candidate.
*/ */
g = (2*start_k) // Q; g = (2*start_k) // Q;
tmp = 2*start_k - Q*g; tmp = 2*start_k - Q*g;
for (tmp2=0, hindx=0; for (tmp2=0, hindx=0;
hindx < hcount && (tmp2 += hset[hindx]/n) < tmp; hindx < hcount && (tmp2 += hset[hindx]/n) < tmp;
++hindx) { ++hindx) {
} }
if (hindx == hcount) { if (hindx == hcount) {
/* we are beyond the end of a hset[] cycle, start at the next */ /* we are beyond the end of a hset[] cycle, start at the next */
++g; ++g;
hindx = 0; hindx = 0;
tmp2 = hset[0]/n; tmp2 = hset[0]/n;
} }
q = (Q*g + tmp2)*n + 1; q = (Q*g + tmp2)*n + 1;
/* /*
* look for a factor * look for a factor
* *
* We ignore factors that themselves are divisible by a prime <= * We ignore factors that themselves are divisible by a prime <=
* some small prime p. * some small prime p.
* *
* This process is guaranteed to find the smallest factor * This process is guaranteed to find the smallest factor
* of 2^n-1. A smallest factor of 2^n-1 must be prime, otherwise * of 2^n-1. A smallest factor of 2^n-1 must be prime, otherwise
* the divisors of that factor would also be factors of 2^n-1. * the divisors of that factor would also be factors of 2^n-1.
* Thus we know that if a test factor itself is not prime, it * Thus we know that if a test factor itself is not prime, it
* cannot be the smallest factor of 2^n-1. * cannot be the smallest factor of 2^n-1.
* *
* Eliminating all non-prime test factors would take too long. * Eliminating all non-prime test factors would take too long.
* However we can eliminate 80.81% of the test factors * However we can eliminate 80.81% of the test factors
* by not using test factors that are divisible by a prime <= 17. * by not using test factors that are divisible by a prime <= 17.
*/ */
if (pmod(2,n,q) == 1) { if (pmod(2,n,q) == 1) {
return q; return q;
} else { } else {
/* report this loop */ /* report this loop */
printf("at 2*%d*%d+1, CPU: %f\n", printf("at 2*%d*%d+1, CPU: %f\n",
(q-1)/(2*n), n, usertime()); (q-1)/(2*n), n, usertime());
fflush(files(1)); fflush(files(1));
loop = 0; loop = 0;
} }
do { do {
/* /*
* determine if we need to report * determine if we need to report
* *
* NOTE: (q-1)/(2*n) is the k value from 2*k*n + 1. * NOTE: (q-1)/(2*n) is the k value from 2*k*n + 1.
*/ */
if (rept_loop <= ++loop) { if (rept_loop <= ++loop) {
/* report this loop */ /* report this loop */
printf("at 2*%d*%d+1, CPU: %f\n", printf("at 2*%d*%d+1, CPU: %f\n",
(q-1)/(2*n), n, usertime()); (q-1)/(2*n), n, usertime());
fflush(files(1)); fflush(files(1));
loop = 0; loop = 0;
} }
/* /*
* skip if divisible by a prime <= 449 * skip if divisible by a prime <= 449
* *
* The value 281 was determined by timing loops * The value 281 was determined by timing loops
* which found that 281 was at or near the * which found that 281 was at or near the
* minimum time to factor 2^(2^127-1)-1. * minimum time to factor 2^(2^127-1)-1.
* *
* The addition of the do { ... } while (factor(q, 449)>1); * The addition of the do { ... } while (factor(q, 449)>1);
* loop reduced the factoring loop time (36504 k values with * loop reduced the factoring loop time (36504 k values with
* the hset[] initialization time removed) from 25.69 sec to * the hset[] initialization time removed) from 25.69 sec to
* 15.62 sec of CPU time on a 200MHz r4k. * 15.62 sec of CPU time on a 200MHz r4k.
*/ */
do { do {
/* /*
* determine the next factor candidate * determine the next factor candidate
*/ */
q += hset[++hindx]; q += hset[++hindx];
if (hindx >= hcount) { if (hindx >= hcount) {
hindx = 0; hindx = 0;
/* /*
* if we cared about g, * if we cared about g,
* then we wound ++g here too * then we wound ++g here too
*/ */
} }
} while (factor(q, 449) > 1); } while (factor(q, 449) > 1);
} while (pmod(2,n,q) != 1); } while (pmod(2,n,q) != 1);
/* /*
* return the factor found * return the factor found
* *
* q is a factor of (2^n)-1 * q is a factor of (2^n)-1
*/ */
return q; return q;
} }
if (config("resource_debug") & 3) { if (config("resource_debug") & 3) {
print "mfactor(n [, start_k=1 [, rept_loop=10000 [, p_elim=17]]])" print "mfactor(n [, start_k=1 [, rept_loop=10000 [, p_elim=17]]])"
} }

198
cal/mod.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,192 +17,192 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:34 * Under source code control: 1990/02/15 01:50:34
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
obj mod {a}; /* definition of the object */ obj mod {a}; /* definition of the object */
global mod_value = 100; /* modulus value (value of N) */ global mod_value = 100; /* modulus value (value of N) */
define lmod(a) define lmod(a)
{ {
local obj mod x; local obj mod x;
if (!isreal(a) || !isint(a)) if (!isreal(a) || !isint(a))
quit "Bad argument for lmod function"; quit "Bad argument for lmod function";
x.a = a % mod_value; x.a = a % mod_value;
return x; return x;
} }
define mod_print(a) define mod_print(a)
{ {
if (digits(mod_value) <= 20) if (digits(mod_value) <= 20)
print a.a, "(mod", mod_value : ")" :; print a.a, "(mod", mod_value : ")" :;
else else
print a.a, "(mod N)" :; print a.a, "(mod N)" :;
} }
define mod_one() define mod_one()
{ {
return lmod(1); return lmod(1);
} }
define mod_cmp(a, b) define mod_cmp(a, b)
{ {
if (isnum(a)) if (isnum(a))
return (a % mod_value) != b.a; return (a % mod_value) != b.a;
if (isnum(b)) if (isnum(b))
return (b % mod_value) != a.a; return (b % mod_value) != a.a;
return a.a != b.a; return a.a != b.a;
} }
define mod_rel(a, b) define mod_rel(a, b)
{ {
if (isnum(a)) if (isnum(a))
a = lmod(a); a = lmod(a);
if (isnum(b)) if (isnum(b))
b = lmod(b); b = lmod(b);
if (a.a < b.a) if (a.a < b.a)
return -1; return -1;
return a.a != b.a; return a.a != b.a;
} }
define mod_add(a, b) define mod_add(a, b)
{ {
local obj mod x; local obj mod x;
if (isnum(b)) { if (isnum(b)) {
if (!isint(b)) if (!isint(b))
quit "Adding non-integer"; quit "Adding non-integer";
x.a = (a.a + b) % mod_value; x.a = (a.a + b) % mod_value;
return x; return x;
} }
if (isnum(a)) { if (isnum(a)) {
if (!isint(a)) if (!isint(a))
quit "Adding non-integer"; quit "Adding non-integer";
x.a = (a + b.a) % mod_value; x.a = (a + b.a) % mod_value;
return x; return x;
} }
x.a = (a.a + b.a) % mod_value; x.a = (a.a + b.a) % mod_value;
return x; return x;
} }
define mod_sub(a, b) define mod_sub(a, b)
{ {
return a + (-b); return a + (-b);
} }
define mod_neg(a) define mod_neg(a)
{ {
local obj mod x; local obj mod x;
x.a = mod_value - a.a; x.a = mod_value - a.a;
return x; return x;
} }
define mod_mul(a, b) define mod_mul(a, b)
{ {
local obj mod x; local obj mod x;
if (isnum(b)) { if (isnum(b)) {
if (!isint(b)) if (!isint(b))
quit "Multiplying by non-integer"; quit "Multiplying by non-integer";
x.a = (a.a * b) % mod_value; x.a = (a.a * b) % mod_value;
return x; return x;
} }
if (isnum(a)) { if (isnum(a)) {
if (!isint(a)) if (!isint(a))
quit "Multiplying by non-integer"; quit "Multiplying by non-integer";
x.a = (a * b.a) % mod_value; x.a = (a * b.a) % mod_value;
return x; return x;
} }
x.a = (a.a * b.a) % mod_value; x.a = (a.a * b.a) % mod_value;
return x; return x;
} }
define mod_square(a) define mod_square(a)
{ {
local obj mod x; local obj mod x;
x.a = a.a^2 % mod_value; x.a = a.a^2 % mod_value;
return x; return x;
} }
define mod_inc(a) define mod_inc(a)
{ {
local x; local x;
x = a; x = a;
if (++x.a == mod_value) if (++x.a == mod_value)
x.a = 0; x.a = 0;
return x; return x;
} }
define mod_dec(a) define mod_dec(a)
{ {
local x; local x;
x = a; x = a;
if (--x.a < 0) if (--x.a < 0)
x.a = mod_value - 1; x.a = mod_value - 1;
return x; return x;
} }
define mod_inv(a) define mod_inv(a)
{ {
local obj mod x; local obj mod x;
x.a = minv(a.a, mod_value); x.a = minv(a.a, mod_value);
return x; return x;
} }
define mod_div(a, b) define mod_div(a, b)
{ {
local c; local c;
local obj mod x; local obj mod x;
local obj mod y; local obj mod y;
if (isnum(a)) if (isnum(a))
a = lmod(a); a = lmod(a);
if (isnum(b)) if (isnum(b))
b = lmod(b); b = lmod(b);
c = gcd(a.a, b.a); c = gcd(a.a, b.a);
x.a = a.a / c; x.a = a.a / c;
y.a = b.a / c; y.a = b.a / c;
return x * inverse(y); return x * inverse(y);
} }
define mod_pow(a, b) define mod_pow(a, b)
{ {
local x, y, z; local x, y, z;
obj mod x; obj mod x;
y = a; y = a;
z = b; z = b;
if (b < 0) { if (b < 0) {
y = inverse(a); y = inverse(a);
z = -b; z = -b;
} }
x.a = pmod(y.a, z, mod_value); x.a = pmod(y.a, z, mod_value);
return x; return x;
} }

724
cal/natnumset.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1997/09/07 23:53:51 * Under source code control: 1997/09/07 23:53:51
* File existed as early as: 1997 * File existed as early as: 1997
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -40,14 +40,14 @@
* *
* In an assignment of a set-valued lvalue to an lvalue, as in * In an assignment of a set-valued lvalue to an lvalue, as in
* *
* A = set(1,2,3); * A = set(1,2,3);
* B = A; * B = A;
* *
* the sets share the same data string, so a change to either has the effect * the sets share the same data string, so a change to either has the effect
* of changing both. A set equal to A but with a different string can be * of changing both. A set equal to A but with a different string can be
* created by * created by
* *
* B = A | set() * B = A | set()
* *
* The functions empty() and full() return the empty set and the set of all * The functions empty() and full() return the empty set and the set of all
* integers in [0,B] respectively. * integers in [0,B] respectively.
@@ -57,58 +57,58 @@
* test(A) returns 0 or 1 according as A is or is not the empty set * test(A) returns 0 or 1 according as A is or is not the empty set
* *
* isin(A, n) for set A and integer n returns 1 if n is in A, 0 if * isin(A, n) for set A and integer n returns 1 if n is in A, 0 if
* 0 <= n <= B and n is not in A, the null value if n < 0 or n > B. * 0 <= n <= B and n is not in A, the null value if n < 0 or n > B.
* *
* addmember(A, n) adds n as a member of A, provided n is in [0, B]; * addmember(A, n) adds n as a member of A, provided n is in [0, B];
* this is also achieved by A |= n. * this is also achieved by A |= n.
* *
* rmmember(A, n) removes n from A if it is a member; this is also achieved * rmmember(A, n) removes n from A if it is a member; this is also achieved
* by A \= n. * by A \= n.
* *
* The following unary and binary operations are defined for sets A, B. * The following unary and binary operations are defined for sets A, B.
* For binary operations with one argument a set and the other an * For binary operations with one argument a set and the other an
* integer n, the integer taken to represent set(n). * integer n, the integer taken to represent set(n).
* *
* A | B = union of A and B, integers in at least one of A and B * A | B = union of A and B, integers in at least one of A and B
* A & B = intersection of A and B, integers in both A and B * A & B = intersection of A and B, integers in both A and B
* A ~ B = symmetric difference (boolean sum) of A and Bi, integers * A ~ B = symmetric difference (boolean sum) of A and Bi, integers
* in exactly one of A and B * in exactly one of A and B
* A \ B = set difference, integers in A but not in B * A \ B = set difference, integers in A but not in B
* *
* ~A = complement of A, integers not in A * ~A = complement of A, integers not in A
* #A = number of integers in A * #A = number of integers in A
* !A = 1 or 0 according as A is empty or not empty * !A = 1 or 0 according as A is empty or not empty
* +A = sum of the members of A * +A = sum of the members of A
* *
* min(A) = least member of A, -1 for empty set * min(A) = least member of A, -1 for empty set
* max(A) = greatest member of A, -1 for empty set * max(A) = greatest member of A, -1 for empty set
* sum(A) = sum of the members of A * sum(A) = sum of the members of A
* *
* In the following a and b denote arbitrary members of A and B: * In the following a and b denote arbitrary members of A and B:
* *
* A + B = set of sums a + b * A + B = set of sums a + b
* A - B = set of differences a - b * A - B = set of differences a - b
* A * B = set of products a * b * A * B = set of products a * b
* A ^ n = set of powers a ^ n * A ^ n = set of powers a ^ n
* A % m = set of integers congruent to a mod m * A % m = set of integers congruent to a mod m
* *
* A == B returns 1 or not according as A and B are equal or not * A == B returns 1 or not according as A and B are equal or not
* A != B = !(A == B) * A != B = !(A == B)
* A <= B returns 1 if A is a subset of B, i.e. every member of A is * A <= B returns 1 if A is a subset of B, i.e. every member of A is
* a member of B * a member of B
* A < B = ((A <= B) && (A != B)) * A < B = ((A <= B) && (A != B))
* A >= B = (B <= A) * A >= B = (B <= A)
* A > B = (B < A) * A > B = (B < A)
* *
* Expressions may be formed from the above "arithmetic" operations in * Expressions may be formed from the above "arithmetic" operations in
* the usual way, with parentheses for variations from the usual precedence * the usual way, with parentheses for variations from the usual precedence
* rules. For example * rules. For example
* *
* A + 3 * A ^ 2 + (A - B) ^ 3 * A + 3 * A ^ 2 + (A - B) ^ 3
* *
* returns the set of integers expressible as * returns the set of integers expressible as
* *
* a_1 + 3 * a_2 ^ 2 + (a_3 - b) ^3 * a_1 + 3 * a_2 ^ 2 + (a_3 - b) ^3
* *
* where a_1, a_2, a_3 are in A, and b is in B. * where a_1, a_2, a_3 are in A, and b is in B.
* *
@@ -119,28 +119,28 @@
* isinterval(A) returns 1 if A is a non-empty interval, 0 otherwise. * isinterval(A) returns 1 if A is a non-empty interval, 0 otherwise.
* *
* randset(n, a, b) returns a random set of n integers between a and b * randset(n, a, b) returns a random set of n integers between a and b
* inclusive; a defaults to 0, b to N-1. An error occurs if * inclusive; a defaults to 0, b to N-1. An error occurs if
* n is too large. * n is too large.
* *
* polyvals(L, A) for L = list(c_0, c_1, c_2, ...) returns the set of * polyvals(L, A) for L = list(c_0, c_1, c_2, ...) returns the set of
* values of * values of
* *
* c_0 + c_1 * a + c_2 * a^2 + ... * c_0 + c_1 * a + c_2 * a^2 + ...
* *
* for a in the set A. * for a in the set A.
* *
* polyvals2(L, A, B) returns the set of values of poly(L, i, j) for i in * polyvals2(L, A, B) returns the set of values of poly(L, i, j) for i in
* A and j in B. Here L is a list whose members are integers or * A and j in B. Here L is a list whose members are integers or
* lists of integers, the latter representing polynomials in the * lists of integers, the latter representing polynomials in the
* second variable. For example, with L = list(0, list(0, 1), 1), * second variable. For example, with L = list(0, list(0, 1), 1),
* polyvals2(L, A, B) will return the values of i^2 + i * j for * polyvals2(L, A, B) will return the values of i^2 + i * j for
* i in A, j in B. * i in A, j in B.
* *
*/ */
static N; /* Number of integers in [0,B], = B + 1 */ static N; /* Number of integers in [0,B], = B + 1 */
static M; /* Maximum string size required, = N // 8 */ static M; /* Maximum string size required, = N // 8 */
obj set {s}; obj set {s};
@@ -148,17 +148,17 @@ define isset(a) = istype(a, obj set);
define setbound(n) define setbound(n)
{ {
local v; local v;
v = N - 1; v = N - 1;
if (isnull(n)) if (isnull(n))
return v; return v;
if (!isint(n) || n < 0) if (!isint(n) || n < 0)
quit "Bad argument for setbound"; quit "Bad argument for setbound";
N = n + 1; N = n + 1;
M = quo(N, 8, 1); /* M // 8 rounded up */ M = quo(N, 8, 1); /* M // 8 rounded up */
if (v >= 0) if (v >= 0)
return v; return v;
} }
setbound(100); setbound(100);
@@ -167,90 +167,90 @@ define empty() = obj set = {""};
define full() define full()
{ {
local v; local v;
obj set v; obj set v;
v.s = M * char(-1); v.s = M * char(-1);
if (!ismult(N, 8)) v.s[M-1] = 255 >> (8 - N & 7); if (!ismult(N, 8)) v.s[M-1] = 255 >> (8 - N & 7);
return v; return v;
} }
define isin(a, b) define isin(a, b)
{ {
if (!isset(a) || !isint(b)) if (!isset(a) || !isint(b))
quit "Bad argument for isin"; quit "Bad argument for isin";
return bit(a.s, b); return bit(a.s, b);
} }
define addmember(a, n) define addmember(a, n)
{ {
if (!isset(a) || !isint(n)) if (!isset(a) || !isint(n))
quit "Bad argument for addmember"; quit "Bad argument for addmember";
if (n < N && n >= 0) if (n < N && n >= 0)
setbit(a.s, n); setbit(a.s, n);
} }
define rmmember(a, n) define rmmember(a, n)
{ {
if (n < N && n >= 0) if (n < N && n >= 0)
setbit(a.s, n, 0); setbit(a.s, n, 0);
} }
define set() define set()
{ {
local i, v, s; local i, v, s;
s = M * char(0); s = M * char(0);
for (i = 1; i <= param(0); i++) { for (i = 1; i <= param(0); i++) {
v = param(i); v = param(i);
if (!isint(v)) if (!isint(v))
quit "Non-integral argument for set"; quit "Non-integral argument for set";
if (v >= 0 && v < N) if (v >= 0 && v < N)
setbit(s, v); setbit(s, v);
} }
return mkset(s); return mkset(s);
} }
define mkset(s) define mkset(s)
{ {
local h, m; local h, m;
if (!isstr(s)) if (!isstr(s))
quit "Non-string argument for mkset"; quit "Non-string argument for mkset";
h = highbit(s); h = highbit(s);
if (h >= N) if (h >= N)
quit "Too-long string for mkset"; quit "Too-long string for mkset";
m = quo(h + 1, 8, 1); m = quo(h + 1, 8, 1);
return obj set = {head(s, m)}; return obj set = {head(s, m)};
} }
define primes(a,b) define primes(a,b)
{ {
local i, s, m; local i, s, m;
if (isnull(b)) { if (isnull(b)) {
if (isnull(a)) { if (isnull(a)) {
a = 0; a = 0;
b = N - 1; b = N - 1;
} }
else b = 0; else b = 0;
} }
if (!isint(a) || !isint(b)) if (!isint(a) || !isint(b))
quit "Non-integer argument for primes"; quit "Non-integer argument for primes";
if (a > b) if (a > b)
swap(a,b); swap(a,b);
if (b < 0 || a >= N) if (b < 0 || a >= N)
return empty(); return empty();
a = max(a, 0); a = max(a, 0);
b = min(b, N-1); b = min(b, N-1);
s = M * char(0); s = M * char(0);
for (i = a; i <= b; i++) for (i = a; i <= b; i++)
if (isprime(i)) if (isprime(i))
setbit(s, i); setbit(s, i);
return mkset(s); return mkset(s);
} }
define set_max(a) = highbit(a.s); define set_max(a) = highbit(a.s);
@@ -261,56 +261,56 @@ define set_not(a) = !a.s;
define set_cmp(a,b) define set_cmp(a,b)
{ {
if (isset(a) && isset(b)) if (isset(a) && isset(b))
return a.s != b.s; return a.s != b.s;
return 1; return 1;
} }
define set_rel(a,b) define set_rel(a,b)
{ {
local c; local c;
if (a == b) if (a == b)
return 0; return 0;
if (isset(a)) { if (isset(a)) {
if (isset(b)) { if (isset(b)) {
c = a & b; c = a & b;
if (c == a) if (c == a)
return -1; return -1;
if (c == b) if (c == b)
return 1; return 1;
return; return;
} }
if (!isint(b)) if (!isint(b))
return set_rel(a, set(b)); return set_rel(a, set(b));
} }
if (isint(a)) if (isint(a))
return set_rel(set(a), b); return set_rel(set(a), b);
} }
define set_or(a, b) define set_or(a, b)
{ {
if (isset(a)) { if (isset(a)) {
if (isset(b)) if (isset(b))
return obj set = {a.s | b.s}; return obj set = {a.s | b.s};
if (isint(b)) if (isint(b))
return a | set(b); return a | set(b);
} }
if (isint(a)) if (isint(a))
return set(a) | b; return set(a) | b;
return newerror("Bad argument for set_or"); return newerror("Bad argument for set_or");
} }
define set_and(a, b) define set_and(a, b)
{ {
if (isint(a)) if (isint(a))
return set(a) & b; return set(a) & b;
if (isint(b)) if (isint(b))
return a & set(b); return a & set(b);
if (!isset(a) || !isset(b)) if (!isset(a) || !isset(b))
return newerror("Bad argument for set_and"); return newerror("Bad argument for set_and");
return mkset(a.s & b.s); return mkset(a.s & b.s);
} }
@@ -318,295 +318,295 @@ define set_comp(a) = full() \ a;
define set_setminus(a,b) define set_setminus(a,b)
{ {
if (isint(a)) if (isint(a))
return set(a) \ b; return set(a) \ b;
if (isint(b)) if (isint(b))
return a \ set(b); return a \ set(b);
if (!isset(a) || !isset(b)) if (!isset(a) || !isset(b))
return newerror("Bad argument for set_setminus"); return newerror("Bad argument for set_setminus");
return mkset(a.s \ b.s); return mkset(a.s \ b.s);
} }
define set_xor(a,b) define set_xor(a,b)
{ {
if (isint(a)) if (isint(a))
return set(a) ~ b; return set(a) ~ b;
if (isint(b)) if (isint(b))
return a ~ set(b); return a ~ set(b);
if (!isset(a) || !isset(b)) if (!isset(a) || !isset(b))
return newerror("Bad argument for set_xor"); return newerror("Bad argument for set_xor");
return mkset(a.s ~ b.s); return mkset(a.s ~ b.s);
} }
define set_content(a) = #a.s; define set_content(a) = #a.s;
define set_add(a, b) define set_add(a, b)
{ {
local s, i, j, m, n; local s, i, j, m, n;
if (isint(a)) if (isint(a))
return set(a) + b; return set(a) + b;
if (isint(b)) if (isint(b))
return a + set(b); return a + set(b);
if (!isset(a) || !isset(b)) if (!isset(a) || !isset(b))
return newerror("Bad argument for set_add"); return newerror("Bad argument for set_add");
if (!a || !b) if (!a || !b)
return empty(); return empty();
m = highbit(a.s); m = highbit(a.s);
n = highbit(b.s); n = highbit(b.s);
s = M * char(0); s = M * char(0);
for (i = 0; i <= m; i++) for (i = 0; i <= m; i++)
if (isin(a, i)) if (isin(a, i))
for (j = 0; j <= n && i + j < N; j++) for (j = 0; j <= n && i + j < N; j++)
if (isin(b, j)) if (isin(b, j))
setbit(s, i + j); setbit(s, i + j);
return mkset(s); return mkset(s);
} }
define set_sub(a,b) define set_sub(a,b)
{ {
local s, i, j, m, n; local s, i, j, m, n;
if (isint(b)) if (isint(b))
return a - set(b); return a - set(b);
if (isint(a)) if (isint(a))
return set(a) - b; return set(a) - b;
if (isset(a) && isset(b)) { if (isset(a) && isset(b)) {
if (!a || !b) if (!a || !b)
return empty(); return empty();
m = highbit(a.s); m = highbit(a.s);
n = highbit(b.s); n = highbit(b.s);
s = M * char(0); s = M * char(0);
for (i = 0; i <= m; i++) for (i = 0; i <= m; i++)
if (isin(a, i)) if (isin(a, i))
for (j = 0; j <= n && j <= i; j++) for (j = 0; j <= n && j <= i; j++)
if (isin(b, j)) if (isin(b, j))
setbit(s, i - j); setbit(s, i - j);
return mkset(s); return mkset(s);
} }
return newerror("Bad argument for set_sub"); return newerror("Bad argument for set_sub");
} }
define set_mul(a, b) define set_mul(a, b)
{ {
local s, i, j, m, n; local s, i, j, m, n;
if (isset(a)) { if (isset(a)) {
s = M * char(0); s = M * char(0);
m = highbit(a.s); m = highbit(a.s);
if (isset(b)) { if (isset(b)) {
if (!a || !b) if (!a || !b)
return empty(); return empty();
n = highbit(b.s); n = highbit(b.s);
for (i = 0; i <= m; ++i) for (i = 0; i <= m; ++i)
if (isin(a, i)) if (isin(a, i))
for (j = 1; j <= n && i * j < N; ++j) for (j = 1; j <= n && i * j < N; ++j)
if (isin(b, j)) if (isin(b, j))
setbit(s, i * j); setbit(s, i * j);
return mkset(s); return mkset(s);
} }
if (isint(b)) { if (isint(b)) {
if (b == 0) { if (b == 0) {
if (a) if (a)
return set(0); return set(0);
return empty(); return empty();
} }
s = M * char(0); s = M * char(0);
for (i = 0; i <= m && b * i < N; ++i) for (i = 0; i <= m && b * i < N; ++i)
if (isin(a, i)) if (isin(a, i))
setbit(s, b * i); setbit(s, b * i);
return mkset(s); return mkset(s);
} }
} }
if (isint(a)) if (isint(a))
return b * a; return b * a;
return newerror("Bad argument for set_mul"); return newerror("Bad argument for set_mul");
} }
define set_square(a) define set_square(a)
{ {
local s, i, m; local s, i, m;
s = M * char(0); s = M * char(0);
m = highbit(a.s); m = highbit(a.s);
for (i = 0; i <= m && i^2 < N; ++i) for (i = 0; i <= m && i^2 < N; ++i)
if (bit(a.s, i)) if (bit(a.s, i))
setbit(s, i^2); setbit(s, i^2);
return mkset(s); return mkset(s);
} }
define set_pow(a, n) define set_pow(a, n)
{ {
local s, i, m; local s, i, m;
if (!isint(n) || n < 0) if (!isint(n) || n < 0)
quit "Bad exponent for set_power"; quit "Bad exponent for set_power";
s = M * char(0); s = M * char(0);
m = highbit(a.s); m = highbit(a.s);
for (i = 0; i <= m && i^n < N; ++i) for (i = 0; i <= m && i^n < N; ++i)
if (bit(a.s, i)) if (bit(a.s, i))
setbit(s, i^n); setbit(s, i^n);
return mkset(s); return mkset(s);
} }
define set_sum(a) define set_sum(a)
{ {
local v, m, i; local v, m, i;
v = 0; v = 0;
m = highbit(a.s); m = highbit(a.s);
for (i = 0; i <= m; ++i) for (i = 0; i <= m; ++i)
if (bit(a.s, i)) if (bit(a.s, i))
v += i; v += i;
return v; return v;
} }
define set_plus(a) = set_sum(a); define set_plus(a) = set_sum(a);
define interval(a, b) define interval(a, b)
{ {
local i, j, s; local i, j, s;
static tail = "\0\1\3\7\17\37\77\177\377"; static tail = "\0\1\3\7\17\37\77\177\377";
if (!isint(a) || !isint(b)) if (!isint(a) || !isint(b))
quit "Non-integer argument for interval"; quit "Non-integer argument for interval";
if (a > b) if (a > b)
swap(a, b); swap(a, b);
if (b < 0 || a >= N) if (b < 0 || a >= N)
return empty(); return empty();
a = max(a, 0); a = max(a, 0);
b = min(b, N-1); b = min(b, N-1);
i = quo(a, 8, 0); i = quo(a, 8, 0);
j = quo(b, 8, 0); j = quo(b, 8, 0);
s = M * char(0); s = M * char(0);
if (i == j) { if (i == j) {
s[i] = tail[b + 1 - 8 * i] \ tail[a - 8 * i]; s[i] = tail[b + 1 - 8 * i] \ tail[a - 8 * i];
return mkset(s); return mkset(s);
} }
s[i] = ~tail[a - 8 * i]; s[i] = ~tail[a - 8 * i];
while (++i < j) while (++i < j)
s[i] = -1; s[i] = -1;
s[j] = tail[b + 1 - 8 * j]; s[j] = tail[b + 1 - 8 * j];
return mkset(s); return mkset(s);
} }
define isinterval(a) define isinterval(a)
{ {
local i, max, s; local i, max, s;
if (!isset(a)) if (!isset(a))
quit "Non-set argument for isinterval"; quit "Non-set argument for isinterval";
s = a.s; s = a.s;
if (!s) if (!s)
return 0; return 0;
for (i = lowbit(s) + 1, max = highbit(s); i < max; i++) for (i = lowbit(s) + 1, max = highbit(s); i < max; i++)
if (!bit(s, i)) if (!bit(s, i))
return 0; return 0;
return 1; return 1;
} }
define set_mod(a, b) define set_mod(a, b)
{ {
local s, m, i, j; local s, m, i, j;
if (isset(a) && isint(b)) { if (isset(a) && isint(b)) {
s = M * char(0); s = M * char(0);
m = highbit(a.s); m = highbit(a.s);
for (i = 0; i <= m; i++) for (i = 0; i <= m; i++)
if (bit(a.s, i)) if (bit(a.s, i))
for (j = 0; j < N; j++) for (j = 0; j < N; j++)
if (meq(i, j, b)) if (meq(i, j, b))
setbit(s, j); setbit(s, j);
return mkset(s); return mkset(s);
} }
return newerror("Bad argument for set_mod"); return newerror("Bad argument for set_mod");
} }
define randset(n, a, b) define randset(n, a, b)
{ {
local m, s, i; local m, s, i;
if (isnull(a)) if (isnull(a))
a = 0; a = 0;
if (isnull(b)) if (isnull(b))
b = N - 1; b = N - 1;
if (!isint(n) || !isint(a) || !isint(b) || n < 0 || a < 0 || b < 0) if (!isint(n) || !isint(a) || !isint(b) || n < 0 || a < 0 || b < 0)
quit "Bad argument for randset"; quit "Bad argument for randset";
if (a > b) if (a > b)
swap(a, b); swap(a, b);
m = b - a + 1; m = b - a + 1;
if (n > m) if (n > m)
return newerror("Too many numbers specified for randset"); return newerror("Too many numbers specified for randset");
if (2 * n > m) if (2 * n > m)
return interval(a,b) \ randset(m - n, a, b); return interval(a,b) \ randset(m - n, a, b);
++b; ++b;
s = M * char(0); s = M * char(0);
while (n-- > 0) { while (n-- > 0) {
do do
i = rand(a, b); i = rand(a, b);
while while
(bit(s, i)); (bit(s, i));
setbit(s, i); setbit(s, i);
} }
return mkset(s); return mkset(s);
} }
define polyvals(L, A) define polyvals(L, A)
{ {
local s, m, v, i; local s, m, v, i;
if (!islist(L)) if (!islist(L))
quit "Non-list first argument for polyvals"; quit "Non-list first argument for polyvals";
if (!isset(A)) if (!isset(A))
quit "Non-set second argument for polyvals"; quit "Non-set second argument for polyvals";
m = highbit(A.s); m = highbit(A.s);
s = M * char(0); s = M * char(0);
for (i = 0; i <= m; i++) for (i = 0; i <= m; i++)
if (bit(A.s, i)) { if (bit(A.s, i)) {
v = poly(L,i); v = poly(L,i);
if (v >> 0 && v < N) if (v >> 0 && v < N)
setbit(s, v); setbit(s, v);
} }
return mkset(s); return mkset(s);
} }
define polyvals2(L, A, B) define polyvals2(L, A, B)
{ {
local s1, s2, s, m, n, i, j, v; local s1, s2, s, m, n, i, j, v;
s1 = A.s; s1 = A.s;
s2 = B.s; s2 = B.s;
m = highbit(s1); m = highbit(s1);
n = highbit(s2); n = highbit(s2);
s = M * char(0); s = M * char(0);
for (i = 0; i <= m; i++) for (i = 0; i <= m; i++)
if (bit(s1, i)) if (bit(s1, i))
for (j = 0; j <= n; j++) for (j = 0; j <= n; j++)
if (bit(s2, j)) { if (bit(s2, j)) {
v = poly(L, i, j); v = poly(L, i, j);
if (v >= 0 && v < N) if (v >= 0 && v < N)
setbit(s, v); setbit(s, v);
} }
return mkset(s); return mkset(s);
} }
define set_print(a) define set_print(a)
{ {
local i, s, m; local i, s, m;
s = a.s; s = a.s;
i = lowbit(s); i = lowbit(s);
print "set(":; print "set(":;
if (i >= 0) { if (i >= 0) {
print i:; print i:;
m = highbit(s); m = highbit(s);
while (++i <= m) while (++i <= m)
if (bit(s, i)) if (bit(s, i))
print ",":i:; print ",":i:;
} }
print ")",; print ")",;
} }
local N, M; /* End scope of static variables N, M */ local N, M; /* End scope of static variables N, M */

392
cal/palindrome.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2021/11/06 14:35:37 * Under source code control: 2021/11/06 14:35:37
* File existed as early as: 2021 * File existed as early as: 2021
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -30,23 +30,23 @@
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val value to find a digit of * val value to find a digit of
* place digit place * place digit place
* *
* returns: * returns:
* value (>= 0 and < 10) that is the place-th digit of val * value (>= 0 and < 10) that is the place-th digit of val
* or 0 if place is not a digit of val * or 0 if place is not a digit of val
*/ */
define digitof(val, place) define digitof(val, place)
{ {
local d; /* length of val in digits */ local d; /* length of val in digits */
/* determine length */ /* determine length */
d = digits(val); d = digits(val);
/* firewall - return 0 if digit place doesn't exist */ /* firewall - return 0 if digit place doesn't exist */
if (place < 1 || place > d) { if (place < 1 || place > d) {
return 0; return 0;
} }
/* return the place-th digit of val as a single digit */ /* return the place-th digit of val as a single digit */
@@ -60,18 +60,18 @@ define digitof(val, place)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* d digits of a value * d digits of a value
* place digit place * place digit place
* *
* returns: * returns:
* given palindrome val, the other digit paired with place * given palindrome val, the other digit paired with place
* or 0 if place is not a digit of val * or 0 if place is not a digit of val
*/ */
define copalplace(d, place) define copalplace(d, place)
{ {
/* firewall - return 0 if digit place doesn't exist */ /* firewall - return 0 if digit place doesn't exist */
if (d < 1 || place < 1 || place > d) { if (d < 1 || place < 1 || place > d) {
return 0; return 0;
} }
/* return digit coplace */ /* return digit coplace */
@@ -85,18 +85,18 @@ define copalplace(d, place)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* NOTE: When the value has an odd number of digits, the upper half * NOTE: When the value has an odd number of digits, the upper half
* includes the middle digit. * includes the middle digit.
* *
* given: * given:
* val a value * val a value
* *
* returns: * returns:
* the upper half digits of a value * the upper half digits of a value
*/ */
define upperhalf(val) define upperhalf(val)
{ {
local d; /* length of val in digits */ local d; /* length of val in digits */
local halfd; /* length of upper hand of val */ local halfd; /* length of upper hand of val */
/* determine length */ /* determine length */
d = digits(val); d = digits(val);
@@ -113,16 +113,16 @@ define upperhalf(val)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val a value * val a value
* *
* returns: * returns:
* val as a palindrome with lower half being reverse digits of val * val as a palindrome with lower half being reverse digits of val
*/ */
define mkpal(val) define mkpal(val)
{ {
local d; /* length of val in digits */ local d; /* length of val in digits */
local i; /* counter */ local i; /* counter */
local ret; /* palindrome being formed */ local ret; /* palindrome being formed */
/* determine length */ /* determine length */
d = digits(val); d = digits(val);
@@ -130,7 +130,7 @@ define mkpal(val)
/* insert digits in reverse order at the bottom */ /* insert digits in reverse order at the bottom */
ret = val; ret = val;
for (i=0; i < d; ++i) { for (i=0; i < d; ++i) {
ret = ret*10 + digit(val, i); ret = ret*10 + digit(val, i);
} }
return ret; return ret;
} }
@@ -142,18 +142,18 @@ define mkpal(val)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val a value * val a value
* digit the digit to put into the middle of the palindrome * digit the digit to put into the middle of the palindrome
* *
* returns: * returns:
* val as a palindrome with lower half being reverse digits of val * val as a palindrome with lower half being reverse digits of val
* and digit as a middle digit * and digit as a middle digit
*/ */
define mkpalmiddigit(val, digit) define mkpalmiddigit(val, digit)
{ {
local d; /* length of val in digits */ local d; /* length of val in digits */
local i; /* counter */ local i; /* counter */
local ret; /* palindrome being formed */ local ret; /* palindrome being formed */
/* determine length */ /* determine length */
d = digits(val); d = digits(val);
@@ -161,7 +161,7 @@ define mkpalmiddigit(val, digit)
/* insert digits in reverse order at the bottom */ /* insert digits in reverse order at the bottom */
ret = val*10 + digit; ret = val*10 + digit;
for (i=0; i < d; ++i) { for (i=0; i < d; ++i) {
ret = ret*10 + digit(val, i); ret = ret*10 + digit(val, i);
} }
return ret; return ret;
} }
@@ -173,31 +173,31 @@ define mkpalmiddigit(val, digit)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val a value * val a value
* *
* returns: * returns:
* 1 ==> val is a palindrome * 1 ==> val is a palindrome
* 0 ==> val is NOT a palindrome * 0 ==> val is NOT a palindrome
*/ */
define ispal(val) define ispal(val)
{ {
local half; /* upper half of digits of val */ local half; /* upper half of digits of val */
local digit; /* middle digit */ local digit; /* middle digit */
/* case: val has an even number of digits */ /* case: val has an even number of digits */
if (iseven(digits(val))) { if (iseven(digits(val))) {
/* test palindrome-ness */ /* test palindrome-ness */
return (val == mkpal(upperhalf(val))); return (val == mkpal(upperhalf(val)));
/* case: val can an odd number of digits */ /* case: val can an odd number of digits */
} else { } else {
/* test palindrome-ness */ /* test palindrome-ness */
half = upperhalf(val); half = upperhalf(val);
digit = half % 10; digit = half % 10;
half //= 10; half //= 10;
return (val == mkpalmiddigit(half, digit)); return (val == mkpalmiddigit(half, digit));
} }
} }
@@ -208,21 +208,21 @@ define ispal(val)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* pal a palindrome * pal a palindrome
* *
* returns: * returns:
* next palindrome > pal * next palindrome > pal
*/ */
define palnextpal(pal) define palnextpal(pal)
{ {
local paldigits; /* digits in pal */ local paldigits; /* digits in pal */
local half; /* upper half of newval */ local half; /* upper half of newval */
local newhalf; /* half+1 */ local newhalf; /* half+1 */
local newpal; /* new palindrome */ local newpal; /* new palindrome */
/* case: negative palindrome */ /* case: negative palindrome */
if (pal < 0) { if (pal < 0) {
return -(palprevpal(-pal)); return -(palprevpal(-pal));
} }
/* /*
@@ -244,19 +244,19 @@ define palnextpal(pal)
*/ */
paldigits = digits(pal); paldigits = digits(pal);
if (digits(newhalf) == digits(half)) { if (digits(newhalf) == digits(half)) {
/* no change in half digits: process as normal */ /* no change in half digits: process as normal */
if (iseven(paldigits)) { if (iseven(paldigits)) {
newpal = mkpal(newhalf); newpal = mkpal(newhalf);
} else { } else {
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10); newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
} }
} else { } else {
/* change in half digits: process as opposite */ /* change in half digits: process as opposite */
if (iseven(paldigits)) { if (iseven(paldigits)) {
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10); newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
} else { } else {
newpal = mkpal(newhalf); newpal = mkpal(newhalf);
} }
} }
/* /*
@@ -272,22 +272,22 @@ define palnextpal(pal)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val a value * val a value
* *
* returns: * returns:
* next palindrome > val * next palindrome > val
*/ */
define nextpal(val) define nextpal(val)
{ {
local newval; /* val+1 */ local newval; /* val+1 */
local newvaldigits; /* digits in newval */ local newvaldigits; /* digits in newval */
local half; /* upper half of newval */ local half; /* upper half of newval */
local pal; /* palindrome test value */ local pal; /* palindrome test value */
local newpal; /* new palindrome */ local newpal; /* new palindrome */
/* case: negative value */ /* case: negative value */
if (val < 0) { if (val < 0) {
return -(prevpal(-val)); return -(prevpal(-val));
} }
/* /*
@@ -298,7 +298,7 @@ define nextpal(val)
/* case: single digit palindrome */ /* case: single digit palindrome */
if (newvaldigits < 2) { if (newvaldigits < 2) {
return newval; return newval;
} }
/* /*
@@ -314,16 +314,16 @@ define nextpal(val)
* half may not or may include the middle digit. * half may not or may include the middle digit.
*/ */
if (iseven(newvaldigits)) { if (iseven(newvaldigits)) {
pal = mkpal(half); pal = mkpal(half);
} else { } else {
pal = mkpalmiddigit(half // 10, half % 10); pal = mkpalmiddigit(half // 10, half % 10);
} }
/* /*
* case: we found a larger palindrome, we are done * case: we found a larger palindrome, we are done
*/ */
if (pal > val) { if (pal > val) {
return pal; return pal;
} }
/* /*
@@ -344,33 +344,33 @@ define nextpal(val)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* pal a palindrome * pal a palindrome
* *
* returns: * returns:
* previous palindrome < pal * previous palindrome < pal
*/ */
define palprevpal(pal) define palprevpal(pal)
{ {
local paldigits; /* digits in pal */ local paldigits; /* digits in pal */
local half; /* upper half of newval */ local half; /* upper half of newval */
local newhalf; /* half+1 */ local newhalf; /* half+1 */
local newpal; /* new palindrome */ local newpal; /* new palindrome */
/* case: negative value */ /* case: negative value */
if (pal < 0) { if (pal < 0) {
return -(palnextpal(-pal)); return -(palnextpal(-pal));
} }
/* case: single digit palindrome */ /* case: single digit palindrome */
if (pal < 10) { if (pal < 10) {
newpal = pal-1; newpal = pal-1;
return newpal; return newpal;
} }
/* case: 10 or 11 */ /* case: 10 or 11 */
if (pal < 12) { if (pal < 12) {
newpal = 9; newpal = 9;
return newpal; return newpal;
} }
/* /*
@@ -392,19 +392,19 @@ define palprevpal(pal)
*/ */
paldigits = digits(pal); paldigits = digits(pal);
if (digits(newhalf) == digits(half)) { if (digits(newhalf) == digits(half)) {
/* no change in half digits: process as normal */ /* no change in half digits: process as normal */
if (iseven(paldigits)) { if (iseven(paldigits)) {
newpal = mkpal(newhalf); newpal = mkpal(newhalf);
} else { } else {
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10); newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
} }
} else { } else {
/* change in half digits: process as opposite */ /* change in half digits: process as opposite */
if (iseven(paldigits)) { if (iseven(paldigits)) {
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10); newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
} else { } else {
newpal = mkpal(newhalf); newpal = mkpal(newhalf);
} }
} }
/* /*
@@ -420,22 +420,22 @@ define palprevpal(pal)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val a value * val a value
* *
* returns: * returns:
* previous palindrome < val * previous palindrome < val
*/ */
define prevpal(val) define prevpal(val)
{ {
local newval; /* val-1 */ local newval; /* val-1 */
local newvaldigits; /* digits in newval */ local newvaldigits; /* digits in newval */
local half; /* upper half of newval */ local half; /* upper half of newval */
local pal; /* palindrome test value */ local pal; /* palindrome test value */
local newpal; /* new palindrome */ local newpal; /* new palindrome */
/* case: negative value */ /* case: negative value */
if (val < 0) { if (val < 0) {
return -(nextpal(-val)); return -(nextpal(-val));
} }
/* /*
@@ -446,7 +446,7 @@ define prevpal(val)
/* case: single digit palindrome */ /* case: single digit palindrome */
if (newvaldigits < 2) { if (newvaldigits < 2) {
return newval; return newval;
} }
/* /*
@@ -462,16 +462,16 @@ define prevpal(val)
* half may not or may include the middle digit. * half may not or may include the middle digit.
*/ */
if (iseven(newvaldigits)) { if (iseven(newvaldigits)) {
pal = mkpal(half); pal = mkpal(half);
} else { } else {
pal = mkpalmiddigit(half // 10, half % 10); pal = mkpalmiddigit(half // 10, half % 10);
} }
/* /*
* case: we found a smaller palindrome, we are done * case: we found a smaller palindrome, we are done
*/ */
if (pal < val) { if (pal < val) {
return pal; return pal;
} }
/* /*
@@ -492,15 +492,15 @@ define prevpal(val)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val a value * val a value
* *
* returns: * returns:
* next palindrome (highly probable) prime > val * next palindrome (highly probable) prime > val
*/ */
define nextprimepal(val) define nextprimepal(val)
{ {
local pal; /* palindrome test value */ local pal; /* palindrome test value */
local dpal; /* digits in pal */ local dpal; /* digits in pal */
/* /*
* pre-start under the next palindrome * pre-start under the next palindrome
@@ -512,45 +512,45 @@ define nextprimepal(val)
*/ */
do { do {
/* case: negative values and tiny values */ /* case: negative values and tiny values */
if (pal < 2) { if (pal < 2) {
return 2; return 2;
} }
/* /*
* compute the next palindrome * compute the next palindrome
*/ */
pal = palnextpal(pal); pal = palnextpal(pal);
dpal = digits(pal); dpal = digits(pal);
/* case: 11 is the only prime palindrome with even digit count */ /* case: 11 is the only prime palindrome with even digit count */
if (pal == 11) { if (pal == 11) {
return 11; return 11;
} }
/* case: even number of digits and not 11 */ /* case: even number of digits and not 11 */
if (iseven(dpal)) { if (iseven(dpal)) {
/* /*
* Except for 11 (which is handled above already), there are * Except for 11 (which is handled above already), there are
* no prime palindrome with even digits. So we need to * no prime palindrome with even digits. So we need to
* increase the digit count and work with that larger palindrome. * increase the digit count and work with that larger palindrome.
*/ */
pal = nextpal(10^dpal); pal = nextpal(10^dpal);
} }
/* case: palindrome is even or ends in 5 */ /* case: palindrome is even or ends in 5 */
if (iseven(pal % 10) || (pal%10 == 10/2)) { if (iseven(pal % 10) || (pal%10 == 10/2)) {
/* /*
* we need to increase the bottom and top digits * we need to increase the bottom and top digits
* so that we have a chance to be prime * so that we have a chance to be prime
*/ */
pal += (1 + 10^(dpal-1)); pal += (1 + 10^(dpal-1));
} }
if (config("resource_debug") & 0x8) { if (config("resource_debug") & 0x8) {
print "DEBUG: nextprimepal:", pal; print "DEBUG: nextprimepal:", pal;
} }
} while (ptest(pal) == 0 && pal > 0); } while (ptest(pal) == 0 && pal > 0);
/* return palindrome that his (highly probable) prime or 0 */ /* return palindrome that his (highly probable) prime or 0 */
@@ -564,15 +564,15 @@ define nextprimepal(val)
* NOTE: We assume base 10 digits and place 1 is the units digit. * NOTE: We assume base 10 digits and place 1 is the units digit.
* *
* given: * given:
* val a value * val a value
* *
* returns: * returns:
* prev palindrome (highly probable) prime < val or 0 * prev palindrome (highly probable) prime < val or 0
*/ */
define prevprimepal(val) define prevprimepal(val)
{ {
local pal; /* palindrome test value */ local pal; /* palindrome test value */
local dpal; /* digits in pal */ local dpal; /* digits in pal */
/* /*
* pre-start over the previous palindrome * pre-start over the previous palindrome
@@ -584,56 +584,56 @@ define prevprimepal(val)
*/ */
do { do {
/* /*
* case: single digit values are always palindromes * case: single digit values are always palindromes
*/ */
if (val < 10) { if (val < 10) {
/* /*
* The prevcand() call will return 0 if there is no previous prime * The prevcand() call will return 0 if there is no previous prime
* such as the case when val < 2. * such as the case when val < 2.
*/ */
return prevcand(pal); return prevcand(pal);
} }
/* /*
* compute the previous palindrome * compute the previous palindrome
*/ */
pal = palprevpal(pal); pal = palprevpal(pal);
dpal = digits(pal); dpal = digits(pal);
/* case: 11 is the only prime palindrome with even digit count */ /* case: 11 is the only prime palindrome with even digit count */
if (pal == 11) { if (pal == 11) {
return 11; return 11;
} }
/* case: 2 digit palindrome and not 11 */ /* case: 2 digit palindrome and not 11 */
if (dpal == 2) { if (dpal == 2) {
return 7; return 7;
} }
/* case: even number of digits */ /* case: even number of digits */
if (iseven(dpal)) { if (iseven(dpal)) {
/* /*
* Except for 11 (which is handled above already), there are * Except for 11 (which is handled above already), there are
* no prime palindrome with even digits. So we need to * no prime palindrome with even digits. So we need to
* decrease the digit count and work with that smaller palindrome. * decrease the digit count and work with that smaller palindrome.
*/ */
pal = prevpal(10^(dpal-1)); pal = prevpal(10^(dpal-1));
} }
/* case: palindrome is even or ends in 5 */ /* case: palindrome is even or ends in 5 */
if (iseven(pal % 10) || (pal%10 == 10/2)) { if (iseven(pal % 10) || (pal%10 == 10/2)) {
/* /*
* we need to decrease the bottom and top digits * we need to decrease the bottom and top digits
* so that we have a chance to be prime * so that we have a chance to be prime
*/ */
pal -= (1 + 10^(dpal-1)); pal -= (1 + 10^(dpal-1));
} }
if (config("resource_debug") & 0x8) { if (config("resource_debug") & 0x8) {
print "DEBUG: prevprimepal:", pal; print "DEBUG: prevprimepal:", pal;
} }
} while (ptest(pal) == 0 && pal > 0); } while (ptest(pal) == 0 && pal > 0);
/* return palindrome that his (highly probable) prime or 0 */ /* return palindrome that his (highly probable) prime or 0 */

98
cal/pell.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:34 * Under source code control: 1990/02/15 01:50:34
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -31,60 +31,60 @@
define pell(D) define pell(D)
{ {
local X, Y; local X, Y;
X = pellx(D); X = pellx(D);
if (isnull(X)) { if (isnull(X)) {
print "D=":D:" is square"; print "D=":D:" is square";
return; return;
} }
Y = isqrt((X^2 - 1) / D); Y = isqrt((X^2 - 1) / D);
print X : "^2 - " : D : "*" : Y : "^2 = " : X^2 - D*Y^2; print X : "^2 - " : D : "*" : Y : "^2 = " : X^2 - D*Y^2;
} }
/* /*
* Function to solve Pell's equation * Function to solve Pell's equation
* Returns the solution X to: * Returns the solution X to:
* X^2 - D * Y^2 = 1 * X^2 - D * Y^2 = 1
*/ */
define pellx(D) define pellx(D)
{ {
local R, Rp, U, Up, V, Vp, A, T, Q1, Q2, n; local R, Rp, U, Up, V, Vp, A, T, Q1, Q2, n;
local mat ans[2,2]; local mat ans[2,2];
local mat tmp[2,2]; local mat tmp[2,2];
R = isqrt(D); R = isqrt(D);
Vp = D - R^2; Vp = D - R^2;
if (Vp == 0) if (Vp == 0)
return; return;
Rp = R + R; Rp = R + R;
U = Rp; U = Rp;
Up = U; Up = U;
V = 1; V = 1;
A = 0; A = 0;
n = 0; n = 0;
ans[0,0] = 1; ans[0,0] = 1;
ans[1,1] = 1; ans[1,1] = 1;
tmp[0,1] = 1; tmp[0,1] = 1;
tmp[1,0] = 1; tmp[1,0] = 1;
do { do {
T = V; T = V;
V = A * (Up - U) + Vp; V = A * (Up - U) + Vp;
Vp = T; Vp = T;
A = U // V; A = U // V;
Up = U; Up = U;
U = Rp - U % V; U = Rp - U % V;
tmp[0,0] = A; tmp[0,0] = A;
ans *= tmp; ans *= tmp;
n++; n++;
} while (A != Rp); } while (A != Rp);
Q2 = ans[[1]]; Q2 = ans[[1]];
Q1 = isqrt(Q2^2 * D + 1); Q1 = isqrt(Q2^2 * D + 1);
if (isodd(n)) { if (isodd(n)) {
T = Q1^2 + D * Q2^2; T = Q1^2 + D * Q2^2;
Q2 = Q1 * Q2 * 2; Q2 = Q1 * Q2 * 2;
Q1 = T; Q1 = T;
} }
return Q1; return Q1;
} }

178
cal/pi.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1991/05/22 21:56:37 * Under source code control: 1991/05/22 21:56:37
* File existed as early as: 1991 * File existed as early as: 1991
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -31,43 +31,43 @@
define qpi(epsilon) define qpi(epsilon)
{ {
local niter, yn, ym, tm, an, am, t, tn, sqrt2, epsilon2, count, digits; local niter, yn, ym, tm, an, am, t, tn, sqrt2, epsilon2, count, digits;
local bits, bits2; local bits, bits2;
if (isnull(epsilon)) if (isnull(epsilon))
epsilon = epsilon(); epsilon = epsilon();
digits = digits(1/epsilon); digits = digits(1/epsilon);
if (digits <= 8) { niter = 1; epsilon = 1e-8; } if (digits <= 8) { niter = 1; epsilon = 1e-8; }
else if (digits <= 40) { niter = 2; epsilon = 1e-40; } else if (digits <= 40) { niter = 2; epsilon = 1e-40; }
else if (digits <= 170) { niter = 3; epsilon = 1e-170; } else if (digits <= 170) { niter = 3; epsilon = 1e-170; }
else if (digits <= 693) { niter = 4; epsilon = 1e-693; } else if (digits <= 693) { niter = 4; epsilon = 1e-693; }
else { else {
niter = 4; niter = 4;
t = 693; t = 693;
while (t < digits) { while (t < digits) {
++niter; ++niter;
t *= 4; t *= 4;
} }
} }
epsilon2 = epsilon/(digits/10 + 1); epsilon2 = epsilon/(digits/10 + 1);
digits = digits(1/epsilon2); digits = digits(1/epsilon2);
sqrt2 = sqrt(2, epsilon2); sqrt2 = sqrt(2, epsilon2);
bits = abs(ilog2(epsilon)) + 1; bits = abs(ilog2(epsilon)) + 1;
bits2 = abs(ilog2(epsilon2)) + 1; bits2 = abs(ilog2(epsilon2)) + 1;
yn = sqrt2 - 1; yn = sqrt2 - 1;
an = 6 - 4 * sqrt2; an = 6 - 4 * sqrt2;
tn = 2; tn = 2;
for (count = 0; count < niter; ++count) { for (count = 0; count < niter; ++count) {
ym = yn; ym = yn;
am = an; am = an;
tn *= 4; tn *= 4;
t = sqrt(sqrt(1-ym^4, epsilon2), epsilon2); t = sqrt(sqrt(1-ym^4, epsilon2), epsilon2);
yn = (1-t)/(1+t); yn = (1-t)/(1+t);
an = (1+yn)^4*am-tn*yn*(1+yn+yn^2); an = (1+yn)^4*am-tn*yn*(1+yn+yn^2);
yn = bround(yn, bits2); yn = bround(yn, bits2);
an = bround(an, bits2); an = bround(an, bits2);
} }
return (bround(1/an, bits)); return (bround(1/an, bits));
} }
@@ -86,58 +86,58 @@ define qpi(epsilon)
define piforever() define piforever()
{ {
local k = 2; local k = 2;
local a = 4; local a = 4;
local b = 1; local b = 1;
local a1 = 12; local a1 = 12;
local b1 = 4; local b1 = 4;
local a2, b2, p, q, d, d1; local a2, b2, p, q, d, d1;
local stdout = files(1); local stdout = files(1);
local first = 1, row = -1, col = 0; local first = 1, row = -1, col = 0;
while (1) { while (1) {
/* /*
* Next approximation * Next approximation
*/ */
p = k * k; p = k * k;
q = k + ++k; q = k + ++k;
a2 = a; a2 = a;
b2 = b; b2 = b;
a = a1; a = a1;
a1 = p * a2 + q * a1; a1 = p * a2 + q * a1;
b = b1; b = b1;
b1 = p * b2 + q * b1; b1 = p * b2 + q * b1;
/* /*
* Print common digits * Print common digits
*/ */
d = a // b; d = a // b;
d1 = a1 // b1; d1 = a1 // b1;
while (d == d1) { while (d == d1) {
if (first) { if (first) {
printf("%d.", d); printf("%d.", d);
first = 0; first = 0;
} else { } else {
if (!(col % 50)) { if (!(col % 50)) {
printf("\n"); printf("\n");
col = 0; col = 0;
if (!(++row % 20)) { if (!(++row % 20)) {
printf("\n"); printf("\n");
row = 0; row = 0;
} }
} }
printf("%d", d); printf("%d", d);
if (!(++col % 10)) if (!(++col % 10))
printf(" "); printf(" ");
} }
a = 10 * (a % b); a = 10 * (a % b);
a1 = 10 * (a1 % b1); a1 = 10 * (a1 % b1);
d = a // b; d = a // b;
d1 = a1 // b1; d1 = a1 // b1;
} }
fflush(stdout); fflush(stdout);
} }
} }

66
cal/pix.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,51 +17,51 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/07/09 03:14:14 * Under source code control: 1996/07/09 03:14:14
* File existed as early as: 1996 * File existed as early as: 1996
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* Here is an iterative method of finding the number of primes less than * Here is an iterative method of finding the number of primes less than
* or equal to a given number. This method is from "Computer Recreations" * or equal to a given number. This method is from "Computer Recreations"
* June 1996 issue of Scientific American. * June 1996 issue of Scientific American.
* *
* NOTE: For reasonable values of x, the builtin function pix(x) is * NOTE: For reasonable values of x, the builtin function pix(x) is
* much faster. This code is provided because the method * much faster. This code is provided because the method
* is interesting. * is interesting.
*/ */
define pi_of_x(x) define pi_of_x(x)
{ {
local An; /* A(n) */ local An; /* A(n) */
local An1; /* A(n-1) */ local An1; /* A(n-1) */
local An2; /* A(n-2) */ local An2; /* A(n-2) */
local An3; /* A(n-3) */ local An3; /* A(n-3) */
local primes; /* number of primes found */ local primes; /* number of primes found */
local n; /* loop counter */ local n; /* loop counter */
/* /*
* setup * setup
*/ */
An1 = 2; An1 = 2;
An2 = 0; An2 = 0;
An3 = 3; An3 = 3;
primes = 1; primes = 1;
/* /*
* main A(n+1)=A(n-1)+A(n-2) sequence loop * main A(n+1)=A(n-1)+A(n-2) sequence loop
*/ */
for (n = 3; n < x; ++n) { for (n = 3; n < x; ++n) {
An = An2 + An3; An = An2 + An3;
An3 = An2; An3 = An2;
An2 = An1; An2 = An1;
An1 = An; An1 = An;
if (An % n == 0) if (An % n == 0)
++primes; ++primes;
} }
return primes; return primes;
} }

44
cal/pollard.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,32 +17,32 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1991/05/22 21:56:37 * Under source code control: 1991/05/22 21:56:37
* File existed as early as: 1991 * File existed as early as: 1991
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
define pfactor(N, B, ai, af) define pfactor(N, B, ai, af)
{ {
local a, k, i, d; local a, k, i, d;
if (isnull(B)) if (isnull(B))
B = 1000; B = 1000;
if (isnull(ai)) if (isnull(ai))
ai = 2; ai = 2;
if (isnull(af)) if (isnull(af))
af = ai + 20; af = ai + 20;
k = lcmfact(B); k = lcmfact(B);
d = lfactor(N, B); d = lfactor(N, B);
if (d > 1) if (d > 1)
return d; return d;
for (a = ai; a <= af; a++) { for (a = ai; a <= af; a++) {
i = pmod(a, k, N); i = pmod(a, k, N);
d = gcd(i - 1, N); d = gcd(i - 1, N);
if ((d > 1) && (d != N)) if ((d > 1) && (d != N))
return d; return d;
} }
return 1; return 1;
} }

1050
cal/poly.cal
View File

File diff suppressed because it is too large Load Diff

88
cal/prompt.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/12/18 04:43:25 * Under source code control: 1995/12/18 04:43:25
* File existed as early as: 1995 * File existed as early as: 1995
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -32,7 +32,7 @@
* entering "end", "exit" or "quit"; "end" returns to the level from * entering "end", "exit" or "quit"; "end" returns to the level from
* which adder() is called, e.g. with: * which adder() is called, e.g. with:
* *
* for (;;) adder() * for (;;) adder()
* *
* entering "end" would start a new edition with sum = 0; "quit" and * entering "end" would start a new edition with sum = 0; "quit" and
* "exit" return to the top level. * "exit" return to the top level.
@@ -43,25 +43,25 @@
* thus the string may include variables, assignments, functions, etc. * thus the string may include variables, assignments, functions, etc.
* as in: * as in:
* *
* 2 + 3 * 2 + 3
* x = 2 + 3, x^3 * x = 2 + 3, x^3
* x^2 * x^2
* local x = 2; while (x < 100) x *= 2; x % 100 * local x = 2; while (x < 100) x *= 2; x % 100
* x * x
* exp(2, 1e-5) * exp(2, 1e-5)
* sum * sum
* print sum^2; * print sum^2;
* 3; print sum^2; * 3; print sum^2;
* *
* (Here the second line creates x as a global variable; the local * (Here the second line creates x as a global variable; the local
* variable x in the fourth line has no effect on the global x. In * variable x in the fourth line has no effect on the global x. In
* the last three lines, sum is the sum of numbers already entered, so * the last three lines, sum is the sum of numbers already entered, so
* the third last line doubles the value of sum. The value returned * the third last line doubles the value of sum. The value returned
* by "print sum^2;" is the null value, so the second last line adds * by "print sum^2;" is the null value, so the second last line adds
* nothing to sum. The last line returns the value 3, i.e. the last * nothing to sum. The last line returns the value 3, i.e. the last
* non-null value found for the expressions separated by semicolons, * non-null value found for the expressions separated by semicolons,
* so sum will be increased by 3 after the "print sum^2;" command * so sum will be increased by 3 after the "print sum^2;" command
* is executed. XXX The terminating semicolon is essential in the * is executed. XXX The terminating semicolon is essential in the
* last two lines. A command like eval("print 7;") is acceptable to * last two lines. A command like eval("print 7;") is acceptable to
* calc but eval("print 7") causes an exit from calc. XXX) * calc but eval("print 7") causes an exit from calc. XXX)
* *
@@ -72,44 +72,44 @@
* *
* Calling showvalues(str) assumes str defines a function of x as in: * Calling showvalues(str) assumes str defines a function of x as in:
* *
* "sin(x)", "x^2 + 3*x", "exp(x, 1e-5)". * "sin(x)", "x^2 + 3*x", "exp(x, 1e-5)".
* *
* Values of the function so defined are returned for values of x * Values of the function so defined are returned for values of x
* entered in response to the ? prompt. Operation is terminated by * entered in response to the ? prompt. Operation is terminated by
* entering "end", "exit" or "quit". * entering "end", "exit" or "quit".
*/ */
define adder() { define adder() {
global sum = 0; global sum = 0;
local s, t; local s, t;
for (;;) { for (;;) {
s = prompt("? "); s = prompt("? ");
if (s == "end") if (s == "end")
break; break;
t = eval(s); t = eval(s);
if (!isnum(t)) { if (!isnum(t)) {
print "Please enter a number"; print "Please enter a number";
continue; continue;
} }
sum += t; sum += t;
print "\t":sum; print "\t":sum;
} }
} }
global prompt_x; global prompt_x;
define showvalues(str) { define showvalues(str) {
local s; local s;
for (;;) { for (;;) {
s = prompt("? "); s = prompt("? ");
if (s == "end") if (s == "end")
break; break;
prompt_x = eval(s); prompt_x = eval(s);
if (!isnum(prompt_x)) { if (!isnum(prompt_x)) {
print "Please enter a number"; print "Please enter a number";
continue; continue;
} }
print "\t":eval(str); print "\t":eval(str);
} }
} }

78
cal/psqrt.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:35 * Under source code control: 1990/02/15 01:50:35
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -31,40 +31,40 @@
define psqrt(u, p) define psqrt(u, p)
{ {
local p1, q, n, y, r, v, w, t, k; local p1, q, n, y, r, v, w, t, k;
p1 = p - 1; p1 = p - 1;
r = lowbit(p1); r = lowbit(p1);
q = p >> r; q = p >> r;
t = 1 << (r - 1); t = 1 << (r - 1);
for (n = 2; ; n++) { for (n = 2; ; n++) {
if (ptest(n, 1) == 0) if (ptest(n, 1) == 0)
continue; continue;
y = pmod(n, q, p); y = pmod(n, q, p);
k = pmod(y, t, p); k = pmod(y, t, p);
if (k == 1) if (k == 1)
continue; continue;
if (k != p1) if (k != p1)
return; return;
break; break;
} }
t = pmod(u, (q - 1) / 2, p); t = pmod(u, (q - 1) / 2, p);
v = (t * u) % p; v = (t * u) % p;
w = (t^2 * u) % p; w = (t^2 * u) % p;
while (w != 1) { while (w != 1) {
k = 0; k = 0;
t = w; t = w;
do { do {
k++; k++;
t = t^2 % p; t = t^2 % p;
} while (t != 1); } while (t != 1);
if (k == r) if (k == r)
return; return;
t = pmod(y, 1 << (r - k - 1), p); t = pmod(y, 1 << (r - k - 1), p);
y = t^2 % p; y = t^2 % p;
v = (v * t) % p; v = (v * t) % p;
w = (w * y) % p; w = (w * y) % p;
r = k; r = k;
} }
return min(v, p - v); return min(v, p - v);
} }

88
cal/qtime.cal
View File

@@ -12,7 +12,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -20,21 +20,21 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1999/10/13 04:10:33 * Under source code control: 1999/10/13 04:10:33
* File existed as early as: 1999 * File existed as early as: 1999
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* usage: * usage:
* qtime(utc_hr_offset) * qtime(utc_hr_offset)
* *
* utc_hr_offset Offset from UTC in hours. * utc_hr_offset Offset from UTC in hours.
* *
* See: * See:
* http://www.magnetic-ink.dk/download/qtime.html * http://www.magnetic-ink.dk/download/qtime.html
* *
* for examples of qtime() written on other languages. * for examples of qtime() written on other languages.
*/ */
@@ -45,42 +45,42 @@
*/ */
define qtime(utc_hr_offset) define qtime(utc_hr_offset)
{ {
static mat hr[12] = { static mat hr[12] = {
"twelve", "one", "two", "three", "four", "five", "twelve", "one", "two", "three", "four", "five",
"six", "seven", "eight", "nine", "ten", "eleven" "six", "seven", "eight", "nine", "ten", "eleven"
}; };
static mat mn[7] = { static mat mn[7] = {
"", "five ", "ten ", "a quarter ", "twenty ", "twenty-five ", "half " "", "five ", "ten ", "a quarter ", "twenty ", "twenty-five ", "half "
}; };
static mat ny[5] = { static mat ny[5] = {
"nearly ", "almost ", "", "just after ", "after " "nearly ", "almost ", "", "just after ", "after "
}; };
static mat up[3] = { static mat up[3] = {
"to ", "", "past " "to ", "", "past "
}; };
local adj_mins = (((time() + utc_hr_offset*3600) % 86400) + 30)//60+27; local adj_mins = (((time() + utc_hr_offset*3600) % 86400) + 30)//60+27;
local hours = (adj_mins // 60) % 12; local hours = (adj_mins // 60) % 12;
local minutes = adj_mins % 60; local minutes = adj_mins % 60;
local almost = minutes % 5; local almost = minutes % 5;
local divisions = (minutes // 5) - 5; local divisions = (minutes // 5) - 5;
local to_past_idx = divisions > 0 ? 1 : 0; local to_past_idx = divisions > 0 ? 1 : 0;
if (divisions < 0) { if (divisions < 0) {
divisions = -divisions; divisions = -divisions;
to_past_idx = -1; to_past_idx = -1;
} }
++to_past_idx; ++to_past_idx;
/* /*
* Print the English sentence * Print the English sentence
* *
* We avoid forward and back quotes just to show that the char() * We avoid forward and back quotes just to show that the char()
* builtin function can be used in conjunction with a printf. * builtin function can be used in conjunction with a printf.
*/ */
printf("It%cs %s%s%s%s", printf("It%cs %s%s%s%s",
char(0x27), ny[almost], mn[divisions], char(0x27), ny[almost], mn[divisions],
up[to_past_idx], hr[hours]); up[to_past_idx], hr[hours]);
if (divisions == 0) if (divisions == 0)
printf(" o%cclock", char(0x27)); printf(" o%cclock", char(0x27));
print "."; print ".";
} }

206
cal/quat.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,205 +17,205 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:35 * Under source code control: 1990/02/15 01:50:35
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* Routines to handle quaternions of the form: * Routines to handle quaternions of the form:
* a + bi + cj + dk * a + bi + cj + dk
* *
* Note: In this module, quaternians are manipulated in the form: * Note: In this module, quaternians are manipulated in the form:
* s + v * s + v
* Where s is a scalar and v is a vector of size 3. * Where s is a scalar and v is a vector of size 3.
*/ */
obj quat {s, v}; /* definition of the quaternion object */ obj quat {s, v}; /* definition of the quaternion object */
define quat(a,b,c,d) define quat(a,b,c,d)
{ {
local obj quat x; local obj quat x;
x.s = isnull(a) ? 0 : a; x.s = isnull(a) ? 0 : a;
mat x.v[3]; mat x.v[3];
x.v[0] = isnull(b) ? 0 : b; x.v[0] = isnull(b) ? 0 : b;
x.v[1] = isnull(c) ? 0 : c; x.v[1] = isnull(c) ? 0 : c;
x.v[2] = isnull(d) ? 0 : d; x.v[2] = isnull(d) ? 0 : d;
return x; return x;
} }
define quat_print(a) define quat_print(a)
{ {
print "quat(" : a.s : ", " : a.v[0] : ", " : print "quat(" : a.s : ", " : a.v[0] : ", " :
a.v[1] : ", " : a.v[2] : ")" :; a.v[1] : ", " : a.v[2] : ")" :;
} }
define quat_norm(a) define quat_norm(a)
{ {
return a.s^2 + dp(a.v, a.v); return a.s^2 + dp(a.v, a.v);
} }
define quat_abs(a, e) define quat_abs(a, e)
{ {
return sqrt(a.s^2 + dp(a.v, a.v), e); return sqrt(a.s^2 + dp(a.v, a.v), e);
} }
define quat_conj(a) define quat_conj(a)
{ {
local obj quat x; local obj quat x;
x.s = a.s; x.s = a.s;
x.v = -a.v; x.v = -a.v;
return x; return x;
} }
define quat_add(a, b) define quat_add(a, b)
{ {
local obj quat x; local obj quat x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.s = a.s + b; x.s = a.s + b;
x.v = a.v; x.v = a.v;
return x; return x;
} }
if (!istype(a, x)) { if (!istype(a, x)) {
x.s = a + b.s; x.s = a + b.s;
x.v = b.v; x.v = b.v;
return x; return x;
} }
x.s = a.s + b.s; x.s = a.s + b.s;
x.v = a.v + b.v; x.v = a.v + b.v;
if (x.v) if (x.v)
return x; return x;
return x.s; return x.s;
} }
define quat_sub(a, b) define quat_sub(a, b)
{ {
local obj quat x; local obj quat x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.s = a.s - b; x.s = a.s - b;
x.v = a.v; x.v = a.v;
return x; return x;
} }
if (!istype(a, x)) { if (!istype(a, x)) {
x.s = a - b.s; x.s = a - b.s;
x.v = -b.v; x.v = -b.v;
return x; return x;
} }
x.s = a.s - b.s; x.s = a.s - b.s;
x.v = a.v - b.v; x.v = a.v - b.v;
if (x.v) if (x.v)
return x; return x;
return x.s; return x.s;
} }
define quat_inc(a) define quat_inc(a)
{ {
local x; local x;
x = a; x = a;
x.s++; x.s++;
return x; return x;
} }
define quat_dec(a) define quat_dec(a)
{ {
local x; local x;
x = a; x = a;
x.s--; x.s--;
return x; return x;
} }
define quat_neg(a) define quat_neg(a)
{ {
local obj quat x; local obj quat x;
x.s = -a.s; x.s = -a.s;
x.v = -a.v; x.v = -a.v;
return x; return x;
} }
define quat_mul(a, b) define quat_mul(a, b)
{ {
local obj quat x; local obj quat x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.s = a.s * b; x.s = a.s * b;
x.v = a.v * b; x.v = a.v * b;
} else if (!istype(a, x)) { } else if (!istype(a, x)) {
x.s = b.s * a; x.s = b.s * a;
x.v = b.v * a; x.v = b.v * a;
} else { } else {
x.s = a.s * b.s - dp(a.v, b.v); x.s = a.s * b.s - dp(a.v, b.v);
x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v); x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v);
} }
if (x.v) if (x.v)
return x; return x;
return x.s; return x.s;
} }
define quat_div(a, b) define quat_div(a, b)
{ {
local obj quat x; local obj quat x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.s = a.s / b; x.s = a.s / b;
x.v = a.v / b; x.v = a.v / b;
return x; return x;
} }
return a * quat_inv(b); return a * quat_inv(b);
} }
define quat_inv(a) define quat_inv(a)
{ {
local x, q2; local x, q2;
obj quat x; obj quat x;
q2 = a.s^2 + dp(a.v, a.v); q2 = a.s^2 + dp(a.v, a.v);
x.s = a.s / q2; x.s = a.s / q2;
x.v = a.v / (-q2); x.v = a.v / (-q2);
return x; return x;
} }
define quat_scale(a, b) define quat_scale(a, b)
{ {
local obj quat x; local obj quat x;
x.s = scale(a.s, b); x.s = scale(a.s, b);
x.v = scale(a.v, b); x.v = scale(a.v, b);
return x; return x;
} }
define quat_shift(a, b) define quat_shift(a, b)
{ {
local obj quat x; local obj quat x;
x.s = a.s << b; x.s = a.s << b;
x.v = a.v << b; x.v = a.v << b;
if (x.v) if (x.v)
return x; return x;
return x.s; return x.s;
} }
if (config("resource_debug") & 3) { if (config("resource_debug") & 3) {

88
cal/randbitrun.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/02/13 03:43:11 * Under source code control: 1995/02/13 03:43:11
* File existed as early as: 1995 * File existed as early as: 1995
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -32,30 +32,30 @@
define randbitrun(run_cnt) define randbitrun(run_cnt)
{ {
local i; /* index */ local i; /* index */
local max_run; /* longest run */ local max_run; /* longest run */
local long_run_cnt; /* number of runs longer than MAX_RUN */ local long_run_cnt; /* number of runs longer than MAX_RUN */
local run; /* current run length */ local run; /* current run length */
local tally_sum; /* sum of all tally values */ local tally_sum; /* sum of all tally values */
local last; /* last random number */ local last; /* last random number */
local current; /* current random number */ local current; /* current random number */
local MAX_RUN = 18; /* max run we will keep track of */ local MAX_RUN = 18; /* max run we will keep track of */
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */ local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */ local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
/* /*
* parse args * parse args
*/ */
if (param(0) == 0) { if (param(0) == 0) {
run_cnt = 65536; run_cnt = 65536;
} }
/* /*
* run setup * run setup
*/ */
max_run = 0; /* no runs yet */ max_run = 0; /* no runs yet */
long_run_cnt = 0; /* no long runs set */ long_run_cnt = 0; /* no long runs set */
current = randbit(1); /* our first number */ current = randbit(1); /* our first number */
run = 1; run = 1;
/* /*
@@ -63,10 +63,10 @@ define randbitrun(run_cnt)
* *
* A bit run length of 'r' occurs with a probability of: * A bit run length of 'r' occurs with a probability of:
* *
* 1/2^n; * 1/2^n;
*/ */
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
prob[i] = 1.0/(1<<i); prob[i] = 1.0/(1<<i);
} }
/* /*
@@ -74,31 +74,31 @@ define randbitrun(run_cnt)
*/ */
for (i=0; i < run_cnt; ++i) { for (i=0; i < run_cnt; ++i) {
/* get our current number */ /* get our current number */
last = current; last = current;
current = randbit(1); current = randbit(1);
/* look for a run break */ /* look for a run break */
if (current != last) { if (current != last) {
/* record the stats */ /* record the stats */
if (run > max_run) { if (run > max_run) {
max_run = run; max_run = run;
} }
if (run > MAX_RUN) { if (run > MAX_RUN) {
++long_run_cnt; ++long_run_cnt;
} else { } else {
++tally[run]; ++tally[run];
} }
/* start a new run */ /* start a new run */
current = randbit(1); current = randbit(1);
run = 1; run = 1;
/* note the continuing run */ /* note the continuing run */
} else { } else {
++run; ++run;
} }
} }
/* determine the number of runs found */ /* determine the number of runs found */
tally_sum = matsum(tally) + long_run_cnt; tally_sum = matsum(tally) + long_run_cnt;
@@ -109,9 +109,9 @@ define randbitrun(run_cnt)
printf("rand runbit test used %d values to produce %d runs\n", printf("rand runbit test used %d values to produce %d runs\n",
run_cnt, tally_sum); run_cnt, tally_sum);
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n", printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
i, prob[i], round(tally_sum*prob[i]), tally[i], i, prob[i], round(tally_sum*prob[i]), tally[i],
(tally[i] - round(tally_sum*prob[i]))/tally_sum); (tally[i] - round(tally_sum*prob[i]))/tally_sum);
} }
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt); printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
printf("max length=%d\n", max_run); printf("max length=%d\n", max_run);

108
cal/randmprime.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1994/03/14 23:11:21 * Under source code control: 1994/03/14 23:11:21
* File existed as early as: 1994 * File existed as early as: 1994
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -32,37 +32,37 @@ read -once "lucas.cal"
* randmprime - find a random prime of the form h*2^n-1 of a given size * randmprime - find a random prime of the form h*2^n-1 of a given size
* *
* given: * given:
* bits minimum bits in prime to return * bits minimum bits in prime to return
* seed random seed for srandom() * seed random seed for srandom()
* [dbg] if given, enable debugging * [dbg] if given, enable debugging
* *
* returns: * returns:
* a prime of the form h*2^n-1 * a prime of the form h*2^n-1
*/ */
define define
randmprime(bits, seed, dbg) randmprime(bits, seed, dbg)
{ {
local n; /* n as in h*2^n-1 */ local n; /* n as in h*2^n-1 */
local h; /* h as in h*2^n-1 */ local h; /* h as in h*2^n-1 */
local plush; /* value added to h since the beginning */ local plush; /* value added to h since the beginning */
local init; /* initial CPU time */ local init; /* initial CPU time */
local start; /* CPU time before last test */ local start; /* CPU time before last test */
local stop; /* CPU time after last test */ local stop; /* CPU time after last test */
local tmp; /* just a tmp place holder value */ local tmp; /* just a tmp place holder value */
local ret; /* h*2^n-1 that is prime */ local ret; /* h*2^n-1 that is prime */
/* firewall */ /* firewall */
if (param(0) < 2 || param(0) > 3) { if (param(0) < 2 || param(0) > 3) {
quit "bad usage: rndprime(dig, seed [,dbg])"; quit "bad usage: rndprime(dig, seed [,dbg])";
} }
if (!isint(bits) || bits < 0 || !isint(seed) || seed < 0) { if (!isint(bits) || bits < 0 || !isint(seed) || seed < 0) {
quit "args must be non-negative integers"; quit "args must be non-negative integers";
} }
if (bits < 1) { if (bits < 1) {
bits = 1; bits = 1;
} }
if (param(0) == 2 || dbg < 0) { if (param(0) == 2 || dbg < 0) {
dbg = 0; dbg = 0;
} }
/* seed generator */ /* seed generator */
@@ -76,57 +76,57 @@ randmprime(bits, seed, dbg)
++n; ++n;
} }
if (dbg >= 1) { if (dbg >= 1) {
print "DEBUG3: initial h =", h; print "DEBUG3: initial h =", h;
print "DEBUG3: initial n =", n; print "DEBUG3: initial n =", n;
} }
/* /*
* loop until we find a prime * loop until we find a prime
*/ */
if (dbg >= 1) { if (dbg >= 1) {
start = usertime(); start = usertime();
init = usertime(); init = usertime();
plush = 0; plush = 0;
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1"; print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
} }
while (lucas(h,n) == 0) { while (lucas(h,n) == 0) {
/* bump h, and n if needed */ /* bump h, and n if needed */
if (dbg >= 2) { if (dbg >= 2) {
stop = usertime(); stop = usertime();
print "DEBUG2: last test:", stop-start, " total time:", stop-init; print "DEBUG2: last test:", stop-start, " total time:", stop-init;
} }
if (dbg >= 1) { if (dbg >= 1) {
print "DEBUG1: composite: (h+" : plush : ")*2^" : n : "-1"; print "DEBUG1: composite: (h+" : plush : ")*2^" : n : "-1";
plush += 2; plush += 2;
} }
h += 2; h += 2;
while (highbit(h) >= n) { while (highbit(h) >= n) {
++n; ++n;
} }
if (dbg >= 1) { if (dbg >= 1) {
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1"; print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
start = stop; start = stop;
} }
} }
/* found a prime */ /* found a prime */
if (dbg >= 2) { if (dbg >= 2) {
stop = usertime(); stop = usertime();
print "DEBUG2: last test:", stop-start, " total time:", stop-init; print "DEBUG2: last test:", stop-start, " total time:", stop-init;
print "DEBUG3: " : h : "*2^" : n : "-1 is prime"; print "DEBUG3: " : h : "*2^" : n : "-1 is prime";
} }
if (dbg >= 1) { if (dbg >= 1) {
print "DEBUG1: prime: (h+" : plush : ")*2^" : n : "-1"; print "DEBUG1: prime: (h+" : plush : ")*2^" : n : "-1";
} }
ret = h*2^n-1; ret = h*2^n-1;
if (dbg >= 3) { if (dbg >= 3) {
print "DEBUG3: highbit(h):", highbit(h); print "DEBUG3: highbit(h):", highbit(h);
print "DEBUG3: digits(h):", digits(h); print "DEBUG3: digits(h):", digits(h);
print "DEBUG3: highbit(n):", highbit(n); print "DEBUG3: highbit(n):", highbit(n);
print "DEBUG3: digits(2^n):", int(n*ln(10)/ln(2)+1); print "DEBUG3: digits(2^n):", int(n*ln(10)/ln(2)+1);
print "DEBUG3: highbit(h*2^n-1):", highbit(ret); print "DEBUG3: highbit(h*2^n-1):", highbit(ret);
print "DEBUG3: digits(h*2^n)-1:", digits(ret); print "DEBUG3: digits(h*2^n)-1:", digits(ret);
} }
return ret; return ret;
} }

88
cal/randombitrun.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/02/13 03:43:11 * Under source code control: 1995/02/13 03:43:11
* File existed as early as: 1995 * File existed as early as: 1995
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -32,30 +32,30 @@
define randombitrun(run_cnt) define randombitrun(run_cnt)
{ {
local i; /* index */ local i; /* index */
local max_run; /* longest run */ local max_run; /* longest run */
local long_run_cnt; /* number of runs longer than MAX_RUN */ local long_run_cnt; /* number of runs longer than MAX_RUN */
local run; /* current run length */ local run; /* current run length */
local tally_sum; /* sum of all tally values */ local tally_sum; /* sum of all tally values */
local last; /* last random number */ local last; /* last random number */
local current; /* current random number */ local current; /* current random number */
local MAX_RUN = 18; /* max run we will keep track of */ local MAX_RUN = 18; /* max run we will keep track of */
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */ local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */ local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
/* /*
* parse args * parse args
*/ */
if (param(0) == 0) { if (param(0) == 0) {
run_cnt = 65536; run_cnt = 65536;
} }
/* /*
* run setup * run setup
*/ */
max_run = 0; /* no runs yet */ max_run = 0; /* no runs yet */
long_run_cnt = 0; /* no long runs set */ long_run_cnt = 0; /* no long runs set */
current = randombit(1); /* our first number */ current = randombit(1); /* our first number */
run = 1; run = 1;
/* /*
@@ -63,10 +63,10 @@ define randombitrun(run_cnt)
* *
* A bit run length of 'r' occurs with a probability of: * A bit run length of 'r' occurs with a probability of:
* *
* 1/2^n; * 1/2^n;
*/ */
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
prob[i] = 1.0/(1<<i); prob[i] = 1.0/(1<<i);
} }
/* /*
@@ -74,31 +74,31 @@ define randombitrun(run_cnt)
*/ */
for (i=0; i < run_cnt; ++i) { for (i=0; i < run_cnt; ++i) {
/* get our current number */ /* get our current number */
last = current; last = current;
current = randombit(1); current = randombit(1);
/* look for a run break */ /* look for a run break */
if (current != last) { if (current != last) {
/* record the stats */ /* record the stats */
if (run > max_run) { if (run > max_run) {
max_run = run; max_run = run;
} }
if (run > MAX_RUN) { if (run > MAX_RUN) {
++long_run_cnt; ++long_run_cnt;
} else { } else {
++tally[run]; ++tally[run];
} }
/* start a new run */ /* start a new run */
current = randombit(1); current = randombit(1);
run = 1; run = 1;
/* note the continuing run */ /* note the continuing run */
} else { } else {
++run; ++run;
} }
} }
/* determine the number of runs found */ /* determine the number of runs found */
tally_sum = matsum(tally) + long_run_cnt; tally_sum = matsum(tally) + long_run_cnt;
@@ -109,9 +109,9 @@ define randombitrun(run_cnt)
printf("random runbit test used %d values to produce %d runs\n", printf("random runbit test used %d values to produce %d runs\n",
run_cnt, tally_sum); run_cnt, tally_sum);
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n", printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
i, prob[i], round(tally_sum*prob[i]), tally[i], i, prob[i], round(tally_sum*prob[i]), tally[i],
(tally[i] - round(tally_sum*prob[i]))/tally_sum); (tally[i] - round(tally_sum*prob[i]))/tally_sum);
} }
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt); printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
printf("max length=%d\n", max_run); printf("max length=%d\n", max_run);

88
cal/randomrun.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1997/02/19 03:35:59 * Under source code control: 1997/02/19 03:35:59
* File existed as early as: 1997 * File existed as early as: 1997
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -41,30 +41,30 @@
define randomrun(run_cnt) define randomrun(run_cnt)
{ {
local i; /* index */ local i; /* index */
local max_run; /* longest run */ local max_run; /* longest run */
local long_run_cnt; /* number of runs longer than MAX_RUN */ local long_run_cnt; /* number of runs longer than MAX_RUN */
local run; /* current run length */ local run; /* current run length */
local tally_sum; /* sum of all tally values */ local tally_sum; /* sum of all tally values */
local last; /* last random number */ local last; /* last random number */
local current; /* current random number */ local current; /* current random number */
local MAX_RUN = 9; /* max run we will keep track of */ local MAX_RUN = 9; /* max run we will keep track of */
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */ local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */ local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
/* /*
* parse args * parse args
*/ */
if (param(0) == 0) { if (param(0) == 0) {
run_cnt = 65536; run_cnt = 65536;
} }
/* /*
* run setup * run setup
*/ */
max_run = 0; /* no runs yet */ max_run = 0; /* no runs yet */
long_run_cnt = 0; /* no long runs set */ long_run_cnt = 0; /* no long runs set */
current = random(); /* our first number */ current = random(); /* our first number */
run = 1; run = 1;
/* /*
@@ -72,10 +72,10 @@ define randomrun(run_cnt)
* *
* A run length of 'r' occurs with a probability of: * A run length of 'r' occurs with a probability of:
* *
* 1/r! - 1/(r+1)! * 1/r! - 1/(r+1)!
*/ */
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
prob[i] = 1.0/fact(i) - 1.0/fact(i+1); prob[i] = 1.0/fact(i) - 1.0/fact(i+1);
} }
/* /*
@@ -83,31 +83,31 @@ define randomrun(run_cnt)
*/ */
for (i=0; i < run_cnt; ++i) { for (i=0; i < run_cnt; ++i) {
/* get our current number */ /* get our current number */
last = current; last = current;
current = random(); current = random();
/* look for a run break */ /* look for a run break */
if (current < last) { if (current < last) {
/* record the stats */ /* record the stats */
if (run > max_run) { if (run > max_run) {
max_run = run; max_run = run;
} }
if (run > MAX_RUN) { if (run > MAX_RUN) {
++long_run_cnt; ++long_run_cnt;
} else { } else {
++tally[run]; ++tally[run];
} }
/* start a new run */ /* start a new run */
current = random(); current = random();
run = 1; run = 1;
/* note the continuing run */ /* note the continuing run */
} else { } else {
++run; ++run;
} }
} }
/* determine the number of runs found */ /* determine the number of runs found */
tally_sum = matsum(tally) + long_run_cnt; tally_sum = matsum(tally) + long_run_cnt;
@@ -118,9 +118,9 @@ define randomrun(run_cnt)
printf("random run test used %d values to produce %d runs\n", printf("random run test used %d values to produce %d runs\n",
run_cnt, tally_sum); run_cnt, tally_sum);
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n", printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
i, prob[i], round(tally_sum*prob[i]), tally[i], i, prob[i], round(tally_sum*prob[i]), tally[i],
(tally[i] - round(tally_sum*prob[i]))/tally_sum); (tally[i] - round(tally_sum*prob[i]))/tally_sum);
} }
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt); printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
printf("max length=%d\n", max_run); printf("max length=%d\n", max_run);

86
cal/randrun.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/02/12 20:00:06 * Under source code control: 1995/02/12 20:00:06
* File existed as early as: 1995 * File existed as early as: 1995
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -40,30 +40,30 @@
define randrun(run_cnt) define randrun(run_cnt)
{ {
local i; /* index */ local i; /* index */
local max_run; /* longest run */ local max_run; /* longest run */
local long_run_cnt; /* number of runs longer than MAX_RUN */ local long_run_cnt; /* number of runs longer than MAX_RUN */
local run; /* current run length */ local run; /* current run length */
local tally_sum; /* sum of all tally values */ local tally_sum; /* sum of all tally values */
local last; /* last random number */ local last; /* last random number */
local current; /* current random number */ local current; /* current random number */
local MAX_RUN = 9; /* max run we will keep track of */ local MAX_RUN = 9; /* max run we will keep track of */
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */ local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */ local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
/* /*
* parse args * parse args
*/ */
if (param(0) == 0) { if (param(0) == 0) {
run_cnt = 65536; run_cnt = 65536;
} }
/* /*
* run setup * run setup
*/ */
max_run = 0; /* no runs yet */ max_run = 0; /* no runs yet */
long_run_cnt = 0; /* no long runs set */ long_run_cnt = 0; /* no long runs set */
current = rand(); /* our first number */ current = rand(); /* our first number */
run = 1; run = 1;
/* /*
@@ -71,10 +71,10 @@ define randrun(run_cnt)
* *
* A run length of 'r' occurs with a probability of: * A run length of 'r' occurs with a probability of:
* *
* 1/r! - 1/(r+1)! * 1/r! - 1/(r+1)!
*/ */
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
prob[i] = 1.0/fact(i) - 1.0/fact(i+1); prob[i] = 1.0/fact(i) - 1.0/fact(i+1);
} }
/* /*
@@ -82,31 +82,31 @@ define randrun(run_cnt)
*/ */
for (i=0; i < run_cnt; ++i) { for (i=0; i < run_cnt; ++i) {
/* get our current number */ /* get our current number */
last = current; last = current;
current = rand(); current = rand();
/* look for a run break */ /* look for a run break */
if (current < last) { if (current < last) {
/* record the stats */ /* record the stats */
if (run > max_run) { if (run > max_run) {
max_run = run; max_run = run;
} }
if (run > MAX_RUN) { if (run > MAX_RUN) {
++long_run_cnt; ++long_run_cnt;
} else { } else {
++tally[run]; ++tally[run];
} }
/* start a new run */ /* start a new run */
current = rand(); current = rand();
run = 1; run = 1;
/* note the continuing run */ /* note the continuing run */
} else { } else {
++run; ++run;
} }
} }
/* determine the number of runs found */ /* determine the number of runs found */
tally_sum = matsum(tally) + long_run_cnt; tally_sum = matsum(tally) + long_run_cnt;
@@ -117,9 +117,9 @@ define randrun(run_cnt)
printf("rand run test used %d values to produce %d runs\n", printf("rand run test used %d values to produce %d runs\n",
run_cnt, tally_sum); run_cnt, tally_sum);
for (i=1; i <= MAX_RUN; ++i) { for (i=1; i <= MAX_RUN; ++i) {
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n", printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
i, prob[i], round(tally_sum*prob[i]), tally[i], i, prob[i], round(tally_sum*prob[i]), tally[i],
(tally[i] - round(tally_sum*prob[i]))/tally_sum); (tally[i] - round(tally_sum*prob[i]))/tally_sum);
} }
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt); printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
printf("max length=%d\n", max_run); printf("max length=%d\n", max_run);

15746
cal/regress.cal
View File

File diff suppressed because it is too large Load Diff

18
cal/repeat.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2003/01/05 00:00:01 * Under source code control: 2003/01/05 00:00:01
* File existed as early as: 2003 * File existed as early as: 2003
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -29,18 +29,18 @@
* repeat - return the value of a repeated set of digits * repeat - return the value of a repeated set of digits
* *
* usage: * usage:
* repeat(digit_set, repeat_count) * repeat(digit_set, repeat_count)
*/ */
define repeat(digit_set, repeat_count) define repeat(digit_set, repeat_count)
{ {
local digit_count; /* digits in the digit_set */ local digit_count; /* digits in the digit_set */
/* firewall */ /* firewall */
if (!isint(digit_set) || digit_set <= 0) { if (!isint(digit_set) || digit_set <= 0) {
quit "digit set must be an integer > 0"; quit "digit set must be an integer > 0";
} }
if (!isint(repeat_count) || repeat_count <= 0) { if (!isint(repeat_count) || repeat_count <= 0) {
quit "repeat count must be an integer > 0"; quit "repeat count must be an integer > 0";
} }
/* return repeated set of digits */ /* return repeated set of digits */

6
cal/screen.cal
View File

@@ -6,7 +6,7 @@
* This file is not covered under version 2.1 of the GNU LGPL. * This file is not covered under version 2.1 of the GNU LGPL.
* This file is covered under "The unlicense": * This file is covered under "The unlicense":
* *
* https://unlicense.org * https://unlicense.org
* *
* In particular: * In particular:
* *
@@ -35,8 +35,8 @@
* *
* For more information, please refer to <http://unlicense.org/> * For more information, please refer to <http://unlicense.org/>
* *
* Under source code control: 2006/03/08 05:54:09 * Under source code control: 2006/03/08 05:54:09
* File existed as early as: 2006 * File existed as early as: 2006
*/ */
up = CUU ="\e[A"; up = CUU ="\e[A";

204
cal/seedrandom.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,18 +17,18 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/01/01 08:21:00 * Under source code control: 1996/01/01 08:21:00
* File existed as early as: 1996 * File existed as early as: 1996
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* The period of Blum generators with modulus 'n=p*q' (where p and * The period of Blum generators with modulus 'n=p*q' (where p and
* q are primes 3 mod 4) is: * q are primes 3 mod 4) is:
* *
* lambda(n) = lcm(factors of p-1 & q-1) * lambda(n) = lcm(factors of p-1 & q-1)
* *
* One can construct a generator with a maximal period when * One can construct a generator with a maximal period when
* 'p' and 'q' have the fewest possible factors in common. * 'p' and 'q' have the fewest possible factors in common.
@@ -38,118 +38,118 @@
* such primes. * such primes.
* *
* given: * given:
* seed1 - a large random value (at least 10^20 and perhaps < 10^314) * seed1 - a large random value (at least 10^20 and perhaps < 10^314)
* seed2 - a large random value (at least 10^20 and perhaps < 10^314) * seed2 - a large random value (at least 10^20 and perhaps < 10^314)
* size - min Blum modulus as a power of 2 (at least 32, perhaps >= 512) * size - min Blum modulus as a power of 2 (at least 32, perhaps >= 512)
* trials - number of ptest() trials (default 25) * trials - number of ptest() trials (default 25)
* *
* returns: * returns:
* the previous random state * the previous random state
* *
* NOTE: The [10^20, 10^314) range comes from the fact that the 13th internal * NOTE: The [10^20, 10^314) range comes from the fact that the 13th internal
* modulus is ~10^315. We want the lower bound seed to be reasonably big. * modulus is ~10^315. We want the lower bound seed to be reasonably big.
*/ */
define seedrandom(seed1, seed2, size, trials) define seedrandom(seed1, seed2, size, trials)
{ {
local p; /* first Blum prime */ local p; /* first Blum prime */
local fp; /* prime co-factor of p-1 */ local fp; /* prime co-factor of p-1 */
local sp; /* min bit size of p */ local sp; /* min bit size of p */
local q; /* second Blum prime */ local q; /* second Blum prime */
local fq; /* prime co-factor of q-1 */ local fq; /* prime co-factor of q-1 */
local sq; /* min bit size of q */ local sq; /* min bit size of q */
local n; /* Blum modulus */ local n; /* Blum modulus */
local binsize; /* smallest power of 2 > n=p*q */ local binsize; /* smallest power of 2 > n=p*q */
local r; /* initial quadratic residue */ local r; /* initial quadratic residue */
local random_state; /* the initial rand state */ local random_state; /* the initial rand state */
local random_junk; /* rand state that is not needed */ local random_junk; /* rand state that is not needed */
local old_state; /* old random state to return */ local old_state; /* old random state to return */
/* /*
* firewall * firewall
*/ */
if (!isint(seed1)) { if (!isint(seed1)) {
quit "1st arg (seed1) is not an int"; quit "1st arg (seed1) is not an int";
} }
if (!isint(seed2)) { if (!isint(seed2)) {
quit "2nd arg (seed2) is not an int"; quit "2nd arg (seed2) is not an int";
} }
if (!isint(size)) { if (!isint(size)) {
quit "3rd arg (size) is not an int"; quit "3rd arg (size) is not an int";
} }
if (!isint(trials)) { if (!isint(trials)) {
trials = 25; trials = 25;
} }
if (digits(seed1) <= 20) { if (digits(seed1) <= 20) {
quit "1st arg (seed1) must be > 10^20 and perhaps < 10^314"; quit "1st arg (seed1) must be > 10^20 and perhaps < 10^314";
} }
if (digits(seed2) <= 20) { if (digits(seed2) <= 20) {
quit "2nd arg (seed2) must be > 10^20 and perhaps < 10^314"; quit "2nd arg (seed2) must be > 10^20 and perhaps < 10^314";
} }
if (size < 32) { if (size < 32) {
quit "3rd arg (size) needs to be >= 32 (perhaps >= 512)"; quit "3rd arg (size) needs to be >= 32 (perhaps >= 512)";
} }
if (trials < 1) { if (trials < 1) {
quit "4th arg (trials) must be > 0"; quit "4th arg (trials) must be > 0";
} }
/* /*
* determine the search parameters * determine the search parameters
*/ */
++size; /* convert power of 2 to bit length */ ++size; /* convert power of 2 to bit length */
sp = int((size/2)-(size*0.03)+1); sp = int((size/2)-(size*0.03)+1);
sq = size - sp; sq = size - sp;
/* /*
* find the first Blum prime * find the first Blum prime
*/ */
random_state = srandom(seed1, 13); random_state = srandom(seed1, 13);
do { do {
do { do {
fp = nextcand(2^sp+randombit(sp), 1, 1, 3, 4); fp = nextcand(2^sp+randombit(sp), 1, 1, 3, 4);
p = 2*fp+1; p = 2*fp+1;
} while (ptest(p,1,0) == 0); } while (ptest(p,1,0) == 0);
} while(ptest(p, trials) == 0 || ptest(fp, trials) == 0); } while(ptest(p, trials) == 0 || ptest(fp, trials) == 0);
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "/* 1st Blum prime */ p=", p; print "/* 1st Blum prime */ p=", p;
} }
/* /*
* find the 2nd Blum prime * find the 2nd Blum prime
*/ */
random_junk = srandom(seed2, 13); random_junk = srandom(seed2, 13);
do { do {
do { do {
fq = nextcand(2^sq+randombit(sq), 1, 1, 3, 4); fq = nextcand(2^sq+randombit(sq), 1, 1, 3, 4);
q = 2*fq+1; q = 2*fq+1;
} while (ptest(q,1,0) == 0); } while (ptest(q,1,0) == 0);
} while(ptest(q, trials) == 0 || ptest(fq, trials) == 0); } while(ptest(q, trials) == 0 || ptest(fq, trials) == 0);
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "/* 2nd Blum prime */ q=", q; print "/* 2nd Blum prime */ q=", q;
} }
/* /*
* seed the Blum generator * seed the Blum generator
*/ */
n = p*q; /* the Blum modulus */ n = p*q; /* the Blum modulus */
binsize = highbit(n)+1; /* smallest power of 2 > p*q */ binsize = highbit(n)+1; /* smallest power of 2 > p*q */
r = pmod(rand(1<<ceil(binsize*4/5), 1<<(binsize-2)), 2, n); r = pmod(rand(1<<ceil(binsize*4/5), 1<<(binsize-2)), 2, n);
if (config("resource_debug") & 8) { if (config("resource_debug") & 8) {
print "/* seed quadratic residue */ r=", r; print "/* seed quadratic residue */ r=", r;
print "/* newn", binsize, "bit quadratic residue*/ newn=", n; print "/* newn", binsize, "bit quadratic residue*/ newn=", n;
} }
old_state = srandom(r, n); old_state = srandom(r, n);
/* /*
* restore other states that we altered * restore other states that we altered
*/ */
random_junk = srandom(random_state); random_junk = srandom(random_state);
/* /*
* return the previous random state * return the previous random state
*/ */
return old_state; return old_state;
} }
if (config("resource_debug") & 3) { if (config("resource_debug") & 3) {

88
cal/set8700.line
View File

@@ -9,7 +9,7 @@
## ##
## Calc is distributed in the hope that it will be useful, but WITHOUT ## Calc is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General ## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
## Public License for more details. ## Public License for more details.
## ##
## A copy of version 2.1 of the GNU Lesser General Public License is ## A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
## received a copy with calc; if not, write to Free Software Foundation, Inc. ## received a copy with calc; if not, write to Free Software Foundation, Inc.
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
## ##
## Under source code control: 2006/05/20 14:10:11 ## Under source code control: 2006/05/20 14:10:11
## File existed as early as: 2006 ## File existed as early as: 2006
## ##
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/ ## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ ## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
strcpy("", "") == "" strcpy("", "") == ""
@@ -49,7 +49,7 @@ strncpy("ab", "xyz", 3) == "xy"
strcmp("", "") == 0 strcmp("", "") == 0
strcmp("", "a") == -1 strcmp("", "a") == -1
strcmp("\n", "\n") == 0 strcmp("\n", "\n") == 0
strcmp("\0", "") == 1 ## '\0' treated like other characters strcmp("\0", "") == 1 ## '\0' treated like other characters
strcmp("ab", "") == 1 strcmp("ab", "") == 1
strcmp("ab", "a") == 1 strcmp("ab", "a") == 1
strcmp("ab", "ab") == 0 strcmp("ab", "ab") == 0
@@ -123,15 +123,15 @@ substr("abcd",5,1) == ""
substr("a\0c\0",2,2) == "\0c" ## '\0' treated like other characters substr("a\0c\0",2,2) == "\0c" ## '\0' treated like other characters
substr("a\0c\0",2,3) == "\0c\0" substr("a\0c\0",2,3) == "\0c\0"
#"" == 0 ## # operator counts number of bits #"" == 0 ## # operator counts number of bits
#"\0" == 0 #"\0" == 0
# "a" == 3 # "a" == 3
# "ab" == 6 ## white space ignored # "ab" == 6 ## white space ignored
# "abc" == 10 # "abc" == 10
# 27 == 4 # 27 == 4
# 0b1010111011 == 7 # 0b1010111011 == 7
7 # 9 == 2 ## 7 # 9 = abs(7 - 9) 7 # 9 == 2 ## 7 # 9 = abs(7 - 9)
3/4 # 2/3 == 1/12 3/4 # 2/3 == 1/12
a = 5, a #= 2, a == 3 a = 5, a #= 2, a == 3
@@ -181,9 +181,9 @@ protect(set8700_A[2]) == 1024
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536 protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
## Testing simple assignment of matrix ## Testing simple assignment of matrix
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## copying matrix to list ## copying matrix to list
set8700_B = list(5,6,7), protect(set8700_B) == 1024 set8700_B = list(5,6,7), protect(set8700_B) == 1024
@@ -192,18 +192,18 @@ protect(set8700_B[2]) == 0
protect(set8700_A,0), protect(set8700_A) == 0 protect(set8700_A,0), protect(set8700_A) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2 copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4) set8700_B[2] == list(3,4)
protect(set8700_B) == 1024 ## protect(set8700_A) not copied protect(set8700_B) == 1024 ## protect(set8700_A) not copied
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## copying matrix to matrix ## copying matrix to matrix
set8700_B = mat[3], protect(set8700_B) == 1024 set8700_B = mat[3], protect(set8700_B) == 1024
protect(set8700_B[2]) == 0 protect(set8700_B[2]) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2 copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4) set8700_B[2] == list(3,4)
protect(set8700_B) == 1024 ## protect(set8700_A) not copied protect(set8700_B) == 1024 ## protect(set8700_A) not copied
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Testing list protection ## Testing list protection
set8700_A = list(1, 2, list(3,4)), 1 set8700_A = list(1, 2, list(3,4)), 1
@@ -212,18 +212,18 @@ protect(set8700_A[2]) == 1024
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536 protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
## Simple assignment of list ## Simple assignment of list
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Copying list to list ## Copying list to list
set8700_B = list(5,6,7), protect(set8700_B) == 1024 set8700_B = list(5,6,7), protect(set8700_B) == 1024
protect(set8700_B[2]) == 0 protect(set8700_B[2]) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2 copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4) set8700_B[2] == list(3,4)
protect(set8700_B) == 1024 ## protect(set8700_A) not copied protect(set8700_B) == 1024 ## protect(set8700_A) not copied
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Copying list to matrix ## Copying list to matrix
set8700_B = mat[3], protect(set8700_B) == 1024 set8700_B = mat[3], protect(set8700_B) == 1024
@@ -231,8 +231,8 @@ protect(set8700_B[2]) == 0
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2 copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
set8700_B[2] == list(3,4) set8700_B[2] == list(3,4)
protect(set8700_B) == 1024 protect(set8700_B) == 1024
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
## Protecting one element of a list ## Protecting one element of a list
set8700_A = list(1,4,3,2), protect(set8700_A[1]) == 0 set8700_A = list(1,4,3,2), protect(set8700_A[1]) == 0
@@ -241,16 +241,16 @@ protect(set8700_A[1], 1024), protect(set8700_A[1]) == 1024
## Testing sort ## Testing sort
set8700_A = sort(set8700_A), set8700_A == list(1,2,3,4) set8700_A = sort(set8700_A), set8700_A == list(1,2,3,4)
protect(set8700_A[1]) == 0 protect(set8700_A[1]) == 0
protect(set8700_A[3]) == 1024 ## status of 4 protect(set8700_A[3]) == 1024 ## status of 4
## Testings reverse ## Testings reverse
set8700_A = reverse(set8700_A), set8700_A == list(4,3,2,1) set8700_A = reverse(set8700_A), set8700_A == list(4,3,2,1)
protect(set8700_A[0]) == 1024 ## status of 4 protect(set8700_A[0]) == 1024 ## status of 4
## Testing swap ## Testing swap
swap(set8700_A[0], set8700_A[1]), set8700_A == list(3,4,2,1) swap(set8700_A[0], set8700_A[1]), set8700_A == list(3,4,2,1)
protect(set8700_A[0]) == 0 ## status moved protect(set8700_A[0]) == 0 ## status moved
protect(set8700_A[1]) == 1024 ## 4 retains protection protect(set8700_A[1]) == 1024 ## 4 retains protection
## Testing list with protected list argument ## Testing list with protected list argument
protect(set8700_A, 0), protect(set8700_A) == 0 protect(set8700_A, 0), protect(set8700_A) == 0
@@ -258,23 +258,23 @@ protect(set8700_A, 512), protect(set8700_A) == 512
protect(set8700_A[1]) == 1024 protect(set8700_A[1]) == 1024
set8700_L = list(1,set8700_A,3), protect(set8700_L) == 0 set8700_L = list(1,set8700_A,3), protect(set8700_L) == 0
protect(set8700_L[0]) == 0 protect(set8700_L[0]) == 0
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
## Testing list with "initialization" ## Testing list with "initialization"
set8700_L = list(1,2,3), protect(set8700_L) == 0 set8700_L = list(1,2,3), protect(set8700_L) == 0
protect(set8700_L[0]) | protect(set8700_L[1]) | protect(set8700_L[2]) == 0 ## All zero protect(set8700_L[0]) | protect(set8700_L[1]) | protect(set8700_L[2]) == 0 ## All zero
set8700_L = {1,set8700_A}, set8700_L[1] == set8700_A set8700_L = {1,set8700_A}, set8700_L[1] == set8700_A
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
set8700_L[1] = 2, protect(set8700_L[1]) == 512 ## Not changed set8700_L[1] = 2, protect(set8700_L[1]) == 512 ## Not changed
## Testing matrix with "initialization" ## Testing matrix with "initialization"
set8700_M = mat[3] = {1,set8700_A}, protect(set8700_M) == 0 set8700_M = mat[3] = {1,set8700_A}, protect(set8700_M) == 0
protect(set8700_M[0]) == 0 protect(set8700_M[0]) == 0
protect(set8700_M[1]) == 512 ## protect(set8700_A) copied protect(set8700_M[1]) == 512 ## protect(set8700_A) copied
protect(set8700_M[2]) == 0 protect(set8700_M[2]) == 0
protect(set8700_M[1][1]) == 1024 ## protect(set8700_A[1]) copied protect(set8700_M[1][1]) == 1024 ## protect(set8700_A[1]) copied
## Testing push, pop, append, remove ## Testing push, pop, append, remove
set8700_A = list(1,2), protect(set8700_A,0,1), protect(set8700_A[0]) == 0 set8700_A = list(1,2), protect(set8700_A,0,1), protect(set8700_A[0]) == 0
@@ -319,12 +319,12 @@ set8700_x == 7
set8700_x-- == error(10388) set8700_x-- == error(10388)
protect(set8700_A,0), protect(set8700_A,16), 1 protect(set8700_A,0), protect(set8700_A,16), 1
set8700_A = "abcdef", protect(set8700_A) == 16 ## No copy to set8700_A set8700_A = "abcdef", protect(set8700_A) == 16 ## No copy to set8700_A
protect(set8700_B,0), set8700_B = "xyz", protect(set8700_B) == 0 protect(set8700_B,0), set8700_B = "xyz", protect(set8700_B) == 0
copy(set8700_B, set8700_A) == error(10226) copy(set8700_B, set8700_A) == error(10226)
set8700_A == "abcdef" ## set8700_A not changed set8700_A == "abcdef" ## set8700_A not changed
protect(set8700_A,0), copy(set8700_B,set8700_A), set8700_A == "xyzdef" protect(set8700_A,0), copy(set8700_B,set8700_A), set8700_A == "xyzdef"
protect(set8700_B,128), protect(set8700_B) == 128 ## No copy from set8700_B protect(set8700_B,128), protect(set8700_B) == 128 ## No copy from set8700_B
copy(set8700_B,set8700_A,,,3) == error(10225) copy(set8700_B,set8700_A,,,3) == error(10225)
set8700_A == "xyzdef" set8700_A == "xyzdef"
protect(set8700_B,0), copy(set8700_B,set8700_A,,,3), set8700_A == "xyzxyz" protect(set8700_B,0), copy(set8700_B,set8700_A,,,3), set8700_A == "xyzxyz"
@@ -354,7 +354,7 @@ set8700_x = 7, protect(set8700_x,0), protect(set8700_x, 512), 1
set8700_A = {set8700_x,,set8700_x}, protect(set8700_A[0]) == 1536 set8700_A = {set8700_x,,set8700_x}, protect(set8700_A[0]) == 1536
protect(set8700_A[1]) == 0 protect(set8700_A[1]) == 0
protect(set8700_A[2]) == 512 protect(set8700_A[2]) == 512
protect(set8700_A,16), protect(set8700_A) == 16 ## No copy to protect(set8700_A,16), protect(set8700_A) == 16 ## No copy to
set8700_A == (mat[3] = {7,0,7}) set8700_A == (mat[3] = {7,0,7})
set8700_A = {1,2,3}, errno() == 10390; set8700_A = {1,2,3}, errno() == 10390;
set8700_A == (mat[3] = {7,0,7}) set8700_A == (mat[3] = {7,0,7})
@@ -368,7 +368,7 @@ set8700_A = list(2,3,5), modify(set8700_A, 7) == error(10406)
protect(set8700_A,2), modify(set8700_A, "set8700_f") == error(10407) protect(set8700_A,2), modify(set8700_A, "set8700_f") == error(10407)
protect(set8700_A,0), modify(set8700_A, "h") == error(10408) protect(set8700_A,0), modify(set8700_A, "h") == error(10408)
set8700_B = 42, protect(set8700_B,0), modify(set8700_B, "set8700_f") == error(10409) set8700_B = 42, protect(set8700_B,0), modify(set8700_B, "set8700_f") == error(10409)
set8700_A == list(2,3,5) ## set8700_A not affected by failures set8700_A == list(2,3,5) ## set8700_A not affected by failures
protect(set8700_A,0,1), modify(set8700_A, "set8700_f") == null() protect(set8700_A,0,1), modify(set8700_A, "set8700_f") == null()
set8700_A == list(4,9,25) set8700_A == list(4,9,25)
modify(set8700_A,"set8700_g") == null() modify(set8700_A,"set8700_g") == null()
@@ -389,7 +389,7 @@ set8700_L = {{1,2,3},{'a','b','c'}}, set8700_L[0] == (mat[3] = {1,0,3})
set8700_L[1] == (mat[3] = {'a','b',0}) set8700_L[1] == (mat[3] = {'a','b',0})
set8700_M = mat[2], protect(set8700_M,0), set8700_M = {1,2,3,4}, set8700_M == (mat[2] = {1,2}) set8700_M = mat[2], protect(set8700_M,0), set8700_M = {1,2,3,4}, set8700_M == (mat[2] = {1,2})
set8700_x = 5, set8700_M = {set8700_x++, set8700_x++, set8700_x++, set8700_x++, set8700_x++}, set8700_M == (mat[2] = {5,6}) set8700_x = 5, set8700_M = {set8700_x++, set8700_x++, set8700_x++, set8700_x++, set8700_x++}, set8700_M == (mat[2] = {5,6})
set8700_x == 10 ## All initialization terms evaluated set8700_x == 10 ## All initialization terms evaluated
set8700_S = " ", set8700_S = {'a','b','c','d'}, set8700_S == "abc" set8700_S = " ", set8700_S = {'a','b','c','d'}, set8700_S == "abc"
set8700_P = obj set8700_point = {1,2,3,4}, set8700_P.set8700_x == 1 && set8700_P.set8700_y == 2 && set8700_P.set8700_z == 3 set8700_P = obj set8700_point = {1,2,3,4}, set8700_P.set8700_x == 1 && set8700_P.set8700_y == 2 && set8700_P.set8700_z == 3

28
cal/smallfactors.cal
View File

@@ -28,7 +28,7 @@ define smallfactors(x0)
local d q x flist tuple w; local d q x flist tuple w;
if (x >= (2 ^ 32) - 1) if (x >= (2 ^ 32) - 1)
return newerror("smallfactors: number must be < 2^32 -1"); return newerror("smallfactors: number must be < 2^32 -1");
tuple = mat[2]; tuple = mat[2];
flist = list(); flist = list();
@@ -37,19 +37,19 @@ define smallfactors(x0)
q = 0; q = 0;
tuple[0] = d; tuple[0] = d;
if (x < 2) if (x < 2)
return 0; return 0;
do { do {
q = x // d; q = x // d;
while (x == (q * d)) { while (x == (q * d)) {
tuple[0] = d; tuple[0] = d;
tuple[1]++; tuple[1]++;
x = floor(q); x = floor(q);
q = x // d; q = x // d;
} }
d = nextprime(d); d = nextprime(d);
if (tuple[1] > 0) if (tuple[1] > 0)
append(flist, tuple); append(flist, tuple);
tuple = mat[2]; tuple = mat[2];
} while (d <= x); } while (d <= x);
return flist; return flist;
} }
@@ -58,7 +58,7 @@ define printsmallfactors(flist)
{ {
local k; local k;
for (k = 0; k < size(flist); k++) { for (k = 0; k < size(flist); k++) {
print flist[k][0]:"^":flist[k][1]; print flist[k][0]:"^":flist[k][1];
} }
} }

68
cal/solve.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:37 * Under source code control: 1990/02/15 01:50:37
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -32,35 +32,35 @@
define solve(low, high, epsilon) define solve(low, high, epsilon)
{ {
local flow, fhigh, fmid, mid, places; local flow, fhigh, fmid, mid, places;
if (isnull(epsilon)) if (isnull(epsilon))
epsilon = epsilon(); epsilon = epsilon();
if (epsilon <= 0) if (epsilon <= 0)
quit "Non-positive epsilon value"; quit "Non-positive epsilon value";
places = highbit(1 + int(1/epsilon)) + 1; places = highbit(1 + int(1/epsilon)) + 1;
flow = f(low); flow = f(low);
if (abs(flow) < epsilon) if (abs(flow) < epsilon)
return low; return low;
fhigh = f(high); fhigh = f(high);
if (abs(fhigh) < epsilon) if (abs(fhigh) < epsilon)
return high; return high;
if (sgn(flow) == sgn(fhigh)) if (sgn(flow) == sgn(fhigh))
quit "Non-opposite signs"; quit "Non-opposite signs";
while (1) { while (1) {
mid = bround(high - fhigh * (high - low) / (fhigh - flow), mid = bround(high - fhigh * (high - low) / (fhigh - flow),
places); places);
if ((mid == low) || (mid == high)) if ((mid == low) || (mid == high))
places++; places++;
fmid = f(mid); fmid = f(mid);
if (abs(fmid) < epsilon) if (abs(fmid) < epsilon)
return mid; return mid;
if (sgn(fmid) == sgn(flow)) { if (sgn(fmid) == sgn(flow)) {
low = mid; low = mid;
flow = fmid; flow = fmid;
} else { } else {
high = mid; high = mid;
fhigh = fmid; fhigh = fmid;
} }
} }
} }

1296
cal/specialfunctions.cal
View File

File diff suppressed because it is too large Load Diff

42
cal/splitbits.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2006/06/07 14:10:11 * Under source code control: 2006/06/07 14:10:11
* File existed as early as: 2006 * File existed as early as: 2006
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -39,43 +39,43 @@ if (! iserror(E_SPLITBITS_3)) E_SPLITBITS_3 = newerror("2nd argument must be an
*/ */
define splitbits(x, b) define splitbits(x, b)
{ {
local ret; /* list to return */ local ret; /* list to return */
local mask; /* 2^b-1 */ local mask; /* 2^b-1 */
local x_is_reg = 0; /* true if x < 0 */ local x_is_reg = 0; /* true if x < 0 */
/* firewall */ /* firewall */
if (! isint(x)) { if (! isint(x)) {
return error(E_SPLITBITS_1); return error(E_SPLITBITS_1);
} }
if (! isint(b)) { if (! isint(b)) {
return error(E_SPLITBITS_2); return error(E_SPLITBITS_2);
} }
if (b <= 0) { if (b <= 0) {
return error(E_SPLITBITS_3); return error(E_SPLITBITS_3);
} }
/* special case: x == 0 */ /* special case: x == 0 */
if (x == 0) { if (x == 0) {
return list(0); return list(0);
} }
/* setup for splitting x */ /* setup for splitting x */
ret = list(); ret = list();
mask = 2^b-1; mask = 2^b-1;
if (x < 0) { if (x < 0) {
x_is_reg = 1; x_is_reg = 1;
x = abs(x); x = abs(x);
} }
/* split x */ /* split x */
while (x > 0) { while (x > 0) {
printf("%d %x\n", size(ret), x); printf("%d %x\n", size(ret), x);
if (x_is_reg) { if (x_is_reg) {
append(ret, xor(x & mask, mask)); append(ret, xor(x & mask, mask));
} else { } else {
append(ret, x & mask); append(ret, x & mask);
} }
x >>= b; x >>= b;
} }
/* return list */ /* return list */

4
cal/statistics.cal
View File

@@ -17,8 +17,8 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2013/08/11 01:31:28 * Under source code control: 2013/08/11 01:31:28
* File existed as early as: 2013 * File existed as early as: 2013
*/ */

58
cal/sumsq.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:37 * Under source code control: 1990/02/15 01:50:37
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -32,30 +32,30 @@
define ss(p) define ss(p)
{ {
local a, b, i, p4; local a, b, i, p4;
if (p == 2) { if (p == 2) {
print "1^2 + 1^2 = 2"; print "1^2 + 1^2 = 2";
return; return;
} }
if ((p % 4) != 1) { if ((p % 4) != 1) {
print p, "is not of the form 4N+1"; print p, "is not of the form 4N+1";
return; return;
} }
if (!ptest(p, min(p-2, 10))) { if (!ptest(p, min(p-2, 10))) {
print p, "is not a prime"; print p, "is not a prime";
return; return;
} }
p4 = (p - 1) / 4; p4 = (p - 1) / 4;
i = 2; i = 2;
do { do {
a = pmod(i++, p4, p); a = pmod(i++, p4, p);
} while ((a^2 % p) == 1); } while ((a^2 % p) == 1);
b = p; b = p;
while (b^2 > p) { while (b^2 > p) {
i = b % a; i = b % a;
b = a; b = a;
a = i; a = i;
} }
print a : "^2 +" , b : "^2 =" , a^2 + b^2; print a : "^2 +" , b : "^2 =" , a^2 + b^2;
} }

8
cal/sumtimes.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,10 +17,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 2006/06/22 17:29 * Under source code control: 2006/06/22 17:29
* File existed as early as: 2006 * File existed as early as: 2006
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */

298
cal/surd.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,266 +17,266 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1990/02/15 01:50:38 * Under source code control: 1990/02/15 01:50:38
* File existed as early as: before 1990 * File existed as early as: before 1990
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
obj surd {a, b}; /* definition of the surd object */ obj surd {a, b}; /* definition of the surd object */
global surd_type = -1; /* type of surd (value of D) */ global surd_type = -1; /* type of surd (value of D) */
static obj surd surd__; /* example surd for testing against */ static obj surd surd__; /* example surd for testing against */
define surd(a,b) define surd(a,b)
{ {
local x; local x;
obj surd x; obj surd x;
x.a = a; x.a = a;
x.b = b; x.b = b;
return x; return x;
} }
define surd_print(a) define surd_print(a)
{ {
print "surd(" : a.a : ", " : a.b : ")" :; print "surd(" : a.a : ", " : a.b : ")" :;
} }
define surd_conj(a) define surd_conj(a)
{ {
local x; local x;
obj surd x; obj surd x;
x.a = a.a; x.a = a.a;
x.b = -a.b; x.b = -a.b;
return x; return x;
} }
define surd_norm(a) define surd_norm(a)
{ {
return a.a^2 + abs(surd_type) * a.b^2; return a.a^2 + abs(surd_type) * a.b^2;
} }
define surd_value(a, xepsilon) define surd_value(a, xepsilon)
{ {
local epsilon; local epsilon;
epsilon = xepsilon; epsilon = xepsilon;
if (isnull(epsilon)) if (isnull(epsilon))
epsilon = epsilon(); epsilon = epsilon();
return a.a + a.b * sqrt(surd_type, epsilon); return a.a + a.b * sqrt(surd_type, epsilon);
} }
define surd_add(a, b) define surd_add(a, b)
{ {
local obj surd x; local obj surd x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.a = a.a + b; x.a = a.a + b;
x.b = a.b; x.b = a.b;
return x; return x;
} }
if (!istype(a, x)) { if (!istype(a, x)) {
x.a = a + b.a; x.a = a + b.a;
x.b = b.b; x.b = b.b;
return x; return x;
} }
x.a = a.a + b.a; x.a = a.a + b.a;
x.b = a.b + b.b; x.b = a.b + b.b;
if (x.b) if (x.b)
return x; return x;
return x.a; return x.a;
} }
define surd_sub(a, b) define surd_sub(a, b)
{ {
local obj surd x; local obj surd x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.a = a.a - b; x.a = a.a - b;
x.b = a.b; x.b = a.b;
return x; return x;
} }
if (!istype(a, x)) { if (!istype(a, x)) {
x.a = a - b.a; x.a = a - b.a;
x.b = -b.b; x.b = -b.b;
return x; return x;
} }
x.a = a.a - b.a; x.a = a.a - b.a;
x.b = a.b - b.b; x.b = a.b - b.b;
if (x.b) if (x.b)
return x; return x;
return x.a; return x.a;
} }
define surd_inc(a) define surd_inc(a)
{ {
local x; local x;
x = a; x = a;
x.a++; x.a++;
return x; return x;
} }
define surd_dec(a) define surd_dec(a)
{ {
local x; local x;
x = a; x = a;
x.a--; x.a--;
return x; return x;
} }
define surd_neg(a) define surd_neg(a)
{ {
local obj surd x; local obj surd x;
x.a = -a.a; x.a = -a.a;
x.b = -a.b; x.b = -a.b;
return x; return x;
} }
define surd_mul(a, b) define surd_mul(a, b)
{ {
local obj surd x; local obj surd x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.a = a.a * b; x.a = a.a * b;
x.b = a.b * b; x.b = a.b * b;
} else if (!istype(a, x)) { } else if (!istype(a, x)) {
x.a = b.a * a; x.a = b.a * a;
x.b = b.b * a; x.b = b.b * a;
} else { } else {
x.a = a.a * b.a + surd_type * a.b * b.b; x.a = a.a * b.a + surd_type * a.b * b.b;
x.b = a.a * b.b + a.b * b.a; x.b = a.a * b.b + a.b * b.a;
} }
if (x.b) if (x.b)
return x; return x;
return x.a; return x.a;
} }
define surd_square(a) define surd_square(a)
{ {
local obj surd x; local obj surd x;
x.a = a.a^2 + a.b^2 * surd_type; x.a = a.a^2 + a.b^2 * surd_type;
x.b = a.a * a.b * 2; x.b = a.a * a.b * 2;
if (x.b) if (x.b)
return x; return x;
return x.a; return x.a;
} }
define surd_scale(a, b) define surd_scale(a, b)
{ {
local obj surd x; local obj surd x;
x.a = scale(a.a, b); x.a = scale(a.a, b);
x.b = scale(a.b, b); x.b = scale(a.b, b);
return x; return x;
} }
define surd_shift(a, b) define surd_shift(a, b)
{ {
local obj surd x; local obj surd x;
x.a = a.a << b; x.a = a.a << b;
x.b = a.b << b; x.b = a.b << b;
if (x.b) if (x.b)
return x; return x;
return x.a; return x.a;
} }
define surd_div(a, b) define surd_div(a, b)
{ {
local x, y; local x, y;
if ((a == 0) && b) if ((a == 0) && b)
return 0; return 0;
obj surd x; obj surd x;
if (!istype(b, x)) { if (!istype(b, x)) {
x.a = a.a / b; x.a = a.a / b;
x.b = a.b / b; x.b = a.b / b;
return x; return x;
} }
y = b; y = b;
y.b = -b.b; y.b = -b.b;
return (a * y) / (b.a^2 - surd_type * b.b^2); return (a * y) / (b.a^2 - surd_type * b.b^2);
} }
define surd_inv(a) define surd_inv(a)
{ {
return 1 / a; return 1 / a;
} }
define surd_sgn(a) define surd_sgn(a)
{ {
if (surd_type < 0) if (surd_type < 0)
quit "Taking sign of complex surd"; quit "Taking sign of complex surd";
if (a.a == 0) if (a.a == 0)
return sgn(a.b); return sgn(a.b);
if (a.b == 0) if (a.b == 0)
return sgn(a.a); return sgn(a.a);
if ((a.a > 0) && (a.b > 0)) if ((a.a > 0) && (a.b > 0))
return 1; return 1;
if ((a.a < 0) && (a.b < 0)) if ((a.a < 0) && (a.b < 0))
return -1; return -1;
return sgn(a.a^2 - a.b^2 * surd_type) * sgn(a.a); return sgn(a.a^2 - a.b^2 * surd_type) * sgn(a.a);
} }
define surd_cmp(a, b) define surd_cmp(a, b)
{ {
if (!istype(a, surd__)) if (!istype(a, surd__))
return ((b.b != 0) || (a != b.a)); return ((b.b != 0) || (a != b.a));
if (!istype(b, surd__)) if (!istype(b, surd__))
return ((a.b != 0) || (b != a.a)); return ((a.b != 0) || (b != a.a));
return ((a.a != b.a) || (a.b != b.b)); return ((a.a != b.a) || (a.b != b.b));
} }
define surd_rel(a, b) define surd_rel(a, b)
{ {
local x, y; local x, y;
if (surd_type < 0) if (surd_type < 0)
quit "Relative comparison of complex surds"; quit "Relative comparison of complex surds";
if (!istype(a, surd__)) { if (!istype(a, surd__)) {
x = a - b.a; x = a - b.a;
y = -b.b; y = -b.b;
} else if (!istype(b, surd__)) { } else if (!istype(b, surd__)) {
x = a.a - b; x = a.a - b;
y = a.b; y = a.b;
} else { } else {
x = a.a - b.a; x = a.a - b.a;
y = a.b - b.b; y = a.b - b.b;
} }
if (y == 0) if (y == 0)
return sgn(x); return sgn(x);
if (x == 0) if (x == 0)
return sgn(y); return sgn(y);
if ((x < 0) && (y < 0)) if ((x < 0) && (y < 0))
return -1; return -1;
if ((x > 0) && (y > 0)) if ((x > 0) && (y > 0))
return 1; return 1;
return sgn(x^2 - y^2 * surd_type) * sgn(x); return sgn(x^2 - y^2 * surd_type) * sgn(x);
} }
if (config("resource_debug") & 3) { if (config("resource_debug") & 3) {

98
cal/test2300.obj_incdec.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/07/09 06:12:13 * Under source code control: 1995/07/09 06:12:13
* File existed as early as: 1995 * File existed as early as: 1995
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -33,12 +33,12 @@ obj matrix {m}
*/ */
define matrix_inc(a) define matrix_inc(a)
{ {
local i; local i;
/* increment each matrix member */ /* increment each matrix member */
for (i= 0; i < size(a.m); i++) for (i= 0; i < size(a.m); i++)
++a.m[[i]]; ++a.m[[i]];
return a; return a;
} }
/* /*
@@ -46,12 +46,12 @@ define matrix_inc(a)
*/ */
define matrix_dec(a) define matrix_dec(a)
{ {
local i; local i;
/* decrement each matrix member */ /* decrement each matrix member */
for (i= 0; i < size(a.m); i++) for (i= 0; i < size(a.m); i++)
--a.m[[i]]; --a.m[[i]];
return a; return a;
} }
/* /*
@@ -59,24 +59,24 @@ define matrix_dec(a)
*/ */
define mkmat() define mkmat()
{ {
local s, M, i, v; local s, M, i, v;
/* firewall */ /* firewall */
s = param(0); s = param(0);
if (s == 0) if (s == 0)
quit "Need at least one argument"; quit "Need at least one argument";
/* create the matrix */ /* create the matrix */
mat M[s]; mat M[s];
/* load the matrix with the args */ /* load the matrix with the args */
for (i = 0; i < s; i++) for (i = 0; i < s; i++)
M[i] = param(i + 1); M[i] = param(i + 1);
/* create the object with the matrix */ /* create the object with the matrix */
obj matrix v; obj matrix v;
v.m = M; v.m = M;
return v; return v;
} }
/* /*
@@ -84,29 +84,29 @@ define mkmat()
*/ */
define ckmat() define ckmat()
{ {
local s, a, i; local s, a, i;
/* firewall */ /* firewall */
s = param(0); s = param(0);
if (s < 2) if (s < 2)
quit "Need at least two arguments"; quit "Need at least two arguments";
/* get the object to test */ /* get the object to test */
a = param(1); a = param(1);
/* verify the matrix in the object is the right size */ /* verify the matrix in the object is the right size */
if (size(a.m) != s-1) { if (size(a.m) != s-1) {
return 0; return 0;
} }
/* check each matrix element with the args passed */ /* check each matrix element with the args passed */
for (i = 2; i <= s; i++) { for (i = 2; i <= s; i++) {
if (a.m[i-2] != param(i)) { if (a.m[i-2] != param(i)) {
/* args do not match */ /* args do not match */
return 0; return 0;
} }
} }
/* args match the matrix in the object */ /* args match the matrix in the object */
return 1; return 1;
} }

910
cal/test2600.numfunc.cal
View File

File diff suppressed because it is too large Load Diff

392
cal/test2700.isqrt.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,10 +19,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/11/01 22:52:25 * Under source code control: 1995/11/01 22:52:25
* File existed as early as: 1995 * File existed as early as: 1995
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -40,25 +40,25 @@
defaultverbose = 1; defaultverbose = 1;
define mknonnegreal() { define mknonnegreal() {
switch(rand(8)) { switch(rand(8)) {
case 0: return rand(20); case 0: return rand(20);
case 1: return rand(20,1000); case 1: return rand(20,1000);
case 2: return rand(1,10000)/rand(1,100); case 2: return rand(1,10000)/rand(1,100);
case 3: return scale(mkposreal(), rand(1,100)); case 3: return scale(mkposreal(), rand(1,100));
case 4: return scale(mkposreal(), -rand(1,100)); case 4: return scale(mkposreal(), -rand(1,100));
case 5: return rand(1, 1000) + scale(mkfrac(),-rand(1,100)); case 5: return rand(1, 1000) + scale(mkfrac(),-rand(1,100));
case 6: return mkposreal()^2; case 6: return mkposreal()^2;
case 7: return mkposreal() * (1+scale(mkfrac(),-rand(1,100))); case 7: return mkposreal() * (1+scale(mkfrac(),-rand(1,100)));
} }
} }
define mkposreal() { define mkposreal() {
local x; local x;
x = mknonnegreal(); x = mknonnegreal();
while (x == 0) while (x == 0)
x = mknonnegreal(); x = mknonnegreal();
return x; return x;
} }
define mkreal_2700() = rand(2) ? mknonnegreal() : -mknonnegreal(); define mkreal_2700() = rand(2) ? mknonnegreal() : -mknonnegreal();
@@ -67,15 +67,15 @@ define mknonzeroreal() = rand(2) ? mkposreal() : -mkposreal();
/* Number > 0 and < 1, almost uniformly distributed */ /* Number > 0 and < 1, almost uniformly distributed */
define mkposfrac() { define mkposfrac() {
local x,y; local x,y;
x = rand(1,1000); x = rand(1,1000);
do do
y = rand(1,1000); y = rand(1,1000);
while (y == x); while (y == x);
if (x > y) if (x > y)
swap(x,y); swap(x,y);
return x/y; return x/y;
} }
/* Nonzero > -1 and < 1 */ /* Nonzero > -1 and < 1 */
@@ -86,13 +86,13 @@ define mksquarereal() = mknonnegreal()^2;
/* /*
* We might be able to do better than the following. For non-square * We might be able to do better than the following. For non-square
* positive integer less than 1e6, could use: * positive integer less than 1e6, could use:
* x = rand(1, 1000); * x = rand(1, 1000);
* return rand(x^2 + 1, (x + 1)^2); * return rand(x^2 + 1, (x + 1)^2);
* Maybe could do: * Maybe could do:
* do * do
* x = mkreal_2700(); * x = mkreal_2700();
* while * while
* (issq(x)); * (issq(x));
* This would of course not be satisfactory for testing issq(). * This would of course not be satisfactory for testing issq().
*/ */
@@ -102,127 +102,127 @@ define mkcomplex_2700() = mkreal_2700() + 1i * mkreal_2700();
define testcsqrt(str, n, verbose) define testcsqrt(str, n, verbose)
{ {
local x, y, z, m, i, p, v; local x, y, z, m, i, p, v;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
for (i = 1; i <= n; i++) { for (i = 1; i <= n; i++) {
if (verbose > 1) print i,:; if (verbose > 1) print i,:;
x = rand(3) ? mkreal_2700(): mkcomplex_2700(); x = rand(3) ? mkreal_2700(): mkcomplex_2700();
y = scale(mknonzeroreal(), -100); y = scale(mknonzeroreal(), -100);
if (verbose > 2) if (verbose > 2)
printf("%d: x = %d, y = %d\n", i, x, y); printf("%d: x = %d, y = %d\n", i, x, y);
for (z = 0; z < 128; z++) { for (z = 0; z < 128; z++) {
v = sqrt(x,y,z); v = sqrt(x,y,z);
p = checksqrt(x,y,z,v); p = checksqrt(x,y,z,v);
if (p) { if (p) {
if (verbose > 0) if (verbose > 0)
printf( printf(
"*** Type %d failure for x = %r, " "*** Type %d failure for x = %r, "
"y = %r, z = %d\n", "y = %r, z = %d\n",
p, x, y, z); p, x, y, z);
m++; m++;
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("no errors\n"); printf("no errors\n");
} }
} }
return m; return m;
} }
define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */ define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */
{ {
local A, B, X, Y, t1, t2, eps, u, n, f, s; local A, B, X, Y, t1, t2, eps, u, n, f, s;
A = re(x); A = re(x);
B = im(x); B = im(x);
X = re(v); X = re(v);
Y = im(v); Y = im(v);
/* checking signs of X and Y */ /* checking signs of X and Y */
if (B == 0 && A <= 0) /* t1 = sgn(re(tvsqrt)) */ if (B == 0 && A <= 0) /* t1 = sgn(re(tvsqrt)) */
t1 = 0; t1 = 0;
else else
t1 = (z & 64) ? -1 : 1; t1 = (z & 64) ? -1 : 1;
t2 = B ? sgn(B) : (A < 0); /* t2 = sgn(im(tvsqrt)) */ t2 = B ? sgn(B) : (A < 0); /* t2 = sgn(im(tvsqrt)) */
if (z & 64) if (z & 64)
t2 = -t2; t2 = -t2;
if (t1 == 0 && X != 0) if (t1 == 0 && X != 0)
return 1; return 1;
if (t2 == 0 && Y != 0) { if (t2 == 0 && Y != 0) {
printf("x = %d, Y = %d, t2 = %d\n", x, Y, t2); printf("x = %d, Y = %d, t2 = %d\n", x, Y, t2);
return 2; return 2;
} }
if (X && sgn(X) != t1) if (X && sgn(X) != t1)
return 3; return 3;
if (Y && sgn(Y) != t2) if (Y && sgn(Y) != t2)
return 4; return 4;
if (z & 32 && iscomsq(x)) if (z & 32 && iscomsq(x))
return 5 * (x != v^2); return 5 * (x != v^2);
eps = (z & 16) ? abs(y)/2 : abs(y); eps = (z & 16) ? abs(y)/2 : abs(y);
u = sgn(y); u = sgn(y);
/* Checking X */ /* Checking X */
n = X/y; n = X/y;
if (!isint(n)) if (!isint(n))
return 6; return 6;
if (t1) { if (t1) {
f = checkavrem(A, B, abs(X), eps); f = checkavrem(A, B, abs(X), eps);
if (z & 16 && f < 0) if (z & 16 && f < 0)
return 7; return 7;
if (!(z & 16) && f <= 0) if (!(z & 16) && f <= 0)
return 8; return 8;
if (!(z & 16) || f == 0) { if (!(z & 16) || f == 0) {
s = X ? t1 * sgn(A - X^2 + B^2/4/X^2) : t1; s = X ? t1 * sgn(A - X^2 + B^2/4/X^2) : t1;
if (s && !checkrounding(s,n,t1,u,z)) if (s && !checkrounding(s,n,t1,u,z))
return 9; return 9;
} }
} }
/* Checking Y */ /* Checking Y */
n = Y/y; n = Y/y;
if (!isint(n)) if (!isint(n))
return 10; return 10;
if (t2) { if (t2) {
f = checkavrem(-A, B, abs(Y), eps); f = checkavrem(-A, B, abs(Y), eps);
if (z & 16 && f < 0) if (z & 16 && f < 0)
return 11; return 11;
if (!(z & 16) && f <= 0) if (!(z & 16) && f <= 0)
return 12; return 12;
if (!(z & 16) || f == 0) { if (!(z & 16) || f == 0) {
s = Y ? t2 * sgn(-A - Y^2 + B^2/4/Y^2) : t2; s = Y ? t2 * sgn(-A - Y^2 + B^2/4/Y^2) : t2;
if (s && !checkrounding(s,n,t2,u,z)) if (s && !checkrounding(s,n,t2,u,z))
return 13; return 13;
} }
} }
return 0; return 0;
} }
/* /*
@@ -233,61 +233,61 @@ define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */
define checkavrem(A, B, X, eps) define checkavrem(A, B, X, eps)
{ {
local f; local f;
f = sgn(A - (X + eps)^2 + B^2/4/(X + eps)^2); f = sgn(A - (X + eps)^2 + B^2/4/(X + eps)^2);
if (f > 0) if (f > 0)
return -1; /* X < tv - eps */ return -1; /* X < tv - eps */
if (f == 0) if (f == 0)
return 0; /* X = tv - eps */ return 0; /* X = tv - eps */
if (X > eps) { if (X > eps) {
f = sgn(A - (X - eps)^2 + B^2/4/(X - eps)^2); f = sgn(A - (X - eps)^2 + B^2/4/(X - eps)^2);
if (f < 0) if (f < 0)
return -1; /* X > tv + eps */ return -1; /* X > tv + eps */
if (f == 0) if (f == 0)
return 0; /* X = tv + eps */ return 0; /* X = tv + eps */
} }
return 1; /* tv - eps < X < tv + eps */ return 1; /* tv - eps < X < tv + eps */
} }
define checkrounding(s,n,t,u,z) define checkrounding(s,n,t,u,z)
{ {
local w; local w;
switch (z & 15) { switch (z & 15) {
case 0: w = (s == u); break; case 0: w = (s == u); break;
case 1: w = (s == -u); break; case 1: w = (s == -u); break;
case 2: w = (s == t); break; case 2: w = (s == t); break;
case 3: w = (s == -t); break; case 3: w = (s == -t); break;
case 4: w = (s > 0); break; case 4: w = (s > 0); break;
case 5: w = (s < 0); break; case 5: w = (s < 0); break;
case 6: w = (s == u/t); break; case 6: w = (s == u/t); break;
case 7: w = (s == -u/t); break; case 7: w = (s == -u/t); break;
case 8: w = iseven(n); break; case 8: w = iseven(n); break;
case 9: w = isodd(n); break; case 9: w = isodd(n); break;
case 10: w = (u/t > 0) ? iseven(n) : isodd(n); break; case 10: w = (u/t > 0) ? iseven(n) : isodd(n); break;
case 11: w = (u/t > 0) ? isodd(n) : iseven(n); break; case 11: w = (u/t > 0) ? isodd(n) : iseven(n); break;
case 12: w = (u > 0) ? iseven(n) : isodd(n); break; case 12: w = (u > 0) ? iseven(n) : isodd(n); break;
case 13: w = (u > 0) ? isodd(n) : iseven(n); break; case 13: w = (u > 0) ? isodd(n) : iseven(n); break;
case 14: w = (t > 0) ? iseven(n) : isodd(n); break; case 14: w = (t > 0) ? iseven(n) : isodd(n); break;
case 15: w = (t > 0) ? isodd(n) : iseven(n); break; case 15: w = (t > 0) ? isodd(n) : iseven(n); break;
} }
return w; return w;
} }
define iscomsq(x) define iscomsq(x)
{ {
local c; local c;
if (isreal(x)) if (isreal(x))
return issq(abs(x)); return issq(abs(x));
c = norm(x); c = norm(x);
if (!issq(c)) if (!issq(c))
return 0; return 0;
return issq((re(x) + sqrt(c,1,32))/2); return issq((re(x) + sqrt(c,1,32))/2);
} }
/* /*
@@ -295,33 +295,33 @@ define iscomsq(x)
*/ */
define test2700(verbose, tnum) define test2700(verbose, tnum)
{ {
local n; /* test parameter */ local n; /* test parameter */
local ep; /* test parameter */ local ep; /* test parameter */
local i; local i;
/* set test parameters */ /* set test parameters */
n = 32; /* internal test loop count */ n = 32; /* internal test loop count */
if (isnull(verbose)) { if (isnull(verbose)) {
verbose = defaultverbose; verbose = defaultverbose;
} }
if (isnull(tnum)) { if (isnull(tnum)) {
tnum = 1; /* initial test number */ tnum = 1; /* initial test number */
} }
/* /*
* test a lot of stuff * test a lot of stuff
*/ */
srand(2700e2700); srand(2700e2700);
for (i=0; i < n; ++i) { for (i=0; i < n; ++i) {
err += testcsqrt(strcat(str(tnum++),": complex sqrt",str(i)), err += testcsqrt(strcat(str(tnum++),": complex sqrt",str(i)),
1, verbose); 1, verbose);
} }
if (verbose > 1) { if (verbose > 1) {
if (err) { if (err) {
print "***", err, "error(s) found in testall"; print "***", err, "error(s) found in testall";
} else { } else {
print "no errors in testall"; print "no errors in testall";
} }
} }
return tnum; return tnum;
} }

8
cal/test3100.matobj.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,10 +19,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/11/28 11:56:57 * Under source code control: 1995/11/28 11:56:57
* File existed as early as: 1995 * File existed as early as: 1995
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */

192
cal/test3300.det.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,82 +19,82 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/12/02 04:27:41 * Under source code control: 1995/12/02 04:27:41
* File existed as early as: 1995 * File existed as early as: 1995
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
defaultverbose = 1; /* default verbose value */ defaultverbose = 1; /* default verbose value */
define testi(str, n, N, verbose) define testi(str, n, N, verbose)
{ {
local A, t, i, j, d1, d2; local A, t, i, j, d1, d2;
local m; local m;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(N)) if (isnull(N))
N = 1e6; N = 1e6;
mat A[n,n]; mat A[n,n];
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
for (j = 0; j < n; j++) for (j = 0; j < n; j++)
A[i,j] = rand(-N, N); A[i,j] = rand(-N, N);
t = runtime(); t = runtime();
d1 = det(A); d1 = det(A);
t = runtime() - t; t = runtime() - t;
d2 = det(A^2); d2 = det(A^2);
if (d2 != d1^2) { if (d2 != d1^2) {
if (verbose > 0) { if (verbose > 0) {
printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1); printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1);
} }
return 1; /* error */ return 1; /* error */
} else { } else {
if (verbose > 0) { if (verbose > 0) {
printf("no errors\n"); printf("no errors\n");
} }
if (verbose > 1) { if (verbose > 1) {
printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t); printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t);
} }
} }
return 0; /* ok */ return 0; /* ok */
} }
define testr(str, n, N, verbose) define testr(str, n, N, verbose)
{ {
local A, t, i, j, d1, d2; local A, t, i, j, d1, d2;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(N)) if (isnull(N))
N = 1e6; N = 1e6;
mat A[n,n]; mat A[n,n];
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
for (j = 0; j < n; j++) for (j = 0; j < n; j++)
A[i,j] = rand(-(N^2), N^2)/rand(1, N); A[i,j] = rand(-(N^2), N^2)/rand(1, N);
t = usertime(); t = usertime();
d1 = det(A); d1 = det(A);
t = usertime() - t; t = usertime() - t;
d2 = det(A^2); d2 = det(A^2);
if (d2 != d1^2) { if (d2 != d1^2) {
if (verbose > 0) { if (verbose > 0) {
printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1); printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1);
} }
return 1; /* error */ return 1; /* error */
} else { } else {
if (verbose > 0) { if (verbose > 0) {
printf("no errors\n"); printf("no errors\n");
} }
if (verbose > 1) { if (verbose > 1) {
printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t); printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t);
} }
} }
return 0; /* ok */ return 0; /* ok */
} }
/* /*
@@ -102,39 +102,39 @@ define testr(str, n, N, verbose)
*/ */
define test3300(verbose, tnum) define test3300(verbose, tnum)
{ {
local N; /* test parameter */ local N; /* test parameter */
local i; local i;
/* /*
* set test parameters * set test parameters
*/ */
if (isnull(verbose)) { if (isnull(verbose)) {
verbose = defaultverbose; verbose = defaultverbose;
} }
N = 1e6; N = 1e6;
srand(3300e3300); srand(3300e3300);
/* /*
* test a lot of stuff * test a lot of stuff
*/ */
for (i=0; i < 19; ++i) { for (i=0; i < 19; ++i) {
err += testi(strcat(str(tnum++), ": testi(", str(i), ")"), \ err += testi(strcat(str(tnum++), ": testi(", str(i), ")"), \
i, N, verbose); i, N, verbose);
} }
for (i=0; i < 9; ++i) { for (i=0; i < 9; ++i) {
err += testr(strcat(str(tnum++), ": testr(", str(i), ")"), \ err += testr(strcat(str(tnum++), ": testr(", str(i), ")"), \
i, N, verbose); i, N, verbose);
} }
/* /*
* test results * test results
*/ */
if (verbose > 1) { if (verbose > 1) {
if (err) { if (err) {
print "***", err, "error(s) found in testall"; print "***", err, "error(s) found in testall";
} else { } else {
print "no errors in testall"; print "no errors in testall";
} }
} }
return tnum; return tnum;
} }

444
cal/test3400.trig.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,10 +19,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1995/12/02 05:20:11 * Under source code control: 1995/12/02 05:20:11
* File existed as early as: 1995 * File existed as early as: 1995
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -50,223 +50,223 @@
*/ */
defaultverbose = 1; /* default verbose value */ defaultverbose = 1; /* default verbose value */
global pi1k = pi(1e-1000); global pi1k = pi(1e-1000);
define test3401(str, n, eps, verbose) define test3401(str, n, eps, verbose)
{ {
local i, m, x, y, N; local i, m, x, y, N;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(n)) n = 250; if (isnull(n)) n = 250;
if (isnull(eps)) eps = epsilon(); if (isnull(eps)) eps = epsilon();
m = 0; m = 0;
N = pi(eps)/eps; N = pi(eps)/eps;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rand(1, N) * eps; x = rand(1, N) * eps;
y = cot(x, eps); y = cot(x, eps);
if (verbose > 1) if (verbose > 1)
printf("%r\n", x); printf("%r\n", x);
if (abs(acot(y, eps) - x) > eps) { if (abs(acot(y, eps) - x) > eps) {
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure for x = %r\n", x); printf("*** Failure for x = %r\n", x);
} }
m++; m++;
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("no errors\n"); printf("no errors\n");
} }
} }
return m; return m;
} }
define test3402(str, n, eps, verbose) define test3402(str, n, eps, verbose)
{ {
local i, m, x, y, N; local i, m, x, y, N;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(n)) n = 250; if (isnull(n)) n = 250;
if (isnull(eps)) eps = epsilon(); if (isnull(eps)) eps = epsilon();
eps = abs(eps); eps = abs(eps);
m = 0; m = 0;
N = 1e10; N = 1e10;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rand(-N, N)/rand(1, N); x = rand(-N, N)/rand(1, N);
y = tan(x/2, eps) - csc(x,eps) + cot(x,eps); y = tan(x/2, eps) - csc(x,eps) + cot(x,eps);
if (verbose > 1) if (verbose > 1)
printf("%r\n", x); printf("%r\n", x);
if (abs(y) > eps) { if (abs(y) > eps) {
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure for x = %r\n", x); printf("*** Failure for x = %r\n", x);
} }
m++; m++;
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("no errors\n"); printf("no errors\n");
} }
} }
return m; return m;
} }
define test3403(str, n, eps, verbose) define test3403(str, n, eps, verbose)
{ {
local i, m, x, y, N; local i, m, x, y, N;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(n)) n = 250; if (isnull(n)) n = 250;
if (isnull(eps)) eps = epsilon(); if (isnull(eps)) eps = epsilon();
eps = abs(eps); eps = abs(eps);
m = 0; m = 0;
N = 1e10; N = 1e10;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rand(-N, N)/rand(1, N); x = rand(-N, N)/rand(1, N);
y = tan(x, eps) - cot(x,eps) + 2 * cot(2 * x,eps); y = tan(x, eps) - cot(x,eps) + 2 * cot(2 * x,eps);
if (verbose > 1) if (verbose > 1)
printf("%r\n", x); printf("%r\n", x);
if (abs(y) > eps) { if (abs(y) > eps) {
m++; m++;
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure for x = %r\n", x); printf("*** Failure for x = %r\n", x);
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("no errors\n"); printf("no errors\n");
} }
} }
return m; return m;
} }
define test3404(str, n, eps, verbose) define test3404(str, n, eps, verbose)
{ {
local i, m, x, y, N; local i, m, x, y, N;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(n)) n = 250; if (isnull(n)) n = 250;
if (isnull(eps)) eps = epsilon(); if (isnull(eps)) eps = epsilon();
eps = abs(eps); eps = abs(eps);
m = 0; m = 0;
N = 1e10; N = 1e10;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rand(-N, N)/rand(1, N); x = rand(-N, N)/rand(1, N);
y = cot(x/2, eps) - csc(x,eps) - cot(x,eps); y = cot(x/2, eps) - csc(x,eps) - cot(x,eps);
if (verbose > 1) if (verbose > 1)
printf("%r\n", x); printf("%r\n", x);
if (abs(y) > eps) { if (abs(y) > eps) {
m++; m++;
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure for x = %r\n", x); printf("*** Failure for x = %r\n", x);
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("no errors\n"); printf("no errors\n");
} }
} }
return m; return m;
} }
define test3405(str, n, eps, verbose) define test3405(str, n, eps, verbose)
{ {
local i, m, x, y, N; local i, m, x, y, N;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(n)) n = 250; if (isnull(n)) n = 250;
if (isnull(eps)) eps = epsilon(); if (isnull(eps)) eps = epsilon();
m = 0; m = 0;
N = pi(eps)/eps; N = pi(eps)/eps;
N = quo(N, 2, 0); N = quo(N, 2, 0);
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rand(-N, N) * eps; x = rand(-N, N) * eps;
y = tan(x, eps); y = tan(x, eps);
if (verbose > 1) if (verbose > 1)
printf("%r\n", x); printf("%r\n", x);
if (atan(y, eps) != x) { if (atan(y, eps) != x) {
m++; m++;
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure for x = %r\n", x); printf("*** Failure for x = %r\n", x);
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("no errors\n"); printf("no errors\n");
} }
} }
return m; return m;
} }
define test3406(str, n, eps, verbose) define test3406(str, n, eps, verbose)
{ {
local i, m, x, y, z, N; local i, m, x, y, z, N;
if (isnull(verbose)) verbose = defaultverbose; if (isnull(verbose)) verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(n)) n = 250; if (isnull(n)) n = 250;
if (isnull(eps)) eps = epsilon(); if (isnull(eps)) eps = epsilon();
m = 0; m = 0;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rand(-1e10, 1e10)/rand(1, 1e10); x = rand(-1e10, 1e10)/rand(1, 1e10);
N = rand(-1e10, 1e10); N = rand(-1e10, 1e10);
y = sec(x, eps); y = sec(x, eps);
z = sec(x + 2 * N * pi1k, eps); z = sec(x + 2 * N * pi1k, eps);
if (verbose > 1) if (verbose > 1)
printf("%r, %d\n", x, N); printf("%r, %d\n", x, N);
if (abs(y-z) > eps) { if (abs(y-z) > eps) {
m++; m++;
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure for x = %r\n", x); printf("*** Failure for x = %r\n", x);
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("no errors\n"); printf("no errors\n");
} }
} }
return m; return m;
} }
/* /*
@@ -274,45 +274,45 @@ define test3406(str, n, eps, verbose)
*/ */
define test3400(verbose, tnum) define test3400(verbose, tnum)
{ {
local n; /* test parameter */ local n; /* test parameter */
local eps; /* test parameter */ local eps; /* test parameter */
local i; local i;
/* /*
* set test parameters * set test parameters
*/ */
if (isnull(verbose)) { if (isnull(verbose)) {
verbose = defaultverbose; verbose = defaultverbose;
} }
n = 250; n = 250;
eps = epsilon(); eps = epsilon();
srand(3400e3400); srand(3400e3400);
/* /*
* test a lot of stuff * test a lot of stuff
*/ */
err += test3401(strcat(str(tnum++), \ err += test3401(strcat(str(tnum++), \
": acot(cot(x))"), n, eps, verbose); ": acot(cot(x))"), n, eps, verbose);
err += test3402(strcat(str(tnum++), \ err += test3402(strcat(str(tnum++), \
": tan(x/2)-csc(x)+cot(x)"), n, eps, verbose); ": tan(x/2)-csc(x)+cot(x)"), n, eps, verbose);
err += test3403(strcat(str(tnum++), \ err += test3403(strcat(str(tnum++), \
": tan(x)-cot(x)+2*cot(2*x)"), n, eps, verbose); ": tan(x)-cot(x)+2*cot(2*x)"), n, eps, verbose);
err += test3404(strcat(str(tnum++), \ err += test3404(strcat(str(tnum++), \
": cot(x/2)-csc(x)-cot(x)"), n, eps, verbose); ": cot(x/2)-csc(x)-cot(x)"), n, eps, verbose);
err += test3405(strcat(str(tnum++), \ err += test3405(strcat(str(tnum++), \
": atan(tan(x))"), n, eps, verbose); ": atan(tan(x))"), n, eps, verbose);
err += test3406(strcat(str(tnum++), \ err += test3406(strcat(str(tnum++), \
": sec(x)-sec(x+2*N*pi)"), n, eps, verbose); ": sec(x)-sec(x+2*N*pi)"), n, eps, verbose);
/* /*
* test results * test results
*/ */
if (verbose > 1) { if (verbose > 1) {
if (err) { if (err) {
print "***", err, "error(s) found in test3400"; print "***", err, "error(s) found in test3400";
} else { } else {
print "no errors in test3400"; print "no errors in test3400";
} }
} }
return tnum; return tnum;
} }

678
cal/test4000.ptest.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,10 +19,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/03/13 02:38:45 * Under source code control: 1996/03/13 02:38:45
* File existed as early as: 1996 * File existed as early as: 1996
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -31,47 +31,47 @@
* rlen(N) for N > 0 generates a random N-word positive integer. * rlen(N) for N > 0 generates a random N-word positive integer.
* *
* plen(N) for N > 0 generates an almost certainly prime positive * plen(N) for N > 0 generates an almost certainly prime positive
* integer whose word-count is about N. * integer whose word-count is about N.
* *
* clen(N) for N > 0 generates a composite odd N-word integer. * clen(N) for N > 0 generates a composite odd N-word integer.
* *
* ptimes(str, N [, n [, count [, skip, [, verbose]]]]) * ptimes(str, N [, n [, count [, skip, [, verbose]]]])
* tests, and finds the runtime, for * tests, and finds the runtime, for
* ptest(x, count, skip) for n random almost certainly prime integers x * ptest(x, count, skip) for n random almost certainly prime integers x
* with word-count about N; n defaults to ceil(K1/abs(count)/(H1 + N^3)), * with word-count about N; n defaults to ceil(K1/abs(count)/(H1 + N^3)),
* count to COUNT, skip to SKIP. * count to COUNT, skip to SKIP.
* *
* ctimes(str, N [, n [, count [, skip, [, verbose]]]]) * ctimes(str, N [, n [, count [, skip, [, verbose]]]])
* tests, and finds the runtime, for * tests, and finds the runtime, for
* ptest(x, count, skip) for n random composite integers x with word-count * ptest(x, count, skip) for n random composite integers x with word-count
* about N; n defaults to ceil(K2/(H2 + N^3)), count to COUNT, skip * about N; n defaults to ceil(K2/(H2 + N^3)), count to COUNT, skip
* to SKIP. * to SKIP.
* *
* crtimes(str,a,b,n, [,count [, skip, [, verbose]]]) * crtimes(str,a,b,n, [,count [, skip, [, verbose]]])
* tests, and finds the runtime, * tests, and finds the runtime,
* for ptest(x, count, skip) for n random integers x between a and b; * for ptest(x, count, skip) for n random integers x between a and b;
* count defaults to COUNT, skip to SKIP. * count defaults to COUNT, skip to SKIP.
* *
* ntimes (str, N [,n, [, count [, skip [, residue [, modulus[,verb]]]]]]) tests * ntimes (str, N [,n, [, count [, skip [, residue [, modulus[,verb]]]]]]) tests
* and finds the runtime for nextcand(...) and prevcand (...) for * and finds the runtime for nextcand(...) and prevcand (...) for
* n integers x with word-count about N, etc. n defaults to * n integers x with word-count about N, etc. n defaults to
* ceil(K3/(H3 + N^3)); * ceil(K3/(H3 + N^3));
* *
* testnextcand(str, N [, n [, count [, skip [, residue [, modulus [, verb]]]]]) * testnextcand(str, N [, n [, count [, skip [, residue [, modulus [, verb]]]]])
* performs tests of nextcand(x, count, skip, residue, modulus) * performs tests of nextcand(x, count, skip, residue, modulus)
* for n values of x with word-count N; n defaults to * for n values of x with word-count N; n defaults to
* ceil(K3/(H3 + N^3)), count to COUNT, skip to SKIP, residue to 0, * ceil(K3/(H3 + N^3)), count to COUNT, skip to SKIP, residue to 0,
* modulus to 1. * modulus to 1.
* *
* testprevcand(str, N [, n [, count [, skip [, residue [, modulus [, verb]]]]]) * testprevcand(str, N [, n [, count [, skip [, residue [, modulus [, verb]]]]])
* performs tests of prevcand(x, count, skip, residue, modulus) * performs tests of prevcand(x, count, skip, residue, modulus)
* for n values of x with word-count N; n defaults to * for n values of x with word-count N; n defaults to
* ceil(K3/(H3 + N^3)), count to COUNT, skip to SKIP, residue to 0, * ceil(K3/(H3 + N^3)), count to COUNT, skip to SKIP, residue to 0,
* modulus to 1. * modulus to 1.
*/ */
defaultverbose = 1; /* default verbose value */ defaultverbose = 1; /* default verbose value */
/* /*
* test defaults * test defaults
@@ -97,324 +97,324 @@ global H3 = 10;
define rlen(N) define rlen(N)
{ {
if (!isint(N) || N <= 0) if (!isint(N) || N <= 0)
quit "Bad argument for rlen"; quit "Bad argument for rlen";
return rand(BASE^(N-1), BASE^N); return rand(BASE^(N-1), BASE^N);
} }
define plen(N) = nextcand(rlen(N), 10, 0); define plen(N) = nextcand(rlen(N), 10, 0);
define clen(N) define clen(N)
{ {
local n, v; local n, v;
do { do {
v = rlen(N); v = rlen(N);
if (iseven(v)) if (iseven(v))
v++; v++;
} }
while while
(ptest(v, 10, 0)); (ptest(v, 10, 0));
return v; return v;
} }
define ptimes(str, N, n, count, skip, verbose) define ptimes(str, N, n, count, skip, verbose)
{ {
local A, i, t, p, m; local A, i, t, p, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (isnull(count)) if (isnull(count))
count = COUNT; count = COUNT;
if (isnull(n)) { if (isnull(n)) {
n = ceil(K1/abs(count)/(H1 + N^3)); n = ceil(K1/abs(count)/(H1 + N^3));
if (verbose > 1) { if (verbose > 1) {
print "n =",n; print "n =",n;
} }
} }
if (isnull(skip)) if (isnull(skip))
skip = SKIP; skip = SKIP;
mat A[n]; mat A[n];
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
A[i] = plen(N); A[i] = plen(N);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
p = ptest(A[i], count, skip); p = ptest(A[i], count, skip);
if (!p) { if (!p) {
if (verbose > 0) { if (verbose > 0) {
printf("*** Error for x = %d\n", A[i]); printf("*** Error for x = %d\n", A[i]);
m++; m++;
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
t = round(usertime() - t, 4); t = round(usertime() - t, 4);
if (verbose > 1) { if (verbose > 1) {
printf("%d probable primes: time = %d\n", n, t); printf("%d probable primes: time = %d\n", n, t);
} else { } else {
printf("%d probable primes: passed\n", n); printf("%d probable primes: passed\n", n);
} }
} }
} }
return m; return m;
} }
define ctimes(str, N, n, count, skip, verbose) define ctimes(str, N, n, count, skip, verbose)
{ {
local A, i, r, t, p, m; local A, i, r, t, p, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (isnull(count)) if (isnull(count))
count = COUNT; count = COUNT;
if (isnull(n)) { if (isnull(n)) {
n = ceil(K2/(H2 + N^3)); n = ceil(K2/(H2 + N^3));
if (verbose > 1) { if (verbose > 1) {
print "n =",n; print "n =",n;
} }
} }
if (isnull(skip)) if (isnull(skip))
skip = SKIP; skip = SKIP;
mat A[n]; mat A[n];
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
A[i] = clen(N); A[i] = clen(N);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
p = ptest(A[i], count, skip); p = ptest(A[i], count, skip);
if (p) { if (p) {
if (verbose > 0) { if (verbose > 0) {
printf("*** Error, what should be rare " printf("*** Error, what should be rare "
"has occurred for x = %d \n", A[i]); "has occurred for x = %d \n", A[i]);
m++; m++;
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
t = round(usertime() - t, 4); t = round(usertime() - t, 4);
if (verbose > 1) { if (verbose > 1) {
printf("%d probable primes: time = %d\n", n, t); printf("%d probable primes: time = %d\n", n, t);
} else { } else {
printf("%d probable primes: passed\n", n); printf("%d probable primes: passed\n", n);
} }
} }
} }
return m; return m;
} }
define crtimes(str, a, b, n, count, skip, verbose) define crtimes(str, a, b, n, count, skip, verbose)
{ {
local A, P, i, t, p, m; local A, P, i, t, p, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (b < a) if (b < a)
swap(a,b); swap(a,b);
b++; b++;
if (isnull(count)) if (isnull(count))
count = COUNT; count = COUNT;
if (isnull(skip)) if (isnull(skip))
skip = SKIP; skip = SKIP;
mat A[n]; mat A[n];
mat P[n]; mat P[n];
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
A[i] = rand(a,b); A[i] = rand(a,b);
P[i] = ptest(A[i], 20, 0); P[i] = ptest(A[i], 20, 0);
} }
t = usertime(); t = usertime();
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
p = ptest(A[i], count, skip); p = ptest(A[i], count, skip);
if (p != P[i]) { if (p != P[i]) {
if (verbose > 0) { if (verbose > 0) {
printf("*** Apparent error for %s x = %d\n", printf("*** Apparent error for %s x = %d\n",
P[i] ? "prime" : "composite", A[i]); P[i] ? "prime" : "composite", A[i]);
++m; ++m;
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)?\n", m); printf("*** %d error(s)?\n", m);
} else { } else {
t = round(usertime() - t, 4); t = round(usertime() - t, 4);
if (verbose > 1) { if (verbose > 1) {
printf("%d probable primes: time = %d\n", n, t); printf("%d probable primes: time = %d\n", n, t);
} else { } else {
printf("%d probable primes: passed\n", n); printf("%d probable primes: passed\n", n);
} }
} }
} }
return m; return m;
} }
define ntimes(str, N, n, count, skip, residue, modulus, verbose) define ntimes(str, N, n, count, skip, residue, modulus, verbose)
{ {
local A, i, t, p, tnext, tprev; local A, i, t, p, tnext, tprev;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
if (isnull(count)) if (isnull(count))
count = COUNT; count = COUNT;
if (isnull(n)) { if (isnull(n)) {
n = ceil(K3/(H3 + N^3)); n = ceil(K3/(H3 + N^3));
if (verbose > 1) { if (verbose > 1) {
print "n =",n; print "n =",n;
} }
} }
if (isnull(skip)) if (isnull(skip))
skip = SKIP; skip = SKIP;
if (isnull(residue)) if (isnull(residue))
residue = RESIDUE; residue = RESIDUE;
if (isnull(modulus)) if (isnull(modulus))
modulus = MODULUS; modulus = MODULUS;
mat A[n]; mat A[n];
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
A[i] = rlen(N); A[i] = rlen(N);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
p = nextcand(A[i], count, skip, residue, modulus); p = nextcand(A[i], count, skip, residue, modulus);
} }
tnext = round(usertime() - t, 4); tnext = round(usertime() - t, 4);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
p = prevcand(A[i], count, skip, residue, modulus); p = prevcand(A[i], count, skip, residue, modulus);
} }
tprev = round(usertime() - t, 4); tprev = round(usertime() - t, 4);
if (verbose > 0) { if (verbose > 0) {
printf("%d evaluations, nextcand: %d, " printf("%d evaluations, nextcand: %d, "
"prevcand: %d\n", n, tnext, tprev); "prevcand: %d\n", n, tnext, tprev);
} }
} }
define testnextcand(str, N, n, count, skip, residue, modulus, verbose) define testnextcand(str, N, n, count, skip, residue, modulus, verbose)
{ {
local p, x, y, i, m; local p, x, y, i, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (isnull(count)) if (isnull(count))
count = COUNT; count = COUNT;
if (isnull(n)) { if (isnull(n)) {
n = ceil(K3/(H3 + N^3)); n = ceil(K3/(H3 + N^3));
print "n =",n; print "n =",n;
} }
if (isnull(skip)) if (isnull(skip))
skip = SKIP; skip = SKIP;
if (isnull(residue)) if (isnull(residue))
residue = RESIDUE; residue = RESIDUE;
if (isnull(modulus)) if (isnull(modulus))
modulus = MODULUS; modulus = MODULUS;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rlen(N); x = rlen(N);
y = nextcand(x, count, skip, residue, modulus); y = nextcand(x, count, skip, residue, modulus);
p = testnext1(x, y, count, skip, residue, modulus); p = testnext1(x, y, count, skip, residue, modulus);
if (p) { if (p) {
m++; m++;
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure %d for x = %d\n", p, x); printf("*** Failure %d for x = %d\n", p, x);
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)?\n", m); printf("*** %d error(s)?\n", m);
} else { } else {
printf("%d successful tests\n", n); printf("%d successful tests\n", n);
} }
} }
return m; return m;
} }
define testnext1(x, y, count, skip, residue, modulus) define testnext1(x, y, count, skip, residue, modulus)
{ {
if (y <= x) if (y <= x)
return 1; return 1;
if (!ptest(y, count, skip)) if (!ptest(y, count, skip))
return 2; return 2;
if (mne(y, residue, modulus)) if (mne(y, residue, modulus))
return 3; return 3;
return 0; return 0;
} }
define testprevcand(str, N, n, count, skip, residue, modulus, verbose) define testprevcand(str, N, n, count, skip, residue, modulus, verbose)
{ {
local p, x, y, i, m; local p, x, y, i, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (isnull(count)) if (isnull(count))
count = COUNT; count = COUNT;
if (isnull(n)) { if (isnull(n)) {
n = ceil(K3/(H3 + N^3)); n = ceil(K3/(H3 + N^3));
print "n =",n; print "n =",n;
} }
if (isnull(skip)) if (isnull(skip))
skip = SKIP; skip = SKIP;
if (isnull(residue)) if (isnull(residue))
residue = RESIDUE; residue = RESIDUE;
if (isnull(modulus)) if (isnull(modulus))
modulus = MODULUS; modulus = MODULUS;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rlen(N); x = rlen(N);
y = prevcand(x, count, skip, residue, modulus); y = prevcand(x, count, skip, residue, modulus);
p = testprev1(x, y, count, skip, residue, modulus); p = testprev1(x, y, count, skip, residue, modulus);
if (p) { if (p) {
m++; m++;
if (verbose > 1) { if (verbose > 1) {
printf("*** Failure %d for x = %d\n", p, x); printf("*** Failure %d for x = %d\n", p, x);
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)?\n", m); printf("*** %d error(s)?\n", m);
} else { } else {
printf("%d successful tests\n", n); printf("%d successful tests\n", n);
} }
} }
return m; return m;
} }
define testprev1(x, y, count, skip, residue, modulus) define testprev1(x, y, count, skip, residue, modulus)
{ {
if (y >= x) if (y >= x)
return 1; return 1;
if (!ptest(y, count, skip)) if (!ptest(y, count, skip))
return 2; return 2;
if (mne(y, residue, modulus)) if (mne(y, residue, modulus))
return 3; return 3;
return 0; return 0;
} }
/* /*
@@ -422,52 +422,52 @@ define testprev1(x, y, count, skip, residue, modulus)
*/ */
define test4000(v, tnum) define test4000(v, tnum)
{ {
local n; /* test parameter */ local n; /* test parameter */
/* /*
* set test parameters * set test parameters
*/ */
srand(4000e4000); srand(4000e4000);
/* /*
* test a lot of stuff * test a lot of stuff
*/ */
err += ptimes(strcat(str(tnum++),": ptimes(1,250)"), 1, 250,,,v); err += ptimes(strcat(str(tnum++),": ptimes(1,250)"), 1, 250,,,v);
err += ptimes(strcat(str(tnum++),": ptimes(3,50)"), 3, 50,,,v); err += ptimes(strcat(str(tnum++),": ptimes(3,50)"), 3, 50,,,v);
err += ptimes(strcat(str(tnum++),": ptimes(5,20)"), 5, 20,,,v); err += ptimes(strcat(str(tnum++),": ptimes(5,20)"), 5, 20,,,v);
err += ctimes(strcat(str(tnum++),": ctimes(1,7500)"), 1, 7500,,,v); err += ctimes(strcat(str(tnum++),": ctimes(1,7500)"), 1, 7500,,,v);
err += ctimes(strcat(str(tnum++),": ctimes(3,500)"), 3, 500,,,v); err += ctimes(strcat(str(tnum++),": ctimes(3,500)"), 3, 500,,,v);
err += ctimes(strcat(str(tnum++),": ctimes(5,200)"), 5, 200,,,v); err += ctimes(strcat(str(tnum++),": ctimes(5,200)"), 5, 200,,,v);
err += crtimes(strcat(str(tnum++),": crtimes(2^30,2^31,2500)"), err += crtimes(strcat(str(tnum++),": crtimes(2^30,2^31,2500)"),
2^30, 2^31, 2500,,,v); 2^30, 2^31, 2500,,,v);
err += crtimes(strcat(str(tnum++),": crtimes(2^300,2^301,75)"), err += crtimes(strcat(str(tnum++),": crtimes(2^300,2^301,75)"),
2^300, 2^301, 75,,,v); 2^300, 2^301, 75,,,v);
err += testprevcand(strcat(str(tnum++),": testprevcand(1,250)"), err += testprevcand(strcat(str(tnum++),": testprevcand(1,250)"),
1, 250, ,,,,v); 1, 250, ,,,,v);
err += testprevcand(strcat(str(tnum++),": testprevcand(3,25)"), err += testprevcand(strcat(str(tnum++),": testprevcand(3,25)"),
3, 25, ,,,,v); 3, 25, ,,,,v);
err += testprevcand(strcat(str(tnum++),": testprevcand(5,10)"), err += testprevcand(strcat(str(tnum++),": testprevcand(5,10)"),
5, 10, ,,,,v); 5, 10, ,,,,v);
err += testnextcand(strcat(str(tnum++),": testnextcand(1,250)"), err += testnextcand(strcat(str(tnum++),": testnextcand(1,250)"),
1, 250, ,,,,v); 1, 250, ,,,,v);
err += testnextcand(strcat(str(tnum++),": testnextcand(3,25)"), err += testnextcand(strcat(str(tnum++),": testnextcand(3,25)"),
3, 25, ,,,,v); 3, 25, ,,,,v);
err += testnextcand(strcat(str(tnum++),": testnextcand(5,10)"), err += testnextcand(strcat(str(tnum++),": testnextcand(5,10)"),
5, 10, ,,,,v); 5, 10, ,,,,v);
/* /*
* report results * report results
*/ */
if (v > 1) { if (v > 1) {
if (err) { if (err) {
print "***", err, "error(s) found in testall"; print "***", err, "error(s) found in testall";
} else { } else {
print "no errors in testall"; print "no errors in testall";
} }
} }
return tnum; return tnum;
} }

772
cal/test4100.redc.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,54 +19,54 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/03/13 03:53:22 * Under source code control: 1996/03/13 03:53:22
* File existed as early as: 1996 * File existed as early as: 1996
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
* Some severe tests and timing functions for REDC functions and pmod. * Some severe tests and timing functions for REDC functions and pmod.
* *
* testall(str,n,N,M,verbose) * testall(str,n,N,M,verbose)
* performs n tests using arguments x, y, ... * performs n tests using arguments x, y, ...
* randomly selected from [-N, N) or when nonnegative values are * randomly selected from [-N, N) or when nonnegative values are
* required, [0, N), and m an odd positive integer in [1,N], * required, [0, N), and m an odd positive integer in [1,N],
* and where a "small" (say less than 10000) exponent k is to be * and where a "small" (say less than 10000) exponent k is to be
* used (when computing x^k % m directly) k is random in [0,M). * used (when computing x^k % m directly) k is random in [0,M).
* Default values for N and M are 1e20 and 100. * Default values for N and M are 1e20 and 100.
* *
* times(str,N,n,verbose) * times(str,N,n,verbose)
* gives times for n evaluations of rcin, etc. with * gives times for n evaluations of rcin, etc. with
* N-word arguments; default n is ceil(K1/power(N,1.585). * N-word arguments; default n is ceil(K1/power(N,1.585).
* *
* powtimes(str, N1,N2,n, verbose) * powtimes(str, N1,N2,n, verbose)
* gives times for n evaluations of pmod(x,k,m) * gives times for n evaluations of pmod(x,k,m)
* for the three algorithms "small", "normal", "bignum" that * for the three algorithms "small", "normal", "bignum" that
* pmod may use, and equivalent functions rcpow(xr,k,m) for * pmod may use, and equivalent functions rcpow(xr,k,m) for
* "small" or "bignum" cases, where xr = rcin(x,m). The * "small" or "bignum" cases, where xr = rcin(x,m). The
* modulus m is a random positive odd N1-word number; x has * modulus m is a random positive odd N1-word number; x has
* random integer values in [0, m-1]; k has random N2-word values. * random integer values in [0, m-1]; k has random N2-word values.
* N2 defaults to 1; n defaults to ceil(K2/power(N1,1.585)/N2). * N2 defaults to 1; n defaults to ceil(K2/power(N1,1.585)/N2).
* *
* inittimes(str, N, n, verbose) * inittimes(str, N, n, verbose)
* displays the times and tests n evaluations of rcin(x,m) * displays the times and tests n evaluations of rcin(x,m)
* and rcout(x,m) where m is a random positive odd N-word integer, * and rcout(x,m) where m is a random positive odd N-word integer,
* x is a random integer in [0, m-1]; n defaults to ceil(K1/N^2). * x is a random integer in [0, m-1]; n defaults to ceil(K1/N^2).
* *
* rlen_4100(N) * rlen_4100(N)
* generates a random positive N-word integer. The global * generates a random positive N-word integer. The global
* BASEB should be set to the word-size for the computer being * BASEB should be set to the word-size for the computer being
* used. The parameters K1, K2 which control the default n * used. The parameters K1, K2 which control the default n
* should be adjusted to give reasonable runtimes. * should be adjusted to give reasonable runtimes.
* *
* olen(N) * olen(N)
* generates a random odd positive N-word number. * generates a random odd positive N-word number.
* *
*/ */
defaultverbose = 1; /* default verbose value */ defaultverbose = 1; /* default verbose value */
/* /*
* test defaults * test defaults
@@ -79,371 +79,371 @@ define rlen_4100(N) = rand(test4100_BASE^(N-1), test4100_BASE^N);
define olen(N) define olen(N)
{ {
local v; local v;
v = rlen_4100(N); v = rlen_4100(N);
if (iseven(v)) if (iseven(v))
v++; v++;
return v; return v;
} }
define test4101(x,y,m,k,z1,z2,verbose) define test4101(x,y,m,k,z1,z2,verbose)
{ {
local xr, yr, v, w, oneone; local xr, yr, v, w, oneone;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
xr = rcin(x,m); xr = rcin(x,m);
yr = rcin(y,m); yr = rcin(y,m);
oneone = rcin(rcin(1,m),m); oneone = rcin(rcin(1,m),m);
if (xr >= m || xr < 0) { if (xr >= m || xr < 0) {
if (verbose > 1) if (verbose > 1)
printf("Failure 1 for x = %d, m = %d\n", x, m); printf("Failure 1 for x = %d, m = %d\n", x, m);
return 1; return 1;
} }
if (rcin(x * y, m) != mod(xr * y, m, 0)) { if (rcin(x * y, m) != mod(xr * y, m, 0)) {
if (verbose > 1) { if (verbose > 1) {
printf("Failure 2 for x = %d, y = %d, m = %d\n", printf("Failure 2 for x = %d, y = %d, m = %d\n",
x, y, m); x, y, m);
} }
return 2; return 2;
} }
if (rcout(xr, m) != x % m) { if (rcout(xr, m) != x % m) {
if (verbose > 1) if (verbose > 1)
printf("Failure 3 for x = %d, m = %d\n", x, m); printf("Failure 3 for x = %d, m = %d\n", x, m);
return 3; return 3;
} }
if (rcout(rcmul(xr,yr,m),m) != mod(x * y, m, 0)) { if (rcout(rcmul(xr,yr,m),m) != mod(x * y, m, 0)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 4 for x = %d, y = %d, m = %d\n", printf("Failure 4 for x = %d, y = %d, m = %d\n",
x, y, m); x, y, m);
return 4; return 4;
} }
if (rcmul(x,yr,m) != mod(x * y, m, 0)) { if (rcmul(x,yr,m) != mod(x * y, m, 0)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 5 for x = %d, y = %d, m = %d\n", printf("Failure 5 for x = %d, y = %d, m = %d\n",
x, y, m); x, y, m);
return 5; return 5;
} }
if (rcin(rcmul(x,y,m),m) != mod(x * y, m, 0)) { if (rcin(rcmul(x,y,m),m) != mod(x * y, m, 0)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 6 for x = %d, y = %d, m = %d\n", printf("Failure 6 for x = %d, y = %d, m = %d\n",
x, y, m); x, y, m);
return 6; return 6;
} }
if (rcout(rcsq(xr,m),m) != mod(x^2, m, 0)) { if (rcout(rcsq(xr,m),m) != mod(x^2, m, 0)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 7 for x = %d, m = %d\n", x, m); printf("Failure 7 for x = %d, m = %d\n", x, m);
return 7; return 7;
} }
if (rcin(rcsq(x,m),m) != mod(x^2, m, 0)) { if (rcin(rcsq(x,m),m) != mod(x^2, m, 0)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 8 for x = %d, m = %d\n", printf("Failure 8 for x = %d, m = %d\n",
x, y, m); x, y, m);
return 8; return 8;
} }
if (rcout(rcpow(xr,k,m),m) != mod(x^k, m, 0)) { if (rcout(rcpow(xr,k,m),m) != mod(x^k, m, 0)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 9 for x = %d, m = %d, k = %d\n", printf("Failure 9 for x = %d, m = %d, k = %d\n",
x, m, k); x, m, k);
return 9; return 9;
} }
if (rcpow(x,k,m) != rcin(rcout(x,m)^k, m)) { if (rcpow(x,k,m) != rcin(rcout(x,m)^k, m)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 10: x = %d, k = %d, m = %d\n", printf("Failure 10: x = %d, k = %d, m = %d\n",
x, k, m); x, k, m);
return 10; return 10;
} }
if (rcpow(x, z1 * z2, m) != rcpow(rcpow(x,z1,m), z2, m)) { if (rcpow(x, z1 * z2, m) != rcpow(rcpow(x,z1,m), z2, m)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 11: x = %d, z1 = %d, z2 = %d, m = %d\n", printf("Failure 11: x = %d, z1 = %d, z2 = %d, m = %d\n",
x, z1, z2, m); x, z1, z2, m);
return 11; return 11;
} }
if (xr != rcmul(oneone, x, m)) { if (xr != rcmul(oneone, x, m)) {
if (verbose > 1) if (verbose > 1)
printf("Failure 12: x = %d, m = %d\n", x, m); printf("Failure 12: x = %d, m = %d\n", x, m);
return 12; return 12;
} }
return 0; return 0;
} }
define testall(str,n,N,M,verbose) define testall(str,n,N,M,verbose)
{ {
local i, p, x, y, z1, z2, c, k, m; local i, p, x, y, z1, z2, c, k, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (isnull(N)) if (isnull(N))
N = 1e20; N = 1e20;
if (isnull(M)) if (isnull(M))
M = 100; M = 100;
c = 0; c = 0;
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
x = rand(-N, N); x = rand(-N, N);
y = rand(-N, N); y = rand(-N, N);
z1 = rand(N); z1 = rand(N);
z2 = rand(N); z2 = rand(N);
c = rand(N); c = rand(N);
if (iseven(c)) if (iseven(c))
c++; c++;
k = rand(M); k = rand(M);
if (verbose > 1) if (verbose > 1)
printf("x = %d, y = %d, c = %d, k = %d\n", x, y, c, k); printf("x = %d, y = %d, c = %d, k = %d\n", x, y, c, k);
p = test4101(x,y,c,k,z1,z2); p = test4101(x,y,c,k,z1,z2);
if (p) { if (p) {
m++; m++;
if (verbose > 0) { if (verbose > 0) {
printf("*** Failure %d in test %d\n", p, i); printf("*** Failure %d in test %d\n", p, i);
} }
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("passed %d tests\n", n); printf("passed %d tests\n", n);
} }
} }
return m; return m;
} }
define times(str,N,n,verbose) define times(str,N,n,verbose)
{ {
local m, m2, A, B, C, x, y, t, i, z; local m, m2, A, B, C, x, y, t, i, z;
local trcin, trcout, trcmul, trcsq; local trcin, trcout, trcmul, trcsq;
local tmul, tsq, tmod, tquomod; local tmul, tsq, tmod, tquomod;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = olen(N); m = olen(N);
m2 = m^2; m2 = m^2;
if (isnull(n)) { if (isnull(n)) {
n = ceil(test4100_K1/power(N,1.585)); n = ceil(test4100_K1/power(N,1.585));
if (verbose > 1) if (verbose > 1)
printf("n = %d\n", n); printf("n = %d\n", n);
} }
mat A[n]; mat A[n];
mat B[n]; mat B[n];
mat C[n]; mat C[n];
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
A[i] = rand(m); A[i] = rand(m);
B[i] = rand(m); B[i] = rand(m);
C[i] = rand(m2); C[i] = rand(m2);
} }
z = rcin(0,m); /* to initialize redc and maybe lastmod information */ z = rcin(0,m); /* to initialize redc and maybe lastmod information */
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z = rcin(A[i],m); z = rcin(A[i],m);
trcin = round(usertime() - t, 3); trcin = round(usertime() - t, 3);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z = rcout(A[i],m); z = rcout(A[i],m);
trcout = round(usertime() - t, 3); trcout = round(usertime() - t, 3);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z = rcmul(A[i],B[i],m); z = rcmul(A[i],B[i],m);
trcmul = round(usertime() - t, 3); trcmul = round(usertime() - t, 3);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z = rcsq(A[i],m); z = rcsq(A[i],m);
trcsq = round(usertime() - t, 3); trcsq = round(usertime() - t, 3);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z = A[i] * B[i]; z = A[i] * B[i];
tmul = round(usertime() - t, 3); tmul = round(usertime() - t, 3);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z = A[i]^2; z = A[i]^2;
tsq = round(usertime() - t, 3); tsq = round(usertime() - t, 3);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z = C[i] % A[i]; z = C[i] % A[i];
tmod = round(usertime() - t, 3); tmod = round(usertime() - t, 3);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
quomod(C[i], A[i], x, y); quomod(C[i], A[i], x, y);
tquomod = round(usertime() - t,3); tquomod = round(usertime() - t,3);
if (verbose > 1) { if (verbose > 1) {
printf("rcin: %d, rcout: %d, rcmul: %d, rcsq: %d\n", printf("rcin: %d, rcout: %d, rcmul: %d, rcsq: %d\n",
trcin, trcout, trcmul, trcsq); trcin, trcout, trcmul, trcsq);
printf("%s: mul: %d, sq: %d, mod: %d, quomod: %d\n", printf("%s: mul: %d, sq: %d, mod: %d, quomod: %d\n",
str, tmul, tsq, tmod, tquomod); str, tmul, tsq, tmod, tquomod);
} else if (verbose > 0) { } else if (verbose > 0) {
printf("no error(s)\n"); printf("no error(s)\n");
} }
return 0; return 0;
} }
define powtimes(str, N1, N2, n, verbose) define powtimes(str, N1, N2, n, verbose)
{ {
local A, Ar, B, v, i, t, z1, z2, z3, z4, z5, cp, crc; local A, Ar, B, v, i, t, z1, z2, z3, z4, z5, cp, crc;
local tsmall, tnormal, tbignum, trcsmall, trcbig, m; local tsmall, tnormal, tbignum, trcsmall, trcbig, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (isnull(N2)) if (isnull(N2))
N2 = 1; N2 = 1;
if (isnull(n)) { if (isnull(n)) {
n = ceil(test4100_K2/power(N1, 1.585)/N2); n = ceil(test4100_K2/power(N1, 1.585)/N2);
printf ("n = %d\n", n); printf ("n = %d\n", n);
} }
mat A[n]; mat A[n];
mat Ar[n]; mat Ar[n];
mat B[n]; mat B[n];
v = olen(N1); v = olen(N1);
cp = config("pow2", 2); cp = config("pow2", 2);
crc = config("redc2", 2); crc = config("redc2", 2);
/* initialize redc and lastmod info */ /* initialize redc and lastmod info */
z1 = z2 = z3 = z4 = z5 = rcin(0,v); z1 = z2 = z3 = z4 = z5 = rcin(0,v);
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
A[i] = rand(v); A[i] = rand(v);
Ar[i] = rcin(A[i], v); Ar[i] = rcin(A[i], v);
B[i] = rlen_4100(N2); B[i] = rlen_4100(N2);
} }
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z1 += pmod(A[i], B[i], v); z1 += pmod(A[i], B[i], v);
tbignum = round(usertime() - t, 4); tbignum = round(usertime() - t, 4);
config("pow2", 1e6); config("pow2", 1e6);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z2 += pmod(A[i], B[i], v); z2 += pmod(A[i], B[i], v);
tnormal = round(usertime() - t, 4); tnormal = round(usertime() - t, 4);
config("redc2",1e6); config("redc2",1e6);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z3 += pmod(A[i], B[i], v); z3 += pmod(A[i], B[i], v);
tsmall = round(usertime() - t, 4); tsmall = round(usertime() - t, 4);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z4 += rcpow(Ar[i], B[i], v); z4 += rcpow(Ar[i], B[i], v);
trcsmall = round(usertime() - t, 4); trcsmall = round(usertime() - t, 4);
config("redc2", 2); config("redc2", 2);
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
z5 += rcpow(Ar[i], B[i], v); z5 += rcpow(Ar[i], B[i], v);
trcbig = round(usertime() - t, 4); trcbig = round(usertime() - t, 4);
if (z1 != z2) { if (z1 != z2) {
++m; ++m;
if (verbose > 0) { if (verbose > 0) {
print "*** z1 != z2"; print "*** z1 != z2";
} }
} else if (z1 != z3) { } else if (z1 != z3) {
++m; ++m;
if (verbose > 0) { if (verbose > 0) {
print "*** z1 != z3"; print "*** z1 != z3";
} }
} else if (z2 != z3) { } else if (z2 != z3) {
++m; ++m;
if (verbose > 0) { if (verbose > 0) {
print "*** z2 != z3"; print "*** z2 != z3";
} }
} else if (rcout(z4, v) != z1 % v) { } else if (rcout(z4, v) != z1 % v) {
++m; ++m;
if (verbose > 0) { if (verbose > 0) {
print "*** z4 != z1"; print "*** z4 != z1";
} }
} else if (z4 != z5) { } else if (z4 != z5) {
++m; ++m;
if (verbose > 0) { if (verbose > 0) {
print "*** z4 != z5"; print "*** z4 != z5";
} }
} }
config("pow2", cp); config("pow2", cp);
config("redc2", crc); config("redc2", crc);
if (verbose > 1) { if (verbose > 1) {
} }
if (verbose > 1) { if (verbose > 1) {
printf("Small: %d, normal: %d, bignum: %d\n", printf("Small: %d, normal: %d, bignum: %d\n",
tsmall, tnormal, tbignum); tsmall, tnormal, tbignum);
printf("%s: rcsmall: %d, rcbig: %d\n", printf("%s: rcsmall: %d, rcbig: %d\n",
str, trcsmall, trcbig); str, trcsmall, trcbig);
} else if (verbose > 0) { } else if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)\n", m); printf("*** %d error(s)\n", m);
} else { } else {
printf("passed\n"); printf("passed\n");
} }
} }
return 0; return 0;
} }
define inittimes(str,N,n,verbose) define inittimes(str,N,n,verbose)
{ {
local A, M, B, R, i, t, trcin, trcout, m; local A, M, B, R, i, t, trcin, trcout, m;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
m = 0; m = 0;
if (isnull(n)) { if (isnull(n)) {
n = ceil(test4100_K1/N^2); n = ceil(test4100_K1/N^2);
if (verbose > 1) { if (verbose > 1) {
printf ("n = %d\n", n); printf ("n = %d\n", n);
} }
} }
mat A[n]; mat A[n];
mat M[n]; mat M[n];
mat B[n]; mat B[n];
mat R[n]; mat R[n];
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
M[i] = olen(N); M[i] = olen(N);
A[i] = rand(M[i]); A[i] = rand(M[i]);
} }
t = usertime(); t = usertime();
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
R[i] = rcin(A[i], M[i]); R[i] = rcin(A[i], M[i]);
trcin = round(usertime() - t, 4); trcin = round(usertime() - t, 4);
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
B[i] = rcout(R[i], M[i]); B[i] = rcout(R[i], M[i]);
trcout = round(usertime() - t, 4); trcout = round(usertime() - t, 4);
for (i = 0; i < n; i++) { for (i = 0; i < n; i++) {
if (B[i] != A[i]) { if (B[i] != A[i]) {
++m; ++m;
if (verbose > 0) { if (verbose > 0) {
print "*** Error!!!"; print "*** Error!!!";
} }
break; break;
} }
} }
if (verbose > 0) { if (verbose > 0) {
if (m) { if (m) {
printf("*** %d error(s)?\n", m); printf("*** %d error(s)?\n", m);
} else { } else {
if (verbose > 1) { if (verbose > 1) {
printf("%d successful tests: rcin: %d, rcout: %d\n", printf("%d successful tests: rcin: %d, rcout: %d\n",
n, trcin, trcout); n, trcin, trcout);
} else { } else {
printf("%d successful tests: passed\n", n); printf("%d successful tests: passed\n", n);
} }
} }
} }
return m; return m;
} }
/* /*
@@ -451,40 +451,40 @@ define inittimes(str,N,n,verbose)
*/ */
define test4100(v, tnum) define test4100(v, tnum)
{ {
local n; /* test parameter */ local n; /* test parameter */
/* /*
* set test parameters * set test parameters
*/ */
srand(4100e4100); srand(4100e4100);
/* /*
* test a lot of stuff * test a lot of stuff
*/ */
err += testall(strcat(str(tnum++),": testall(10,,500)"), 10,, 500, v); err += testall(strcat(str(tnum++),": testall(10,,500)"), 10,, 500, v);
err += testall(strcat(str(tnum++),": testall(200)"), 200,,, v); err += testall(strcat(str(tnum++),": testall(200)"), 200,,, v);
err += times(strcat(str(tnum++),": times(3,3000)"), 3, 3000, v); err += times(strcat(str(tnum++),": times(3,3000)"), 3, 3000, v);
err += times(strcat(str(tnum++),": times(30,300)"), 30, 300, v); err += times(strcat(str(tnum++),": times(30,300)"), 30, 300, v);
err += times(strcat(str(tnum++),": times(300,30)"), 300, 30, v); err += times(strcat(str(tnum++),": times(300,30)"), 300, 30, v);
err += times(strcat(str(tnum++),": times(1000,3)"), 1000, 3, v); err += times(strcat(str(tnum++),": times(1000,3)"), 1000, 3, v);
err += powtimes(strcat(str(tnum++),": powtimes(100)"),100,,v); err += powtimes(strcat(str(tnum++),": powtimes(100)"),100,,v);
err += powtimes(strcat(str(tnum++),": powtimes(250)"),250,,v); err += powtimes(strcat(str(tnum++),": powtimes(250)"),250,,v);
err += inittimes(strcat(str(tnum++),": inittimes(10)"),10,,v); err += inittimes(strcat(str(tnum++),": inittimes(10)"),10,,v);
err += inittimes(strcat(str(tnum++),": inittimes(100,70)"),100,70,v); err += inittimes(strcat(str(tnum++),": inittimes(100,70)"),100,70,v);
err += inittimes(strcat(str(tnum++),": inittimes(1000,4)"),1000,4,v); err += inittimes(strcat(str(tnum++),": inittimes(1000,4)"),1000,4,v);
/* /*
* report results * report results
*/ */
if (v > 1) { if (v > 1) {
if (err) { if (err) {
print "***", err, "error(s) found in testall"; print "***", err, "error(s) found in testall";
} else { } else {
print "no errors in testall"; print "no errors in testall";
} }
} }
return tnum; return tnum;
} }

500
cal/test4600.fileop.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,14 +19,14 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/07/02 20:04:40 * Under source code control: 1996/07/02 20:04:40
* File existed as early as: 1996 * File existed as early as: 1996
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
defaultverbose = 1; /* default verbose value */ defaultverbose = 1; /* default verbose value */
/* /*
* test globals * test globals
@@ -35,254 +35,254 @@ global A, f, pos;
define stest(str, verbose) define stest(str, verbose)
{ {
local x; local x;
/* setup */ /* setup */
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
x = rm("-f", "junk4600"); x = rm("-f", "junk4600");
/* /*
* do file operations * do file operations
*/ */
f = fopen("junk4600", "wb"); f = fopen("junk4600", "wb");
if (iserror(f)) { if (iserror(f)) {
print 'failed'; print 'failed';
print '**** fopen("junk4600", "wb") failed'; print '**** fopen("junk4600", "wb") failed';
return 1; return 1;
} }
if (iserror(fputs(f, if (iserror(fputs(f,
"Fourscore and seven years ago our fathers brought forth\n", "Fourscore and seven years ago our fathers brought forth\n",
"on this continent a new nation, conceived in liberty and dedicated\n", "on this continent a new nation, conceived in liberty and dedicated\n",
"to the proposition that all men are created equal.\n"))) { "to the proposition that all men are created equal.\n"))) {
print 'failed'; print 'failed';
print '**** fputs(f, "Fourscore ... failed'; print '**** fputs(f, "Fourscore ... failed';
return 1; return 1;
} }
if (iserror(freopen(f, "rb"))) { if (iserror(freopen(f, "rb"))) {
print 'failed'; print 'failed';
print '**** iserror(freopen(f, "rb")) failed'; print '**** iserror(freopen(f, "rb")) failed';
return 1; return 1;
} }
if (iserror(rewind(f))) { if (iserror(rewind(f))) {
print 'failed'; print 'failed';
print '**** iserror(rewind(f)) failed'; print '**** iserror(rewind(f)) failed';
return 1; return 1;
} }
if (search(f, "and") != 10) { if (search(f, "and") != 10) {
print 'failed'; print 'failed';
print '**** search(f, "and") != 10 failed'; print '**** search(f, "and") != 10 failed';
return 1; return 1;
} }
if (ftell(f) != 13) { if (ftell(f) != 13) {
print 'failed'; print 'failed';
print '**** ftell(f) != 13 failed'; print '**** ftell(f) != 13 failed';
return 1; return 1;
} }
if (search(f, "and") != 109) { if (search(f, "and") != 109) {
print 'failed'; print 'failed';
print '**** search(f, "and") != 109 failed'; print '**** search(f, "and") != 109 failed';
return 1; return 1;
} }
if (ftell(f) != 112) { if (ftell(f) != 112) {
print 'failed'; print 'failed';
print '**** ftell(f) != 112 failed'; print '**** ftell(f) != 112 failed';
return 1; return 1;
} }
if (!isnull(search(f, "and"))) { if (!isnull(search(f, "and"))) {
print 'failed'; print 'failed';
print '**** !isnull(search(f, "and")) failed'; print '**** !isnull(search(f, "and")) failed';
return 1; return 1;
} }
if (ftell(f) != 172) { if (ftell(f) != 172) {
print 'failed'; print 'failed';
print '**** ftell(f) != 172 failed'; print '**** ftell(f) != 172 failed';
return 1; return 1;
} }
if (rsearch(f, "and") != 109) { if (rsearch(f, "and") != 109) {
print 'failed'; print 'failed';
print '**** rsearch(f, "and") != 109 failed'; print '**** rsearch(f, "and") != 109 failed';
return 1; return 1;
} }
if (ftell(f) != 111) { if (ftell(f) != 111) {
print 'failed'; print 'failed';
print '**** ftell(f) != 111 failed'; print '**** ftell(f) != 111 failed';
return 1; return 1;
} }
if (iserror(fseek(f, -4, 1))) { if (iserror(fseek(f, -4, 1))) {
print 'failed'; print 'failed';
print '**** iserror(fseek(f, -4, 1)) failed'; print '**** iserror(fseek(f, -4, 1)) failed';
return 1; return 1;
} }
if (rsearch(f, "and") != 10) { if (rsearch(f, "and") != 10) {
print 'failed'; print 'failed';
print '**** rsearch(f, "and") != 10 failed'; print '**** rsearch(f, "and") != 10 failed';
return 1; return 1;
} }
if (ftell(f) != 12) { if (ftell(f) != 12) {
print 'failed'; print 'failed';
print '**** ftell(f) != 12 failed'; print '**** ftell(f) != 12 failed';
return 1; return 1;
} }
if (iserror(fseek(f, -4, 1))) { if (iserror(fseek(f, -4, 1))) {
print 'failed'; print 'failed';
print '**** iserror(fseek(f, -4, 1)) failed'; print '**** iserror(fseek(f, -4, 1)) failed';
return 1; return 1;
} }
if (!isnull(rsearch(f, "and"))) { if (!isnull(rsearch(f, "and"))) {
print 'failed'; print 'failed';
print '**** !isnull(rsearch(f, "and")) failed'; print '**** !isnull(rsearch(f, "and")) failed';
return 1; return 1;
} }
if (ftell(f) != 0) { if (ftell(f) != 0) {
print 'failed'; print 'failed';
print '**** ftell(f) != 0 failed'; print '**** ftell(f) != 0 failed';
return 1; return 1;
} }
if (iserror(fclose(f))) { if (iserror(fclose(f))) {
print 'failed'; print 'failed';
print '**** iserror(fclose(f)) failed'; print '**** iserror(fclose(f)) failed';
return 1; return 1;
} }
/* /*
* cleanup * cleanup
*/ */
x = rm("junk4600"); x = rm("junk4600");
if (verbose > 0) { if (verbose > 0) {
printf("passed\n"); printf("passed\n");
} }
return 0; return 0;
} }
define ttest(str, m, n, verbose) define ttest(str, m, n, verbose)
{ {
local a, s, i, j; local a, s, i, j;
if (isnull(verbose)) if (isnull(verbose))
verbose = defaultverbose; verbose = defaultverbose;
if (verbose > 0) { if (verbose > 0) {
print str:":",:; print str:":",:;
} }
i = rm("-f", "junk4600"); i = rm("-f", "junk4600");
f = fopen("junk4600", "wb"); f = fopen("junk4600", "wb");
if (isnull(n)) if (isnull(n))
n = 4; n = 4;
if (isnull(m)) if (isnull(m))
m = 4; m = 4;
mat A[m]; mat A[m];
mat pos[m + 1]; mat pos[m + 1];
pos[0] = 0; pos[0] = 0;
for (i = 0; i < m; i++) { for (i = 0; i < m; i++) {
j = 1 + randbit(n); j = 1 + randbit(n);
a = ""; a = "";
while (j-- > 0) while (j-- > 0)
a = strcat(a, char(rand(32, 127))); a = strcat(a, char(rand(32, 127)));
A[i] = a; A[i] = a;
fputs(f, a); fputs(f, a);
pos[i+1] = ftell(f); pos[i+1] = ftell(f);
if (verbose > 1) if (verbose > 1)
printf("A[%d] has length %d\n", i, strlen(a)); printf("A[%d] has length %d\n", i, strlen(a));
} }
fflush(f); fflush(f);
if (verbose > 1) if (verbose > 1)
printf("File has size %d\n", pos[i]); printf("File has size %d\n", pos[i]);
freopen(f, "rb"); freopen(f, "rb");
if (size(f) != pos[i]) { if (size(f) != pos[i]) {
print 'failed'; print 'failed';
printf("**** Failure 1 for file size\n"); printf("**** Failure 1 for file size\n");
return 1; return 1;
} }
for (i = 0; i < m; i++) { for (i = 0; i < m; i++) {
rewind(f); rewind(f);
for (;;) { for (;;) {
j = search(f, A[i]); j = search(f, A[i]);
if (isnull(j) || j > pos[i]) { if (isnull(j) || j > pos[i]) {
print 'failed'; print 'failed';
printf("**** Failure 2 for i = %d\n", i); printf("**** Failure 2 for i = %d\n", i);
return 1; return 1;
} }
if (j == pos[i]) if (j == pos[i])
break; break;
fseek(f, j + 1, 0); fseek(f, j + 1, 0);
} }
if (ftell(f) != pos[i + 1]) { if (ftell(f) != pos[i + 1]) {
print 'failed'; print 'failed';
printf("**** Failure 3 for i = %d\n", i); printf("**** Failure 3 for i = %d\n", i);
return 1; return 1;
} }
} }
for (i = m - 1; i >= 0; i--) { for (i = m - 1; i >= 0; i--) {
fseek(f, 0, 2); fseek(f, 0, 2);
for (;;) { for (;;) {
j = rsearch(f, A[i]); j = rsearch(f, A[i]);
if (isnull(j) || j < pos[i]) { if (isnull(j) || j < pos[i]) {
print 'failed'; print 'failed';
printf("**** Failure 4 for i = %d\n", i); printf("**** Failure 4 for i = %d\n", i);
return 1; return 1;
} }
if (j == pos[i]) if (j == pos[i])
break; break;
fseek(f, -1, 1); fseek(f, -1, 1);
} }
if (ftell(f) != pos[i + 1] - 1) { if (ftell(f) != pos[i + 1] - 1) {
print 'failed'; print 'failed';
printf("**** Failure 5 for i = %d\n", i); printf("**** Failure 5 for i = %d\n", i);
return 1; return 1;
} }
} }
if (iserror(fclose(f))) { if (iserror(fclose(f))) {
print 'failed'; print 'failed';
printf("**** Failure 6 for i = %d\n", i); printf("**** Failure 6 for i = %d\n", i);
return 1; return 1;
} }
i = rm("junk4600"); i = rm("junk4600");
if (verbose > 0) { if (verbose > 0) {
printf("passed\n"); printf("passed\n");
} }
return 0; return 0;
} }
define sprint(x) define sprint(x)
{ {
local i, n; local i, n;
n = strlen(x); n = strlen(x);
for (i = 1; i <= n; i++) print ord(substr(x, i, 1)),; for (i = 1; i <= n; i++) print ord(substr(x, i, 1)),;
print; print;
} }
define findline(f,s) define findline(f,s)
{ {
if (!isfile(f)) if (!isfile(f))
quit "First argument to be a file"; quit "First argument to be a file";
if (!isstr(s)) if (!isstr(s))
quit "Second argument to be a string"; quit "Second argument to be a string";
if (!isnull(search(f,s))) { if (!isnull(search(f,s))) {
rsearch(f, "\n"); rsearch(f, "\n");
print fgetline(f); print fgetline(f);
} }
} }
define findlineold(f,s) define findlineold(f,s)
{ {
local str; local str;
if (!isfile(f)) if (!isfile(f))
quit "First argument to be a file"; quit "First argument to be a file";
if (!isstr(s)) if (!isstr(s))
quit "Second argument to be a string"; quit "Second argument to be a string";
while (!isnull(str = fgetline(f)) && strpos(str, s) == 0); while (!isnull(str = fgetline(f)) && strpos(str, s) == 0);
print str; print str;
} }
/* /*
@@ -290,32 +290,32 @@ define findlineold(f,s)
*/ */
define test4600(v, tnum) define test4600(v, tnum)
{ {
local n; /* test parameter */ local n; /* test parameter */
local i; local i;
/* /*
* set test parameters * set test parameters
*/ */
srand(4600e4600); srand(4600e4600);
/* /*
* test a lot of stuff * test a lot of stuff
*/ */
for (i=0; i < 10; ++i) { for (i=0; i < 10; ++i) {
err += ttest(strcat(str(tnum++), err += ttest(strcat(str(tnum++),
": ttest(",str(i),",",str(i),")"), i, i, v); ": ttest(",str(i),",",str(i),")"), i, i, v);
err += stest(strcat(str(tnum++), ": stest()"), v); err += stest(strcat(str(tnum++), ": stest()"), v);
} }
/* /*
* report results * report results
*/ */
if (v > 1) { if (v > 1) {
if (err) { if (err) {
print "****", err, "error(s) found in testall"; print "****", err, "error(s) found in testall";
} else { } else {
print "no errors in testall"; print "no errors in testall";
} }
} }
return tnum; return tnum;
} }

30
cal/test5100.newdecl.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,14 +19,14 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1996/12/02 23:57:10 * Under source code control: 1996/12/02 23:57:10
* File existed as early as: 1996 * File existed as early as: 1996
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
defaultverbose = 1; /* default verbose value */ defaultverbose = 1; /* default verbose value */
/* /*
* We test the new code generator declaration scope and order. * We test the new code generator declaration scope and order.
@@ -53,14 +53,14 @@ defaultverbose = 1; /* default verbose value */
*/ */
define test5100(x) define test5100(x)
{ {
if (isint(x) && x > 0) { if (isint(x) && x > 0) {
if (iseven(x)) { if (iseven(x)) {
static a5100 = x; static a5100 = x;
a5100++; a5100++;
} else { } else {
static b5100 = x; static b5100 = x;
b5100++; b5100++;
} }
} }
global a5100 = a5100, b5100 = b5100; global a5100 = a5100, b5100 = b5100;
} }

20
cal/test5200.globstat.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,25 +19,25 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1997/02/07 02:48:10 * Under source code control: 1997/02/07 02:48:10
* File existed as early as: 1997 * File existed as early as: 1997
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
defaultverbose = 1; /* default verbose value */ defaultverbose = 1; /* default verbose value */
/* /*
* test the fix of a global/static bug * test the fix of a global/static bug
* *
* Given the following: * Given the following:
* *
* global a = 10; * global a = 10;
* static a = 20; * static a = 20;
* define f(x) = a + x; * define f(x) = a + x;
* define g(x) {global a = 30; return a + x;} * define g(x) {global a = 30; return a + x;}
* define h(x) = a + x; * define h(x) = a + x;
* *
* Older versions of * Older versions of
*/ */

10
cal/test8000.read.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1994/03/14 23:12:51 * Under source code control: 1994/03/14 23:12:51
* File existed as early as: 1994 * File existed as early as: 1994
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */

12
cal/test8400.quit.cal
View File

@@ -9,7 +9,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -17,11 +17,11 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1999/10/31 01:00:03 * Under source code control: 1999/10/31 01:00:03
* File existed as early as: 1999 * File existed as early as: 1999
* *
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/ * chongo <was here> /\oo/\ http://www.isthe.com/chongo/
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
@@ -38,7 +38,7 @@ define test8400()
return x8401+s8401; return x8401+s8401;
} }
print "8402: parsed test8400()"; print "8402: parsed test8400()";
vrfy(test8400() == 64434, '8403: test8400() == 64434'); vrfy(test8400() == 64434, '8403: test8400() == 64434');
quit; quit;
prob('quit did not end test8400.cal'); prob('quit did not end test8400.cal');

288
cal/test8500.divmod.cal
View File

@@ -11,7 +11,7 @@
* *
* Calc is distributed in the hope that it will be useful, but WITHOUT * Calc is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
* Public License for more details. * Public License for more details.
* *
* A copy of version 2.1 of the GNU Lesser General Public License is * A copy of version 2.1 of the GNU Lesser General Public License is
@@ -19,10 +19,10 @@
* received a copy with calc; if not, write to Free Software Foundation, Inc. * received a copy with calc; if not, write to Free Software Foundation, Inc.
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
* *
* Under source code control: 1999/11/12 20:59:59 * Under source code control: 1999/11/12 20:59:59
* File existed as early as: 1999 * File existed as early as: 1999
* *
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
*/ */
/* /*
@@ -30,10 +30,10 @@
*/ */
global err_8500; /* divmod_8500 error count */ global err_8500; /* divmod_8500 error count */
global L_8500; /* list of problem values */ global L_8500; /* list of problem values */
global ver_8500; /* test verbosity - see setting comment near bottom */ global ver_8500; /* test verbosity - see setting comment near bottom */
global old_seed_8500; /* old srand() seed */ global old_seed_8500; /* old srand() seed */
/* /*
* save the config state so that we can change it and restore later * save the config state so that we can change it and restore later
@@ -45,73 +45,73 @@ global cfg_8500 = config("all");
* onetest_8500 - perform one division / remainder test * onetest_8500 - perform one division / remainder test
* *
* Returns: * Returns:
* 0 = test was successful * 0 = test was successful
* >0 = test error indicator * >0 = test error indicator
*/ */
define onetest_8500(a,b,rnd) { define onetest_8500(a,b,rnd) {
local q, r, s, S; local q, r, s, S;
/* /*
* set a random rounding mode * set a random rounding mode
*/ */
config("quo", rnd), config("mod", rnd); config("quo", rnd), config("mod", rnd);
/* /*
* perform the division and mod * perform the division and mod
*/ */
q = a // b; q = a // b;
r = a % b; r = a % b;
/* /*
* verify the fundamental math * verify the fundamental math
*/ */
if (a != q * b + r) if (a != q * b + r)
return 1; return 1;
/* /*
* determine if the rounding worked * determine if the rounding worked
*/ */
if (b) { if (b) {
if (rnd & 16) if (rnd & 16)
s = sgn(abs(r) - abs(b)/2); s = sgn(abs(r) - abs(b)/2);
else else
s = sgn(abs(r) - abs(b)); s = sgn(abs(r) - abs(b));
if (s < 0 || r == 0) if (s < 0 || r == 0)
return 0; return 0;
if (s > 0) if (s > 0)
return 2; return 2;
if (((rnd & 16) && s == 0) || !(rnd & 16)) { if (((rnd & 16) && s == 0) || !(rnd & 16)) {
S = sgn(r) * sgn(b); /* This is sgn(a/b) - a//b */ S = sgn(r) * sgn(b); /* This is sgn(a/b) - a//b */
switch (rnd & 15) { switch (rnd & 15) {
case 0: return (S < 0) ? 3 : 0; case 0: return (S < 0) ? 3 : 0;
case 1: return (S > 0) ? 4 : 0; case 1: return (S > 0) ? 4 : 0;
case 2: return (S != sgn(a)*sgn(b)) ? 5 : 0; case 2: return (S != sgn(a)*sgn(b)) ? 5 : 0;
case 3: return (S != -sgn(a)*sgn(b)) ? 6 : 0; case 3: return (S != -sgn(a)*sgn(b)) ? 6 : 0;
break; break;
case 4: return (S != sgn(b)) ? 7 : 0; case 4: return (S != sgn(b)) ? 7 : 0;
case 5: return (S != -sgn(b)) ? 8 : 0; case 5: return (S != -sgn(b)) ? 8 : 0;
case 6: return (S != sgn(a)) ? 9 : 0; case 6: return (S != sgn(a)) ? 9 : 0;
case 7: return (S != -sgn(a)) ? 10 : 0; case 7: return (S != -sgn(a)) ? 10 : 0;
case 8: return (isodd(q)) ? 11 : 0; case 8: return (isodd(q)) ? 11 : 0;
case 9: return (iseven(q)) ? 12 : 0; case 9: return (iseven(q)) ? 12 : 0;
case 10: return (iseven(q) != (a/b > 0)) ? 13:0; case 10: return (iseven(q) != (a/b > 0)) ? 13:0;
case 11: return (isodd(q) != (a/b > 0)) ? 14:0; case 11: return (isodd(q) != (a/b > 0)) ? 14:0;
case 12: return (iseven(q) != (b > 0)) ? 15 : 0; case 12: return (iseven(q) != (b > 0)) ? 15 : 0;
case 13: return (isodd(q) != (b > 0)) ? 16 : 0; case 13: return (isodd(q) != (b > 0)) ? 16 : 0;
case 14: return (iseven(q) != (a > 0)) ? 17 : 0; case 14: return (iseven(q) != (a > 0)) ? 17 : 0;
case 15: return (isodd(q) != (a > 0)) ? 18 : 0; case 15: return (isodd(q) != (a > 0)) ? 18 : 0;
} }
} }
} }
/* /*
* all is well * all is well
*/ */
return 0; return 0;
} }
@@ -135,96 +135,96 @@ define onetest_8500(a,b,rnd) {
*/ */
define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0) define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
{ {
local a, b, i, v, rnd; local a, b, i, v, rnd;
local errmsg; /* error message to display */ local errmsg; /* error message to display */
/* /*
* firewall * firewall
*/ */
if (!isint(M1) || M1 < 2) if (!isint(M1) || M1 < 2)
quit "Bad second arg for dtest"; quit "Bad second arg for dtest";
if (!isint(M2) || M2 < 2) if (!isint(M2) || M2 < 2)
quit "Bad third arg for dtest"; quit "Bad third arg for dtest";
/* /*
* test setup * test setup
*/ */
err_8500 = 0; err_8500 = 0;
L_8500 = list(); L_8500 = list();
/* /*
* perform the random results * perform the random results
*/ */
for (i = 0; i < N; i++) { for (i = 0; i < N; i++) {
/* /*
* randomly select two values in the range controlled by M1,M2 * randomly select two values in the range controlled by M1,M2
*/ */
a = rand(-M1+1, M1); a = rand(-M1+1, M1);
b = rand(-M2+1, M2); b = rand(-M2+1, M2);
if (rand(2)) { if (rand(2)) {
a = (2 * a + 1) * b; a = (2 * a + 1) * b;
b *= 2; b *= 2;
} }
/* /*
* select one of the 32 rounding modes at random * select one of the 32 rounding modes at random
*/ */
rnd = rand(32); rnd = rand(32);
/* /*
* ver_8500 pre-test reporting * ver_8500 pre-test reporting
*/ */
if (ver_8500 > 1) if (ver_8500 > 1)
printf("Test %d: a = %d, b = %d, rnd = %d\n", printf("Test %d: a = %d, b = %d, rnd = %d\n",
i, a, b, rnd); i, a, b, rnd);
/* /*
* perform the actual test * perform the actual test
*/ */
v = onetest_8500(a, b, rnd); v = onetest_8500(a, b, rnd);
/* /*
* individual test analysis * individual test analysis
*/ */
if (v != 0) { if (v != 0) {
err_8500++; err_8500++;
if (ver_8500 != 0) { if (ver_8500 != 0) {
if (testnum > 0) { if (testnum > 0) {
errmsg = strprintf( errmsg = strprintf(
"Failure %d on test %d", v, i); "Failure %d on test %d", v, i);
prob(errmsg); prob(errmsg);
} else { } else {
printf("Failure %d on test %d", v, i); printf("Failure %d on test %d", v, i);
} }
} }
append(L_8500, a, b, rnd); append(L_8500, a, b, rnd);
} }
} }
/* /*
* report in the results * report in the results
*/ */
if (err_8500) { if (err_8500) {
if (testnum > 0) { if (testnum > 0) {
errmsg = strprintf( errmsg = strprintf(
"%d: divmod_8500(%d,,,%d): %d failures", "%d: divmod_8500(%d,,,%d): %d failures",
testnum, N, testnum, err_8500); testnum, N, testnum, err_8500);
prob(errmsg); prob(errmsg);
} else { } else {
printf("%s failure%s", err_8500, printf("%s failure%s", err_8500,
(err_8500 > 1) ? "s" : ""); (err_8500 > 1) ? "s" : "");
} }
} else { } else {
if (testnum > 0) { if (testnum > 0) {
errmsg = strprintf("%d: divmod_8500(%d,,,%d)", errmsg = strprintf("%d: divmod_8500(%d,,,%d)",
testnum, N, testnum); testnum, N, testnum);
vrfy(err_8500 == 0, errmsg); vrfy(err_8500 == 0, errmsg);
} else { } else {
print "No failure"; print "No failure";
} }
} }
} }
/* /*

Some files were not shown because too many files have changed in this diff Show More