mirror of
https://github.com/lcn2/calc.git
synced 2025-08-19 01:13:27 +03:00
Compare commits
87 Commits
2.11.0t10.
...
2.12.5.2
Author | SHA1 | Date | |
---|---|---|---|
|
28d1e35362 | ||
|
1ae2f953d3 | ||
|
ed4b56d1ec | ||
|
cc2f6f7b85 | ||
|
57a22a6f39 | ||
|
85bfa30897 | ||
|
17e3535595 | ||
|
7f125396c1 | ||
|
7cf611bca8 | ||
|
c9fce6a5bb | ||
|
a1c96f95a6 | ||
|
5e6b3cbd3f | ||
|
5bada5fefd | ||
|
0c20c96a7e | ||
|
e054ea87f2 | ||
|
e229393250 | ||
|
a407c7d197 | ||
|
9ea569152a | ||
|
cbcb5801fb | ||
|
bdf495150e | ||
|
b3648f030f | ||
|
71e88bdc91 | ||
|
ca0dd4560b | ||
|
f62d9fa1e6 | ||
|
253b47942f | ||
|
c773ee736f | ||
|
7d0cc52afe | ||
|
2441df7fdc | ||
|
5c565a7cea | ||
|
810e541281 | ||
|
ee30d787ea | ||
|
4e92927183 | ||
|
fb4a03c1f1 | ||
|
81a523043e | ||
|
2c0d0bbc1b | ||
|
a7147039ee | ||
|
6fa83e417e | ||
|
c335809b5f | ||
|
ee99adf8ca | ||
|
87570b56fe | ||
|
afe37ec851 | ||
|
bd3086138b | ||
|
9d62873a02 | ||
|
23a5fc3ede | ||
|
58d94b08d8 | ||
|
7165fa17c7 | ||
|
64a732b678 | ||
|
a6a37f9cad | ||
|
42b089a87c | ||
|
8c5e9e62fa | ||
|
29e956819c | ||
|
66c3d26611 | ||
|
b4952bd44f | ||
|
0d06d90751 | ||
|
e1a3dfda0b | ||
|
8db4e7af47 | ||
|
bb5c624382 | ||
|
8aedcf801a | ||
|
b60eec99bb | ||
|
383290a844 | ||
|
7e40db44e3 | ||
|
a57ee19ca5 | ||
|
a6e226fa80 | ||
|
86e0f98c8f | ||
|
e4dcbf7ecf | ||
|
10c0bd2d95 | ||
|
ad44f1e3ab | ||
|
fd436d7c15 | ||
|
d2cb9c81d5 | ||
|
a0aba073a6 | ||
|
59837e385c | ||
|
bea726fc16 | ||
|
fc0a3dd183 | ||
|
63d9b22067 | ||
|
fc85ac3791 | ||
|
3d55811205 | ||
|
296aa50ac7 | ||
|
5e098d2adf | ||
|
ae2a752314 | ||
|
61dd47526f | ||
|
417ffb6ab5 | ||
|
121b8f72c6 | ||
|
9968a69f50 | ||
|
1ea579d929 | ||
|
0521ed202f | ||
|
6f5e8bf1b6 | ||
|
f3913609ea |
228
BUGS
228
BUGS
@@ -20,26 +20,43 @@ configuration, try backing them out and see if things get better.
|
||||
|
||||
To be sure that your version of calc is up to date, check out:
|
||||
|
||||
http://reality.sgi.com/chongo/tech/comp/calc/calc-download.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-download.html
|
||||
|
||||
The calc web site is located at:
|
||||
|
||||
http://reality.sgi.com/chongo/tech/comp/calc/index.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/index.html
|
||||
|
||||
=-=
|
||||
|
||||
If you have tried all of the above and things still are not right,
|
||||
then it may be time to send in a bug report. You can send bug reports to:
|
||||
then it may be time to send in a bug report. You can send bug
|
||||
and bug fixes reports to:
|
||||
|
||||
calc-bugs at postofc dot corp dot sgi dot com
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
calc bug report
|
||||
|
||||
That phrase in your subject line will help ensure your request
|
||||
will get past our anti-spam filters. You may have additional
|
||||
words in your subject line.
|
||||
|
||||
However, you may find it more helpful to simply subscribe
|
||||
to the calc-tester mailing list (see below) and then to
|
||||
send your report to that mailing list as a wider set calc
|
||||
testers may be able to help you.
|
||||
|
||||
When you send your report, please include the following information:
|
||||
|
||||
* a description of the problem
|
||||
* the version of calc you are using (if you cannot get calc
|
||||
it to run, then send us the 4 #define lines from version.c)
|
||||
to run, then send us the 4 #define lines from version.c)
|
||||
* if you modified calc from an official patch, send me the mods you made
|
||||
* the type of system you were using
|
||||
* the type of compiler you were using
|
||||
@@ -53,58 +70,15 @@ When you send your report, please include the following information:
|
||||
|
||||
Stack traces from core dumps are useful to send as well.
|
||||
|
||||
=-=
|
||||
|
||||
Send any comments, compiler warning messages, suggestions and most
|
||||
importantly, fixes (in the form of a context diff patch) to:
|
||||
|
||||
calc-tester at postofc dot corp dot sgi dot com
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
|
||||
You should use the above calc-bugs address for bug reports, if you are
|
||||
not currently a member of the calc-tester mailing list.
|
||||
Fell free to use the above address to send in big fixes (in the form
|
||||
of a context diff patch).
|
||||
|
||||
=-=
|
||||
|
||||
Known bugs:
|
||||
|
||||
* Calc does not support the #! exec method. For example of the
|
||||
following is placed in an executable file (assume the path to
|
||||
calc is correct) called /tmp/xyzzy:
|
||||
|
||||
#!/usr/local/bin/calc
|
||||
/*
|
||||
* comment
|
||||
*/
|
||||
print 2+3;
|
||||
|
||||
Will result in '"tmp" is undefined' and '"xyzzy" is undefined'
|
||||
error messages because calc considers $0 as an expression to
|
||||
evaluate.
|
||||
|
||||
* The following file:
|
||||
|
||||
/* this is bugdemo.cal */
|
||||
x = eval(prompt(">>> "));
|
||||
print x;
|
||||
|
||||
when executed as:
|
||||
|
||||
calc read bugdemo.cal
|
||||
|
||||
will obtain a prompt from the terminal, print the value but leave
|
||||
the terminal in a 'bad' state, as if stty -icanon -echo -echoe
|
||||
had been executed.
|
||||
|
||||
* Use of 'fmt' in the 2nd arg of printf() calls in c_sysinfo.c
|
||||
cause some compilers to issue warnings.
|
||||
|
||||
* The builtin function exp(x) will return 0 when x is a large value
|
||||
in certain cases such as exp(2^32).
|
||||
|
||||
* The builtin function power(x,y) will return 0 in certain cases
|
||||
such as power(pi(),2^32).
|
||||
The output of the alg_config.cal resource file is bogus.
|
||||
We would welcome a replacement for this code.
|
||||
|
||||
We are sure some more bugs exist. When you find them, please let
|
||||
us know! See the above for details on how to report and were to
|
||||
@@ -112,76 +86,102 @@ Known bugs:
|
||||
|
||||
=-=
|
||||
|
||||
Problems with known work-a-rounds:
|
||||
mis-features in calc:
|
||||
|
||||
* There is a bug in gcc-2.95 that causes calc, when compiled with -O2,
|
||||
to fail the regression test. The work-a-round is to compile with -O
|
||||
or to use gcc-2.96 or later.
|
||||
Some problems are not bugs but rather mis-features / things that could
|
||||
work better. The following is a list of mis-features that should be
|
||||
addressed and improved someday.
|
||||
|
||||
* Solaris cc somtimes barfs while compiling zrand.c. In particular, calc
|
||||
barfs on on the SVAL macro. The work-a-round is to use the Solaric cc
|
||||
Makefile set sets -DFORCE_STDC. I.e,:
|
||||
* When statement is of the form { ... }, the leading { MUST BE ON
|
||||
THE SAME LINE as the if, for, while or do keyword.
|
||||
|
||||
CCWARN=
|
||||
CCOPT= ${DEBUG} ${NO_SHARED}
|
||||
CCMISC= -DFORCE_STDC
|
||||
#
|
||||
CFLAGS= ${CCWARN} ${CCOPT} ${CCMISC}
|
||||
ICFLAGS= ${CCWARN} ${CCMISC}
|
||||
#
|
||||
LCFLAGS=
|
||||
LDFLAGS= ${NO_SHARED} ${LD_NO_SHARED}
|
||||
ILDFLAGS=
|
||||
#
|
||||
LCC= cc
|
||||
CC= ${PURIFY} ${LCC}
|
||||
This works as expected:
|
||||
|
||||
* There is a bug in some versions of the Dec/Compaq cc for the Alpha
|
||||
where the following:
|
||||
|
||||
#include <stdio.h>
|
||||
#define SVAL(a,b) (unsigned long)(0x ## a ## b ## ULL)
|
||||
main(){SVAL(b8a8aeb0,8168eadc);}
|
||||
|
||||
fails because it puts a space inside the concatenated hex. Calc
|
||||
has code that is affected by this bug. This bug has been reported
|
||||
to Compaq and may be fixed in the future. A work-a-round is to
|
||||
compile with cc -std0 or to use a later version of their compiler.
|
||||
|
||||
* On a Digital UNIX V4.0F (Rev. 1229) on a 500 Mhz 21264, make check
|
||||
dies a horrible death starting in test 600 and 622 gives 100s of
|
||||
messages for calc version 2.11.0t9.4 using the Dec's cc with -O2:
|
||||
|
||||
600: Beginning test_bignums
|
||||
601: muldivcheck 1
|
||||
**** abc != acb: 602: muldivcheck 2
|
||||
**** acb != bac: 602: muldivcheck 2
|
||||
if (expr) {
|
||||
...
|
||||
**** t4 != a4: 622: algcheck 1
|
||||
**** t5 != a5: 622: algcheck 1
|
||||
**** t6 != a6: 622: algcheck 1
|
||||
**** t4 != a4: 622: algcheck 1
|
||||
}
|
||||
|
||||
However this WILL NOT WORK AS EXPECTED:
|
||||
|
||||
if (expr)
|
||||
{
|
||||
...
|
||||
}
|
||||
|
||||
it finally hangs at test 2000.
|
||||
This needs to be changed. See also "help statement", "help unexpected",
|
||||
and "help todo".
|
||||
|
||||
The work-a-round is to compile calc without the optimizer. If this
|
||||
happens to you, try compiling without -O and without -O2. I.e., in
|
||||
the Makefile, set:
|
||||
* The chi.cal resource file does not work well with odd degrees
|
||||
of freedom. Can someone improve this algorithm?
|
||||
|
||||
DEBUG= -g
|
||||
* The intfile.cal resource file reads and writes big or little Endian
|
||||
integers to/from files the hard way. It does NOT use blkcpy. The
|
||||
following code:
|
||||
|
||||
* There are problems compiling calc on the sparcv9 under 64 bit
|
||||
Solaris. On that platform, gcc-2.96 is able to compile calc, but
|
||||
calc dumps core very early on in startup. It is said that sparcv9
|
||||
support in gcc-2.96 is very unofficial and thus there is no
|
||||
work-a-round for gcc-2-96.
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
b = blk()
|
||||
copy(i, b)
|
||||
fd = fopen("file", "w")
|
||||
copy(b, fd);
|
||||
fclose(fd)
|
||||
|
||||
There is a work-a-round for this architecture us one is using the
|
||||
Solaris CC on the sparcv9. It has been reported that setting the
|
||||
following Makefile variables will produce a working version of
|
||||
calc on the sparcv9 under 64 bit Solaris:
|
||||
will write an extra NUL octet to the file. Where as:
|
||||
|
||||
LCC="cc -xarch=v9"
|
||||
CCWARN="-DFORCE_STDC -w"
|
||||
DEBUG="-fast -xarch=v9"
|
||||
read intfile
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
be2file(i, "file2")
|
||||
|
||||
will not.
|
||||
|
||||
=-=
|
||||
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
address. To be sure we see your EMail asking for help with your
|
||||
mailing list subscription, please use the following phase in your
|
||||
EMail Subject line:
|
||||
|
||||
calc tester mailing list help
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
## Copyright (C) 1999-2014 Landon Curt Noll
|
||||
##
|
||||
## Calc is open software; you can redistribute it and/or modify it under
|
||||
## the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
## as published by the Free Software Foundation.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
## distributed with calc under the filename COPYING-LGPL. You should have
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 30.5 $
|
||||
## @(#) $Id: BUGS,v 30.5 2014/10/12 12:23:43 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/bin/calc/RCS/BUGS,v $
|
||||
##
|
||||
## Under source code control: 1994/03/18 14:06:13
|
||||
## File existed as early as: 1994
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
243
COPYING
Normal file
243
COPYING
Normal file
@@ -0,0 +1,243 @@
|
||||
calc - arbitrary precision calculator
|
||||
|
||||
|
||||
This file is Copyrighted
|
||||
------------------------
|
||||
|
||||
This file is covered under the following Copyright:
|
||||
|
||||
Copyright (C) 1999-2014 Landon Curt Noll
|
||||
All rights reserved.
|
||||
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
# @(#) $Revision: 30.6 $
|
||||
# @(#) $Id: COPYING,v 30.6 2014/10/12 12:23:43 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/bin/calc/RCS/COPYING,v $
|
||||
|
||||
-=-
|
||||
|
||||
Calc is covered by the GNU Lesser General Public License
|
||||
--------------------------------------------------------
|
||||
|
||||
Calc is open software; you can redistribute it and/or modify it under
|
||||
the terms of the GNU Lesser General Public License as published by
|
||||
the Free Software Foundation version 2.1 of the License.
|
||||
|
||||
Calc is several binary link libraries, several modules, associated
|
||||
interface definition files and scripts used to control its compilation
|
||||
and installation.
|
||||
|
||||
Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
Public License for more details.
|
||||
|
||||
A copy of the GNU Lesser General Public License is distributed with
|
||||
calc under the filename:
|
||||
|
||||
COPYING-LGPL
|
||||
|
||||
You may display this file by the calc command: help copying
|
||||
|
||||
You may display the GNU Lesser General
|
||||
Public License by the calc command: help copying-lgpl
|
||||
|
||||
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:
|
||||
|
||||
Free Software Foundation, Inc.
|
||||
51 Franklin Street
|
||||
Fifth Floor
|
||||
Boston, MA 02110-1301
|
||||
USA
|
||||
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
address. To be sure we see your EMail asking for help with your
|
||||
mailing list subscription, please use the following phase in your
|
||||
EMail Subject line:
|
||||
|
||||
calc tester mailing list help
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
-=-
|
||||
|
||||
Calc bug reports and calc bug fixes should be sent to:
|
||||
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
calc bug report
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
However, you may find it more helpful to simply subscribe
|
||||
to the calc-tester mailing list (see above) and then to
|
||||
send your report to that mailing list as a wider set calc
|
||||
testers may be able to help you.
|
||||
|
||||
-=-
|
||||
|
||||
The calc web site is located at:
|
||||
|
||||
http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
NOTE: The EMail address uses 'asthe', while the web site uses 'isthe'.
|
||||
|
||||
-=-
|
||||
|
||||
Calc's relationship to the GNU Lesser General Public License
|
||||
------------------------------------------------------------
|
||||
|
||||
In section 0 of the GNU Lesser General Public License, one finds
|
||||
the following definition:
|
||||
|
||||
The "Library", below, refers to any such software library or
|
||||
work which has been distributed under these terms.
|
||||
|
||||
Calc is distributed under the terms of the GNU Lesser
|
||||
General Public License.
|
||||
|
||||
In the same section 0, one also find the following:
|
||||
|
||||
For a library, complete source code means all the source code
|
||||
for all modules it contains, plus any associated interface
|
||||
definition files, plus the scripts used to control compilation
|
||||
and installation of the library.
|
||||
|
||||
There are at least two calc binary link libraries found in calc:
|
||||
|
||||
libcalc.a libcustcalc.a
|
||||
|
||||
Clearly all files that go into the creation of those binary link
|
||||
libraries are covered under the License.
|
||||
|
||||
The ``scripts used to control compilation and installation of the
|
||||
of the library'' include:
|
||||
|
||||
* Makefiles
|
||||
* source files created by the Makefiles
|
||||
* source code used in the creation of intermediate source files
|
||||
|
||||
All of those files are covered under the License.
|
||||
|
||||
The ``associated interface definition files'' are those files that:
|
||||
|
||||
* show how the calc binary link libraries are used
|
||||
* test the validity of the binary link libraries
|
||||
* document routines found in 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
|
||||
functions.
|
||||
|
||||
* files under the sample sub-directory
|
||||
* files under the help sub-directory
|
||||
* files under the lib sub-directory
|
||||
* the main calc.c file
|
||||
|
||||
The ``complete source code'' includes ALL files shipped with calc,
|
||||
except for the exception files explicitly listed in the ``Calc
|
||||
copyrights and exception files'' section below.
|
||||
|
||||
-=-
|
||||
|
||||
Calc copyrights and exception files
|
||||
-----------------------------------
|
||||
|
||||
With the exception of the files listed below, Calc is covered under
|
||||
the following GNU Lesser General Public License Copyrights:
|
||||
|
||||
Copyright (C) year David I. Bell
|
||||
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, Landon Curt Noll and Ernest Bowen
|
||||
Copyright (C) year Landon Curt Noll
|
||||
Copyright (C) year Ernest Bowen and Landon Curt Noll
|
||||
Copyright (C) year Ernest Bowen
|
||||
Copyright (C) year Petteri Kettunen and Landon Curt Noll
|
||||
Copyright (C) year Christoph Zurnieden
|
||||
|
||||
These files are not covered under one of the Copyrights listed above:
|
||||
|
||||
sha1.c sha1.h COPYING
|
||||
COPYING-LGPL cal/qtime.cal cal/screen.cal
|
||||
|
||||
The file COPYING-LGPL, which contains a copy of the version 2.1
|
||||
GNU Lesser General Public License, is itself Copyrighted by the
|
||||
Free Software Foundation, Inc. Please note that the Free Software
|
||||
Foundation, Inc. does NOT have a copyright over calc, only the
|
||||
COPYING-LGPL that is supplied with calc.
|
||||
|
||||
This file, COPYING, is distributed under the Copyright found at the
|
||||
top of this file. It is important to note that you may distribute
|
||||
verbatim copies of this file but you may not modify this file.
|
||||
|
||||
Some of these exception files are in the public domain. Other files
|
||||
are under the LGPL but have different authors that those listed above.
|
||||
|
||||
In all cases one may use and distribute these exception files freely.
|
||||
And because one may freely distribute the LGPL covered files, the
|
||||
entire calc source may be freely used and distributed.
|
||||
|
||||
-=-
|
||||
|
||||
General Copyleft and License info
|
||||
---------------------------------
|
||||
|
||||
For general information on Copylefts, see:
|
||||
|
||||
http://www.gnu.org/copyleft/
|
||||
|
||||
For information on GNU Lesser General Public Licenses, see:
|
||||
|
||||
http://www.gnu.org/copyleft/lesser.html
|
||||
http://www.gnu.org/copyleft/lesser.txt
|
||||
|
||||
-=-
|
||||
|
||||
Why calc did not use the GNU General Public License
|
||||
---------------------------------------------------
|
||||
|
||||
It has been suggested that one should consider using the GNU General
|
||||
Public License instead of the GNU Lesser General Public License:
|
||||
|
||||
http://www.gnu.org/philosophy/why-not-lgpl.html
|
||||
|
||||
As you can read in the above URL, there are times where a library
|
||||
cannot give free software any particular advantage. One of those
|
||||
times is when there is significantly similar versions available
|
||||
that are not covered under a Copyleft such as the GNU General Public
|
||||
License.
|
||||
|
||||
The reason why calc was placed under the GNU Lesser General Public
|
||||
License is because for many years (1984 thru 1999), calc was offered
|
||||
without any form of Copyleft. At the time calc was placed under
|
||||
the GNU Lesser General Public License, a number of systems and
|
||||
distributions distributed calc without a Copyleft.
|
503
COPYING-LGPL
Normal file
503
COPYING-LGPL
Normal file
@@ -0,0 +1,503 @@
|
||||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
Version 2.1, February 1999
|
||||
|
||||
Copyright (C) 1991, 1999 Free Software Foundation, Inc.
|
||||
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
[This is the first released version of the Lesser GPL. It also counts
|
||||
as the successor of the GNU Library Public License, version 2, hence
|
||||
the version number 2.1.]
|
||||
|
||||
Preamble
|
||||
|
||||
The licenses for most software are designed to take away your
|
||||
freedom to share and change it. By contrast, the GNU General Public
|
||||
Licenses are intended to guarantee your freedom to share and change
|
||||
free software--to make sure the software is free for all its users.
|
||||
|
||||
This license, the Lesser General Public License, applies to some
|
||||
specially designated software packages--typically libraries--of the
|
||||
Free Software Foundation and other authors who decide to use it. You
|
||||
can use it too, but we suggest you first think carefully about whether
|
||||
this license or the ordinary General Public License is the better
|
||||
strategy to use in any particular case, based on the explanations below.
|
||||
|
||||
When we speak of free software, we are referring to freedom of use,
|
||||
not price. Our General Public Licenses are designed to make sure that
|
||||
you have the freedom to distribute copies of free software (and charge
|
||||
for this service if you wish); that you receive source code or can get
|
||||
it if you want it; that you can change the software and use pieces of
|
||||
it in new free programs; and that you are informed that you can do
|
||||
these things.
|
||||
|
||||
To protect your rights, we need to make restrictions that forbid
|
||||
distributors to deny you these rights or to ask you to surrender these
|
||||
rights. These restrictions translate to certain responsibilities for
|
||||
you if you distribute copies of the library or if you modify it.
|
||||
|
||||
For example, if you distribute copies of the library, whether gratis
|
||||
or for a fee, you must give the recipients all the rights that we gave
|
||||
you. You must make sure that they, too, receive or can get the source
|
||||
code. If you link other code with the library, you must provide
|
||||
complete object files to the recipients, so that they can relink them
|
||||
with the library after making changes to the library and recompiling
|
||||
it. And you must show them these terms so they know their rights.
|
||||
|
||||
We protect your rights with a two-step method: (1) we copyright the
|
||||
library, and (2) we offer you this license, which gives you legal
|
||||
permission to copy, distribute and/or modify the library.
|
||||
|
||||
To protect each distributor, we want to make it very clear that
|
||||
there is no warranty for the free library. Also, if the library is
|
||||
modified by someone else and passed on, the recipients should know
|
||||
that what they have is not the original version, so that the original
|
||||
author's reputation will not be affected by problems that might be
|
||||
introduced by others.
|
||||
|
||||
Finally, software patents pose a constant threat to the existence of
|
||||
any free program. We wish to make sure that a company cannot
|
||||
effectively restrict the users of a free program by obtaining a
|
||||
restrictive license from a patent holder. Therefore, we insist that
|
||||
any patent license obtained for a version of the library must be
|
||||
consistent with the full freedom of use specified in this license.
|
||||
|
||||
Most GNU software, including some libraries, is covered by the
|
||||
ordinary GNU General Public License. This license, the GNU Lesser
|
||||
General Public License, applies to certain designated libraries, and
|
||||
is quite different from the ordinary General Public License. We use
|
||||
this license for certain libraries in order to permit linking those
|
||||
libraries into non-free programs.
|
||||
|
||||
When a program is linked with a library, whether statically or using
|
||||
a shared library, the combination of the two is legally speaking a
|
||||
combined work, a derivative of the original library. The ordinary
|
||||
General Public License therefore permits such linking only if the
|
||||
entire combination fits its criteria of freedom. The Lesser General
|
||||
Public License permits more lax criteria for linking other code with
|
||||
the library.
|
||||
|
||||
We call this license the "Lesser" General Public License because it
|
||||
does Less to protect the user's freedom than the ordinary General
|
||||
Public License. It also provides other free software developers Less
|
||||
of an advantage over competing non-free programs. These disadvantages
|
||||
are the reason we use the ordinary General Public License for many
|
||||
libraries. However, the Lesser license provides advantages in certain
|
||||
special circumstances.
|
||||
|
||||
For example, on rare occasions, there may be a special need to
|
||||
encourage the widest possible use of a certain library, so that it becomes
|
||||
a de-facto standard. To achieve this, non-free programs must be
|
||||
allowed to use the library. A more frequent case is that a free
|
||||
library does the same job as widely used non-free libraries. In this
|
||||
case, there is little to gain by limiting the free library to free
|
||||
software only, so we use the Lesser General Public License.
|
||||
|
||||
In other cases, permission to use a particular library in non-free
|
||||
programs enables a greater number of people to use a large body of
|
||||
free software. For example, permission to use the GNU C Library in
|
||||
non-free programs enables many more people to use the whole GNU
|
||||
operating system, as well as its variant, the GNU/Linux operating
|
||||
system.
|
||||
|
||||
Although the Lesser General Public License is Less protective of the
|
||||
users' freedom, it does ensure that the user of a program that is
|
||||
linked with the Library has the freedom and the wherewithal to run
|
||||
that program using a modified version of the Library.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow. Pay close attention to the difference between a
|
||||
"work based on the library" and a "work that uses the library". The
|
||||
former contains code derived from the library, whereas the latter must
|
||||
be combined with the library in order to run.
|
||||
|
||||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||
|
||||
0. This License Agreement applies to any software library or other
|
||||
program which contains a notice placed by the copyright holder or
|
||||
other authorized party saying it may be distributed under the terms of
|
||||
this Lesser General Public License (also called "this License").
|
||||
Each licensee is addressed as "you".
|
||||
|
||||
A "library" means a collection of software functions and/or data
|
||||
prepared so as to be conveniently linked with application programs
|
||||
(which use some of those functions and data) to form executables.
|
||||
|
||||
The "Library", below, refers to any such software library or work
|
||||
which has been distributed under these terms. A "work based on the
|
||||
Library" means either the Library or any derivative work under
|
||||
copyright law: that is to say, a work containing the Library or a
|
||||
portion of it, either verbatim or with modifications and/or translated
|
||||
straightforwardly into another language. (Hereinafter, translation is
|
||||
included without limitation in the term "modification".)
|
||||
|
||||
"Source code" for a work means the preferred form of the work for
|
||||
making modifications to it. For a library, complete source code means
|
||||
all the source code for all modules it contains, plus any associated
|
||||
interface definition files, plus the scripts used to control compilation
|
||||
and installation of the library.
|
||||
|
||||
Activities other than copying, distribution and modification are not
|
||||
covered by this License; they are outside its scope. The act of
|
||||
running a program using the Library is not restricted, and output from
|
||||
such a program is covered only if its contents constitute a work based
|
||||
on the Library (independent of the use of the Library in a tool for
|
||||
writing it). Whether that is true depends on what the Library does
|
||||
and what the program that uses the Library does.
|
||||
|
||||
1. You may copy and distribute verbatim copies of the Library's
|
||||
complete source code as you receive it, in any medium, provided that
|
||||
you conspicuously and appropriately publish on each copy an
|
||||
appropriate copyright notice and disclaimer of warranty; keep intact
|
||||
all the notices that refer to this License and to the absence of any
|
||||
warranty; and distribute a copy of this License along with the
|
||||
Library.
|
||||
|
||||
You may charge a fee for the physical act of transferring a copy,
|
||||
and you may at your option offer warranty protection in exchange for a
|
||||
fee.
|
||||
|
||||
2. You may modify your copy or copies of the Library or any portion
|
||||
of it, thus forming a work based on the Library, and copy and
|
||||
distribute such modifications or work under the terms of Section 1
|
||||
above, provided that you also meet all of these conditions:
|
||||
|
||||
a) The modified work must itself be a software library.
|
||||
|
||||
b) You must cause the files modified to carry prominent notices
|
||||
stating that you changed the files and the date of any change.
|
||||
|
||||
c) You must cause the whole of the work to be licensed at no
|
||||
charge to all third parties under the terms of this License.
|
||||
|
||||
d) If a facility in the modified Library refers to a function or a
|
||||
table of data to be supplied by an application program that uses
|
||||
the facility, other than as an argument passed when the facility
|
||||
is invoked, then you must make a good faith effort to ensure that,
|
||||
in the event an application does not supply such function or
|
||||
table, the facility still operates, and performs whatever part of
|
||||
its purpose remains meaningful.
|
||||
|
||||
(For example, a function in a library to compute square roots has
|
||||
a purpose that is entirely well-defined independent of the
|
||||
application. Therefore, Subsection 2d requires that any
|
||||
application-supplied function or table used by this function must
|
||||
be optional: if the application does not supply it, the square
|
||||
root function must still compute square roots.)
|
||||
|
||||
These requirements apply to the modified work as a whole. If
|
||||
identifiable sections of that work are not derived from the Library,
|
||||
and can be reasonably considered independent and separate works in
|
||||
themselves, then this License, and its terms, do not apply to those
|
||||
sections when you distribute them as separate works. But when you
|
||||
distribute the same sections as part of a whole which is a work based
|
||||
on the Library, the distribution of the whole must be on the terms of
|
||||
this License, whose permissions for other licensees extend to the
|
||||
entire whole, and thus to each and every part regardless of who wrote
|
||||
it.
|
||||
|
||||
Thus, it is not the intent of this section to claim rights or contest
|
||||
your rights to work written entirely by you; rather, the intent is to
|
||||
exercise the right to control the distribution of derivative or
|
||||
collective works based on the Library.
|
||||
|
||||
In addition, mere aggregation of another work not based on the Library
|
||||
with the Library (or with a work based on the Library) on a volume of
|
||||
a storage or distribution medium does not bring the other work under
|
||||
the scope of this License.
|
||||
|
||||
3. You may opt to apply the terms of the ordinary GNU General Public
|
||||
License instead of this License to a given copy of the Library. To do
|
||||
this, you must alter all the notices that refer to this License, so
|
||||
that they refer to the ordinary GNU General Public License, version 2,
|
||||
instead of to this License. (If a newer version than version 2 of the
|
||||
ordinary GNU General Public License has appeared, then you can specify
|
||||
that version instead if you wish.) Do not make any other change in
|
||||
these notices.
|
||||
|
||||
Once this change is made in a given copy, it is irreversible for
|
||||
that copy, so the ordinary GNU General Public License applies to all
|
||||
subsequent copies and derivative works made from that copy.
|
||||
|
||||
This option is useful when you wish to copy part of the code of
|
||||
the Library into a program that is not a library.
|
||||
|
||||
4. You may copy and distribute the Library (or a portion or
|
||||
derivative of it, under Section 2) in object code or executable form
|
||||
under the terms of Sections 1 and 2 above provided that you accompany
|
||||
it with the complete corresponding machine-readable source code, which
|
||||
must be distributed under the terms of Sections 1 and 2 above on a
|
||||
medium customarily used for software interchange.
|
||||
|
||||
If distribution of object code is made by offering access to copy
|
||||
from a designated place, then offering equivalent access to copy the
|
||||
source code from the same place satisfies the requirement to
|
||||
distribute the source code, even though third parties are not
|
||||
compelled to copy the source along with the object code.
|
||||
|
||||
5. A program that contains no derivative of any portion of the
|
||||
Library, but is designed to work with the Library by being compiled or
|
||||
linked with it, is called a "work that uses the Library". Such a
|
||||
work, in isolation, is not a derivative work of the Library, and
|
||||
therefore falls outside the scope of this License.
|
||||
|
||||
However, linking a "work that uses the Library" with the Library
|
||||
creates an executable that is a derivative of the Library (because it
|
||||
contains portions of the Library), rather than a "work that uses the
|
||||
library". The executable is therefore covered by this License.
|
||||
Section 6 states terms for distribution of such executables.
|
||||
|
||||
When a "work that uses the Library" uses material from a header file
|
||||
that is part of the Library, the object code for the work may be a
|
||||
derivative work of the Library even though the source code is not.
|
||||
Whether this is true is especially significant if the work can be
|
||||
linked without the Library, or if the work is itself a library. The
|
||||
threshold for this to be true is not precisely defined by law.
|
||||
|
||||
If such an object file uses only numerical parameters, data
|
||||
structure layouts and accessors, and small macros and small inline
|
||||
functions (ten lines or less in length), then the use of the object
|
||||
file is unrestricted, regardless of whether it is legally a derivative
|
||||
work. (Executables containing this object code plus portions of the
|
||||
Library will still fall under Section 6.)
|
||||
|
||||
Otherwise, if the work is a derivative of the Library, you may
|
||||
distribute the object code for the work under the terms of Section 6.
|
||||
Any executables containing that work also fall under Section 6,
|
||||
whether or not they are linked directly with the Library itself.
|
||||
|
||||
6. As an exception to the Sections above, you may also combine or
|
||||
link a "work that uses the Library" with the Library to produce a
|
||||
work containing portions of the Library, and distribute that work
|
||||
under terms of your choice, provided that the terms permit
|
||||
modification of the work for the customer's own use and reverse
|
||||
engineering for debugging such modifications.
|
||||
|
||||
You must give prominent notice with each copy of the work that the
|
||||
Library is used in it and that the Library and its use are covered by
|
||||
this License. You must supply a copy of this License. If the work
|
||||
during execution displays copyright notices, you must include the
|
||||
copyright notice for the Library among them, as well as a reference
|
||||
directing the user to the copy of this License. Also, you must do one
|
||||
of these things:
|
||||
|
||||
a) Accompany the work with the complete corresponding
|
||||
machine-readable source code for the Library including whatever
|
||||
changes were used in the work (which must be distributed under
|
||||
Sections 1 and 2 above); and, if the work is an executable linked
|
||||
with the Library, with the complete machine-readable "work that
|
||||
uses the Library", as object code and/or source code, so that the
|
||||
user can modify the Library and then relink to produce a modified
|
||||
executable containing the modified Library. (It is understood
|
||||
that the user who changes the contents of definitions files in the
|
||||
Library will not necessarily be able to recompile the application
|
||||
to use the modified definitions.)
|
||||
|
||||
b) Use a suitable shared library mechanism for linking with the
|
||||
Library. A suitable mechanism is one that (1) uses at run time a
|
||||
copy of the library already present on the user's computer system,
|
||||
rather than copying library functions into the executable, and (2)
|
||||
will operate properly with a modified version of the library, if
|
||||
the user installs one, as long as the modified version is
|
||||
interface-compatible with the version that the work was made with.
|
||||
|
||||
c) Accompany the work with a written offer, valid for at
|
||||
least three years, to give the same user the materials
|
||||
specified in Subsection 6a, above, for a charge no more
|
||||
than the cost of performing this distribution.
|
||||
|
||||
d) If distribution of the work is made by offering access to copy
|
||||
from a designated place, offer equivalent access to copy the above
|
||||
specified materials from the same place.
|
||||
|
||||
e) Verify that the user has already received a copy of these
|
||||
materials or that you have already sent this user a copy.
|
||||
|
||||
For an executable, the required form of the "work that uses the
|
||||
Library" must include any data and utility programs needed for
|
||||
reproducing the executable from it. However, as a special exception,
|
||||
the materials to be distributed need not include anything that is
|
||||
normally distributed (in either source or binary form) with the major
|
||||
components (compiler, kernel, and so on) of the operating system on
|
||||
which the executable runs, unless that component itself accompanies
|
||||
the executable.
|
||||
|
||||
It may happen that this requirement contradicts the license
|
||||
restrictions of other proprietary libraries that do not normally
|
||||
accompany the operating system. Such a contradiction means you cannot
|
||||
use both them and the Library together in an executable that you
|
||||
distribute.
|
||||
|
||||
7. You may place library facilities that are a work based on the
|
||||
Library side-by-side in a single library together with other library
|
||||
facilities not covered by this License, and distribute such a combined
|
||||
library, provided that the separate distribution of the work based on
|
||||
the Library and of the other library facilities is otherwise
|
||||
permitted, and provided that you do these two things:
|
||||
|
||||
a) Accompany the combined library with a copy of the same work
|
||||
based on the Library, uncombined with any other library
|
||||
facilities. This must be distributed under the terms of the
|
||||
Sections above.
|
||||
|
||||
b) Give prominent notice with the combined library of the fact
|
||||
that part of it is a work based on the Library, and explaining
|
||||
where to find the accompanying uncombined form of the same work.
|
||||
|
||||
8. You may not copy, modify, sublicense, link with, or distribute
|
||||
the Library except as expressly provided under this License. Any
|
||||
attempt otherwise to copy, modify, sublicense, link with, or
|
||||
distribute the Library is void, and will automatically terminate your
|
||||
rights under this License. However, parties who have received copies,
|
||||
or rights, from you under this License will not have their licenses
|
||||
terminated so long as such parties remain in full compliance.
|
||||
|
||||
9. You are not required to accept this License, since you have not
|
||||
signed it. However, nothing else grants you permission to modify or
|
||||
distribute the Library or its derivative works. These actions are
|
||||
prohibited by law if you do not accept this License. Therefore, by
|
||||
modifying or distributing the Library (or any work based on the
|
||||
Library), you indicate your acceptance of this License to do so, and
|
||||
all its terms and conditions for copying, distributing or modifying
|
||||
the Library or works based on it.
|
||||
|
||||
10. Each time you redistribute the Library (or any work based on the
|
||||
Library), the recipient automatically receives a license from the
|
||||
original licensor to copy, distribute, link with or modify the Library
|
||||
subject to these terms and conditions. You may not impose any further
|
||||
restrictions on the recipients' exercise of the rights granted herein.
|
||||
You are not responsible for enforcing compliance by third parties with
|
||||
this License.
|
||||
|
||||
11. If, as a consequence of a court judgment or allegation of patent
|
||||
infringement or for any other reason (not limited to patent issues),
|
||||
conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot
|
||||
distribute so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you
|
||||
may not distribute the Library at all. For example, if a patent
|
||||
license would not permit royalty-free redistribution of the Library by
|
||||
all those who receive copies directly or indirectly through you, then
|
||||
the only way you could satisfy both it and this License would be to
|
||||
refrain entirely from distribution of the Library.
|
||||
|
||||
If any portion of this section is held invalid or unenforceable under any
|
||||
particular circumstance, the balance of the section is intended to apply,
|
||||
and the section as a whole is intended to apply in other circumstances.
|
||||
|
||||
It is not the purpose of this section to induce you to infringe any
|
||||
patents or other property right claims or to contest validity of any
|
||||
such claims; this section has the sole purpose of protecting the
|
||||
integrity of the free software distribution system which is
|
||||
implemented by public license practices. Many people have made
|
||||
generous contributions to the wide range of software distributed
|
||||
through that system in reliance on consistent application of that
|
||||
system; it is up to the author/donor to decide if he or she is willing
|
||||
to distribute software through any other system and a licensee cannot
|
||||
impose that choice.
|
||||
|
||||
This section is intended to make thoroughly clear what is believed to
|
||||
be a consequence of the rest of this License.
|
||||
|
||||
12. If the distribution and/or use of the Library is restricted in
|
||||
certain countries either by patents or by copyrighted interfaces, the
|
||||
original copyright holder who places the Library under this License may add
|
||||
an explicit geographical distribution limitation excluding those countries,
|
||||
so that distribution is permitted only in or among countries not thus
|
||||
excluded. In such case, this License incorporates the limitation as if
|
||||
written in the body of this License.
|
||||
|
||||
13. The Free Software Foundation may publish revised and/or new
|
||||
versions of the Lesser General Public License from time to time.
|
||||
Such new versions will be similar in spirit to the present version,
|
||||
but may differ in detail to address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the Library
|
||||
specifies a version number of this License which applies to it and
|
||||
"any later version", you have the option of following the terms and
|
||||
conditions either of that version or of any later version published by
|
||||
the Free Software Foundation. If the Library does not specify a
|
||||
license version number, you may choose any version ever published by
|
||||
the Free Software Foundation.
|
||||
|
||||
14. If you wish to incorporate parts of the Library into other free
|
||||
programs whose distribution conditions are incompatible with these,
|
||||
write to the author to ask for permission. For software which is
|
||||
copyrighted by the Free Software Foundation, write to the Free
|
||||
Software Foundation; we sometimes make exceptions for this. Our
|
||||
decision will be guided by the two goals of preserving the free status
|
||||
of all derivatives of our free software and of promoting the sharing
|
||||
and reuse of software generally.
|
||||
|
||||
NO WARRANTY
|
||||
|
||||
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
|
||||
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
|
||||
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
|
||||
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
|
||||
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
|
||||
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
|
||||
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
|
||||
|
||||
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
|
||||
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
|
||||
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
|
||||
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
|
||||
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
|
||||
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
|
||||
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
|
||||
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
|
||||
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
|
||||
DAMAGES.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Libraries
|
||||
|
||||
If you develop a new library, and you want it to be of the greatest
|
||||
possible use to the public, we recommend making it free software that
|
||||
everyone can redistribute and change. You can do so by permitting
|
||||
redistribution under these terms (or, alternatively, under the terms of the
|
||||
ordinary General Public License).
|
||||
|
||||
To apply these terms, attach the following notices to the library. It is
|
||||
safest to attach them to the start of each source file to most effectively
|
||||
convey the exclusion of warranty; and each file should have at least the
|
||||
"copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the library's name and a brief idea of what it does.>
|
||||
Copyright (C) <year> <name of author>
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Lesser General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2.1 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Lesser General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
|
||||
USA
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
You should also get your employer (if you work as a programmer) or your
|
||||
school, if any, to sign a "copyright disclaimer" for the library, if
|
||||
necessary. Here is a sample; alter the names:
|
||||
|
||||
Yoyodyne, Inc., hereby disclaims all copyright interest in the
|
||||
library `Frob' (a library for tweaking knobs) written by James Random Hacker.
|
||||
|
||||
<signature of Ty Coon>, 1 April 1990
|
||||
Ty Coon, President of Vice
|
||||
|
||||
That's all there is to it!
|
181
HOWTO.INSTALL
181
HOWTO.INSTALL
@@ -1,8 +1,108 @@
|
||||
Installing calc in 4 easy steps:
|
||||
Installing calc from the bzip2-ed tarball in 4 easy steps:
|
||||
|
||||
0) If your platform supports i686 RPMs, you may want to go to:
|
||||
|
||||
http://www.isthe.com/chongo/src/calc/
|
||||
|
||||
and use these RPMs:
|
||||
|
||||
* calc*.i686.rpm
|
||||
- all that is needed if you just want to use calc
|
||||
|
||||
* calc-devel-*.i686.rpm
|
||||
- calc *.h header and *.a lib files for use in other programs
|
||||
|
||||
* calc.*.src.rpm
|
||||
- calc source in RPM package form
|
||||
|
||||
The following 4 steps apply to calc source tree that comes from either:
|
||||
|
||||
bunzip2 -c calc-*.tar.bz2 | tar -xvf -
|
||||
|
||||
or from:
|
||||
|
||||
rpm -ivh calc-*.src.rpm
|
||||
cd /var/tmp
|
||||
bunzip2 -c /usr/src/redhat/SOURCES/calc-*.tar.bz2 | tar -xvf -
|
||||
|
||||
1) Look at the makefile, and adjust it to suit your needs.
|
||||
|
||||
Here are some Makefile hints:
|
||||
The top level Makefile and the custom/Makefile require a GNU
|
||||
Make (such as gmake) or an equivalently advanced make. On many
|
||||
targets, the default make is sufficent. On FreeBSD for example,
|
||||
one must use gmake instead of make.
|
||||
|
||||
If your target system does not have GNU Make (or equivalent), then
|
||||
you should try using the Makefile.simple and custom/Makefile.simple
|
||||
files:
|
||||
|
||||
mv Makefile Makefile.gmake
|
||||
cp Makefile.simple Makefile
|
||||
mv custom/Makefile custom/Makefile.gmake
|
||||
cp custom/Makefile.simple custom/Makefile
|
||||
|
||||
The Makefile, as shipped, is suitable for installation under
|
||||
Linux and Un*x-like environments. For the most part, the default
|
||||
values should work. If in doubt, follow the 'When in doubt'
|
||||
suggestion.
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! If you are building under Windoz or a Windoz-like environment !
|
||||
! (such as Cygwin or DJGPP), read the README.WINDOWS file. !
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
You should determine if these Makefile variables are reasonable:
|
||||
|
||||
INCDIR Where the system include (.h) files are kept.
|
||||
BINDIR Where to install calc binary files.
|
||||
LIBDIR Where to install calc link library (*.a) files.
|
||||
CALC_SHAREDIR Where to install calc help, .cal, startup, and
|
||||
config files.
|
||||
|
||||
You may want to change the default installation locations for
|
||||
these values, which are based on the 4 values listed above:
|
||||
|
||||
HELPDIR where the help directory is installed
|
||||
CALC_INCDIR where the calc include files are installed
|
||||
CUSTOMCALDIR where custom *.cal files are installed
|
||||
CUSTOMHELPDIR where custom help files are installed
|
||||
CUSTOMINCDIR where custom .h files are installed
|
||||
SCRIPTDIR where calc shell scripts are installed
|
||||
|
||||
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
|
||||
performed under /. The purpose for ${T} is to allow someone
|
||||
to install calc somewhere other than into the system area.
|
||||
|
||||
For example, if:
|
||||
|
||||
BINDIR= /usr/bin
|
||||
LIBDIR= /usr/lib
|
||||
CALC_SHAREDIR= /usr/share/calc
|
||||
|
||||
and if:
|
||||
|
||||
T= /var/tmp/testing
|
||||
|
||||
Then the installation locations will be:
|
||||
|
||||
calc binary files: /var/tmp/testing/usr/bin
|
||||
calc link library: /var/tmp/testing/usr/lib
|
||||
calc help, .cal ...: /var/tmp/testing/usr/share/calc
|
||||
... etc ... /var/tmp/testing/...
|
||||
|
||||
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
|
||||
calc is installed under ${T}, as if one had to chroot under
|
||||
${T} for calc to operate.
|
||||
|
||||
Look for the section that starts:
|
||||
|
||||
################
|
||||
# compiler set #
|
||||
################
|
||||
|
||||
Select a compiler set by commenting in the appropriate set
|
||||
of cc options. As shipped the Makefile assumes a gcc-like
|
||||
@@ -10,37 +110,76 @@ Installing calc in 4 easy steps:
|
||||
found below, comment out the Linux set and comment in that
|
||||
set or edit the gcc set or the common cc set as needed.
|
||||
|
||||
You may want to change these Makrfile variables from their defaults:
|
||||
|
||||
RANLIB
|
||||
|
||||
You may or may not need RANLIB when building libraries.
|
||||
As shipped the Makefile assumes RANLIB is needed.
|
||||
Comment the in/out the RANLIB value if ranlib does
|
||||
not work or does not exist.
|
||||
|
||||
CALCPAGER
|
||||
|
||||
You may want to change the default pager used by calc.
|
||||
As shipped the Makefile assumes 'more'. On your system
|
||||
you may find 'less' to be a better pager.
|
||||
|
||||
Set TOPDIR to be the place under which help files, calc,
|
||||
include files and calc libs are to be installed. As shipped
|
||||
the Makefile assumes a TOPDIR of /usr/local/lib.
|
||||
DEBUG
|
||||
|
||||
Set BINDIR to the place where calc is installed. As shipped
|
||||
the Makefile assumes a BINDIR /usr/local/bin.
|
||||
Some compilers (to put it mildly) have bugs. Sometimes the
|
||||
DEBUG Makefile variable causes the compiler / optimizer to
|
||||
produce bad code. Other compilers do just fine.
|
||||
|
||||
If possible try to use DEBUG=-O3 -g3 (maximum optimization
|
||||
and debug symbols). If the calc test fails (see step 3),
|
||||
try lowering either the -O value and/or the -g3. Also try
|
||||
using -Osomething without -g.
|
||||
|
||||
Adjust other Makefile variables as needed.
|
||||
|
||||
2) build calc:
|
||||
|
||||
The top level Makefile and the custom/Makefile require a GNU
|
||||
Make (such as gmake) or an equivalently advanced make. On many
|
||||
targets, the default make is sufficent. On FreeBSD for example,
|
||||
one must use gmake instead of make.
|
||||
|
||||
If your target system does not have GNU Make (or equivalent), then
|
||||
you should try using the Makefile.simple and custom/Makefile.simple
|
||||
files:
|
||||
|
||||
mv Makefile Makefile.gmake
|
||||
cp Makefile.simple Makefile
|
||||
mv custom/Makefile custom/Makefile.gmake
|
||||
cp custom/Makefile.simple custom/Makefile
|
||||
|
||||
make all
|
||||
|
||||
==> We are interested in any compiler warnings (and errors) that
|
||||
you may find. See the BUGS file if you find any compiler
|
||||
warning or errors.
|
||||
|
||||
NOTE: You can force calc to build with only static libs:
|
||||
|
||||
make clobber
|
||||
make calc-static-only BLD_TYPE=calc-static-only
|
||||
|
||||
or force calc to build with only dynamic libs:
|
||||
|
||||
make clobber
|
||||
make calc-dynamic-only BLD_TYPE=calc-dynamic-only
|
||||
|
||||
3) test calc:
|
||||
|
||||
make check
|
||||
|
||||
==> If you run into problems, follow the BUGS file instructions.
|
||||
==> If you run into problems, read the BUGS file and follow
|
||||
the instructions found in there.
|
||||
|
||||
NOTE: For a quiet check which only prints if something goes wrong:
|
||||
|
||||
make chk
|
||||
|
||||
4) install calc:
|
||||
|
||||
@@ -48,3 +187,29 @@ Installing calc in 4 easy steps:
|
||||
|
||||
We suggest that you might want to read the README file and look at
|
||||
the calc help subsystem. See the README file for details.
|
||||
|
||||
## Copyright (C) 1999-2007 Landon Curt Noll
|
||||
##
|
||||
## Calc is open software; you can redistribute it and/or modify it under
|
||||
## the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
## as published by the Free Software Foundation.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
## distributed with calc under the filename COPYING-LGPL. You should have
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 30.6 $
|
||||
## @(#) $Id: HOWTO.INSTALL,v 30.6 2007/10/16 12:22:22 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/bin/calc/RCS/HOWTO.INSTALL,v $
|
||||
##
|
||||
## Under source code control: 1999/09/27 20:48:44
|
||||
## File existed as early as: 1999
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
302
LIBRARY
302
LIBRARY
@@ -1,11 +1,11 @@
|
||||
USING THE ARBITRARY PRECISION ROUTINES IN A C PROGRAM
|
||||
|
||||
Part of the calc release consists of an arbitrary precision math library.
|
||||
This library is used by the calc program to perform its own calculations.
|
||||
Part of the calc release consists of an arbitrary precision math link library.
|
||||
This link library is used by the calc program to perform its own calculations.
|
||||
If you wish, you can ignore the calc program entirely and call the arbitrary
|
||||
precision math routines from your own C programs.
|
||||
|
||||
The library is called libcalc.a, and provides routines to handle arbitrary
|
||||
The link library is called libcalc.a, and provides routines to handle arbitrary
|
||||
precision arithmetic with integers, rational numbers, or complex numbers.
|
||||
There are also many numeric functions such as factorial and gcd, along
|
||||
with some transcendental functions such as sin and exp.
|
||||
@@ -48,79 +48,245 @@ 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
|
||||
obscure internal routines won't change or disappear in future releases!
|
||||
|
||||
When calc is installed, all of the include files needed to build
|
||||
libcalc.a along with the library itself (and the lint library
|
||||
llib-lcalc.ln, if made) are installed into ${LIBDIR}.
|
||||
When calc is installed, all of libraries are installed into ${LIBDIR}.
|
||||
All of the calc header files are installed under ${INCDIRCALC}.
|
||||
|
||||
If CALC_SRC is defined, then the calc header files will assume that
|
||||
they are in or under the current directory. However, most external
|
||||
programs most likely will not be located under calc'c source tree.
|
||||
External programs most likely want to use the installed calc header
|
||||
files under ${INCDIRCALC}. External programs most likely NOT want
|
||||
to define CALC_SRC.
|
||||
|
||||
You need to include the following file to get the symbols and variables
|
||||
related to error handling:
|
||||
|
||||
lib_calc.h
|
||||
|
||||
External programs may want to compile with:
|
||||
|
||||
-I${LIBDIR} -L${LIBDIR} -lcalc
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
--------------
|
||||
ERROR HANDLING
|
||||
--------------
|
||||
If custom functions are also used, they may want to compile with:
|
||||
|
||||
Your program MUST provide a function called math_error. This is called by
|
||||
the math routines on an error condition, such as malloc failures or a
|
||||
division by zero. The routine is called in the manner of printf, with a
|
||||
format string and optional arguments. (However, none of the low level math
|
||||
routines currently uses formatting, so if you are lazy you can simply use
|
||||
the first argument as a simple error string.) For example, one of the
|
||||
error calls you might expect to receive is:
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc
|
||||
|
||||
math_error("Division by zero");
|
||||
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:
|
||||
|
||||
Your program can handle errors in basically one of two ways. Firstly, it
|
||||
can simply print the error message and then exit. Secondly, you can make
|
||||
use of setjmp and longjmp in your program. Use setjmp at some appropriate
|
||||
level in your program, and use longjmp in the math_error routine to return
|
||||
to that level and so recover from the error. This is what the calc program
|
||||
does.
|
||||
-UCALC_SRC
|
||||
|
||||
For convenience, the library libcalc.a contains a math_error routine.
|
||||
By default, this routine simply prints a message to stderr and then exits.
|
||||
By simply linking in this library, any calc errors will result in a
|
||||
error message on stderr followed by an exit.
|
||||
as well.
|
||||
|
||||
External programs that wish to use this math_error may want to compile with:
|
||||
-------------------
|
||||
MATH ERROR HANDLING
|
||||
-------------------
|
||||
|
||||
-I${LIBDIR} -L${LIBDIR} -lcalc
|
||||
The math_error() function is called by the math routines on an error
|
||||
condition, such as malloc failures, division by zero, or some form of
|
||||
an internal computation error. The routine is called in the manner of
|
||||
printf, with a format string and optional arguments:
|
||||
|
||||
If one sets up calc_jmp_buf, and then sets calc_jmp to non-zero then
|
||||
this routine will longjmp back (with the value of calc_jmp) instead.
|
||||
In addition, the last calc error message will be found in calc_error;
|
||||
this error is not printed to stderr. The calc error message will
|
||||
not have a trailing newline.
|
||||
void math_error(char *fmt, ...);
|
||||
|
||||
Your program must handle math errors in one of three ways:
|
||||
|
||||
1) Print the error message and then exit
|
||||
|
||||
There is a math_error() function supplied with the calc library.
|
||||
By default, this routine simply prints a message to stderr and
|
||||
then exits. By simply linking in this link library, any calc
|
||||
errors will result in a error message on stderr followed by
|
||||
an exit.
|
||||
|
||||
2) Use setjmp and longjmp in your program
|
||||
|
||||
Use setjmp at some appropriate level in your program, and let
|
||||
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.
|
||||
|
||||
If one sets up calc_matherr_jmpbuf, and then sets
|
||||
calc_use_matherr_jmpbuf to non-zero then math_error() will
|
||||
longjmp back with the return value of calc_use_matherr_jmpbuf.
|
||||
In addition, the last 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 trailing newline.
|
||||
|
||||
For example:
|
||||
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
|
||||
extern jmp_buf calc_jmp_buf;
|
||||
extern int calc_jmp;
|
||||
extern char *calc_error;
|
||||
int error;
|
||||
|
||||
...
|
||||
|
||||
if ((error = setjmp(calc_jmp_buf)) != 0) {
|
||||
|
||||
/* reinitialize calc after a longjmp */
|
||||
reinitialize();
|
||||
if ((error = setjmp(calc_matherr_jmpbuf)) != 0) {
|
||||
|
||||
/* report the error */
|
||||
printf("Ouch: %s\n", calc_error);
|
||||
printf("Ouch: %s\n", calc_err_msg);
|
||||
|
||||
/* reinitialize calc after the longjmp */
|
||||
reinitialize();
|
||||
}
|
||||
calc_jmp = 1;
|
||||
calc_use_matherr_jmpbuf = 1;
|
||||
|
||||
If calc_use_matherr_jmpbuf is non-zero, then the jmp_buf value
|
||||
calc_matherr_jmpbuf must be initialized by the setjmp() function
|
||||
or your program will crash.
|
||||
|
||||
3) Supply your own math_error function:
|
||||
|
||||
void math_error(char *fmt, ...);
|
||||
|
||||
Your math_error() function may exit or transfer control to outside
|
||||
of the calc library, but it must never return or calc will crash.
|
||||
|
||||
External programs can obtain the appropriate calc symbols by compiling with:
|
||||
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
-------------------------
|
||||
PARSE/SCAN ERROR HANDLING
|
||||
-------------------------
|
||||
|
||||
The scanerror() function is called when calc encounters a parse/scan
|
||||
error. For example, scanerror() is called when calc is given code
|
||||
with a syntax error.
|
||||
|
||||
The variable, calc_print_scanerr_msg, controls if calc prints to stderr,
|
||||
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 not printed:
|
||||
|
||||
#include "lib_calc.h"
|
||||
|
||||
/* do not print parse/scan errors to stderr */
|
||||
calc_print_scanerr_msg = 0;
|
||||
|
||||
The last calc math error or calc parse/scan error message is kept
|
||||
in the NUL terminated buffer:
|
||||
|
||||
char calc_err_msg[MAXERROR+1];
|
||||
|
||||
The value of calc_print_scanerr_msg does not change the use
|
||||
of the calc_err_msg[] buffer. Messages are stored in that
|
||||
buffer regardless of the calc_print_scanerr_msg value.
|
||||
|
||||
The calc_print_scanerr_msg and the calc_err_msg[] buffer are declared
|
||||
lib_calc.h include file. The initialized storage for these variables
|
||||
comes from the calc library. The MAXERROR symbol is also declared in
|
||||
the lib_calc.h include file.
|
||||
|
||||
Your program must handle parse/scan errors in one of two ways:
|
||||
|
||||
1) exit on error
|
||||
|
||||
If you do not setup the calc_scanerr_jmpbuf, then when calc
|
||||
encounters a parse/scan error, a message will be printed to
|
||||
stderr and calc will exit.
|
||||
|
||||
2) Use setjmp and longjmp in your program
|
||||
|
||||
Use setjmp at some appropriate level in your program, and let
|
||||
the longjmp in scanerror() return to that level and to allow you
|
||||
to recover from the error. This is what the calc program does.
|
||||
|
||||
If one sets up calc_scanerr_jmpbuf, and then sets
|
||||
calc_use_scanerr_jmpbuf to non-zero then scanerror() will longjmp
|
||||
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
|
||||
not printed to stderr. The calc error message will not have a
|
||||
trailing newline.
|
||||
|
||||
For example:
|
||||
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
|
||||
int scan_error;
|
||||
|
||||
...
|
||||
|
||||
/* delay the printing of the parse/scan error */
|
||||
calc_use_scanerr_jmpbuf = 0; /* this is optional */
|
||||
|
||||
if ((scan_error = setjmp(calc_scanerr_jmpbuf)) != 0) {
|
||||
|
||||
/* report the parse/scan */
|
||||
if (calc_use_scanerr_jmpbuf == 0) {
|
||||
printf("parse error: %s\n", calc_err_msg);
|
||||
}
|
||||
|
||||
/* initialize calc after the longjmp */
|
||||
initialize();
|
||||
}
|
||||
calc_use_scanerr_jmpbuf = 1;
|
||||
|
||||
If calc_use_scanerr_jmpbuf is non-zero, then the jmp_buf value
|
||||
calc_scanerr_jmpbuf must be initialized by the setjmp() function
|
||||
or your program will crash.
|
||||
|
||||
External programs can obtain the appropriate calc symbols by compiling with:
|
||||
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
---------------------------
|
||||
PARSE/SCAN WARNING HANDLING
|
||||
---------------------------
|
||||
|
||||
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
|
||||
string and optional arguments:
|
||||
|
||||
void warning(char *fmt, ...);
|
||||
|
||||
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
|
||||
parse/scan warnings are printed to stderr. By setting this value to zero,
|
||||
parse/scan warnings are not printed:
|
||||
|
||||
#include "lib_calc.h"
|
||||
|
||||
/* do not print parse/scan warnings to stderr */
|
||||
calc_print_scanwarn_msg = 0;
|
||||
|
||||
The last calc calc parse/scan warning message is kept in the NUL
|
||||
terminated buffer:
|
||||
|
||||
char calc_warn_msg[MAXERROR+1];
|
||||
|
||||
The value of calc_print_scanwarn_msg does not change the use
|
||||
of the calc_warn_msg[] buffer. Messages are stored in that
|
||||
buffer regardless of the calc_print_scanwarn_msg value.
|
||||
|
||||
Your program must handle parse/scan warnings in one of two ways:
|
||||
|
||||
1) print the warning to stderr and continue
|
||||
|
||||
The warning() from libcalc prints warning messages to
|
||||
stderr and returns. The flow of execution is not changed.
|
||||
This is what calc does by default.
|
||||
|
||||
2) Supply your own warning function:
|
||||
|
||||
void warning(char *fmt, ...);
|
||||
|
||||
Your warning function should simply return when it is finished.
|
||||
|
||||
External programs can obtain the appropriate calc symbols by compiling with:
|
||||
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
|
||||
---------------
|
||||
OUTPUT ROUTINES
|
||||
---------------
|
||||
|
||||
The output from the routines in the library normally goes to stdout. You
|
||||
can divert that output to either another FILE handle, or else to a string.
|
||||
Read the routines in zio.c to see what is available. Diversions can be
|
||||
nested.
|
||||
The output from the routines in the link library normally goes to stdout.
|
||||
You can divert that output to either another FILE handle, or else
|
||||
to a string. Read the routines in zio.c to see what is available.
|
||||
Diversions can be nested.
|
||||
|
||||
You use math_setfp to divert output to another FILE handle. Calling
|
||||
math_setfp with stdout restores output to stdout.
|
||||
@@ -328,13 +494,13 @@ Examples of these are qnum to return the numerator, qden to return the
|
||||
denominator, qint to return the integer part of, qfrac to return the
|
||||
fractional part of, and qinv to invert a fraction.
|
||||
|
||||
There are some transcendental functions in the library, such as sin and cos.
|
||||
These cannot be evaluated exactly as fractions. Therefore, 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 quantity of
|
||||
the correct value. This is usually an absolute 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:
|
||||
There are some transcendental functions in the link library, such as sin
|
||||
and cos. These cannot be evaluated exactly as fractions. Therefore,
|
||||
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
|
||||
quantity of the correct value. This is usually an absolute 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:
|
||||
|
||||
NUMBER *q, *ans, *epsilon;
|
||||
|
||||
@@ -455,3 +621,29 @@ call. This is not required, but is does bring things to a closure.
|
||||
|
||||
The function libcalc_call_me_last() takes no args and returns void. You
|
||||
need call libcalc_call_me_last() only once.
|
||||
|
||||
## Copyright (C) 1999 David I. Bell and Landon Curt Noll
|
||||
##
|
||||
## Calc is open software; you can redistribute it and/or modify it under
|
||||
## the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
## as published by the Free Software Foundation.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
## distributed with calc under the filename COPYING-LGPL. You should have
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 30.1 $
|
||||
## @(#) $Id: LIBRARY,v 30.1 2007/03/16 11:09:46 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/bin/calc/RCS/LIBRARY,v $
|
||||
##
|
||||
## Under source code control: 1993/07/30 19:44:49
|
||||
## File existed as early as: 1993
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
5571
Makefile.simple
Normal file
5571
Makefile.simple
Normal file
File diff suppressed because it is too large
Load Diff
91
README
91
README
@@ -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:
|
||||
|
||||
http://reality.sgi.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.
|
||||
In particular we would like to hear about:
|
||||
@@ -52,9 +52,10 @@ C programmers should note some unexpected differences in the calc syntax:
|
||||
|
||||
> help unexpected
|
||||
|
||||
Calc is shipped with a library of calc scripts. For a list see:
|
||||
Calc is shipped with a standard collection of calc resource files.
|
||||
For a list of calc standard resource files see:
|
||||
|
||||
> help stdlib
|
||||
> help resource
|
||||
|
||||
=-=
|
||||
|
||||
@@ -72,29 +73,85 @@ for a wish/todo list. Code contributions are welcome.
|
||||
|
||||
=-=
|
||||
|
||||
To join the calc-tester mailing list. Send a request to:
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
calc-tester-request at postofc dot corp dot sgi dot com
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
Your message body (not the subject) should consist of:
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
subscribe calc-tester address
|
||||
end
|
||||
name your_full_name
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
where ``address'' is your EMail address and ``your_full_name'' is
|
||||
your full name.
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
Calc bug reports, however should be sent to:
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
calc-bugs at postofc dot corp dot sgi dot com
|
||||
address. To be sure we see your EMail asking for help with your
|
||||
mailing list subscription, please use the following phase in your
|
||||
EMail Subject line:
|
||||
|
||||
[[ Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
calc tester mailing list help
|
||||
|
||||
but see the BUGS file first.
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
-=-
|
||||
|
||||
Calc bug reports and calc bug fixes should be sent to:
|
||||
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
calc bug report
|
||||
|
||||
That phrase in your subject line will help ensure your
|
||||
request will get past our anti-spam filters. You may have
|
||||
additional words in your subject line.
|
||||
|
||||
However, you may find it more helpful to simply subscribe
|
||||
to the calc-tester mailing list (see above) and then to
|
||||
send your report to that mailing list as a wider set calc
|
||||
testers may be able to help you.
|
||||
|
||||
-=-
|
||||
|
||||
The calc web site is located at:
|
||||
|
||||
http://reality.sgi.com/chongo/tech/comp/calc/
|
||||
http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
NOTE: The EMail address uses 'asthe', while the web site uses 'isthe'.
|
||||
|
||||
## Copyright (C) 1999,2014 Landon Curt Noll
|
||||
##
|
||||
## Calc is open software; you can redistribute it and/or modify it under
|
||||
## the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
## as published by the Free Software Foundation.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
## distributed with calc under the filename COPYING-LGPL. You should have
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 30.3 $
|
||||
## @(#) $Id: README,v 30.3 2014/10/12 12:23:43 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/bin/calc/RCS/README,v $
|
||||
##
|
||||
## Under source code control: 1995/10/25 05:27:59
|
||||
## File existed as early as: 1995
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
153
README.WINDOWS
Normal file
153
README.WINDOWS
Normal file
@@ -0,0 +1,153 @@
|
||||
Dear calc user on a Windoz based system,
|
||||
|
||||
See the HOWTO.INSTALL file for information on how to build and install calc.
|
||||
See also the README file.
|
||||
|
||||
NOTE: The main developers do not have access to a Windoz based platform.
|
||||
While we will make an effort to not break calc Windoz based system,
|
||||
our lack of a Windoz test environment will mean we will make mistakes
|
||||
from time to time. Hopefully Windowz users can overcome these mistakes.
|
||||
Of course you are welcome to send us any patches that fix your
|
||||
Windoz build environment.
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
=-= compiling with Cygwin =-=
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
|
||||
An effort is being made to allow windows users to compile calc using the
|
||||
Cygwin project (http://sources.redhat.com/cygwin/) with the GCC compiler
|
||||
and Un*x tools for Windows.
|
||||
|
||||
The major porting work for Cygwin was performed by Thomas Jones-Low
|
||||
(tjoneslo at softstart dot com).
|
||||
|
||||
In March 2009, Michael Penk (mpenk at wuska dot com) reported success in
|
||||
installs under Cygwin:
|
||||
|
||||
On my fairly complete Cygwin installs, everything compiles,
|
||||
checks, and installs correctly. My Cygwin is configured
|
||||
in a very standard way (out of the box, using all of Cygwin's
|
||||
defaults). The install worked on 5 different machines with
|
||||
Cygwin on them: one XP home, one XP professional, and three
|
||||
Vista professionals.
|
||||
|
||||
Using the calc Makefile, he did the following:
|
||||
|
||||
make all target=Cygwin
|
||||
make check
|
||||
make install
|
||||
|
||||
He also reports:
|
||||
|
||||
Of course, one should be logged in as an Administrator when
|
||||
one builds and installs calc.
|
||||
|
||||
He was compiling calc 2.12.4.0 with Cygwin version 1.5.25-15.
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
=-= If all else fails, for Cygwin =-=
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
|
||||
Much earlier (2001?) Thomas Jones-Low (tjoneslo at softstart dot com)
|
||||
recommended that you generate by hand all of the header files that
|
||||
by the Makefile. This has been done for you via the makefile rule:
|
||||
|
||||
make win32_hsrc
|
||||
|
||||
which uses the Makefile variables in win32.mkdef to form these header
|
||||
files under win32 directory.
|
||||
|
||||
You will find generated versions of these files located in the win32
|
||||
sub-directory. These files may be appropriate for your Cygwin building
|
||||
needs.
|
||||
|
||||
In particular:
|
||||
|
||||
Just copy the win32/*.[ch] files up into the top level calc
|
||||
source directory, edit them (if needed) and build using the
|
||||
Cygwin GCC compiler and Cygwin build environment.
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
=-= compiling under DJGPP =-=
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
|
||||
You might want to try using the DJGPP system to compile calc. See:
|
||||
|
||||
http://www.delorie.com/djgpp/
|
||||
|
||||
for DJGPP details and availability.
|
||||
|
||||
To compile with DJGPP, one needs to select a number of Makefile
|
||||
variable changes. Eli Zaretskii <eliz at is dot elta dot co dot il>
|
||||
recommends the following settings:
|
||||
|
||||
TERMCONTROL= -DUSE_TERMIOS
|
||||
BYTE_ORDER= -DLITTLE_ENDIAN
|
||||
LONG_BITS= 32
|
||||
HAVE_FPOS_POS= -DHAVE_NO_FPOS_POS
|
||||
FPOS_BITS= 32
|
||||
OFF_T_BITS= 32
|
||||
DEV_BITS= 32
|
||||
INODE_BITS= 32
|
||||
HAVE_USTAT= -DHAVE_NO_USTAT
|
||||
HAVE_GETSID= -DHAVE_NO_GETSID
|
||||
HAVE_GETPGID= -DHAVE_NO_GETPGID
|
||||
HAVE_GETTIME= -DHAVE_NO_GETTIME
|
||||
HAVE_GETPRID= -DHAVE_NO_GETPRID
|
||||
HAVE_URANDOM_H= NO
|
||||
ALIGN32= -UMUST_ALIGN32
|
||||
HAVE_MALLOC_H= YES
|
||||
HAVE_STDLIB_H= YES
|
||||
HAVE_STRING_H= YES
|
||||
HAVE_TIMES_H= NO
|
||||
HAVE_SYS_TIMES_H= YES
|
||||
HAVE_TIME_H= YES
|
||||
HAVE_SYS_TIME_H= YES
|
||||
HAVE_UNISTD_H= YES
|
||||
BINDIR= /dev/env/DJDIR/bin
|
||||
INCDIR= /dev/env/DJDIR/include
|
||||
LIBDIR= /dev/env/DJDIR/lib
|
||||
MANDIR= /dev/env/DJDIR/man/man1
|
||||
CATDIR= /dev/env/DJDIR/man/cat1
|
||||
NROFF= groff
|
||||
CALCPATH= .;./cal;~/.cal;${CALC_SHAREDIR};${CUSTOMCALDIR}
|
||||
CALCRC= ${CALC_SHAREDIR}/startup;~/.calcrc;./.calcinit
|
||||
CALCPAGER= less.exe -ci
|
||||
DEBUG= -O2 -gstabs+ -DWINDOZ
|
||||
|
||||
The 'Linux set' or 'gcc set' (see the Select your compiler type section)
|
||||
should work for DJGPP systems if you set the above Makefile variables.
|
||||
|
||||
Look for Makefile comments of the form:
|
||||
|
||||
# Select ...something... for DJGPP.
|
||||
|
||||
Follow those recommendations. In cases where they conflict with
|
||||
the above Makefile list, follow the recommendation in the Makefile.
|
||||
|
||||
|
||||
## Copyright (C) 2002-2009 Landon Curt Noll and Thomas Jones-Low
|
||||
##
|
||||
## Calc is open software; you can redistribute it and/or modify it under
|
||||
## the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
## as published by the Free Software Foundation.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
## distributed with calc under the filename COPYING-LGPL. You should have
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 30.2 $
|
||||
## @(#) $Id: README.WINDOWS,v 30.2 2009/03/14 02:29:31 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/bin/calc/RCS/README.WINDOWS,v $
|
||||
##
|
||||
## Under source code control: 2001/02/25 14:00:05
|
||||
## File existed as early as: 2001
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
99
addop.c
99
addop.c
@@ -1,15 +1,39 @@
|
||||
/*
|
||||
* Copyright (c) 1997 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* addop - add opcodes to a function being compiled
|
||||
*
|
||||
* Add opcodes to a function being compiled.
|
||||
* Copyright (C) 1999-2007 David I. Bell and Ernest Bowen
|
||||
*
|
||||
* Primary author: David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: addop.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/addop.c,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:48:10
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include "calc.h"
|
||||
#include "opcodes.h"
|
||||
#include "string.h"
|
||||
#include "str.h"
|
||||
#include "func.h"
|
||||
#include "token.h"
|
||||
#include "label.h"
|
||||
@@ -20,17 +44,17 @@
|
||||
#define OPCODEALLOCSIZE 100 /* reallocate size for opcodes in functions */
|
||||
|
||||
|
||||
static long maxopcodes; /* number of opcodes available */
|
||||
static long newindex; /* index of new function */
|
||||
static char *newname; /* name of new function */
|
||||
static long oldop; /* previous opcode */
|
||||
static long oldoldop; /* opcode before previous opcode */
|
||||
static long debugline; /* line number of latest debug opcode */
|
||||
static long funccount; /* number of functions */
|
||||
static long funcavail; /* available number of functions */
|
||||
static FUNC *functemplate; /* function definition template */
|
||||
static FUNC **functions; /* table of functions */
|
||||
static STRINGHEAD funcnames; /* function names */
|
||||
STATIC unsigned long maxopcodes;/* number of opcodes available */
|
||||
STATIC long newindex; /* index of new function */
|
||||
STATIC char *newname; /* name of new function */
|
||||
STATIC long oldop; /* previous opcode */
|
||||
STATIC long oldoldop; /* opcode before previous opcode */
|
||||
STATIC long debugline; /* line number of latest debug opcode */
|
||||
STATIC long funccount; /* number of functions */
|
||||
STATIC long funcavail; /* available number of functions */
|
||||
STATIC FUNC *functemplate; /* function definition template */
|
||||
STATIC FUNC **functions; /* table of functions */
|
||||
STATIC STRINGHEAD funcnames; /* function names */
|
||||
|
||||
|
||||
/*
|
||||
@@ -68,7 +92,7 @@ showfunctions(void)
|
||||
|
||||
count = 0;
|
||||
if (funccount > 0) {
|
||||
if (conf->lib_debug & LIBDBG_FUNC_INFO)
|
||||
if (conf->resource_debug & RSCDBG_FUNC_INFO)
|
||||
math_str("Index\tName \tArgs\tOpcodes\n"
|
||||
"-----\t------ \t---- \t------\n");
|
||||
else
|
||||
@@ -76,7 +100,7 @@ showfunctions(void)
|
||||
"----\t---------\n");
|
||||
for (index = 0; index < funccount; index++) {
|
||||
fp = functions[index];
|
||||
if (conf->lib_debug & LIBDBG_FUNC_INFO) {
|
||||
if (conf->resource_debug & RSCDBG_FUNC_INFO) {
|
||||
|
||||
math_fmt("%5ld\t%-12s\t", index,
|
||||
namestr(&funcnames,index));
|
||||
@@ -96,7 +120,7 @@ showfunctions(void)
|
||||
}
|
||||
}
|
||||
}
|
||||
if (conf->lib_debug & LIBDBG_FUNC_INFO) {
|
||||
if (conf->resource_debug & RSCDBG_FUNC_INFO) {
|
||||
math_fmt("\nNumber non-null: %ld\n", count);
|
||||
math_fmt("Number null: %ld\n", funccount - count);
|
||||
math_fmt("Total number: %ld\n", funccount);
|
||||
@@ -160,8 +184,8 @@ void
|
||||
endfunc(void)
|
||||
{
|
||||
register FUNC *fp; /* function just finished */
|
||||
unsigned long size; /* size of just created function */
|
||||
long index;
|
||||
size_t size; /* size of just created function */
|
||||
unsigned long index;
|
||||
|
||||
if (oldop != OP_RETURN) {
|
||||
addop(OP_UNDEF);
|
||||
@@ -171,8 +195,8 @@ endfunc(void)
|
||||
checklabels();
|
||||
|
||||
if (errorcount) {
|
||||
printf("\"%s\": %ld error%s\n", newname, errorcount,
|
||||
((errorcount == 1) ? "" : "s"));
|
||||
scanerror(T_NULL,"Compilation of \"%s\" failed: %ld error(s)",
|
||||
newname, errorcount);
|
||||
return;
|
||||
}
|
||||
size = funcsize(curfunc->f_opcodecount);
|
||||
@@ -184,15 +208,15 @@ endfunc(void)
|
||||
memcpy((char *) fp, (char *) curfunc, size);
|
||||
if (curfunc != functemplate)
|
||||
free(curfunc);
|
||||
if (conf->traceflags & TRACE_FNCODES) {
|
||||
if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
|
||||
dumpnames = TRUE;
|
||||
for (size = 0; size < fp->f_opcodecount; ) {
|
||||
printf("%ld: ", (long)size);
|
||||
printf("%ld: ", (unsigned long)size);
|
||||
size += dumpop(&fp->f_opcodes[size]);
|
||||
}
|
||||
}
|
||||
if ((inputisterminal() && conf->lib_debug & LIBDBG_STDIN_FUNC) ||
|
||||
(!inputisterminal() && conf->lib_debug & LIBDBG_FILE_FUNC)) {
|
||||
if ((inputisterminal() && conf->resource_debug & RSCDBG_STDIN_FUNC) ||
|
||||
(!inputisterminal() && conf->resource_debug & RSCDBG_FILE_FUNC)) {
|
||||
printf("%s(", newname);
|
||||
for (index = 0; index < fp->f_paramcount; index++) {
|
||||
if (index)
|
||||
@@ -256,16 +280,17 @@ rmuserfunc(char *name)
|
||||
|
||||
index = findstr(&funcnames, name);
|
||||
if (index < 0) {
|
||||
fprintf(stderr, "%s() has never been defined\n",
|
||||
name);
|
||||
warning("No function named \"%s\" to be undefined", name);
|
||||
return;
|
||||
}
|
||||
if (functions[index] == NULL)
|
||||
if (functions[index] == NULL) {
|
||||
warning("No defined function \"%s\" to be undefined", name);
|
||||
return;
|
||||
}
|
||||
freenumbers(functions[index]);
|
||||
free(functions[index]);
|
||||
if ((inputisterminal() && conf->lib_debug & LIBDBG_STDIN_FUNC) ||
|
||||
(!inputisterminal() && conf->lib_debug & LIBDBG_FILE_FUNC))
|
||||
if ((inputisterminal() && conf->resource_debug & RSCDBG_STDIN_FUNC) ||
|
||||
(!inputisterminal() && conf->resource_debug & RSCDBG_FILE_FUNC))
|
||||
printf("%s() undefined\n", name);
|
||||
functions[index] = NULL;
|
||||
}
|
||||
@@ -278,7 +303,7 @@ void
|
||||
freefunc(FUNC *fp)
|
||||
{
|
||||
long index;
|
||||
long i;
|
||||
unsigned long i;
|
||||
|
||||
if (fp == NULL)
|
||||
return;
|
||||
@@ -294,7 +319,7 @@ freefunc(FUNC *fp)
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
}
|
||||
if (conf->traceflags & TRACE_FNCODES) {
|
||||
if (newname[0] != '*' && (conf->traceflags & TRACE_FNCODES)) {
|
||||
printf("Freeing function \"%s\"\n",namestr(&funcnames,index));
|
||||
dumpnames = FALSE;
|
||||
for (i = 0; i < fp->f_opcodecount; ) {
|
||||
@@ -359,7 +384,7 @@ clearopt(void)
|
||||
FUNC *
|
||||
findfunc(long index)
|
||||
{
|
||||
if ((unsigned long) index >= funccount) {
|
||||
if (index >= funccount) {
|
||||
math_error("Undefined function");
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
@@ -502,9 +527,7 @@ addop(long op)
|
||||
fp->f_opcodecount -= diff;
|
||||
oldop = OP_NOP;
|
||||
oldoldop = OP_NOP;
|
||||
fprintf(stderr,
|
||||
"Line %ld: unused value ignored\n",
|
||||
linenumber());
|
||||
warning("Constant before comma operator");
|
||||
return;
|
||||
}
|
||||
break;
|
||||
|
36
align32.c
36
align32.c
@@ -1,26 +1,34 @@
|
||||
/*
|
||||
* align32 - determine if 32 bit accesses must be aligned
|
||||
*
|
||||
* This file was written by:
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* This code has been placed in the public domain. Please do not
|
||||
* copyright this code.
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO
|
||||
* THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER-
|
||||
* CHANTABILITY AND FITNESS. IN NO EVENT SHALL LANDON CURT
|
||||
* NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL
|
||||
* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
||||
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
||||
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: align32.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/align32.c,v $
|
||||
*
|
||||
* Under source code control: 1995/11/23 05:18:06
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <signal.h>
|
||||
#include "longbits.h"
|
||||
|
93
alloc.h
93
alloc.h
@@ -1,56 +1,74 @@
|
||||
/*
|
||||
* Copyright (c) 1997 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* alloc - storage allocation and storage debug macros
|
||||
*
|
||||
* Copyright (C) 1999-2007,2014 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.5 $
|
||||
* @(#) $Id: alloc.h,v 30.5 2014/08/24 21:56:51 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/alloc.h,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:48:29
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__ALLOC_H__)
|
||||
#define __ALLOC_H__
|
||||
#if !defined(INCLUDE_ALLOC_H)
|
||||
#define INCLUDE_ALLOC_H
|
||||
|
||||
|
||||
#include "have_malloc.h"
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
# include "have_newstr.h"
|
||||
# include "have_string.h"
|
||||
# include "have_memmv.h"
|
||||
|
||||
#ifdef HAVE_MALLOC_H
|
||||
# include <malloc.h>
|
||||
#else
|
||||
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
|
||||
extern void *malloc();
|
||||
extern void *realloc();
|
||||
extern void free();
|
||||
# else
|
||||
extern char *malloc();
|
||||
extern char *realloc();
|
||||
extern void free();
|
||||
# endif
|
||||
# include <calc/have_newstr.h>
|
||||
# include <calc/have_string.h>
|
||||
# include <calc/have_memmv.h>
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_STRING_H
|
||||
# include <string.h>
|
||||
|
||||
#else
|
||||
#if defined(_WIN32) && defined(NOTCYGWIN)
|
||||
#include <stdio.h>
|
||||
#endif
|
||||
|
||||
# if defined(HAVE_NEWSTR)
|
||||
extern void *memcpy();
|
||||
extern void *memset();
|
||||
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
|
||||
extern size_t strlen();
|
||||
E_FUNC void *memcpy();
|
||||
E_FUNC void *memset();
|
||||
#if defined(FORCE_STDC) || \
|
||||
(defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
|
||||
E_FUNC size_t strlen();
|
||||
# else
|
||||
extern long strlen();
|
||||
E_FUNC long strlen();
|
||||
# endif
|
||||
# else /* HAVE_NEWSTR */
|
||||
extern void bcopy();
|
||||
extern void bfill();
|
||||
extern char *index();
|
||||
E_FUNC void bcopy();
|
||||
E_FUNC void bfill();
|
||||
E_FUNC char *index();
|
||||
# endif /* HAVE_NEWSTR */
|
||||
extern char *strchr();
|
||||
extern char *strcpy();
|
||||
extern char *strncpy();
|
||||
extern char *strcat();
|
||||
extern int strcmp();
|
||||
E_FUNC char *strchr();
|
||||
E_FUNC char *strcpy();
|
||||
E_FUNC char *strncpy();
|
||||
E_FUNC char *strcat();
|
||||
E_FUNC int strcmp();
|
||||
|
||||
#endif
|
||||
|
||||
@@ -64,13 +82,14 @@ extern int strcmp();
|
||||
#endif /* HAVE_NEWSTR */
|
||||
|
||||
#if !defined(HAVE_MEMMOVE)
|
||||
# undef CALC_SIZE_T
|
||||
#if defined(FORCE_STDC) || (defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
|
||||
# define CALC_SIZE_T size_t
|
||||
# undef MEMMOVE_SIZE_T
|
||||
#if defined(FORCE_STDC) || \
|
||||
(defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
|
||||
# define MEMMOVE_SIZE_T size_t
|
||||
# else
|
||||
# define CALC_SIZE_T long
|
||||
# define MEMMOVE_SIZE_T long
|
||||
# endif
|
||||
extern void *memmove(void *s1, const void *s2, CALC_SIZE_T n);
|
||||
E_FUNC void *memmove(void *s1, CONST void *s2, MEMMOVE_SIZE_T n);
|
||||
#endif
|
||||
|
||||
#endif /* !__ALLOC_H__ */
|
||||
#endif /* !INCLUDE_ALLOC_H */
|
||||
|
58
assocfunc.c
58
assocfunc.c
@@ -1,8 +1,33 @@
|
||||
/*
|
||||
* Copyright (c) 1995 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* assocfunc - association table routines
|
||||
*
|
||||
* Copyright (C) 1999-2007 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.3 $
|
||||
* @(#) $Id: assocfunc.c,v 30.3 2014/09/30 00:55:11 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/assocfunc.c,v $
|
||||
*
|
||||
* Under source code control: 1993/07/20 23:04:27
|
||||
* File existed as early as: 1993
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Association table routines.
|
||||
* An association table is a type of value which can be "indexed" by
|
||||
* one or more arbitrary values. Each element in the table is thus an
|
||||
@@ -11,6 +36,7 @@
|
||||
* quick access.
|
||||
*/
|
||||
|
||||
|
||||
#include "value.h"
|
||||
|
||||
|
||||
@@ -20,10 +46,10 @@
|
||||
#define ELEMSIZE(n) (sizeof(ASSOCELEM) + (sizeof(VALUE) * ((n) - 1)))
|
||||
|
||||
|
||||
static ASSOCELEM *elemindex(ASSOC *ap, long index);
|
||||
static BOOL compareindices(VALUE *v1, VALUE *v2, long dim);
|
||||
static void resize(ASSOC *ap, long newsize);
|
||||
static void assoc_elemfree(ASSOCELEM *ep);
|
||||
S_FUNC ASSOCELEM *elemindex(ASSOC *ap, long index);
|
||||
S_FUNC BOOL compareindices(VALUE *v1, VALUE *v2, long dim);
|
||||
S_FUNC void resize(ASSOC *ap, long newsize);
|
||||
S_FUNC void assoc_elemfree(ASSOCELEM *ep);
|
||||
|
||||
|
||||
/*
|
||||
@@ -43,7 +69,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
|
||||
{
|
||||
ASSOCELEM **listhead;
|
||||
ASSOCELEM *ep;
|
||||
static VALUE val;
|
||||
STATIC VALUE val;
|
||||
QCKHASH hash;
|
||||
int i;
|
||||
|
||||
@@ -57,7 +83,7 @@ associndex(ASSOC *ap, BOOL create, long dim, VALUE *indices)
|
||||
* so that we can first select the correct hash chain, and
|
||||
* also so we can quickly compare each element for a match.
|
||||
*/
|
||||
hash = FNV1_32_BASIS;
|
||||
hash = QUICKHASH_BASIS;
|
||||
for (i = 0; i < dim; i++)
|
||||
hash = hashvalue(&indices[i], hash);
|
||||
|
||||
@@ -174,7 +200,7 @@ assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
|
||||
* ap association to index into
|
||||
* index index of desired element
|
||||
*/
|
||||
static ASSOCELEM *
|
||||
S_FUNC ASSOCELEM *
|
||||
elemindex(ASSOC *ap, long index)
|
||||
{
|
||||
ASSOCELEM *ep;
|
||||
@@ -306,7 +332,8 @@ assoccopy(ASSOC *oldap)
|
||||
oldep = oldep->e_next) {
|
||||
ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim));
|
||||
if (ep == NULL) {
|
||||
math_error("Cannot allocate association element");
|
||||
math_error("Cannot allocate "
|
||||
"association element");
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
ep->e_dim = oldep->e_dim;
|
||||
@@ -314,7 +341,8 @@ assoccopy(ASSOC *oldap)
|
||||
ep->e_value.v_type = V_NULL;
|
||||
ep->e_value.v_subtype = V_NOSUBTYPE;
|
||||
for (i = 0; i < ep->e_dim; i++)
|
||||
copyvalue(&oldep->e_indices[i], &ep->e_indices[i]);
|
||||
copyvalue(&oldep->e_indices[i],
|
||||
&ep->e_indices[i]);
|
||||
copyvalue(&oldep->e_value, &ep->e_value);
|
||||
listhead = &ap->a_table[ep->e_hash % ap->a_size];
|
||||
ep->e_next = *listhead;
|
||||
@@ -330,7 +358,7 @@ assoccopy(ASSOC *oldap)
|
||||
* This is only actually done if the growth from the previous size is
|
||||
* enough to make this worthwhile.
|
||||
*/
|
||||
static void
|
||||
S_FUNC void
|
||||
resize(ASSOC *ap, long newsize)
|
||||
{
|
||||
ASSOCELEM **oldtable;
|
||||
@@ -374,7 +402,7 @@ resize(ASSOC *ap, long newsize)
|
||||
/*
|
||||
* Free an association element, along with any contained values.
|
||||
*/
|
||||
static void
|
||||
S_FUNC void
|
||||
assoc_elemfree(ASSOCELEM *ep)
|
||||
{
|
||||
int i;
|
||||
@@ -494,7 +522,7 @@ assocprint(ASSOC *ap, long max_print)
|
||||
* Compare two lists of index values to see if they are identical.
|
||||
* Returns TRUE if they are the same.
|
||||
*/
|
||||
static BOOL
|
||||
S_FUNC BOOL
|
||||
compareindices(VALUE *v1, VALUE *v2, long dim)
|
||||
{
|
||||
int i;
|
||||
|
156
blkcpy.c
156
blkcpy.c
@@ -1,19 +1,42 @@
|
||||
/*
|
||||
* Copyright (c) 1997 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* blkcpy - general values and related routines used by the calculator
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: blkcpy.c,v 30.2 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/blkcpy.c,v $
|
||||
*
|
||||
* Under source code control: 1997/04/18 20:41:26
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#include <stdio.h>
|
||||
#include <sys/types.h>
|
||||
#include "calc.h"
|
||||
#include "value.h"
|
||||
#include "file.h"
|
||||
#include "blkcpy.h"
|
||||
#include "string.h"
|
||||
#include "str.h"
|
||||
|
||||
|
||||
/*
|
||||
@@ -257,20 +280,20 @@ copymat2mat(MATRIX *smat, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
VALUE *vp;
|
||||
VALUE *vq;
|
||||
VALUE *vtemp;
|
||||
short subtype;
|
||||
unsigned short subtype;
|
||||
|
||||
if (ssi > smat->m_size)
|
||||
return E_COPY2;
|
||||
|
||||
if (num < 0)
|
||||
num = smat->m_size - ssi;
|
||||
if ((USB32) ssi + num > smat->m_size)
|
||||
if (ssi + num > smat->m_size)
|
||||
return E_COPY5;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dmat->m_size)
|
||||
if (dsi + num > dmat->m_size)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -288,7 +311,7 @@ copymat2mat(MATRIX *smat, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
subtype = vq->v_subtype;
|
||||
freevalue(vq);
|
||||
*vq = *vp;
|
||||
vq->v_subtype = subtype;
|
||||
vq->v_subtype |= subtype;
|
||||
}
|
||||
free(vtemp);
|
||||
return 0;
|
||||
@@ -306,19 +329,19 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
VALUE *vq;
|
||||
VALUE *vtemp;
|
||||
long i;
|
||||
short subtype;
|
||||
unsigned short subtype;
|
||||
|
||||
if (ssi > blk->datalen)
|
||||
return E_COPY2;
|
||||
if (num < 0)
|
||||
num = blk->datalen - ssi;
|
||||
if ((USB32) ssi + num > blk->datalen)
|
||||
if (ssi + num > blk->datalen)
|
||||
return E_COPY5;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dmat->m_size)
|
||||
if (dsi + num > dmat->m_size)
|
||||
return E_COPY7;
|
||||
op = blk->data + ssi;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
@@ -340,7 +363,7 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
subtype = vq->v_subtype;
|
||||
freevalue(vq);
|
||||
*vq = *vp;
|
||||
vq->v_subtype = subtype;
|
||||
vq->v_subtype |= subtype;
|
||||
}
|
||||
free(vtemp);
|
||||
return 0;
|
||||
@@ -351,7 +374,8 @@ copyblk2mat(BLOCK *blk, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
* copymat2blk - copy matrix to block
|
||||
*/
|
||||
int
|
||||
copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi,
|
||||
BOOL noreloc)
|
||||
{
|
||||
long i;
|
||||
long newlen;
|
||||
@@ -366,7 +390,7 @@ copymat2blk(MATRIX *smat, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
|
||||
num = smat->m_size - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > smat->m_size)
|
||||
if (ssi + num > smat->m_size)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = dblk->datalen;
|
||||
@@ -406,6 +430,7 @@ copymat2list(MATRIX *smat, long ssi, long num, LIST *lp, long dsi)
|
||||
LISTELEM *ep;
|
||||
VALUE *vtemp;
|
||||
long i;
|
||||
unsigned short subtype;
|
||||
|
||||
if (ssi > smat->m_size)
|
||||
return E_COPY2;
|
||||
@@ -413,11 +438,11 @@ copymat2list(MATRIX *smat, long ssi, long num, LIST *lp, long dsi)
|
||||
num = smat->m_size - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > smat->m_size)
|
||||
if (ssi + num > smat->m_size)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > lp->l_count)
|
||||
if (dsi + num > lp->l_count)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -433,8 +458,10 @@ copymat2list(MATRIX *smat, long ssi, long num, LIST *lp, long dsi)
|
||||
ep = listelement(lp, (long) dsi);
|
||||
i = num;
|
||||
while (i-- > 0) {
|
||||
subtype = ep->e_value.v_subtype;
|
||||
freevalue(&ep->e_value);
|
||||
ep->e_value = *vq++;
|
||||
ep->e_value.v_subtype |= subtype;
|
||||
ep = ep->e_next;
|
||||
}
|
||||
free(vtemp);
|
||||
@@ -453,7 +480,7 @@ copylist2mat(LIST *lp, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
LISTELEM *ep;
|
||||
VALUE *vtemp;
|
||||
long i;
|
||||
short subtype;
|
||||
unsigned short subtype;
|
||||
|
||||
if (ssi > lp->l_count)
|
||||
return E_COPY2;
|
||||
@@ -461,11 +488,11 @@ copylist2mat(LIST *lp, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
num = lp->l_count - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > lp->l_count)
|
||||
if (ssi + num > lp->l_count)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dmat->m_size)
|
||||
if (dsi + num > dmat->m_size)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -485,7 +512,7 @@ copylist2mat(LIST *lp, long ssi, long num, MATRIX *dmat, long dsi)
|
||||
subtype = vq->v_subtype;
|
||||
freevalue(vq);
|
||||
*vq = *vp;
|
||||
vq->v_subtype = subtype;
|
||||
vq->v_subtype |= subtype;
|
||||
}
|
||||
free(vtemp);
|
||||
return 0;
|
||||
@@ -503,6 +530,7 @@ copylist2list(LIST *slp, long ssi, long num, LIST *dlp, long dsi)
|
||||
LISTELEM *dep;
|
||||
VALUE *vtemp;
|
||||
VALUE *vp;
|
||||
unsigned short subtype;
|
||||
|
||||
if (ssi > slp->l_count)
|
||||
return E_COPY2;
|
||||
@@ -510,11 +538,11 @@ copylist2list(LIST *slp, long ssi, long num, LIST *dlp, long dsi)
|
||||
num = slp->l_count - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > slp->l_count)
|
||||
if (ssi + num > slp->l_count)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = 0;
|
||||
if ((USB32) dsi + num > dlp->l_count)
|
||||
if (dsi + num > dlp->l_count)
|
||||
return E_COPY7;
|
||||
vtemp = (VALUE *) malloc(num * sizeof(VALUE));
|
||||
if (vtemp == NULL) {
|
||||
@@ -532,8 +560,10 @@ copylist2list(LIST *slp, long ssi, long num, LIST *dlp, long dsi)
|
||||
vp = vtemp;
|
||||
i = num;
|
||||
while (i-- > 0) {
|
||||
subtype = dep->e_value.v_subtype;
|
||||
freevalue(&dep->e_value);
|
||||
dep->e_value = *vp++;
|
||||
dep->e_value.v_subtype |= subtype;
|
||||
dep = dep->e_next;
|
||||
}
|
||||
free(vtemp);
|
||||
@@ -549,7 +579,7 @@ copyblk2file(BLOCK *sblk, long ssi, long num, FILEID id, long dsi)
|
||||
{
|
||||
FILEIO *fiop;
|
||||
FILE *fp;
|
||||
unsigned int numw;
|
||||
long numw;
|
||||
|
||||
if (ssi > sblk->datalen)
|
||||
return E_COPY2;
|
||||
@@ -558,7 +588,7 @@ copyblk2file(BLOCK *sblk, long ssi, long num, FILEID id, long dsi)
|
||||
if (num == 0)
|
||||
return 0;
|
||||
|
||||
fiop = findid(id, 'w');
|
||||
fiop = findid(id, TRUE);
|
||||
if (fiop == NULL)
|
||||
return E_COPYF1;
|
||||
fp = fiop->fp;
|
||||
@@ -586,7 +616,7 @@ copyfile2blk(FILEID id, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
{
|
||||
FILEIO *fiop;
|
||||
FILE *fp;
|
||||
unsigned int numw;
|
||||
long numw;
|
||||
ZVALUE fsize;
|
||||
long filelen;
|
||||
long newlen;
|
||||
@@ -595,7 +625,7 @@ copyfile2blk(FILEID id, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
|
||||
if (id < 3) /* excludes copying from stdin */
|
||||
return E_COPYF1;
|
||||
fiop = findid(id, 'r');
|
||||
fiop = findid(id, FALSE);
|
||||
if (fiop == NULL)
|
||||
return E_COPYF1;
|
||||
|
||||
@@ -616,7 +646,7 @@ copyfile2blk(FILEID id, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
num = filelen - ssi;
|
||||
if (num == 0)
|
||||
return 0;
|
||||
if ((USB32) ssi + num > filelen)
|
||||
if (ssi + num > filelen)
|
||||
return E_COPY5;
|
||||
if (fseek(fp, ssi, 0)) /* using system fseek XXX */
|
||||
return E_COPYF2;
|
||||
@@ -654,7 +684,7 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
|
||||
{
|
||||
long len;
|
||||
FILEIO *fiop;
|
||||
unsigned int numw;
|
||||
long numw;
|
||||
FILE *fp;
|
||||
|
||||
len = str->s_len;
|
||||
@@ -665,9 +695,9 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
|
||||
num = len - ssi;
|
||||
if (num <= 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((USB32) ssi + num > len)
|
||||
if (ssi + num > len)
|
||||
return E_COPY5; /* Insufficient memory in str */
|
||||
fiop = findid(id, 'w');
|
||||
fiop = findid(id, TRUE);
|
||||
if (fiop == NULL)
|
||||
return E_COPYF1;
|
||||
fp = fiop->fp;
|
||||
@@ -691,7 +721,8 @@ copystr2file(STRING *str, long ssi, long num, FILEID id, long dsi)
|
||||
* copyblk2blk - copy block to block
|
||||
*/
|
||||
int
|
||||
copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi,
|
||||
BOOL noreloc)
|
||||
{
|
||||
long newlen;
|
||||
long newsize;
|
||||
@@ -703,7 +734,7 @@ copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc
|
||||
num = sblk->datalen - ssi;
|
||||
if (num == 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((unsigned int) ssi + num > sblk->datalen)
|
||||
if (ssi + num > sblk->datalen)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = dblk->datalen;
|
||||
@@ -733,7 +764,8 @@ copyblk2blk(BLOCK *sblk, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc
|
||||
* copystr2blk - copy string to block
|
||||
*/
|
||||
int
|
||||
copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
copystr2blk(STRING *str, long ssi, long num, BLOCK *dblk, long dsi,
|
||||
BOOL noreloc)
|
||||
{
|
||||
long len;
|
||||
long newlen;
|
||||
@@ -783,13 +815,13 @@ copystr2str(STRING *sstr, long ssi, long num, STRING *dstr, long dsi)
|
||||
{
|
||||
char *c, *c1;
|
||||
|
||||
if (num < 0 || ssi + num > sstr->s_len)
|
||||
if (num < 0 || (size_t)(ssi + num) > sstr->s_len)
|
||||
num = sstr->s_len - ssi;
|
||||
if (num <= 0)
|
||||
return 0; /* Nothing to be copied */
|
||||
if (dsi < 0) /* default destination index */
|
||||
dsi = 0;
|
||||
if (dsi + num > dstr->s_len)
|
||||
if ((size_t)(dsi + num) > dstr->s_len)
|
||||
num = dstr->s_len - dsi;
|
||||
c1 = sstr->s_str + ssi;
|
||||
c = dstr->s_str + dsi;
|
||||
@@ -815,7 +847,7 @@ copyblk2str(BLOCK *sblk, long ssi, long num, STRING *dstr, long dsi)
|
||||
return 0; /* Nothing to be copied */
|
||||
if (dsi < 0) /* default destination index */
|
||||
dsi = 0;
|
||||
if (dsi + num > dstr->s_len)
|
||||
if ((size_t)(dsi + num) > dstr->s_len)
|
||||
num = dstr->s_len - dsi;
|
||||
c1 = sblk->data + ssi;
|
||||
c = (USB8 *)dstr->s_str + dsi;
|
||||
@@ -829,18 +861,18 @@ copyblk2str(BLOCK *sblk, long ssi, long num, STRING *dstr, long dsi)
|
||||
int
|
||||
copyostr2str(char *sstr, long ssi, long num, STRING *dstr, long dsi)
|
||||
{
|
||||
long len;
|
||||
size_t len;
|
||||
char *c, *c1;
|
||||
|
||||
len = (long)strlen(sstr);
|
||||
len = strlen(sstr);
|
||||
|
||||
if (num < 0 || ssi + num > len)
|
||||
if (num < 0 || (size_t)(ssi + num) > len)
|
||||
num = len - ssi;
|
||||
if (num <= 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if (dsi < 0)
|
||||
dsi = 0; /* Default destination index */
|
||||
if (dsi + num > dstr->s_len)
|
||||
if ((size_t)(dsi + num) > dstr->s_len)
|
||||
num = dstr->s_len - dsi;
|
||||
c1 = sstr + ssi;
|
||||
c = dstr->s_str + dsi;
|
||||
@@ -856,16 +888,16 @@ copyostr2str(char *sstr, long ssi, long num, STRING *dstr, long dsi)
|
||||
int
|
||||
copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
|
||||
{
|
||||
int len;
|
||||
int newlen;
|
||||
int newsize;
|
||||
size_t len;
|
||||
size_t newlen;
|
||||
size_t newsize;
|
||||
USB8 *newdata;
|
||||
|
||||
len = strlen(str) + 1;
|
||||
|
||||
if (ssi > len)
|
||||
if (ssi > 0 && (size_t)ssi > len)
|
||||
return E_COPY2;
|
||||
if (num < 0 || (unsigned long) ssi + num > len)
|
||||
if (num < 0 || (size_t)(ssi + num) > len)
|
||||
num = len - ssi;
|
||||
if (num <= 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
@@ -874,7 +906,7 @@ copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
|
||||
newlen = dsi + num;
|
||||
if (newlen <= 0)
|
||||
return E_COPY7;
|
||||
if (newlen >= dblk->maxsize) {
|
||||
if (newlen >= (size_t)dblk->maxsize) {
|
||||
if (noreloc)
|
||||
return E_COPY17;
|
||||
newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk;
|
||||
@@ -887,7 +919,7 @@ copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
|
||||
dblk->maxsize = newsize;
|
||||
}
|
||||
memmove(dblk->data + dsi, str + ssi, num);
|
||||
if (newlen > dblk->datalen)
|
||||
if (newlen > (size_t)dblk->datalen)
|
||||
dblk->datalen = newlen;
|
||||
return 0;
|
||||
}
|
||||
@@ -906,7 +938,7 @@ copyostr2blk(char *str,long ssi,long num,BLOCK *dblk,long dsi,BOOL noreloc)
|
||||
* s1
|
||||
*/
|
||||
void *
|
||||
memmove(void *s1, const void *s2, CALC_SIZE_T n)
|
||||
memmove(void *s1, CONST void *s2, MEMMOVE_SIZE_T n)
|
||||
{
|
||||
/*
|
||||
* firewall
|
||||
@@ -953,10 +985,11 @@ memmove(void *s1, const void *s2, CALC_SIZE_T n)
|
||||
* copynum2blk - copy number numerator to block
|
||||
*/
|
||||
int
|
||||
copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL noreloc)
|
||||
copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi,
|
||||
BOOL noreloc)
|
||||
{
|
||||
long newlen;
|
||||
long newsize;
|
||||
size_t newlen;
|
||||
size_t newsize;
|
||||
USB8 *newdata;
|
||||
#if CALC_BYTE_ORDER == BIG_ENDIAN
|
||||
ZVALUE *swnum; /* byte swapped numerator */
|
||||
@@ -968,14 +1001,14 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
|
||||
num = snum->num.len - ssi;
|
||||
if (num == 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((unsigned long) ssi + num > snum->num.len)
|
||||
if (ssi + num > snum->num.len)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = dblk->datalen;
|
||||
newlen = dsi + (long)(num*sizeof(HALF));
|
||||
newlen = dsi + (num*sizeof(HALF));
|
||||
if (newlen <= 0)
|
||||
return E_COPY7;
|
||||
if (newlen >= dblk->maxsize) {
|
||||
if (newlen >= (size_t)dblk->maxsize) {
|
||||
if (noreloc)
|
||||
return E_COPY17;
|
||||
newsize = (1 + newlen/dblk->blkchunk) * dblk->blkchunk;
|
||||
@@ -994,7 +1027,7 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
|
||||
memmove(dblk->data+dsi, (char *)(swnum->v+ssi), num*sizeof(HALF));
|
||||
zfree(*swnum);
|
||||
#endif
|
||||
if (newlen > dblk->datalen)
|
||||
if (newlen > (size_t)dblk->datalen)
|
||||
dblk->datalen = newlen;
|
||||
return 0;
|
||||
}
|
||||
@@ -1004,9 +1037,10 @@ copynum2blk(NUMBER *snum, long ssi, long num, BLOCK *dblk, long dsi, BOOL norelo
|
||||
* copyblk2num - copy block to number
|
||||
*/
|
||||
int
|
||||
copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **res)
|
||||
copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi,
|
||||
NUMBER **res)
|
||||
{
|
||||
long newlen;
|
||||
size_t newlen;
|
||||
NUMBER *ret; /* cloned and modified numerator */
|
||||
#if CALC_BYTE_ORDER == BIG_ENDIAN
|
||||
HALF *swapped; /* byte swapped input data */
|
||||
@@ -1021,11 +1055,11 @@ copyblk2num(BLOCK *sblk, long ssi, long num, NUMBER *dnum, long dsi, NUMBER **re
|
||||
num = sblk->datalen - ssi;
|
||||
if (num == 0) /* Nothing to be copied */
|
||||
return 0;
|
||||
if ((unsigned long) ssi + num > sblk->datalen)
|
||||
if (ssi + num > sblk->datalen)
|
||||
return E_COPY5;
|
||||
if (dsi < 0)
|
||||
dsi = dnum->num.len;
|
||||
newlen = dsi + (long)((num+sizeof(HALF)-1)/sizeof(HALF));
|
||||
newlen = dsi + ((num+sizeof(HALF)-1)/sizeof(HALF));
|
||||
if (newlen <= 0)
|
||||
return E_COPY7;
|
||||
|
||||
|
73
blkcpy.h
73
blkcpy.h
@@ -1,39 +1,62 @@
|
||||
/*
|
||||
* Copyright (c) 1997 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* blkcpy - general values and related routines used by the calculator
|
||||
*
|
||||
* Definitions of general values and related routines used by the calculator.
|
||||
* Copyright (C) 1999-2007,2014 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.3 $
|
||||
* @(#) $Id: blkcpy.h,v 30.3 2014/08/24 21:56:51 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/blkcpy.h,v $
|
||||
*
|
||||
* Under source code control: 1997/04/18 20:41:25
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__BLKCPY_H__)
|
||||
#define __BLKCPY_H__
|
||||
#if !defined(INCLUDE_BLKCPY_H)
|
||||
#define INCLUDE_BLKCPY_H
|
||||
|
||||
/*
|
||||
* the main copy gateway function
|
||||
*/
|
||||
extern int copystod(VALUE *, long, long, VALUE *, long);
|
||||
E_FUNC int copystod(VALUE *, long, long, VALUE *, long);
|
||||
|
||||
/*
|
||||
* specific copy functions
|
||||
*/
|
||||
extern int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL);
|
||||
extern int copyblk2file(BLOCK *, long, long, FILEID, long);
|
||||
extern int copyblk2mat(BLOCK *, long, long, MATRIX *, long);
|
||||
extern int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **);
|
||||
extern int copyblk2str(BLOCK *, long, long, STRING *, long);
|
||||
extern int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL);
|
||||
extern int copylist2list(LIST *, long, long, LIST *, long);
|
||||
extern int copylist2mat(LIST *, long, long, MATRIX *, long);
|
||||
extern int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL);
|
||||
extern int copymat2list(MATRIX *, long, long, LIST *, long);
|
||||
extern int copymat2mat(MATRIX *, long, long, MATRIX *, long);
|
||||
extern int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL);
|
||||
extern int copyostr2blk(char *, long, long, BLOCK *, long, BOOL);
|
||||
extern int copyostr2str(char *, long, long, STRING *, long);
|
||||
extern int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
|
||||
extern int copystr2file(STRING *, long, long, FILEID, long);
|
||||
extern int copystr2str(STRING *, long, long, STRING *, long);
|
||||
E_FUNC int copyblk2blk(BLOCK *, long, long, BLOCK *, long, BOOL);
|
||||
E_FUNC int copyblk2file(BLOCK *, long, long, FILEID, long);
|
||||
E_FUNC int copyblk2mat(BLOCK *, long, long, MATRIX *, long);
|
||||
E_FUNC int copyblk2num(BLOCK *, long, long, NUMBER *, long, NUMBER **);
|
||||
E_FUNC int copyblk2str(BLOCK *, long, long, STRING *, long);
|
||||
E_FUNC int copyfile2blk(FILEID, long, long, BLOCK *, long, BOOL);
|
||||
E_FUNC int copylist2list(LIST *, long, long, LIST *, long);
|
||||
E_FUNC int copylist2mat(LIST *, long, long, MATRIX *, long);
|
||||
E_FUNC int copymat2blk(MATRIX *, long, long, BLOCK *, long, BOOL);
|
||||
E_FUNC int copymat2list(MATRIX *, long, long, LIST *, long);
|
||||
E_FUNC int copymat2mat(MATRIX *, long, long, MATRIX *, long);
|
||||
E_FUNC int copynum2blk(NUMBER *, long, long, BLOCK *, long, BOOL);
|
||||
E_FUNC int copyostr2blk(char *, long, long, BLOCK *, long, BOOL);
|
||||
E_FUNC int copyostr2str(char *, long, long, STRING *, long);
|
||||
E_FUNC int copystr2blk(STRING *, long, long, BLOCK *, long, BOOL);
|
||||
E_FUNC int copystr2file(STRING *, long, long, FILEID, long);
|
||||
E_FUNC int copystr2str(STRING *, long, long, STRING *, long);
|
||||
|
||||
#endif /* !__BLKCPY_H__ */
|
||||
#endif /* !INCLUDE_BLKCPY_H */
|
||||
|
61
block.c
61
block.c
@@ -1,36 +1,33 @@
|
||||
/*
|
||||
* block - fixed, dynamic, fifo and circular memory blocks
|
||||
*/
|
||||
/*
|
||||
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Comments, suggestions, bug fixes and questions about these routines
|
||||
* are welcome. Send EMail to the address given below.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* Happy bit twiddling,
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: block.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/block.c,v $
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* Under source code control: 1997/02/27 00:29:40
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -40,19 +37,19 @@
|
||||
#include "config.h"
|
||||
#include "block.h"
|
||||
#include "nametype.h"
|
||||
#include "string.h"
|
||||
#include "str.h"
|
||||
#include "calcerr.h"
|
||||
|
||||
#define NBLOCKCHUNK 16
|
||||
|
||||
static long nblockcount = 0;
|
||||
static long maxnblockcount = 0;
|
||||
static STRINGHEAD nblocknames;
|
||||
static NBLOCK **nblocks;
|
||||
STATIC long nblockcount = 0;
|
||||
STATIC long maxnblockcount = 0;
|
||||
STATIC STRINGHEAD nblocknames;
|
||||
STATIC NBLOCK **nblocks;
|
||||
|
||||
|
||||
/* forward declarations */
|
||||
static void blkchk(BLOCK*);
|
||||
S_FUNC void blkchk(BLOCK*);
|
||||
|
||||
|
||||
/*
|
||||
@@ -60,7 +57,7 @@ static void blkchk(BLOCK*);
|
||||
*
|
||||
* given:
|
||||
* len - initial memory length of the block
|
||||
* type - BLK_TYPE_XXX
|
||||
* type - BLK_TYPE_XYZ
|
||||
* chunk - allocation chunk size
|
||||
*
|
||||
* returns:
|
||||
@@ -157,7 +154,7 @@ blk_free(BLOCK *blk)
|
||||
* if all is ok, otherwise math_error() is called and this
|
||||
* function does not return
|
||||
*/
|
||||
static void
|
||||
S_FUNC void
|
||||
blkchk(BLOCK *blk)
|
||||
{
|
||||
|
||||
|
85
block.h
85
block.h
@@ -1,41 +1,38 @@
|
||||
/*
|
||||
* block - fixed, dynamic, fifo and circular memory blocks
|
||||
*/
|
||||
/*
|
||||
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Copyright (C) 1999-2007,2014 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Comments, suggestions, bug fixes and questions about these routines
|
||||
* are welcome. Send EMail to the address given below.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* Happy bit twiddling,
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* @(#) $Revision: 30.3 $
|
||||
* @(#) $Id: block.h,v 30.3 2014/08/24 21:56:51 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/block.h,v $
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* Under source code control: 1997/02/21 05:03:39
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__BLOCK_H__)
|
||||
#define __BLOCK_H__
|
||||
#if !defined(INCLUDE_BLOCK_H)
|
||||
#define INCLUDE_BLOCK_H
|
||||
|
||||
|
||||
/*
|
||||
@@ -163,7 +160,7 @@ typedef struct nblock NBLOCK;
|
||||
/*
|
||||
* block debug
|
||||
*/
|
||||
extern int blk_debug; /* 0 => debug off */
|
||||
EXTERN int blk_debug; /* 0 => debug off */
|
||||
|
||||
|
||||
/*
|
||||
@@ -207,22 +204,22 @@ typedef USB8 OCTET;
|
||||
/*
|
||||
* external functions
|
||||
*/
|
||||
extern BLOCK *blkalloc(int, int);
|
||||
extern void blk_free(BLOCK*);
|
||||
extern BLOCK *blkrealloc(BLOCK*, int, int);
|
||||
extern void blktrunc(BLOCK*);
|
||||
extern BLOCK *blk_copy(BLOCK*);
|
||||
extern int blk_cmp(BLOCK*, BLOCK*);
|
||||
extern void blk_print(BLOCK*);
|
||||
extern void nblock_print(NBLOCK *);
|
||||
extern NBLOCK *createnblock(char *, int, int);
|
||||
extern NBLOCK *reallocnblock(int, int, int);
|
||||
extern int removenblock(int);
|
||||
extern int findnblockid(char *);
|
||||
extern NBLOCK *findnblock(int);
|
||||
extern BLOCK *copyrealloc(BLOCK*, int, int);
|
||||
extern int countnblocks(void);
|
||||
extern void shownblocks(void);
|
||||
E_FUNC BLOCK *blkalloc(int, int);
|
||||
E_FUNC void blk_free(BLOCK*);
|
||||
E_FUNC BLOCK *blkrealloc(BLOCK*, int, int);
|
||||
E_FUNC void blktrunc(BLOCK*);
|
||||
E_FUNC BLOCK *blk_copy(BLOCK*);
|
||||
E_FUNC int blk_cmp(BLOCK*, BLOCK*);
|
||||
E_FUNC void blk_print(BLOCK*);
|
||||
E_FUNC void nblock_print(NBLOCK *);
|
||||
E_FUNC NBLOCK *createnblock(char *, int, int);
|
||||
E_FUNC NBLOCK *reallocnblock(int, int, int);
|
||||
E_FUNC int removenblock(int);
|
||||
E_FUNC int findnblockid(char *);
|
||||
E_FUNC NBLOCK *findnblock(int);
|
||||
E_FUNC BLOCK *copyrealloc(BLOCK*, int, int);
|
||||
E_FUNC int countnblocks(void);
|
||||
E_FUNC void shownblocks(void);
|
||||
|
||||
|
||||
#endif /* !__BLOCK_H__ */
|
||||
#endif /* !INCLUDE_BLOCK_H */
|
||||
|
44
byteswap.c
44
byteswap.c
@@ -1,25 +1,34 @@
|
||||
/*
|
||||
* Copyright (c) 1995 by Landon Curt Noll. All Rights Reserved.
|
||||
* byteswap - byte swapping routines
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: byteswap.c,v 30.2 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/byteswap.c,v $
|
||||
*
|
||||
* Under source code control: 1995/10/11 04:44:01
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#include "cmath.h"
|
||||
#include "byteswap.h"
|
||||
|
||||
@@ -93,7 +102,8 @@ swap_b8_in_ZVALUE(ZVALUE *dest, ZVALUE *src, BOOL all)
|
||||
*/
|
||||
dest = malloc(sizeof(ZVALUE));
|
||||
if (dest == NULL) {
|
||||
math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: Not enough memory");
|
||||
math_error("swap_b8_in_ZVALUE: swap_b8_in_ZVALUE: "
|
||||
"Not enough memory");
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
|
50
byteswap.h
50
byteswap.h
@@ -1,31 +1,43 @@
|
||||
/*
|
||||
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
|
||||
* byteswap - byte swapping macros
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Copyright (C) 1999,2014 Landon Curt Noll
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.3 $
|
||||
* @(#) $Id: byteswap.h,v 30.3 2014/08/24 21:56:51 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/RCS/byteswap.h,v $
|
||||
*
|
||||
* Under source code control: 1995/10/11 04:44:01
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__BYTESWAP_H__)
|
||||
#define __BYTESWAP_H__
|
||||
#if !defined(INCLUDE_BYTESWAP_H)
|
||||
#define INCLUDE_BYTESWAP_H
|
||||
|
||||
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
# include "longbits.h"
|
||||
#else
|
||||
# include <calc/longbits.h>
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
@@ -166,4 +178,4 @@
|
||||
#endif /* LONG_BITS == 64 */
|
||||
|
||||
|
||||
#endif /* !__BYTESWAP_H__ */
|
||||
#endif /* !INCLUDE_BYTESWAP_H */
|
||||
|
360
cal/Makefile
Normal file
360
cal/Makefile
Normal file
@@ -0,0 +1,360 @@
|
||||
#!/bin/make
|
||||
#
|
||||
# cal - makefile for calc standard resource files
|
||||
#
|
||||
# Copyright (C) 1999-2006 Landon Curt Noll
|
||||
#
|
||||
# Calc is open software; you can redistribute it and/or modify it under
|
||||
# the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
# as published by the Free Software Foundation.
|
||||
#
|
||||
# Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
# Public License for more details.
|
||||
#
|
||||
# A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
# distributed with calc under the filename COPYING-LGPL. You should have
|
||||
# received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
#
|
||||
# @(#) $Revision: 30.11 $
|
||||
# @(#) $Id: Makefile,v 30.11 2014/09/02 07:14:49 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/bin/calc/cal/RCS/Makefile,v $
|
||||
#
|
||||
# Under source code control: 1991/07/21 05:00:54
|
||||
# File existed as early as: 1991
|
||||
#
|
||||
# chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
# Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
#
|
||||
# calculator by David I. Bell with help/mods from others
|
||||
# Makefile by Landon Curt Noll
|
||||
|
||||
# required vars
|
||||
#
|
||||
SHELL= /bin/sh
|
||||
|
||||
####
|
||||
# Normally, the upper level makefile will set these values. We provide
|
||||
# a default here just in case you want to build from this directory.
|
||||
####
|
||||
|
||||
# Normally certain files depend on the Makefile. If the Makefile is
|
||||
# changed, then certain steps should be redone. If MAKE_FILE is
|
||||
# set to Makefile, then these files will depend on Makefile. If
|
||||
# MAKE_FILE is empty, then they wont.
|
||||
#
|
||||
# If in doubt, set MAKE_FILE to Makefile
|
||||
#
|
||||
MAKE_FILE= Makefile
|
||||
|
||||
# Controlling file makefile basename (without the path)
|
||||
#
|
||||
# This is the basename same of the makefile that may/does/will drive
|
||||
# this makefile.
|
||||
#
|
||||
# If in doubt, set TOP_MAKE_FILE to Makefile
|
||||
#
|
||||
TOP_MAKE_FILE= Makefile
|
||||
|
||||
# Where the system include (.h) files are kept
|
||||
#
|
||||
# For DJGPP, select:
|
||||
#
|
||||
# INCDIR= /dev/env/DJDIR/include
|
||||
#
|
||||
# If in doubt, set:
|
||||
#
|
||||
# INCDIR= /usr/include
|
||||
#
|
||||
|
||||
#INCDIR= /usr/local/include
|
||||
#INCDIR= /dev/env/DJDIR/include
|
||||
INCDIR= /usr/include
|
||||
|
||||
# where to install calc realted things
|
||||
#
|
||||
# ${BINDIR} where to install calc binary files
|
||||
# ${LIBDIR} where calc link library (*.a) files are installed
|
||||
# ${CALC_SHAREDIR} where to install calc help, .cal, startup, config files
|
||||
#
|
||||
# NOTE: The install rule prepends installation paths with ${T}, which
|
||||
# by default is empty. If ${T} is non-empty, then installation
|
||||
# locations will be relative to the ${T} directory.
|
||||
#
|
||||
# For DJGPP, select:
|
||||
#
|
||||
# BINDIR= /dev/env/DJDIR/bin
|
||||
# LIBDIR= /dev/env/DJDIR/lib
|
||||
# CALC_SHAREDIR= /dev/env/DJDIR/share/calc
|
||||
#
|
||||
# If in doubt, set:
|
||||
#
|
||||
# BINDIR= /usr/bin
|
||||
# LIBDIR= /usr/lib
|
||||
# CALC_SHAREDIR= /usr/share/calc
|
||||
#
|
||||
#BINDIR= /usr/local/bin
|
||||
#BINDIR= /dev/env/DJDIR/bin
|
||||
BINDIR= /usr/bin
|
||||
|
||||
#LIBDIR= /usr/local/lib
|
||||
#LIBDIR= /dev/env/DJDIR/lib
|
||||
LIBDIR= /usr/lib
|
||||
|
||||
#CALC_SHAREDIR= /usr/local/lib/calc
|
||||
#CALC_SHAREDIR= /dev/env/DJDIR/share/calc
|
||||
CALC_SHAREDIR= /usr/share/calc
|
||||
|
||||
# By default, these values are based CALC_SHAREDIR, INCDIR, BINDIR
|
||||
# ---------------------------------------------------------------
|
||||
# ${HELPDIR} where the help directory is installed
|
||||
# ${CALC_INCDIR} where the calc include files are installed
|
||||
# ${SCRIPTDIR} where calc shell scripts are installed
|
||||
#
|
||||
# NOTE: The install rule prepends installation paths with ${T}, which
|
||||
# by default is empty. If ${T} is non-empty, then installation
|
||||
# locations will be relative to the ${T} directory.
|
||||
#
|
||||
# If in doubt, set:
|
||||
#
|
||||
# HELPDIR= ${CALC_SHAREDIR}/help
|
||||
# CALC_INCDIR= ${INCDIR}/calc
|
||||
# SCRIPTDIR= ${BINDIR}/cscript
|
||||
#
|
||||
HELPDIR= ${CALC_SHAREDIR}/help
|
||||
CALC_INCDIR= ${INCDIR}/calc
|
||||
SCRIPTDIR= ${BINDIR}/cscript
|
||||
|
||||
# T - top level directory under which calc will be installed
|
||||
#
|
||||
# The calc install is performed under ${T}, the calc build is
|
||||
# performed under /. The purpose for ${T} is to allow someone
|
||||
# to install calc somewhere other than into the system area.
|
||||
#
|
||||
# For example, if:
|
||||
#
|
||||
# BINDIR= /usr/bin
|
||||
# LIBDIR= /usr/lib
|
||||
# CALC_SHAREDIR= /usr/share/calc
|
||||
#
|
||||
# and if:
|
||||
#
|
||||
# T= /var/tmp/testing
|
||||
#
|
||||
# Then the installation locations will be:
|
||||
#
|
||||
# calc binary files: /var/tmp/testing/usr/bin
|
||||
# calc link library: /var/tmp/testing/usr/lib
|
||||
# calc help, .cal ...: /var/tmp/testing/usr/share/calc
|
||||
# ... etc ... /var/tmp/testing/...
|
||||
#
|
||||
# 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
|
||||
# calc is installed under ${T}, as if one had to chroot under
|
||||
# ${T} for calc to operate.
|
||||
#
|
||||
# If in doubt, use T=
|
||||
#
|
||||
T=
|
||||
|
||||
# Makefile debug
|
||||
#
|
||||
# Q=@ do not echo internal makefile actions (quiet mode)
|
||||
# Q= echo internal makefile actions (debug / verbose mode)
|
||||
#
|
||||
#Q=
|
||||
Q=@
|
||||
|
||||
# standard tools
|
||||
#
|
||||
CHMOD= chmod
|
||||
CMP= cmp
|
||||
RM= rm
|
||||
MKDIR= mkdir
|
||||
RMDIR= rmdir
|
||||
CP= cp
|
||||
MV= mv
|
||||
CO= co
|
||||
TRUE= true
|
||||
TOUCH= touch
|
||||
SED= sed
|
||||
SORT= sort
|
||||
FMT= fmt
|
||||
|
||||
# The calc files to install
|
||||
#
|
||||
# This list is prodiced by the detaillist rule when no WARNINGS are detected.
|
||||
#
|
||||
# Please use:
|
||||
#
|
||||
# make calc_files_list
|
||||
#
|
||||
# to keep this list in nice sorted order and to check that these
|
||||
# deailed help files are under RCS control.
|
||||
#
|
||||
CALC_FILES= README alg_config.cal beer.cal bernoulli.cal \
|
||||
bernpoly.cal bigprime.cal bindings brentsolve.cal chi.cal chrem.cal \
|
||||
constants.cal deg.cal dms.cal dotest.cal ellip.cal factorial.cal \
|
||||
factorial2.cal gvec.cal hello.cal hms.cal infinities.cal \
|
||||
intfile.cal intnum.cal lambertw.cal linear.cal lnseries.cal \
|
||||
lucas.cal lucas_chk.cal lucas_tbl.cal mersenne.cal mfactor.cal \
|
||||
mod.cal natnumset.cal pell.cal pi.cal pix.cal pollard.cal poly.cal \
|
||||
prompt.cal psqrt.cal qtime.cal quat.cal randbitrun.cal randmprime.cal \
|
||||
randombitrun.cal randomrun.cal randrun.cal regress.cal repeat.cal \
|
||||
screen.cal seedrandom.cal set8700.cal set8700.line smallfactors.cal \
|
||||
solve.cal specialfunctions.cal statistics.cal strings.cal sumsq.cal \
|
||||
sumtimes.cal surd.cal test1700.cal test2300.cal test2600.cal \
|
||||
test2700.cal test3100.cal test3300.cal test3400.cal test3500.cal \
|
||||
test4000.cal test4100.cal test4600.cal test5100.cal test5200.cal \
|
||||
test8400.cal test8500.cal test8600.cal test8900.cal toomcook.cal \
|
||||
unitfrac.cal varargs.cal xx_print.cal zeta2.cal
|
||||
|
||||
# These files are found (but not built) in the distribution
|
||||
#
|
||||
DISTLIST= ${CALC_FILES} ${MAKE_FILE}
|
||||
|
||||
# These files are used to make (but not built) a calc .a link library
|
||||
#
|
||||
CALCLIBLIST=
|
||||
|
||||
all: ${CALC_FILES} ${MAKE_FILE} .all
|
||||
|
||||
# used by the upper level Makefile to determine of we have done all
|
||||
#
|
||||
.all:
|
||||
${RM} -f .all
|
||||
${TOUCH} .all
|
||||
|
||||
##
|
||||
#
|
||||
# File list generation. You can ignore this section.
|
||||
#
|
||||
#
|
||||
# We will form the names of source files as if they were in a
|
||||
# sub-directory called calc/cal.
|
||||
#
|
||||
# NOTE: Due to bogus shells found on one common system we must have
|
||||
# an non-emoty else clause for every if condition. *sigh*
|
||||
#
|
||||
##
|
||||
|
||||
distlist: ${DISTLIST}
|
||||
${Q} for i in ${DISTLIST} /dev/null; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
echo cal/$$i; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
distdir:
|
||||
${Q} echo cal
|
||||
|
||||
calcliblist:
|
||||
${Q} for i in ${CALCLIBLIST} /dev/null; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
echo cal/$$i; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
# These next rule help form the ${CALC_FILES} makefile variables above.
|
||||
#
|
||||
calc_files_list:
|
||||
${Q} -(find . -mindepth 1 -maxdepth 1 -type f -name '*.cal' -print | \
|
||||
while read i; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
if [ ! -f RCS/$$i,v ]; then \
|
||||
echo "WARNING: $$i not under RCS control" 1>&2; \
|
||||
else \
|
||||
echo $$i; \
|
||||
fi; \
|
||||
fi; \
|
||||
done; \
|
||||
echo '--first_line--'; \
|
||||
echo README; \
|
||||
echo set8700.line; \
|
||||
echo bindings) | \
|
||||
${SED} -e 's:^\./::' | LANG=C ${SORT} | ${FMT} -70 | \
|
||||
${SED} -e '1s/--first_line--/CALC_FILES=/' -e '2,$$s/^/ /' \
|
||||
-e 's/$$/ \\/' -e '$$s/ \\$$//'
|
||||
|
||||
##
|
||||
#
|
||||
# rpm rules
|
||||
#
|
||||
##
|
||||
|
||||
echo_inst_files:
|
||||
${Q} for i in ${CALC_FILES} /dev/null; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
echo __file__ ${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
##
|
||||
#
|
||||
# Utility rules
|
||||
#
|
||||
##
|
||||
|
||||
clean:
|
||||
|
||||
clobber: clean
|
||||
${RM} -f .all
|
||||
|
||||
# install everything
|
||||
#
|
||||
# NOTE: Keep the uninstall rule in reverse order to the install rule
|
||||
#
|
||||
install: all
|
||||
-${Q} if [ ! -d ${T}${CALC_SHAREDIR} ]; then \
|
||||
echo ${MKDIR} -p ${T}${CALC_SHAREDIR}; \
|
||||
${MKDIR} -p ${T}${CALC_SHAREDIR}; \
|
||||
if [ ! -d "${T}${CALC_SHAREDIR}" ]; then \
|
||||
echo ${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
|
||||
${MKDIR} -p "${T}${CALC_SHAREDIR}"; \
|
||||
fi; \
|
||||
echo ${CHMOD} 0755 ${T}${CALC_SHAREDIR}; \
|
||||
${CHMOD} 0755 ${T}${CALC_SHAREDIR}; \
|
||||
else \
|
||||
${TRUE}; \
|
||||
fi
|
||||
${Q} for i in ${CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if ${CMP} -s $$i ${T}${CALC_SHAREDIR}/$$i; then \
|
||||
${TRUE}; \
|
||||
else \
|
||||
${RM} -f ${T}${CALC_SHAREDIR}/$$i.new; \
|
||||
${CP} -f $$i ${T}${CALC_SHAREDIR}/$$i.new; \
|
||||
${CHMOD} 0444 ${T}${CALC_SHAREDIR}/$$i.new; \
|
||||
${MV} -f ${T}${CALC_SHAREDIR}/$$i.new ${T}${CALC_SHAREDIR}/$$i;\
|
||||
echo "installed ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
# Try to remove everything that was installed
|
||||
#
|
||||
# NOTE: Keep the uninstall rule in reverse order to the install rule
|
||||
#
|
||||
uninstall:
|
||||
-${Q} for i in ${CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if [ -f "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
${RM} -f "${T}${CALC_SHAREDIR}/$$i"; \
|
||||
if [ -f "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
echo "cannot uninstall ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
else \
|
||||
echo "uninstalled ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
fi; \
|
||||
fi; \
|
||||
done
|
||||
-${Q} for i in ${CALC_SHAREDIR}; do \
|
||||
if [ -d "${T}$$i" ]; then \
|
||||
${RMDIR} "${T}$$i" 2>/dev/null; \
|
||||
echo "cleaned up ${T}$$i"; \
|
||||
fi; \
|
||||
done
|
1827
cal/README
Normal file
1827
cal/README
Normal file
File diff suppressed because it is too large
Load Diff
1526
cal/alg_config.cal
Normal file
1526
cal/alg_config.cal
Normal file
File diff suppressed because it is too large
Load Diff
50
cal/beer.cal
Normal file
50
cal/beer.cal
Normal file
@@ -0,0 +1,50 @@
|
||||
/*
|
||||
* beer - 99 bottles of beer
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: beer.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/beer.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/11/13 13:21:05
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* See: http://www.ionet.net/~timtroyr/funhouse/beer.html#calc
|
||||
*/
|
||||
|
||||
|
||||
for (i=99; i > 0;) {
|
||||
/* current wall state */
|
||||
some_bottles = (i != 1) ? "bottles" : "bottle";
|
||||
print i, some_bottles, "of beer on the wall,",;
|
||||
print i, some_bottles, "of beer!";
|
||||
|
||||
/* glug, glug */
|
||||
--i;
|
||||
print "Take one down and pass it around,",;
|
||||
|
||||
/* new wall state */
|
||||
less = (i > 0) ? i : "no";
|
||||
bottles = (i!=1) ? "bottles" : "bottle";
|
||||
print less, bottles, "of beer on the wall!\n";
|
||||
}
|
97
cal/bernoulli.cal
Normal file
97
cal/bernoulli.cal
Normal file
@@ -0,0 +1,97 @@
|
||||
/*
|
||||
* bernoulli - clculate the Nth Bernoulli number B(n)
|
||||
*
|
||||
* Copyright (C) 2000 David I. Bell and Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: bernoulli.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bernoulli.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/09/30 11:18:41
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Calculate the Nth Bernoulli number B(n).
|
||||
*
|
||||
* NOTE: This is now a bulitin function.
|
||||
*
|
||||
* The non-buildin code used the following symbolic formula to calculate B(n):
|
||||
*
|
||||
* (b+1)^(n+1) - b^(n+1) = 0
|
||||
*
|
||||
* where b is a dummy value, and each power b^i gets replaced by B(i).
|
||||
* For example, for n = 3:
|
||||
*
|
||||
* (b+1)^4 - 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) + 1 = 0
|
||||
* B(3) = -(6*B(2) + 4*B(1) + 1) / 4
|
||||
*
|
||||
* The combinatorial factors in the expansion of the above formula are
|
||||
* calculated interatively, and we use the fact that B(2i+1) = 0 if i > 0.
|
||||
* Since all previous B(n)'s are needed to calculate a particular B(n), all
|
||||
* values obtained are saved in an array for ease in repeated calculations.
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
static Bnmax;
|
||||
static mat Bn[1001];
|
||||
*/
|
||||
|
||||
define B(n)
|
||||
{
|
||||
/*
|
||||
local nn, np1, i, sum, mulval, divval, combval;
|
||||
|
||||
if (!isint(n) || (n < 0))
|
||||
quit "Non-negative integer required for Bernoulli";
|
||||
|
||||
if (n == 0)
|
||||
return 1;
|
||||
if (n == 1)
|
||||
return -1/2;
|
||||
if (isodd(n))
|
||||
return 0;
|
||||
if (n > 1000)
|
||||
quit "Very large Bernoulli";
|
||||
|
||||
if (n <= Bnmax)
|
||||
return Bn[n];
|
||||
|
||||
for (nn = Bnmax + 2; nn <= n; nn+=2) {
|
||||
np1 = nn + 1;
|
||||
mulval = np1;
|
||||
divval = 1;
|
||||
combval = 1;
|
||||
sum = 1 - np1 / 2;
|
||||
for (i = 2; i < np1; i+=2) {
|
||||
combval = combval * mulval-- / divval++;
|
||||
combval = combval * mulval-- / divval++;
|
||||
sum += combval * Bn[i];
|
||||
}
|
||||
Bn[nn] = -sum / np1;
|
||||
}
|
||||
Bnmax = n;
|
||||
return Bn[n];
|
||||
*/
|
||||
return bernoulli(n);
|
||||
}
|
59
cal/bernpoly.cal
Normal file
59
cal/bernpoly.cal
Normal file
@@ -0,0 +1,59 @@
|
||||
/*
|
||||
* bernpoly - Bernoully polynomials B_n(z) for arbitrary n,z..
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: bernpoly.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bernpoly.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
read -once zeta2
|
||||
|
||||
|
||||
/* Idea by Don Zagier */
|
||||
define bernpoly(n,z){
|
||||
local h s c k;
|
||||
if(isint(n) && n>=0){
|
||||
h=0;s=0;c=-1;
|
||||
for(k=1;k<=n+1;k++){
|
||||
c*=1-(n+2)/k;
|
||||
s+=z^n;
|
||||
z++;
|
||||
h+=c*s/k;
|
||||
}
|
||||
return h;
|
||||
}
|
||||
else return -n*hurwitzzeta(1-n,z);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* restore internal function from resource debugging
|
||||
*/
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "bernpoly(n,z)";
|
||||
}
|
49
cal/bigprime.cal
Normal file
49
cal/bigprime.cal
Normal file
@@ -0,0 +1,49 @@
|
||||
/*
|
||||
* bigprime - a prime test, base a, on p*2^x+1 for even x>m
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: bigprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bigprime.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:32
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
define bigprime(a, m, p)
|
||||
{
|
||||
local n1, n;
|
||||
|
||||
n1 = 2^m * p;
|
||||
for (;;) {
|
||||
m++;
|
||||
n1 += n1;
|
||||
n = n1 + 1;
|
||||
if (isodd(m))
|
||||
continue;
|
||||
print m;
|
||||
if (pmod(a, n1 / 2, n) != n1)
|
||||
continue;
|
||||
if (pmod(a, n1 / p, n) == 1)
|
||||
continue;
|
||||
print " " : n;
|
||||
}
|
||||
}
|
75
cal/bindings
Normal file
75
cal/bindings
Normal file
@@ -0,0 +1,75 @@
|
||||
# bindings - default key bindings for calc line editing functions
|
||||
#
|
||||
# Copyright (C) 1999 David I. Bell
|
||||
#
|
||||
# Calc is open software; you can redistribute it and/or modify it under
|
||||
# the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
# as published by the Free Software Foundation.
|
||||
#
|
||||
# Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
# Public License for more details.
|
||||
#
|
||||
# A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
# distributed with calc under the filename COPYING-LGPL. You should have
|
||||
# received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
#
|
||||
# @(#) $Revision: 30.1 $
|
||||
# @(#) $Id: bindings,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/bin/calc/cal/RCS/bindings,v $
|
||||
#
|
||||
# Under source code control: 1993/05/02 20:09:19
|
||||
# File existed as early as: 1993
|
||||
#
|
||||
# Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
# NOTE: This facility is ignored if calc was compiled with GNU-readline.
|
||||
# In that case, the standard readline mechanisms (see readline(3))
|
||||
# are used in place of those found below.
|
||||
|
||||
|
||||
map base-map
|
||||
default insert-char
|
||||
^@ set-mark
|
||||
^A start-of-line
|
||||
^B backward-char
|
||||
^D delete-char
|
||||
^E end-of-line
|
||||
^F forward-char
|
||||
^H backward-kill-char
|
||||
^J new-line
|
||||
^K kill-line
|
||||
^L refresh-line
|
||||
^M new-line
|
||||
^N forward-history
|
||||
^O save-line
|
||||
^P backward-history
|
||||
^R reverse-search
|
||||
^T swap-chars
|
||||
^U flush-input
|
||||
^V quote-char
|
||||
^W kill-region
|
||||
^Y yank
|
||||
^? backward-kill-char
|
||||
^[ ignore-char esc-map
|
||||
|
||||
map esc-map
|
||||
default ignore-char base-map
|
||||
G start-of-line
|
||||
H backward-history
|
||||
P forward-history
|
||||
K backward-char
|
||||
M forward-char
|
||||
O end-of-line
|
||||
S delete-char
|
||||
g goto-line
|
||||
s backward-word
|
||||
t forward-word
|
||||
d forward-kill-word
|
||||
u uppercase-word
|
||||
l lowercase-word
|
||||
h list-history
|
||||
^[ flush-input
|
||||
[ arrow-key
|
258
cal/brentsolve.cal
Normal file
258
cal/brentsolve.cal
Normal file
@@ -0,0 +1,258 @@
|
||||
/*
|
||||
* brentsolve - Root finding with the Brent-Dekker trick
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: brentsolve.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/brentsolve.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
/*
|
||||
A short explanation is at http://en.wikipedia.org/wiki/Brent%27s_method
|
||||
I tried to follow the description at wikipedia as much as possible to make
|
||||
the slight changes I did more visible.
|
||||
You may give http://people.sc.fsu.edu/~jburkardt/cpp_src/brent/brent.html a
|
||||
short glimpse (Brent's originl Fortran77 versions and some translations of
|
||||
it).
|
||||
*/
|
||||
|
||||
static true = 1;
|
||||
static false = 0;
|
||||
define brentsolve(low, high,eps){
|
||||
local a b c d fa fb fc fa2 fb2 fc2 s fs tmp tmp2 mflag i places;
|
||||
a = low;
|
||||
b = high;
|
||||
c = 0;
|
||||
|
||||
if(isnull(eps))
|
||||
eps = epsilon(epsilon()*1e-3);
|
||||
places = highbit(1 + int( 1/epsilon() ) ) + 1;
|
||||
|
||||
d = 1/eps;
|
||||
|
||||
fa = f(a);
|
||||
fb = f(b);
|
||||
|
||||
fc = 0;
|
||||
s = 0;
|
||||
fs = 0;
|
||||
|
||||
if(fa * fb >= 0){
|
||||
if(fa < fb){
|
||||
epsilon(eps);
|
||||
return a;
|
||||
}
|
||||
else{
|
||||
epsilon(eps);
|
||||
return b;
|
||||
}
|
||||
}
|
||||
|
||||
if(abs(fa) < abs(fb)){
|
||||
tmp = a; a = b; b = tmp;
|
||||
tmp = fa; fa = fb; fb = tmp;
|
||||
}
|
||||
|
||||
c = a;
|
||||
fc = fa;
|
||||
mflag = 1;
|
||||
i = 0;
|
||||
|
||||
while(!(fb==0) && (abs(a-b) > eps)){
|
||||
if((fa != fc) && (fb != fc)){
|
||||
/* Inverse quadratic interpolation*/
|
||||
fc2 = fc^2;
|
||||
fa2 = fa^2;
|
||||
s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa)
|
||||
-(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places++);
|
||||
}
|
||||
else{
|
||||
/* Secant Rule*/
|
||||
s =bround( b - fb * (b - a) / (fb - fa),places++);
|
||||
}
|
||||
tmp2 = (3 * a + b) / 4;
|
||||
if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b))))
|
||||
|| (mflag && (abs(s - b) >= (abs(b - c) / 2)))
|
||||
|| (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) {
|
||||
s = (a + b) / 2;
|
||||
mflag = true;
|
||||
}
|
||||
else{
|
||||
if( (mflag && (abs(b - c) < eps))
|
||||
|| (!mflag && (abs(c - d) < eps))) {
|
||||
s = (a + b) / 2;
|
||||
mflag = true;
|
||||
}
|
||||
else
|
||||
mflag = false;
|
||||
}
|
||||
fs = f(s);
|
||||
c = b;
|
||||
fc = fb;
|
||||
if (fa * fs < 0){
|
||||
b = s;
|
||||
fb = fs;
|
||||
}
|
||||
else {
|
||||
a = s;
|
||||
fa = fs;
|
||||
}
|
||||
|
||||
if (abs(fa) < abs(fb)){
|
||||
tmp = a; a = b; b = tmp;
|
||||
tmp = fa; fa = fb; fb = tmp;
|
||||
}
|
||||
i++;
|
||||
if (i > 1000){
|
||||
epsilon(eps);
|
||||
return newerror("brentsolve: does not converge");
|
||||
}
|
||||
}
|
||||
epsilon(eps);
|
||||
return b;
|
||||
}
|
||||
|
||||
/*
|
||||
A variation of the solver to accept functions named differently from "f". The
|
||||
code should explain it.
|
||||
*/
|
||||
define brentsolve2(low, high,which,eps){
|
||||
local a b c d fa fb fc fa2 fb2 fc2 s fs tmp tmp2 mflag i places;
|
||||
a = low;
|
||||
b = high;
|
||||
c = 0;
|
||||
|
||||
switch(param(0)){
|
||||
case 0:
|
||||
case 1: return newerror("brentsolve2: not enough argments");
|
||||
case 2: eps = epsilon(epsilon()*1e-2);
|
||||
which = 0;break;
|
||||
case 3: eps = epsilon(epsilon()*1e-2);break;
|
||||
default: break;
|
||||
};
|
||||
places = highbit(1 + int(1/epsilon())) + 1;
|
||||
|
||||
d = 1/eps;
|
||||
|
||||
switch(which){
|
||||
case 1: fa = __CZ__invbeta(a);
|
||||
fb = __CZ__invbeta(b); break;
|
||||
case 2: fa = __CZ__invincgamma(a);
|
||||
fb = __CZ__invincgamma(b); break;
|
||||
|
||||
default: fa = f(a);fb = f(b); break;
|
||||
};
|
||||
|
||||
fc = 0;
|
||||
s = 0;
|
||||
fs = 0;
|
||||
|
||||
if(fa * fb >= 0){
|
||||
if(fa < fb)
|
||||
return a;
|
||||
else
|
||||
return b;
|
||||
}
|
||||
|
||||
if(abs(fa) < abs(fb)){
|
||||
tmp = a; a = b; b = tmp;
|
||||
tmp = fa; fa = fb; fb = tmp;
|
||||
}
|
||||
|
||||
c = a;
|
||||
fc = fa;
|
||||
mflag = 1;
|
||||
i = 0;
|
||||
|
||||
while(!(fb==0) && (abs(a-b) > eps)){
|
||||
|
||||
if((fa != fc) && (fb != fc)){
|
||||
/* Inverse quadratic interpolation*/
|
||||
fc2 = fc^2;
|
||||
fa2 = fa^2;
|
||||
s = bround(((fb^2*((fc*a)-(c*fa)))+(fb*((c*fa2)-(fc2*a)))+(b*((fc2*fa)
|
||||
-(fc*fa2))))/((fc - fb)*(fa - fb)*(fc - fa)),places);
|
||||
places++;
|
||||
}
|
||||
else{
|
||||
/* Secant Rule*/
|
||||
s =bround( b - fb * (b - a) / (fb - fa),places);
|
||||
places++;
|
||||
}
|
||||
tmp2 = (3 * a + b) / 4;
|
||||
if( (!( ((s > tmp2) && (s < b))||((s < tmp2) && (s > b))))
|
||||
|| (mflag && (abs(s - b) >= (abs(b - c) / 2)))
|
||||
|| (!mflag && (abs(s - b) >= (abs(c - d) / 2)))) {
|
||||
s = (a + b) / 2;
|
||||
mflag = true;
|
||||
}
|
||||
else{
|
||||
if( (mflag && (abs(b - c) < eps))
|
||||
|| (!mflag && (abs(c - d) < eps))) {
|
||||
s = (a + b) / 2;
|
||||
mflag = true;
|
||||
}
|
||||
else
|
||||
mflag = false;
|
||||
}
|
||||
switch(which){
|
||||
case 1: fs = __CZ__invbeta(s); break;
|
||||
case 2: fs = __CZ__invincgamma(s); break;
|
||||
|
||||
default: fs = f(s); break;
|
||||
};
|
||||
c = b;
|
||||
fc = fb;
|
||||
if (fa * fs < 0){
|
||||
b = s;
|
||||
fb = fs;
|
||||
}
|
||||
else {
|
||||
a = s;
|
||||
fa = fs;
|
||||
}
|
||||
|
||||
if (abs(fa) < abs(fb)){
|
||||
tmp = a; a = b; b = tmp;
|
||||
tmp = fa; fa = fb; fb = tmp;
|
||||
}
|
||||
i++;
|
||||
if (i > 1000){
|
||||
return newerror("brentsolve2: does not converge");
|
||||
}
|
||||
}
|
||||
return b;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* restore internal function from resource debugging
|
||||
*/
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "brentsolve(low, high,eps)";
|
||||
print "brentsolve2(low, high,which,eps)";
|
||||
}
|
251
cal/chi.cal
Normal file
251
cal/chi.cal
Normal file
@@ -0,0 +1,251 @@
|
||||
/*
|
||||
* chi - chi^2 probabilities with degrees of freedom for null hypothesis
|
||||
*
|
||||
* Copyright (C) 2001 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: chi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/chi.cal,v $
|
||||
*
|
||||
* Under source code control: 2001/03/27 14:10:11
|
||||
* File existed as early as: 2001
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* Z(x)
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* Section 26.2.1, p931.
|
||||
*/
|
||||
define Z(x, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/* compute Z(x) value */
|
||||
return exp(-x*x/2, eps) / sqrt(2*pi(eps), eps);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* P(x[, eps]) asymtotic P(x) expansion for x>0 to an given epsilon error term
|
||||
*
|
||||
* NOTE: If eps is omitted, the stored epsilon value is used.
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* 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)};
|
||||
*
|
||||
* We continue the fraction until it is less than epsilon error term.
|
||||
*
|
||||
* Also note 26.2.5:
|
||||
*
|
||||
* P(x) + Q(x) = 1
|
||||
*/
|
||||
define P(x, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
local s; /* sum */
|
||||
local x2; /* x^2 */
|
||||
local x_term; /* x^(2*r+1) */
|
||||
local odd_prod; /* 1*3*5* ... */
|
||||
local odd_term; /* next odd value to multiply into odd_prod */
|
||||
local term; /* the recent term added to the sum */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/* firewall */
|
||||
if (x <= 0) {
|
||||
if (x == 0) {
|
||||
return 0; /* hack */
|
||||
} else {
|
||||
quit "Q(x[,eps]) 1st argument must be >= 0";
|
||||
}
|
||||
}
|
||||
if (eps <= 0) {
|
||||
quit "Q(x[,eps]) 2nd argument must be > 0";
|
||||
}
|
||||
|
||||
/*
|
||||
* aproximate sum(n=0; n < infinity){x^(2*n+1)/(1*3*5*...(2*n+1)}
|
||||
*/
|
||||
x2 = x*x;
|
||||
x_term = x;
|
||||
s = x_term; /* 1st term */
|
||||
odd_term = 1;
|
||||
odd_prod = 1;
|
||||
do {
|
||||
|
||||
/* compute the term */
|
||||
odd_term += 2;
|
||||
odd_prod *= odd_term;
|
||||
x_term *= x2;
|
||||
term = x_term / odd_prod;
|
||||
s += term;
|
||||
|
||||
} while (term >= eps);
|
||||
|
||||
/* apply term and factor */
|
||||
return 0.5 + Z(x,eps)*s;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* chi_prob(chi_sq, v[, eps]) - Prob of >= chi^2 with v degrees of freedom
|
||||
*
|
||||
* Computes the Probability, given the Null Hypothesis, that a given
|
||||
* Chi squared values >= chi_sq with v degrees of freedom.
|
||||
*
|
||||
* The chi_prob() function does not work well with odd degrees of freedom.
|
||||
* It is reasonable with even degrees of freedom, although one must give
|
||||
* a sifficently small error term as the degress gets large (>100).
|
||||
*
|
||||
* NOTE: This function does not work well with odd degrees of freedom.
|
||||
* Can somebody help / find a bug / provide a better method of
|
||||
* this odd degrees of freedom case?
|
||||
*
|
||||
* NOTE: This function works well with even degrees of freedom. However
|
||||
* when the even degrees gets large (say, as you approach 100), you
|
||||
* need to increase your error term.
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* Section 26.4.4, p941:
|
||||
*
|
||||
* For odd v:
|
||||
*
|
||||
* 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)});
|
||||
*
|
||||
* chi = sqrt(chi_sq)
|
||||
*
|
||||
* NOTE: Q(x) = 1-P(x)
|
||||
*
|
||||
* Section 26.4.5, p941.
|
||||
*
|
||||
* For even v:
|
||||
*
|
||||
* Q(chi_sq, v) = sqrt(2*pi()) * Z(chi) * ( 1 +
|
||||
* sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } );
|
||||
*
|
||||
* chi = sqrt(chi_sq)
|
||||
*
|
||||
* Observe that:
|
||||
*
|
||||
* Z(x) = exp(-x*x/2) / sqrt(2*pi()); (Section 26.2.1, p931)
|
||||
*
|
||||
* and thus:
|
||||
*
|
||||
* sqrt(2*pi()) * Z(chi) =
|
||||
* sqrt(2*pi()) * Z(sqrt(chi_sq)) =
|
||||
* 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/2)
|
||||
*
|
||||
* So:
|
||||
*
|
||||
* Q(chi_sq, v) = exp(-sqrt(-chi_sq/2) * ( 1 + sum(....){...} );
|
||||
*/
|
||||
define chi_prob(chi_sq, v, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
local r; /* index in finite sum */
|
||||
local r_lim; /* limit value for r */
|
||||
local s; /* sum */
|
||||
local d; /* demoninator (2*4*6*... or 1*3*5...) */
|
||||
local chi_term; /* chi_sq^r */
|
||||
local ret; /* return value */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/*
|
||||
* odd degrees of freedom
|
||||
*/
|
||||
if (isodd(v)) {
|
||||
|
||||
local chi; /* sqrt(chi_sq) */
|
||||
|
||||
/* setup for sum */
|
||||
s = 1;
|
||||
d = 1;
|
||||
chi = sqrt(abs(chi_sq), eps);
|
||||
chi_term = chi;
|
||||
r_lim = (v-1)/2;
|
||||
|
||||
/* compute sum(r=1, r=((v-1)/2)) {(chi_sq^r/chi) / (1*3*5...*(2r-1))} */
|
||||
for (r=2; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= (2*r)-1;
|
||||
s += chi_term/d;
|
||||
}
|
||||
|
||||
/* apply term and factor, Q(x) = 1-P(x) */
|
||||
ret = 2*(1-P(chi)) + 2*Z(chi)*s;
|
||||
|
||||
/*
|
||||
* even degrees of freedom
|
||||
*/
|
||||
} else {
|
||||
|
||||
/* setup for sum */
|
||||
s =1;
|
||||
d = 1;
|
||||
chi_term = 1;
|
||||
r_lim = (v-2)/2;
|
||||
|
||||
/* compute sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } */
|
||||
for (r=1; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= r*2;
|
||||
s += chi_term/d;
|
||||
}
|
||||
|
||||
/* apply factor - see observation in the main comment above */
|
||||
ret = exp(-chi_sq/2, eps) * s;
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
@@ -1,6 +1,35 @@
|
||||
/*
|
||||
* chrem - Chinese remainder theorem/problem solver
|
||||
* chrem - chinese remainder theorem/problem solver
|
||||
*
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: chrem.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/chrem.cal,v $
|
||||
*
|
||||
* Under source code control: 1992/09/26 01:00:47
|
||||
* File existed as early as: 1992
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* When possible, chrem finds solutions for x of a set of congruences
|
||||
* of the form:
|
||||
*
|
||||
@@ -84,11 +113,9 @@
|
||||
* 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.
|
||||
*
|
||||
* Written by: Ernest W Bowen <ernie@neumann.une.edu.au>
|
||||
* Interface by: Landon Curt Noll http://reality.sgi.com/chongo/
|
||||
*/
|
||||
|
||||
|
||||
static defaultmlist = list(2,3,5,7,11,13,17,19); /* The first eight primes */
|
||||
|
||||
define chrem()
|
||||
@@ -174,7 +201,7 @@ define chrem()
|
||||
}
|
||||
}
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "chrem(r1,m1 [,r2,m2 ...]) defined";
|
||||
print "chrem(rlist [,mlist]) defined";
|
||||
}
|
104
cal/constants.cal
Normal file
104
cal/constants.cal
Normal file
@@ -0,0 +1,104 @@
|
||||
/*
|
||||
* constants - implementation of different constants to arbitrary precision
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: constants.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/constants.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
static __CZ__euler_mascheroni = 0;
|
||||
static __CZ__euler_mascheroni_prec = 0;
|
||||
|
||||
|
||||
define e(){
|
||||
local k temp1 temp2 ret eps factor upperlimit prec;
|
||||
|
||||
prec = digits(1/epsilon());
|
||||
if(__CZ__euler_mascheroni != 0 && __CZ__euler_mascheroni_prec >= prec)
|
||||
return __CZ__euler_mascheroni;
|
||||
if(prec<=20) return 2.718281828459045235360287471;
|
||||
if(prec<=1800){
|
||||
__CZ__euler_mascheroni = exp(1);
|
||||
__CZ__euler_mascheroni_prec = prec;
|
||||
}
|
||||
|
||||
eps=epsilon(1e-20);
|
||||
factor = 1;
|
||||
k = 0;
|
||||
upperlimit = prec * ln(10);
|
||||
while(k<upperlimit){
|
||||
k += ln(factor);
|
||||
factor++;
|
||||
}
|
||||
epsilon(eps);
|
||||
temp1 = 0;
|
||||
ret = 1;
|
||||
for(k=3;k<=factor;k++){
|
||||
temp2 = temp1;
|
||||
temp1 = ret;
|
||||
ret = (k-1) *(temp1 + temp2);
|
||||
}
|
||||
|
||||
ret = inverse( ret * inverse(factorial(factor) ) ) ;
|
||||
__CZ__euler_mascheroni = ret;
|
||||
__CZ__euler_mascheroni_prec = prec;
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/* Lupas' series */
|
||||
static __CZ__catalan = 0;
|
||||
static __CZ__catalan_prec = 0;
|
||||
define G(){
|
||||
local eps a s t n;
|
||||
eps = epsilon(epsilon()*1e-10);
|
||||
if(__CZ__catalan != 0 && __CZ__catalan >= log(1/eps))
|
||||
return __CZ__catalan;
|
||||
a = 1;
|
||||
s = 0;
|
||||
t = 1;
|
||||
n = 1;
|
||||
while(abs(t)> eps){
|
||||
a *= 32 * n^3 * (2*n-1);
|
||||
a /=((3-16*n+16*n^2)^2);
|
||||
t = a * (-1)^(n-1) * (40*n^2-24*n+3) / (n^3 * (2*n-1));
|
||||
s += t;
|
||||
n += 1;
|
||||
}
|
||||
s = s/64;
|
||||
__CZ__catalan = s;
|
||||
__CZ__catalan_prec = log(1/eps);
|
||||
epsilon(eps);
|
||||
return s;
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "e()";
|
||||
print "G()";
|
||||
}
|
138
cal/deg.cal
Normal file
138
cal/deg.cal
Normal file
@@ -0,0 +1,138 @@
|
||||
/*
|
||||
* deg - calculate in degrees, minutes, and seconds
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: deg.cal,v 30.2 2010/09/02 06:01:14 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/deg.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj deg {deg, min, sec};
|
||||
|
||||
define deg(deg, min, sec)
|
||||
{
|
||||
local ans;
|
||||
|
||||
if (isnull(sec))
|
||||
sec = 0;
|
||||
if (isnull(min))
|
||||
min = 0;
|
||||
obj deg ans;
|
||||
ans.deg = deg;
|
||||
ans.min = min;
|
||||
ans.sec = sec;
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_add(a, b)
|
||||
{
|
||||
local obj deg ans;
|
||||
|
||||
ans.deg = 0;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
if (istype(a, ans)) {
|
||||
ans.deg += a.deg;
|
||||
ans.min += a.min;
|
||||
ans.sec += a.sec;
|
||||
} else
|
||||
ans.deg += a;
|
||||
if (istype(b, ans)) {
|
||||
ans.deg += b.deg;
|
||||
ans.min += b.min;
|
||||
ans.sec += b.sec;
|
||||
} else
|
||||
ans.deg += b;
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_neg(a)
|
||||
{
|
||||
local obj deg ans;
|
||||
|
||||
ans.deg = -a.deg;
|
||||
ans.min = -a.min;
|
||||
ans.sec = -a.sec;
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_sub(a, b)
|
||||
{
|
||||
return a - b;
|
||||
}
|
||||
|
||||
|
||||
define deg_mul(a, b)
|
||||
{
|
||||
local obj deg ans;
|
||||
|
||||
if (istype(a, ans) && istype(b, ans))
|
||||
quit "Cannot multiply degrees together";
|
||||
if (istype(a, ans)) {
|
||||
ans.deg = a.deg * b;
|
||||
ans.min = a.min * b;
|
||||
ans.sec = a.sec * b;
|
||||
} else {
|
||||
ans.deg = b.deg * a;
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_print(a)
|
||||
{
|
||||
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
|
||||
}
|
||||
|
||||
|
||||
define deg_abs(a)
|
||||
{
|
||||
return a.deg + a.min / 60 + a.sec / 3600;
|
||||
}
|
||||
|
||||
|
||||
define fixdeg(a)
|
||||
{
|
||||
a.min += frac(a.deg) * 60;
|
||||
a.deg = int(a.deg);
|
||||
a.sec += frac(a.min) * 60;
|
||||
a.min = int(a.min);
|
||||
a.min += a.sec // 60;
|
||||
a.sec %= 60;
|
||||
a.deg += a.min // 60;
|
||||
a.min %= 60;
|
||||
a.deg %= 360;
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj deg {deg, min, sec} defined";
|
||||
}
|
384
cal/dms.cal
Normal file
384
cal/dms.cal
Normal file
@@ -0,0 +1,384 @@
|
||||
/*
|
||||
* dms - calculate in degrees, minutes, and seconds (based on deg)
|
||||
*
|
||||
* Copyright (C) 1999,2010 David I. Bell and Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: dms.cal,v 30.2 2010/09/02 06:14:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/dms.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj dms {deg, min, sec};
|
||||
|
||||
define dms(deg, min, sec)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* default missing args to 0 */
|
||||
if (isnull(sec)) {
|
||||
sec = 0;
|
||||
}
|
||||
if (isnull(min)) {
|
||||
min = 0;
|
||||
}
|
||||
|
||||
/* load object */
|
||||
ans.deg = deg;
|
||||
ans.min = min;
|
||||
ans.sec = sec;
|
||||
|
||||
/* return properly formed object */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_add(a, b)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* initalize value to 1st arg */
|
||||
if (istype(a, ans)) {
|
||||
/* 1st arg is dms object, load it */
|
||||
ans.deg = a.deg;
|
||||
ans.min = a.min;
|
||||
ans.sec = a.sec;
|
||||
} else {
|
||||
/* 1st arg is not dms, assume scalar degrees */
|
||||
ans.deg = a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* add value of 2nd arg */
|
||||
if (istype(b, ans)) {
|
||||
/* 2nd arg is dms object, add it */
|
||||
ans.deg += b.deg;
|
||||
ans.min += b.min;
|
||||
ans.sec += b.sec;
|
||||
} else {
|
||||
/* 2nd arg is not dms, add scalar degrees */
|
||||
ans.deg += b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_neg(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* negate argument */
|
||||
if (istype(a, ans)) {
|
||||
/* 1st arg is dms object, load it */
|
||||
ans.deg = -a.deg;
|
||||
ans.min = -a.min;
|
||||
ans.sec = -a.sec;
|
||||
} else {
|
||||
/* 2nd arg is not dms, negate scalar degrees */
|
||||
ans.deg = -a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_sub(a, b)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* initalize value to 1st arg */
|
||||
if (istype(a, ans)) {
|
||||
/* 1st arg is dms object, load it */
|
||||
ans.deg = a.deg;
|
||||
ans.min = a.min;
|
||||
ans.sec = a.sec;
|
||||
} else {
|
||||
/* 1st arg is not dms, assume scalar degrees */
|
||||
ans.deg = a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* subtract value of 2nd arg */
|
||||
if (istype(b, ans)) {
|
||||
/* 2nd arg is dms object, subtract it */
|
||||
ans.deg -= b.deg;
|
||||
ans.min -= b.min;
|
||||
ans.sec -= b.sec;
|
||||
} else {
|
||||
/* 2nd arg is not dms, subtract scalar degrees */
|
||||
ans.deg -= b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_mul(a, b)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* dms object multiplication */
|
||||
if (istype(a, ans) && istype(b, ans)) {
|
||||
ans.deg = dms_abs(a) * dms_abs(b);
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
|
||||
/* scalar multiplication */
|
||||
} else if (istype(a, ans)) {
|
||||
ans.deg = a.deg * b;
|
||||
ans.min = a.min * b;
|
||||
ans.sec = a.sec * b;
|
||||
} else {
|
||||
ans.deg = b.deg * a;
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_print(a)
|
||||
{
|
||||
local obj dms ans; /* temp object for dms type testing */
|
||||
|
||||
/* firewall - arg must be a dms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "dms_print called with non dms object";
|
||||
}
|
||||
|
||||
/* print in dms form */
|
||||
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
|
||||
}
|
||||
|
||||
|
||||
define dms_abs(a)
|
||||
{
|
||||
local obj dms ans; /* temp object for dms type testing */
|
||||
local deg; /* return scalar value */
|
||||
|
||||
/* firewall - just absolute value non dms objects */
|
||||
if (! istype(a, ans)) {
|
||||
return abs(a);
|
||||
}
|
||||
|
||||
/* compute degrees */
|
||||
deg = a.deg + a.min / 60 + a.sec / 3600;
|
||||
|
||||
/* return degrees */
|
||||
return deg;
|
||||
}
|
||||
|
||||
|
||||
define dms_norm(a)
|
||||
{
|
||||
local obj dms ans; /* temp object for dms type testing */
|
||||
local deg; /* degrees */
|
||||
|
||||
/* firewall - arg must be a dms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "dms_norm called with non dms object";
|
||||
}
|
||||
|
||||
/* square degrees (norm is the square of absolute value */
|
||||
deg = dms_abs(a);
|
||||
|
||||
/* return degrees */
|
||||
return deg*deg;
|
||||
}
|
||||
|
||||
|
||||
define dms_test(a)
|
||||
{
|
||||
local obj dms ans; /* temp value */
|
||||
|
||||
/* firewall - arg must be a dms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "dms_test called with non dms object";
|
||||
}
|
||||
|
||||
/* return false of non-zero */
|
||||
ans = fixdms(a);
|
||||
if (ans.deg == 0 && ans.min == 0 && ans.sec == 0) {
|
||||
/* false */
|
||||
return 0;
|
||||
}
|
||||
/* true */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
define dms_int(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* firewall - arg must be a dms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "dms_int called with non dms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
ans = fixdms(a);
|
||||
|
||||
/* truncate to the nearest second */
|
||||
ans.sec = int(ans.sec);
|
||||
|
||||
/* return value to the nearest second */
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_frac(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* firewall - arg must be a dms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "dms_frac called with non dms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
ans = fixdms(a);
|
||||
|
||||
/* remove all but fractional seconds */
|
||||
ans.deg = 0;
|
||||
ans.min = 0;
|
||||
ans.sec = frac(ans.sec);
|
||||
|
||||
/* return value to the second fraction */
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_rel(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = dms_abs(a);
|
||||
abs_b = dms_abs(b);
|
||||
|
||||
/* return the comparison */
|
||||
return cmp(abs_a, abs_b);
|
||||
}
|
||||
|
||||
|
||||
define dms_cmp(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = dms_abs(a);
|
||||
abs_b = dms_abs(b);
|
||||
|
||||
/* return the equality comparison */
|
||||
return (abs_a == abs_b);
|
||||
}
|
||||
|
||||
|
||||
define dms_inc(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* increment a dms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
++ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* increment a scalar */
|
||||
return a+1;
|
||||
}
|
||||
|
||||
|
||||
define dms_dec(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* decrement a dms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
--ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* decrement a scalar */
|
||||
return a-1;
|
||||
}
|
||||
|
||||
|
||||
define fixdms(a)
|
||||
{
|
||||
local obj dms ans; /* temp value */
|
||||
|
||||
/* firewall */
|
||||
if (! istype(a, ans)) {
|
||||
quit "attempt to fix a non dms object";
|
||||
}
|
||||
|
||||
/* force minutes to be intergral */
|
||||
a.min += frac(a.deg) * 60;
|
||||
a.deg = int(a.deg);
|
||||
|
||||
/* force degrees to be intergral */
|
||||
a.sec += frac(a.min) * 60;
|
||||
a.min = int(a.min);
|
||||
|
||||
/* carry excess seconds into minutes */
|
||||
a.min += a.sec // 60;
|
||||
a.sec %= 60;
|
||||
|
||||
/* carry excess minutes into degrees */
|
||||
a.deg += a.min // 60;
|
||||
a.min %= 60;
|
||||
|
||||
/* round degrees :-) */
|
||||
a.deg %= 360;
|
||||
|
||||
/* return normalized result */
|
||||
return a;
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj dms {deg, min, sec} defined";
|
||||
}
|
193
cal/dotest.cal
Normal file
193
cal/dotest.cal
Normal file
@@ -0,0 +1,193 @@
|
||||
/*
|
||||
* dotest - test truth statements found in line tests of dotest_testline file
|
||||
*
|
||||
* This file was created by Ernest Bowen <ebowen at une dot edu dot au>
|
||||
* and modified by Landon Curt Noll.
|
||||
*
|
||||
* This dotest_code has been placed in the public domain. Please do not
|
||||
* copyright this dotest_code.
|
||||
*
|
||||
* ERNEST BOWEN AND LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO
|
||||
* THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER-
|
||||
* CHANTABILITY AND FITNESS. IN NO EVENT SHALL LANDON CURT
|
||||
* NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL
|
||||
* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
||||
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
||||
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: dotest.cal,v 30.2 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/dotest.cal,v $
|
||||
*
|
||||
* This file is not covered under version 2.1 of the GNU LGPL.
|
||||
*
|
||||
* Under source dotest_code control: 2006/03/08 05:54:09
|
||||
* File existed as early as: 2006
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* dotest - perform tests from dotest_testline file
|
||||
*
|
||||
* given:
|
||||
* dotest_file filename containing single test lines
|
||||
* dotest_code regress.cal test number to use (def: 0)
|
||||
* dotest_maxcond max error conditions allowed (def: <0 ==> 2^31-1)
|
||||
*
|
||||
* returns:
|
||||
* number of line test failures
|
||||
*
|
||||
* NOTE: All variables used by the dotest() function start with "dotest_".
|
||||
* The dotest_file and dotest_read should not use any variable
|
||||
* that starts with "dotest_".
|
||||
*/
|
||||
define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
|
||||
{
|
||||
local dotest_f_file; /* open file containing test lines */
|
||||
local 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_errcnt; /* total number of errors */
|
||||
local dotest_failcnt; /* number of line tests failed */
|
||||
local dotest_testnum; /* number of test lines evaluated */
|
||||
local dotest_linenum; /* test line number */
|
||||
local dotest_old_errmax; /* value of errmax() prior to calling */
|
||||
local dotest_old_errcount; /* value of errcount() prior to calling */
|
||||
|
||||
/*
|
||||
* preserve calling stats
|
||||
*/
|
||||
dotest_old_errmax = errmax();
|
||||
dotest_old_errcount = errcount(0);
|
||||
|
||||
/*
|
||||
* initialize test accounting
|
||||
*/
|
||||
dotest_errcnt = errcount();
|
||||
dotest_failcnt = 0;
|
||||
dotest_testnum = 0;
|
||||
dotest_linenum = 0;
|
||||
|
||||
/*
|
||||
* setup error accounting for dotest
|
||||
*/
|
||||
if (dotest_maxcond >= 0 && dotest_maxcond < 2147483647) {
|
||||
errmax(dotest_maxcond + dotest_old_errcount + 1),;
|
||||
} else {
|
||||
errmax(2147483647),;
|
||||
}
|
||||
|
||||
/*
|
||||
* open the test line file
|
||||
*/
|
||||
printf("%d-: opening line file: %d", dotest_code, dotest_file);
|
||||
dotest_f_file = fpathopen(dotest_file, "r");
|
||||
if (!isfile(dotest_f_file)) {
|
||||
printf("**** Unable to file or open file \"%s\"\n",
|
||||
dotest_file);
|
||||
quit;
|
||||
}
|
||||
printf('%d: testing "%s"\n', dotest_code, dotest_file);
|
||||
|
||||
/*
|
||||
* perform dotest_testline test on each line of the file
|
||||
*/
|
||||
for (;;) {
|
||||
|
||||
/* get the next test line */
|
||||
dotest_testline = fgets(dotest_f_file);
|
||||
++dotest_linenum;
|
||||
if (iserror(dotest_testline)) {
|
||||
quit "**** Error while reading file";
|
||||
} else if (isnull(dotest_testline)) {
|
||||
/* EOF - end of test file */
|
||||
break;
|
||||
}
|
||||
|
||||
/* skip empty lines */
|
||||
if (dotest_testline == "\n") {
|
||||
continue;
|
||||
}
|
||||
|
||||
/* evaluate the test line */
|
||||
dotest_testeval = eval(dotest_testline);
|
||||
|
||||
/* ignore white space or comment lines */
|
||||
if (isnull(dotest_testeval)) {
|
||||
continue;
|
||||
}
|
||||
|
||||
/* look for test line parse errors */
|
||||
if (iserror(dotest_testeval)) {
|
||||
printf("**** evaluation error: ");
|
||||
++dotest_failcnt;
|
||||
|
||||
/* look for test line dotest_failcnt */
|
||||
} else if (dotest_testeval != 1) {
|
||||
printf("**** did not return 1: ");
|
||||
++dotest_failcnt;
|
||||
}
|
||||
|
||||
/* show the test line we just performed */
|
||||
printf("%d-%d: %s", dotest_code, dotest_linenum, dotest_testline);
|
||||
|
||||
/* error accounting */
|
||||
dotest_tmperrcnt = errcount() - dotest_errcnt;
|
||||
if (dotest_tmperrcnt > 0) {
|
||||
|
||||
/* report any other errors */
|
||||
if (dotest_tmperrcnt > 1) {
|
||||
printf("%d-%d: NOTE: %d error conditions(s): %s\n",
|
||||
dotest_code, dotest_linenum, dotest_tmperrcnt);
|
||||
}
|
||||
|
||||
/* report the calc error string */
|
||||
printf("%d-%d: NOTE: last error string: %s\n",
|
||||
dotest_code, dotest_linenum, strerror());
|
||||
|
||||
/* new error count level */
|
||||
dotest_errcnt = errcount();
|
||||
if (dotest_maxcond >= 0 &&
|
||||
dotest_old_errcount-dotest_errcnt > dotest_maxcond) {
|
||||
printf("%d-%d: total error conditions: %d > %d\n",
|
||||
dotest_code, dotest_linenum,
|
||||
dotest_maxcond, dotest_old_errcount-dotest_errcnt);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* test the close of the line file
|
||||
*/
|
||||
printf("%d-: detected %d error condition(s), many of which may be OK\n",
|
||||
dotest_code, dotest_old_errcount-dotest_errcnt);
|
||||
printf("%d-: closing line file: %d\n", dotest_code, dotest_file);
|
||||
fclose(dotest_f_file);
|
||||
|
||||
/*
|
||||
* test line file accounting
|
||||
*/
|
||||
if (dotest_failcnt > 0) {
|
||||
printf("**** %d-: %d test failure(s) in %d line(s)\n",
|
||||
dotest_code, dotest_failcnt, dotest_linenum);
|
||||
} else {
|
||||
printf("%d-: no failure(s) in %d line(s)\n",
|
||||
dotest_code, dotest_linenum);
|
||||
}
|
||||
|
||||
/*
|
||||
* preppare to return to the caller environment
|
||||
*
|
||||
* We increase the caller's error count by the number
|
||||
* of line tests that failed, not the number of internal
|
||||
* errors that were noted.
|
||||
*/
|
||||
errmax(dotest_old_errmax),;
|
||||
errcount(dotest_old_errcount + dotest_failcnt),;
|
||||
|
||||
/*
|
||||
* All Done!!! -- Jessica Noll, Age 2
|
||||
*/
|
||||
return dotest_failcnt;
|
||||
}
|
@@ -1,18 +1,44 @@
|
||||
/*
|
||||
* Copyright (c) 1995 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* ellip - attempt to factor numbers using elliptic functions
|
||||
*
|
||||
* Attempt to factor numbers using elliptic functions.
|
||||
* y^2 = x^3 + a*x + b (mod N).
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Many points (x,y) (mod N) are found that solve the above equation,
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: ellip.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/ellip.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Attempt to factor numbers using elliptic functions:
|
||||
*
|
||||
* y^2 = x^3 + a*x + b (mod ellip_N).
|
||||
*
|
||||
* Many points (x,y) (mod ellip_N) are found that solve the above equation,
|
||||
* starting from a trivial solution and 'multiplying' that point together
|
||||
* to generate high powers of the point, looking for such a point whose
|
||||
* order contains a common factor with N. The order of the group of points
|
||||
* varies almost randomly within a certain interval for each choice of a
|
||||
* and b, and thus each choice provides an independent opportunity to
|
||||
* factor N. To generate a trivial solution, a is chosen and then b is
|
||||
* order contains a common factor with ellip_N. The order of the group of
|
||||
* points varies almost randomly within a certain interval for each choice of
|
||||
* a and b, and thus each choice provides an independent opportunity to
|
||||
* factor ellip_N. To generate a trivial solution, a is chosen and then b is
|
||||
* selected so that (1,1) is a solution. The multiplication is done using
|
||||
* the basic fact that the equation is a cubic, and so if a line hits the
|
||||
* curve in two rational points, then the third intersection point must
|
||||
@@ -20,9 +46,9 @@
|
||||
* the number of rational solutions can be made very large. When modular
|
||||
* arithmetic is used, solving for the third point requires the taking of a
|
||||
* modular inverse (instead of division), and if this fails, then the GCD
|
||||
* of the failing value and N provides a factor of N. This description is
|
||||
* only an approximation, read "A Course in Number Theory and Cryptography"
|
||||
* by Neal Koblitz for a good explanation.
|
||||
* of the failing value and ellip_N provides a factor of ellip_N.
|
||||
* This description is only an approximation, read "A Course in Number
|
||||
* Theory and Cryptography" by Neal Koblitz for a good explanation.
|
||||
*
|
||||
* efactor(iN, ia, B, force)
|
||||
* iN is the number to be factored.
|
||||
@@ -56,14 +82,15 @@
|
||||
*
|
||||
* 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 N.
|
||||
* variable ellip_N.
|
||||
*/
|
||||
|
||||
|
||||
obj point {x, y};
|
||||
global N; /* number to factor */
|
||||
global a; /* first coefficient */
|
||||
global b; /* second coefficient */
|
||||
global f; /* found factor */
|
||||
global ellip_N; /* number to factor */
|
||||
global ellip_a; /* first coefficient */
|
||||
global ellip_b; /* second coefficient */
|
||||
global ellip_f; /* found factor */
|
||||
|
||||
|
||||
define efactor(iN, ia, B, force)
|
||||
@@ -77,28 +104,28 @@ define efactor(iN, ia, B, force)
|
||||
if (isnull(ia))
|
||||
ia = 1;
|
||||
obj point x;
|
||||
a = ia;
|
||||
b = -ia;
|
||||
N = iN;
|
||||
C = isqrt(N);
|
||||
ellip_a = ia;
|
||||
ellip_b = -ia;
|
||||
ellip_N = iN;
|
||||
C = isqrt(ellip_N);
|
||||
C = 2 * C + 2 * isqrt(C) + 1;
|
||||
f = 0;
|
||||
while (f == 0) {
|
||||
print "A =", a;
|
||||
ellip_f = 0;
|
||||
while (ellip_f == 0) {
|
||||
print "A =", ellip_a;
|
||||
x.x = 1;
|
||||
x.y = 1;
|
||||
print 2, x;
|
||||
x = x ^ (2 ^ (highbit(C) + 1));
|
||||
for (p = 3; ((p < B) && (f == 0)); p += 2) {
|
||||
for (p = 3; ((p < B) && (ellip_f == 0)); p += 2) {
|
||||
if (!ptest(p, 1))
|
||||
continue;
|
||||
print p, x;
|
||||
x = x ^ (p ^ ((highbit(C) // highbit(p)) + 1));
|
||||
}
|
||||
a++;
|
||||
b--;
|
||||
ellip_a++;
|
||||
ellip_b--;
|
||||
}
|
||||
return f;
|
||||
return ellip_f;
|
||||
}
|
||||
|
||||
|
||||
@@ -115,18 +142,18 @@ define point_mul(p1, p2)
|
||||
if (p2 == 1)
|
||||
return p1;
|
||||
if (p1 == p2)
|
||||
return point_square(&p1);
|
||||
return point_square(`p1);
|
||||
obj point r;
|
||||
m = (minv(p2.x - p1.x, N) * (p2.y - p1.y)) % N;
|
||||
m = (minv(p2.x - p1.x, ellip_N) * (p2.y - p1.y)) % ellip_N;
|
||||
if (m == 0) {
|
||||
if (f == 0)
|
||||
f = gcd(p2.x - p1.x, N);
|
||||
if (ellip_f == 0)
|
||||
ellip_f = gcd(p2.x - p1.x, ellip_N);
|
||||
r.x = 1;
|
||||
r.y = 1;
|
||||
return r;
|
||||
}
|
||||
r.x = (m^2 - p1.x - p2.x) % N;
|
||||
r.y = ((m * (p1.x - r.x)) - p1.y) % N;
|
||||
r.x = (m^2 - p1.x - p2.x) % ellip_N;
|
||||
r.y = ((m * (p1.x - r.x)) - p1.y) % ellip_N;
|
||||
return r;
|
||||
}
|
||||
|
||||
@@ -136,16 +163,16 @@ define point_square(p)
|
||||
local r, m;
|
||||
|
||||
obj point r;
|
||||
m = ((3 * p.x^2 + a) * minv(p.y << 1, N)) % N;
|
||||
m = ((3 * p.x^2 + ellip_a) * minv(p.y << 1, ellip_N)) % ellip_N;
|
||||
if (m == 0) {
|
||||
if (f == 0)
|
||||
f = gcd(p.y << 1, N);
|
||||
if (ellip_f == 0)
|
||||
ellip_f = gcd(p.y << 1, ellip_N);
|
||||
r.x = 1;
|
||||
r.y = 1;
|
||||
return r;
|
||||
}
|
||||
r.x = (m^2 - p.x - p.x) % N;
|
||||
r.y = ((m * (p.x - r.x)) - p.y) % N;
|
||||
r.x = (m^2 - p.x - p.x) % ellip_N;
|
||||
r.y = ((m * (p.x - r.x)) - p.y) % ellip_N;
|
||||
return r;
|
||||
}
|
||||
|
||||
@@ -158,10 +185,10 @@ define point_pow(p, pow)
|
||||
if (isodd(pow))
|
||||
r = p;
|
||||
t = p;
|
||||
for (bit = 2; ((bit <= pow) && (f == 0)); bit <<= 1) {
|
||||
t = point_square(&t);
|
||||
for (bit = 2; ((bit <= pow) && (ellip_f == 0)); bit <<= 1) {
|
||||
t = point_square(`t);
|
||||
if (bit & pow)
|
||||
r = point_mul(&t, &r);
|
||||
r = point_mul(`t, `r);
|
||||
}
|
||||
return r;
|
||||
}
|
204
cal/factorial.cal
Normal file
204
cal/factorial.cal
Normal file
@@ -0,0 +1,204 @@
|
||||
/*
|
||||
* factorial - implementation of different algorithms for the factorial
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: factorial.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/factorial.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* hide internal function from resource debugging
|
||||
*/
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
/*
|
||||
get dependencies
|
||||
*/
|
||||
read -once toomcook;
|
||||
|
||||
|
||||
/* A simple list to keep things...uhm...simple?*/
|
||||
static __CZ__primelist = list();
|
||||
|
||||
/* Helper for primorial: fill list with primes in range a,b */
|
||||
define __CZ__fill_prime_list(a,b)
|
||||
{
|
||||
local k;
|
||||
k=a;
|
||||
if(isprime(k))k--;
|
||||
while(1){
|
||||
k = nextprime(k);
|
||||
if(k > b) break;
|
||||
append(__CZ__primelist,k );
|
||||
}
|
||||
}
|
||||
|
||||
/* Helper for factorial: how often prime p divides the factorial of n */
|
||||
define __CZ__prime_divisors(n,p)
|
||||
{
|
||||
local q,m;
|
||||
q = n;
|
||||
m = 0;
|
||||
if (p > n) return 0;
|
||||
if (p > n/2) return 1;
|
||||
while (q >= p) {
|
||||
q = q//p;
|
||||
m += q;
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
/*
|
||||
Wrapper. Please set cut-offs to own taste and hardware.
|
||||
*/
|
||||
define factorial(n){
|
||||
local prime result shift prime_list k k1 k2 expo_list pix cut primorial;
|
||||
|
||||
result = 1;
|
||||
prime = 2;
|
||||
|
||||
if(!isint(n)) {
|
||||
return newerror("factorial(n): n is not an integer"); ## or gamma(n)?
|
||||
}
|
||||
if(n < 0) return newerror("factorial(n): n < 0");
|
||||
if(n < 9000 && !isdefined("test8900")) {
|
||||
## builtin is implemented with splitting but only with
|
||||
## Toom-Cook 2 (by Karatsuba (the father))
|
||||
return n!;
|
||||
}
|
||||
|
||||
shift = __CZ__prime_divisors(n,prime);
|
||||
prime = 3;
|
||||
cut = n//2;
|
||||
pix = pix(cut);
|
||||
prime_list = mat[pix];
|
||||
expo_list = mat[pix];
|
||||
|
||||
k = 0;
|
||||
/*
|
||||
Peter Borwein's algorithm
|
||||
|
||||
@Article{journals/jal/Borwein85,
|
||||
author = {Borwein, Peter B.},
|
||||
title = {On the Complexity of Calculating Factorials.},
|
||||
journal = {J. Algorithms},
|
||||
year = {1985},
|
||||
number = {3},
|
||||
url = {http://dblp.uni-trier.de/db/journals/jal/jal6.html#Borwein85}
|
||||
*/
|
||||
|
||||
do {
|
||||
prime_list[k] = prime;
|
||||
expo_list[k++] = __CZ__prime_divisors(n,prime);
|
||||
prime = nextprime(prime);
|
||||
}while(prime <= cut);
|
||||
|
||||
/* size of the largest exponent in bits */
|
||||
k1 = highbit(expo_list[0]);
|
||||
k2 = size(prime_list)-1;
|
||||
|
||||
for(;k1>=0;k1--){
|
||||
/*
|
||||
the cut-off for T-C-4 ist still to low, using T-C-3 here
|
||||
TODO: check cutoffs
|
||||
*/
|
||||
result = toomcook3square(result);
|
||||
/*
|
||||
almost all time is spend in this loop, so cutting of the
|
||||
upper half of the primes makes sense
|
||||
*/
|
||||
for(k=0; k<=k2; k++) {
|
||||
if((expo_list[k] & (1 << k1)) != 0) {
|
||||
result *= prime_list[k];
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
primorial = primorial( cut, n);
|
||||
result *= primorial;
|
||||
result <<= shift;
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
Helper for primorial: do the product with binary splitting
|
||||
TODO: do it without the intermediate list
|
||||
*/
|
||||
define __CZ__primorial__lowlevel( a, b ,p)
|
||||
{
|
||||
local c;
|
||||
if( b == a) return p ;
|
||||
if( b-a > 1){
|
||||
c= (b + a) >> 1;
|
||||
return __CZ__primorial__lowlevel( a , c , __CZ__primelist[a] )
|
||||
* __CZ__primorial__lowlevel( c+1 , b , __CZ__primelist[b] ) ;
|
||||
}
|
||||
return __CZ__primelist[a] * __CZ__primelist[b];
|
||||
}
|
||||
|
||||
/*
|
||||
Primorial, Product of consecutive primes in range a,b
|
||||
|
||||
Originally meant to do primorials with a start different from 2, but
|
||||
found out that this is faster at about a=1,b>=10^5 than the builtin
|
||||
function pfact(). With the moderately small list a=1,b=10^6 (78498
|
||||
primes) it is 3 times faster. A quick look-up showed what was already
|
||||
guessed: pfact() does it linearly. (BTW: what is the time complexity
|
||||
of the primorial with the naive algorithm?)
|
||||
*/
|
||||
define primorial(a,b)
|
||||
{
|
||||
local C1 C2;
|
||||
if(!isint(a)) return newerror("primorial(a,b): a is not an integer");
|
||||
else if(!isint(b)) return newerror("primorial(a,b): b is not an integer");
|
||||
else if(a < 0) return newerror("primorial(a,b): a < 0");
|
||||
else if( b < 2 ) return newerror("primorial(a,b): b < 2");
|
||||
else if( b < a) return newerror("primorial(a,b): b < a");
|
||||
else{
|
||||
/* last prime < 2^32 is also max. prime for nextprime()*/
|
||||
if(b >= 4294967291) return newerror("primorial(a,b): max. prime exceeded");
|
||||
if(b == 2) return 2;
|
||||
/*
|
||||
Can be extended by way of pfact(b)/pfact(floor(a-1/2)) for small a
|
||||
*/
|
||||
if(a<=2 && b < 10^5) return pfact(b);
|
||||
/* TODO: use pix() and a simple array (mat[])instead*/
|
||||
__CZ__primelist = list();
|
||||
__CZ__fill_prime_list(a,b);
|
||||
C1 = size(__CZ__primelist)-1;
|
||||
return __CZ__primorial__lowlevel( 0, C1,1)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* restore internal function from resource debugging
|
||||
* report important interface functions
|
||||
*/
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "factorial(n)";
|
||||
print "primorial(a, b)";
|
||||
}
|
723
cal/factorial2.cal
Normal file
723
cal/factorial2.cal
Normal file
@@ -0,0 +1,723 @@
|
||||
/*
|
||||
* factorial2 - implementation of different factorial related functions
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: factorial2.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/factorial2.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* hide internal function from resource debugging
|
||||
*/
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
/*
|
||||
get dependencies
|
||||
*/
|
||||
read -once factorial toomcook specialfunctions;
|
||||
|
||||
|
||||
/*
|
||||
Factorize a factorial and put the result in a 2-column matrix with pi(n) rows
|
||||
mat[ primes , exponent ]
|
||||
Result can be restricted to start at a prime different from 2 with the second
|
||||
argument "start". That arguments gets taken at face value if it prime and
|
||||
smaller than n, otherwise the next larger prime is taken if that prime is
|
||||
smaller than n.
|
||||
*/
|
||||
|
||||
define __CZ__factor_factorial(n,start){
|
||||
local prime prime_list k pix stop;
|
||||
|
||||
|
||||
if(!isint(n)) return
|
||||
newerror("__CZ__factor_factorial(n,start): n is not integer");
|
||||
if(n < 0) return newerror("__CZ__factor_factorial(n,start): n < 0");
|
||||
if(n == 1) return newerror("__CZ__factor_factorial(n,start): n == 1");
|
||||
|
||||
if(start){
|
||||
if(!isint(start) && start < 0 && start > n)
|
||||
return newerror("__CZ__factor_factorial(n,start): value of "
|
||||
"parameter 'start' out of range");
|
||||
if(start == n && isprime(n)){
|
||||
prime_list = mat[1 , 2];
|
||||
prime_list[0,0] = n;
|
||||
prime_list[0,1] = 1;
|
||||
}
|
||||
else if(!isprime(start) && nextprime(start) >n)
|
||||
return newerror("__CZ__factor_factorial(n,start): value of parameter "
|
||||
"'start' out of range");
|
||||
else{
|
||||
if(!isprime(start)) prime = nextprime(start);
|
||||
else prime = start;
|
||||
}
|
||||
}
|
||||
else
|
||||
prime = 2;
|
||||
|
||||
pix = pix(n);
|
||||
if(start){
|
||||
pix -= pix(prime) -1;
|
||||
}
|
||||
prime_list = mat[pix , 2];
|
||||
|
||||
k = 0;
|
||||
|
||||
do {
|
||||
prime_list[k ,0] = prime;
|
||||
prime_list[k++,1] = __CZ__prime_divisors(n,prime);
|
||||
prime = nextprime(prime);
|
||||
}while(prime <= n);
|
||||
|
||||
return prime_list;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
subtracts exponents of n_1! from exponents of n_2! with n_1<=n_2
|
||||
|
||||
Does not check for size or consecutiveness of the primes or a carry
|
||||
*/
|
||||
|
||||
define __CZ__subtract_factored_factorials(matrix_2n,matrix_n){
|
||||
local k ret len1,len2,tmp count p e;
|
||||
len1 = size(matrix_n)/2;
|
||||
len2 = size(matrix_2n)/2;
|
||||
if(len2<len1){
|
||||
|
||||
swap(len1,len2);
|
||||
tmp = matrix_n;
|
||||
matrix_n = matrix_2n;
|
||||
matrix_2n = tmp;
|
||||
}
|
||||
tmp = mat[len1,2];
|
||||
k = 0;
|
||||
|
||||
for(;k<len1;k++){
|
||||
p = matrix_2n[k,0];
|
||||
e = matrix_2n[k,1] - matrix_n[k,1];
|
||||
if(e!=0){
|
||||
tmp[count ,0] = p;
|
||||
tmp[count++,1] = e;
|
||||
}
|
||||
}
|
||||
ret = mat[count + (len2-len1),2];
|
||||
for(k=0;k<count;k++){
|
||||
ret[k,0] = tmp[k,0];
|
||||
ret[k,1] = tmp[k,1];
|
||||
}
|
||||
|
||||
free(tmp);
|
||||
for(k=len1;k<len2;k++){
|
||||
ret[count,0] = matrix_2n[k,0];
|
||||
ret[count++,1] = matrix_2n[k,1];
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
adds exponents of n_1! to exponents of n_2! with n_1<=n_2
|
||||
|
||||
Does not check for size or consecutiveness of the primes or a carry
|
||||
*/
|
||||
|
||||
define __CZ__add_factored_factorials(matrix_2n,matrix_n){
|
||||
local k ret len1,len2,tmp;
|
||||
len1 = size(matrix_n)/2;
|
||||
len2 = size(matrix_2n)/2;
|
||||
if(len2<len1){
|
||||
swap(len1,len2);
|
||||
tmp = matrix_n;
|
||||
matrix_n = matrix_2n;
|
||||
matrix_2n = tmp;
|
||||
}
|
||||
ret = mat[len2,2];
|
||||
k = 0;
|
||||
for(;k<len1;k++){
|
||||
ret[k,0] = matrix_2n[k,0];
|
||||
ret[k,1] = matrix_2n[k,1] + matrix_n[k,1];
|
||||
}
|
||||
for(;k<len2;k++){
|
||||
ret[k,0] = matrix_2n[k,0];
|
||||
ret[k,1] = matrix_2n[k,1];
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
Does not check if all exponents are positive
|
||||
|
||||
|
||||
timings
|
||||
this comb comb-this rel. k/n
|
||||
; benchmark_binomial(10,13)
|
||||
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^12 0.068004 0.124008 - 0.92307692307692307692
|
||||
; benchmark_binomial(10,15)
|
||||
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^12 0.228014 0.212014 + 0.8
|
||||
n=2^15 k=2^13 0.216013 0.664042 - 0.86666666666666666667
|
||||
n=2^15 k=2^14 0.240015 1.868117 - 0.93333333333333333333
|
||||
; benchmark_binomial(11,15)
|
||||
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^13 0.216013 0.656041 - 0.86666666666666666667
|
||||
n=2^15 k=2^14 0.244016 1.872117 - 0.93333333333333333333
|
||||
; benchmark_binomial(11,18)
|
||||
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^13 1.700106 1.140071 + 0.72222222222222222222
|
||||
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^16 2.172135 41.974624 - 0.88888888888888888889
|
||||
n=2^18 k=2^17 2.528158 121.523594 - 0.94444444444444444444
|
||||
; benchmark_binomial(15,25)
|
||||
n=2^25 k=2^15 303.790985 38.266392 + 0.6
|
||||
; benchmark_binomial(17,25)
|
||||
n=2^25 k=2^17 319.127944 529.025062 - 0.68
|
||||
*/
|
||||
|
||||
define benchmark_binomial(s,limit){
|
||||
local ret k A B T1 T2 start end N K;
|
||||
N = 2^(limit);
|
||||
for(k=s;k<limit;k++){
|
||||
K = 2^k;
|
||||
start=usertime();A=binomial(N,K);end=usertime();
|
||||
T1 = end-start;
|
||||
start=usertime();B=comb(N,K);end=usertime();
|
||||
T2 = end-start;
|
||||
print "n=2^"limit,"k=2^"k," ",T1," ",T2,T1<T2?"-":"+"," "k/limit;
|
||||
if(A!=B){
|
||||
print "false";
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
define __CZ__multiply_factored_factorial(matrix,stop){
|
||||
local prime result shift prime_list k k1 k2 expo_list pix count start;
|
||||
local hb flag;
|
||||
|
||||
result = 1;
|
||||
shift = 0;
|
||||
|
||||
|
||||
if(!ismat(matrix))
|
||||
return newerror("__CZ__multiply_factored_factorial(matrix): "
|
||||
"argument matrix not a matrix ");
|
||||
if(!matrix[0,0])
|
||||
return
|
||||
newerror("__CZ__multiply_factored_factorial(matrix): "
|
||||
"matrix[0,0] is null/0");
|
||||
|
||||
if(!isnull(stop))
|
||||
pix = stop;
|
||||
else
|
||||
pix = size(matrix)/2-1;
|
||||
|
||||
if(matrix[0,0] == 2 && matrix[0,1] > 0){
|
||||
shift = matrix[0,1];
|
||||
if(pix-1 == 0)
|
||||
return 2^matrix[0,1];
|
||||
}
|
||||
|
||||
/*
|
||||
This is a more general way to do the multiplication, so any optimization
|
||||
must have been done by the caller.
|
||||
*/
|
||||
k = 0;
|
||||
/*
|
||||
The size of the largest exponent in bits is calculated dynamically.
|
||||
Can be done more elegantly and saves one run over the whole array if done
|
||||
inside the main loop.
|
||||
*/
|
||||
hb =0;
|
||||
for(k=0;k<pix;k++){
|
||||
k1=highbit(matrix[k,1]);
|
||||
if(hb < k1)hb=k1;
|
||||
}
|
||||
|
||||
k2 = pix;
|
||||
start = 0;
|
||||
if(shift) start++;
|
||||
|
||||
for(k1=hb;k1>=0;k1--){
|
||||
/*
|
||||
the cut-off for T-C-4 ist still too low, using T-C-3 here
|
||||
TODO: check cutoffs
|
||||
*/
|
||||
result = toomcook3square(result);
|
||||
|
||||
for(k=start; k<=k2; k++) {
|
||||
if((matrix[k,1] & (1 << k1)) != 0) {
|
||||
result *= matrix[k,0];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
result <<= shift;
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
Compute binomial coeficients n!/(k!(n-k)!)
|
||||
|
||||
One of the rare cases where a formula once meant to ease manual computation
|
||||
is actually the (aymptotically) fastest way to do it (in July 2013) for
|
||||
the extreme case binomial(2N,N) but for a high price, the memory
|
||||
needed is pi(N)--theoretically.
|
||||
*/
|
||||
define binomial(n,k){
|
||||
local ret factored_n factored_k factored_nk denom num quot K prime_list prime;
|
||||
local pix diff;
|
||||
|
||||
if(!isint(n) || !isint(k))
|
||||
return newerror("binomial(n,k): input is not integer");
|
||||
if(n<0 || k<0)
|
||||
return newerror("binomial(n,k): input is not >= 0"); ;
|
||||
if(n<k ) return 0;
|
||||
if(n==k) return 1;
|
||||
if(k==0) return 1;
|
||||
if(k==1) return n;
|
||||
if(n-k==1) return n;
|
||||
/*
|
||||
cut-off depends on real size of n,k and size of n/k
|
||||
The current cut-off is to small for large n, e.g.:
|
||||
for 2n=2^23, k=n-n/2 the quotient is q=2n/k=0.25. Empirical tests showed
|
||||
that 2n=2^23 and k=2^16 with q=0.0078125 are still faster than the
|
||||
builtin function.
|
||||
|
||||
The symmetry (n,k) = (n,n-k) is of not much advantage here. One way
|
||||
might be to get closer to k=n/2 if k<n-k but only if the difference
|
||||
is small and n very large.
|
||||
*/
|
||||
if(n<2e4 && !isdefined("test8900")) return comb(n,k);
|
||||
if(n<2e4 && k< n-n/2 && !isdefined("test8900")) return comb(n,k);
|
||||
/*
|
||||
This should be done in parallel to save some memory, e.g. no temporary
|
||||
arrays are needed, all can be done inline.
|
||||
The theoretical memory needed is pi(k).
|
||||
Which is still a lot.
|
||||
*/
|
||||
|
||||
prime = 2;
|
||||
pix = pix(n);
|
||||
prime_list = mat[pix , 2];
|
||||
K = 0;
|
||||
do {
|
||||
prime_list[K ,0] = prime;
|
||||
diff = __CZ__prime_divisors(n,prime)-
|
||||
( __CZ__prime_divisors(n-k,prime)+__CZ__prime_divisors(k,prime));
|
||||
if(diff != 0)
|
||||
prime_list[K++,1] = diff;
|
||||
prime = nextprime(prime);
|
||||
}while(prime <= k);
|
||||
|
||||
do {
|
||||
prime_list[K ,0] = prime;
|
||||
diff = __CZ__prime_divisors(n,prime)-__CZ__prime_divisors(n-k,prime);
|
||||
if(diff != 0)
|
||||
prime_list[K++,1] = diff;
|
||||
prime = nextprime(prime);
|
||||
}while(prime <= n-k);
|
||||
|
||||
do {
|
||||
prime_list[K ,0] = prime;
|
||||
prime_list[K++,1] = __CZ__prime_divisors(n,prime);
|
||||
prime = nextprime(prime);
|
||||
}while(prime <= n);
|
||||
##print K,pix(k),pix(n-k),pix(n);
|
||||
##factored_k = __CZ__factor_factorial(k,1);
|
||||
##factored_nk = __CZ__factor_factorial(n-k,1);
|
||||
|
||||
##denom = __CZ__add_factored_factorials(factored_k,factored_nk);
|
||||
##free(factored_k,factored_nk);
|
||||
##num = __CZ__factor_factorial(n,1);
|
||||
##quot = __CZ__subtract_factored_factorials( num , denom );
|
||||
##free(num,denom);
|
||||
|
||||
ret = __CZ__multiply_factored_factorial(`prime_list,K-1);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
Compute large catalan numbers C(n) = binomial(2n,n)/(n+1) with
|
||||
cut-off: (n>5e4)
|
||||
Needs a lot of memory.
|
||||
*/
|
||||
define bigcatalan(n){
|
||||
if(!isint(n) )return newerror("bigcatalan(n): n is not integer");
|
||||
if( n<0) return newerror("bigcatalan(n): n < 0");
|
||||
if( n<5e4 && !isdefined("test8900") ) return catalan(n);
|
||||
return binomial(2*n,n)/(n+1);
|
||||
}
|
||||
|
||||
/*
|
||||
df(-111) = -1/3472059605858239446587523014902616804783337112829102414124928
|
||||
7753332469144201839599609375
|
||||
|
||||
df(-3+1i) = 0.12532538977287649201-0.0502372106177184607i
|
||||
df(2n + 1) = (2*n)!/(n!*2^n)
|
||||
*/
|
||||
define __CZ__double_factorial(n){
|
||||
local n1 n2 diff prime pix K prime_list k;
|
||||
prime = 3;
|
||||
pix = pix(2*n)+1;
|
||||
prime_list = mat[pix , 2];
|
||||
K = 0;
|
||||
do {
|
||||
prime_list[K ,0] = prime;
|
||||
diff = __CZ__prime_divisors(2*n,prime)-( __CZ__prime_divisors(n,prime));
|
||||
if(diff != 0)
|
||||
prime_list[K++,1] = diff;
|
||||
prime = nextprime(prime);
|
||||
}while(prime <= n);
|
||||
do {
|
||||
prime_list[K ,0] = prime;
|
||||
prime_list[K++,1] = __CZ__prime_divisors(2*n,prime);
|
||||
prime = nextprime(prime);
|
||||
}while(prime <= 2*n);
|
||||
return __CZ__multiply_factored_factorial(prime_list,K);
|
||||
/*
|
||||
n1=__CZ__factor_factorial(2*n,1);
|
||||
n1[0,1] = n1[0,1]-n;
|
||||
n2=__CZ__factor_factorial(n,1);
|
||||
diff=__CZ__subtract_factored_factorials( n1 , n2 );
|
||||
return __CZ__multiply_factored_factorial(diff);
|
||||
*/
|
||||
}
|
||||
|
||||
##1, 1, 3, 15, 105, 945, 10395, 135135, 2027025, 34459425, 654729075,
|
||||
##13749310575, 316234143225, 7905853580625, 213458046676875,
|
||||
##6190283353629375, 191898783962510625, 6332659870762850625,
|
||||
##221643095476699771875, 8200794532637891559375
|
||||
|
||||
## 1, 2, 8, 48, 384, 3840, 46080, 645120, 10321920, 185794560,
|
||||
##3715891200, 81749606400, 1961990553600, 51011754393600,
|
||||
##1428329123020800, 42849873690624000, 1371195958099968000,
|
||||
##46620662575398912000, 1678343852714360832000, 63777066403145711616000
|
||||
define doublefactorial(n){
|
||||
local n1 n2 diff eps ret;
|
||||
if(!isint(n) ){
|
||||
/*
|
||||
Probably one of the not-so-good ideas. See result of
|
||||
http://www.wolframalpha.com/input/?i=doublefactorial%28a%2Bbi%29
|
||||
*/
|
||||
eps=epsilon(epsilon()*1e-2);
|
||||
ret = 2^(n/2-1/4 * cos(pi()* n)+1/4) * pi()^(1/4 *
|
||||
cos(pi()* n)-1/4)* gamma(n/2+1);
|
||||
epsilon(eps);
|
||||
return ret;
|
||||
}
|
||||
if(n==2) return 2;
|
||||
if(n==3) return 3;
|
||||
switch(n){
|
||||
case -1:
|
||||
case 0 : return 1;break;
|
||||
case 2 : return 2;break;
|
||||
case 3 : return 3;break;
|
||||
case 4 : return 8;break;
|
||||
default: break;
|
||||
}
|
||||
if(isodd(n)){
|
||||
/*
|
||||
TODO: find reasonable cutoff
|
||||
df(2n + 1) = (2*n)!/(n!*2^n)
|
||||
*/
|
||||
if(n>0){
|
||||
n = (n+1)//2;
|
||||
return __CZ__double_factorial(n);
|
||||
}
|
||||
else{
|
||||
if(n == -3 ) return -1;
|
||||
n = ((-n)-1)/2;
|
||||
return ((-1)^-n)/__CZ__double_factorial(n);
|
||||
}
|
||||
}
|
||||
else{
|
||||
/*
|
||||
I'm undecided here. The formula for complex n is valid for the negative
|
||||
integers, too.
|
||||
*/
|
||||
n = n>>1;
|
||||
if(n>0){
|
||||
if(!isdefined("test8900"))
|
||||
return factorial(n)<<n;
|
||||
else
|
||||
return n!<<n;
|
||||
}
|
||||
else
|
||||
return newerror("doublefactorial(n): even(n) < 0");
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
Algorithm 3.17,
|
||||
Donald Kreher and Douglas Simpson,
|
||||
Combinatorial Algorithms,
|
||||
CRC Press, 1998, page 89.
|
||||
*/
|
||||
static __CZ__stirling1;
|
||||
static __CZ__stirling1_n = -1;
|
||||
static __CZ__stirling1_m = -1;
|
||||
|
||||
define stirling1(n,m){
|
||||
local i j k;
|
||||
if(n<0)return newerror("stirling1(n,m): n <= 0");
|
||||
if(m<0)return newerror("stirling1(n,m): m < 0");
|
||||
if(n<m) return 0;
|
||||
if(n==m) return 1;
|
||||
if(m==0 || n==0) return 0;
|
||||
/* We always use the list */
|
||||
/*
|
||||
if(m=1){
|
||||
if(iseven(n)) return -factorial(n-1);
|
||||
else return factorial(n-1);
|
||||
}
|
||||
if(m == n-1){
|
||||
if(iseven(n)) return -binomial(n,2);
|
||||
else return -binomial(n,2);
|
||||
}
|
||||
*/
|
||||
if(__CZ__stirling1_n >= n && __CZ__stirling1_m >= m){
|
||||
return __CZ__stirling1[n,m];
|
||||
}
|
||||
else{
|
||||
__CZ__stirling1 = mat[n+1,m+1];
|
||||
__CZ__stirling1[0,0] = 1;
|
||||
for(i=1;i<=n;i++)
|
||||
__CZ__stirling1[i,0] = 0;
|
||||
for(i=1;i<=n;i++){
|
||||
for(j=1;j<=m;j++){
|
||||
if(j<=i){
|
||||
__CZ__stirling1[i, j] = __CZ__stirling1[i - 1, j - 1] - (i - 1)\
|
||||
* __CZ__stirling1[i - 1, j];
|
||||
}
|
||||
else{
|
||||
__CZ__stirling1[i, j] = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
__CZ__stirling1_n = n;
|
||||
__CZ__stirling1_m = m;
|
||||
return __CZ__stirling1[n,m];
|
||||
}
|
||||
}
|
||||
|
||||
define stirling2(n,m){
|
||||
local k sum;
|
||||
if(n<0)return newerror("stirling2(n,m): n < 0");
|
||||
if(m<0)return newerror("stirling2(n,m): m < 0");
|
||||
if(n<m) return 0;
|
||||
if(n==0 && n!=m) return 0;
|
||||
if(n==m) return 1;
|
||||
if(m==0 )return 0;
|
||||
if(m==1) return 1;
|
||||
if(m==2) return 2^(n-1)-1;
|
||||
/*
|
||||
There are different methods to speed up alternating sums.
|
||||
This one doesn't.
|
||||
*/
|
||||
if(isdefined("test8900")){
|
||||
for(k=0;k<=m;k++){
|
||||
sum += (-1)^(m-k)*comb(m,k)*k^n;
|
||||
}
|
||||
return sum/(m!);
|
||||
}
|
||||
else{
|
||||
for(k=0;k<=m;k++){
|
||||
sum += (-1)^(m-k)*binomial(m,k)*k^n;
|
||||
}
|
||||
return sum/factorial(m);
|
||||
}
|
||||
}
|
||||
|
||||
static __CZ__stirling2;
|
||||
static __CZ__stirling2_n = -1;
|
||||
static __CZ__stirling2_m = -1;
|
||||
define stirling2caching(n,m){
|
||||
local nm i j ;
|
||||
if(n<0)return newerror("stirling2iter(n,m): n < 0");
|
||||
if(m<0)return newerror("stirling2iter(n,m): m < 0");
|
||||
/* no shortcuts here */
|
||||
|
||||
if(n<m) return 0;
|
||||
if(n==0 && n!=m) return 0;
|
||||
if(n==m) return 1;
|
||||
if(m==0 )return 0;
|
||||
if(m==1) return 1;
|
||||
if(m==2) return 2^(n-1)-1;
|
||||
|
||||
nm = n-m;
|
||||
if(__CZ__stirling2_n >= n && __CZ__stirling2_m >= m){
|
||||
return __CZ__stirling2[n,m];
|
||||
}
|
||||
else{
|
||||
__CZ__stirling2 = mat[n+1,m+1];
|
||||
__CZ__stirling2[0,0] = 1;
|
||||
for(i=1;i<=n;i++){
|
||||
__CZ__stirling2[i,0] = 0;
|
||||
for(j=1;j<=m;j++){
|
||||
if(j<=i){
|
||||
__CZ__stirling2[i, j] = __CZ__stirling2[i -1, j -1] + (j )\
|
||||
* __CZ__stirling2[i - 1, j];
|
||||
}
|
||||
else{
|
||||
__CZ__stirling2[i, j] = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
__CZ__stirling2_n = (n);
|
||||
__CZ__stirling2_m = (m);
|
||||
return __CZ__stirling2[n,m];
|
||||
}
|
||||
|
||||
define bell(n){
|
||||
local sum s2list k A;
|
||||
|
||||
if(!isint(n)) return newerror("bell(n): n is not integer");
|
||||
if(n < 0) return newerror("bell(n): n is not positive");
|
||||
/* place some more shortcuts here?*/
|
||||
if(n<=15){
|
||||
mat A[16] = {
|
||||
1, 1, 2, 5, 15, 52, 203, 877, 4140, 21147, 115975, 678570,
|
||||
4213597, 27644437, 190899322, 1382958545
|
||||
};
|
||||
return A[n];
|
||||
}
|
||||
/* Start by generating the list of stirling numbers of the second kind */
|
||||
s2list = stirling2caching(n,n//2);
|
||||
if(iserror(s2list))
|
||||
return newerror("bell(n): could not build stirling num. list");
|
||||
sum = 0;
|
||||
for(k=1;k<=n;k++){
|
||||
sum += stirling2caching(n,k);
|
||||
}
|
||||
return sum;
|
||||
}
|
||||
|
||||
define subfactorialrecursive(n){
|
||||
if(n==0) return 1;
|
||||
if(n==1) return 0;
|
||||
if(n==2) return 1;
|
||||
return n * subfactorialrecursive(n-1) + (-1)^n;
|
||||
}
|
||||
|
||||
/* This is, quite amusingely, faster than the very same algorithm in
|
||||
PARI/GP + GMP*/
|
||||
define subfactorialiterative(n){
|
||||
local k temp1 temp2 ret;
|
||||
if(n==0) return 1;
|
||||
if(n==1) return 0;
|
||||
if(n==2) return 1;
|
||||
temp1 = 0;
|
||||
ret = 1;
|
||||
for(k=3;k<=n;k++){
|
||||
temp2 = temp1;
|
||||
temp1 = ret;
|
||||
ret = (k-1) *(temp1 + temp2);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
define subfactorial(n){
|
||||
local epsilon eps ret lnfact;
|
||||
if(!isint(n))return newerror("subfactorial(n): n is not integer.");
|
||||
if(n < 0)return newerror("subfactorial(n): n < 0");
|
||||
return subfactorialiterative(n);
|
||||
}
|
||||
|
||||
define risingfactorial(x,n){
|
||||
local num denom quot ret;
|
||||
if(n == 1) return x;
|
||||
if(x==0) return newerror("risingfactorial(x,n): x == 0");
|
||||
if(!isint(x) || !isint(n)){
|
||||
return gamma(x+n)/gamma(x);
|
||||
}
|
||||
if(x<1)return newerror("risingfactorial(x,n): integer x and x < 1");
|
||||
if(x+n < 1)return newerror("risingfactorial(x,n): integer x+n and x+n < 1");
|
||||
if(x<9000&&n<9000){
|
||||
return (x+n-1)!/(x-1)!;
|
||||
}
|
||||
else{
|
||||
num = __CZ__factor_factorial(x+n-1,1);
|
||||
denom = __CZ__factor_factorial(x-1,1);
|
||||
quot = __CZ__subtract_factored_factorials( num , denom );
|
||||
free(num,denom);
|
||||
ret = __CZ__multiply_factored_factorial(quot);
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
|
||||
define fallingfactorial(x,n){
|
||||
local num denom quot ret;
|
||||
if(n == 0) return 1;
|
||||
|
||||
if(!isint(x) || !isint(n)){
|
||||
if(x == n) return gamma(x+1);
|
||||
return gamma(x+1)/gamma(x-n+1);
|
||||
}
|
||||
else{
|
||||
if(x<0 || x-n < 0)
|
||||
return newerror("fallingfactorial(x,n): integer x<0 or x-n < 0");
|
||||
if(x == n) return factorial(x);
|
||||
if(x<9000&&n<9000){
|
||||
return (x)!/(x-n)!;
|
||||
}
|
||||
else{
|
||||
num = __CZ__factor_factorial(x,1);
|
||||
denom = __CZ__factor_factorial(x-n,1);
|
||||
quot = __CZ__subtract_factored_factorials( num , denom );
|
||||
free(num,denom);
|
||||
ret = __CZ__multiply_factored_factorial(quot);
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* restore internal function from resource debugging
|
||||
* report important interface functions
|
||||
*/
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "binomial(n,k)";
|
||||
print "bigcatalan(n)";
|
||||
print "doublefactorial(n)";
|
||||
print "subfactorial(n)";
|
||||
print "stirling1(n,m)";
|
||||
print "stirling2(n,m)";
|
||||
print "stirling2caching(n,m)";
|
||||
print "bell(n)";
|
||||
print "subfactorial(n)";
|
||||
print "risingfactorial(x,n)";
|
||||
print "fallingfactorial(x,n)";
|
||||
}
|
107
cal/gvec.cal
Normal file
107
cal/gvec.cal
Normal file
@@ -0,0 +1,107 @@
|
||||
/*
|
||||
* gvec - vectorize any single-input function or trailing operator
|
||||
*
|
||||
* This version accepts arbitrary number of arguments, but of course
|
||||
* they must all be same length vectors.
|
||||
*
|
||||
* The gvec function is for use in either a two-arg function or a two-arg
|
||||
* operation "function" must be first; calc doesn't care how many more
|
||||
* arguments there actually are.
|
||||
*
|
||||
* @(#) $Revision: 30.3 $
|
||||
* @(#) $Id: gvec.cal,v 30.3 2011/05/23 23:00:55 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/gvec.cal,v $
|
||||
*
|
||||
* Under source code control: 2011/03/31 17:54:55
|
||||
* File existed as early as: 2010
|
||||
*
|
||||
* By Carl Witthoft carl at witthoft dot com
|
||||
*/
|
||||
|
||||
define gvec(function, vector)
|
||||
{
|
||||
local xlen,y,foo;
|
||||
local precx = 1e-50; /* default for now */
|
||||
local argc = param(0)-1;
|
||||
local old_tilde; /* previous config("tilde") */
|
||||
|
||||
/*
|
||||
* parse args
|
||||
*/
|
||||
local plist = mat[argc];
|
||||
if (config("resource_debug") & 8) {
|
||||
print "plist=", plist;
|
||||
print "argc=", argc;
|
||||
}
|
||||
for(local i = 0; i< argc; i++) {
|
||||
local ii = i + 2;
|
||||
if (config("resource_debug") & 8) {
|
||||
print "ii=", ii;
|
||||
print "param(" : ii : "}=", param(ii);
|
||||
print "size(param(" : ii : ")=", size(param(ii));
|
||||
}
|
||||
plist[i] = size(param(ii));
|
||||
}
|
||||
local slist=sort(plist);
|
||||
if (config("resource_debug") & 8) {
|
||||
print "plist=", plist;
|
||||
}
|
||||
local argm = argc-1;
|
||||
if (config("resource_debug") & 8) {
|
||||
print "argm=", argm;
|
||||
}
|
||||
if (slist[0] != slist[argm]) {
|
||||
quit "lengths don't match";
|
||||
}
|
||||
xlen = size(vector);
|
||||
y = mat[xlen];
|
||||
|
||||
/*
|
||||
* We can't do str(vector[j]) outside loop, eval() petulantly refuses to
|
||||
* look at local variables.
|
||||
*
|
||||
* Also we need to config("tilde",0) to turn off lead tilde
|
||||
* (so str(vector[j]) looks like a number.
|
||||
*/
|
||||
old_tilde = config("tilde",0);
|
||||
|
||||
/*
|
||||
* Ok, now check to see if "function" is a function. If not, it's an
|
||||
* operation and it's up to user to make it valid
|
||||
*/
|
||||
if (isdefined(function)) {
|
||||
|
||||
/* yep, it's a function, either builtin or user-defined */
|
||||
for (local j=0; j<xlen; j++) {
|
||||
|
||||
/* build the function call */
|
||||
foo = strcat(function, "(");
|
||||
for (local jj = 0; jj<argc; jj++) {
|
||||
foo = strcat(foo , str(param(jj+2)[j]), ",");
|
||||
}
|
||||
foo = strcat(foo, str(precx), ")");
|
||||
if (config("resource_debug") & 8) {
|
||||
print "foo=", foo;
|
||||
}
|
||||
y[j] = eval(foo);
|
||||
}
|
||||
|
||||
/*
|
||||
* it is an operator -- multi-argument operator makes no sense
|
||||
*/
|
||||
} else {
|
||||
if (argc > 1) {
|
||||
quit "Error: operator can accept only one argument";
|
||||
}
|
||||
for (j=0; j<xlen; j++) {
|
||||
foo = strcat(str(vector[j]), function);
|
||||
y[j] = eval(foo);
|
||||
}
|
||||
}
|
||||
|
||||
/* restore tilde mode if needed */
|
||||
config("tilde", old_tilde);
|
||||
|
||||
/* return result */
|
||||
return y;
|
||||
}
|
36
cal/hello.cal
Normal file
36
cal/hello.cal
Normal file
@@ -0,0 +1,36 @@
|
||||
/*
|
||||
* hello - print Hello World! forever
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: hello.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/hello.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/11/13 13:25:43
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* See: http://www.latech.edu/~acm/helloworld/calc.html
|
||||
*/
|
||||
|
||||
|
||||
while(1) print "Hello World!";
|
384
cal/hms.cal
Normal file
384
cal/hms.cal
Normal file
@@ -0,0 +1,384 @@
|
||||
/*
|
||||
* hms - calculate in hours, minutes, and seconds
|
||||
*
|
||||
* Copyright (C) 2010 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: hms.cal,v 30.2 2010/09/02 06:14:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/hms.cal,v $
|
||||
*
|
||||
* Under source code control: 2010/09/01 17:14:55
|
||||
* File existed as early as: 2010
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj hms {hour, min, sec};
|
||||
|
||||
define hms(hour, min, sec)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* default missing args to 0 */
|
||||
if (isnull(sec)) {
|
||||
sec = 0;
|
||||
}
|
||||
if (isnull(min)) {
|
||||
min = 0;
|
||||
}
|
||||
|
||||
/* load object */
|
||||
ans.hour = hour;
|
||||
ans.min = min;
|
||||
ans.sec = sec;
|
||||
|
||||
/* return properly formed object */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define hms_add(a, b)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* initalize value to 1st arg */
|
||||
if (istype(a, ans)) {
|
||||
/* 1st arg is hms object, load it */
|
||||
ans.hour = a.hour;
|
||||
ans.min = a.min;
|
||||
ans.sec = a.sec;
|
||||
} else {
|
||||
/* 1st arg is not hms, assume scalar hours */
|
||||
ans.hour = a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* add value of 2nd arg */
|
||||
if (istype(b, ans)) {
|
||||
/* 2nd arg is hms object, add it */
|
||||
ans.hour += b.hour;
|
||||
ans.min += b.min;
|
||||
ans.sec += b.sec;
|
||||
} else {
|
||||
/* 2nd arg is not hms, add scalar hours */
|
||||
ans.hour += b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define hms_neg(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* negate argument */
|
||||
if (istype(a, ans)) {
|
||||
/* 1st arg is hms object, load it */
|
||||
ans.hour = -a.hour;
|
||||
ans.min = -a.min;
|
||||
ans.sec = -a.sec;
|
||||
} else {
|
||||
/* 2nd arg is not hms, negate scalar hours */
|
||||
ans.hour = -a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define hms_sub(a, b)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* initalize value to 1st arg */
|
||||
if (istype(a, ans)) {
|
||||
/* 1st arg is hms object, load it */
|
||||
ans.hour = a.hour;
|
||||
ans.min = a.min;
|
||||
ans.sec = a.sec;
|
||||
} else {
|
||||
/* 1st arg is not hms, assume scalar hours */
|
||||
ans.hour = a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* subtract value of 2nd arg */
|
||||
if (istype(b, ans)) {
|
||||
/* 2nd arg is hms object, subtract it */
|
||||
ans.hour -= b.hour;
|
||||
ans.min -= b.min;
|
||||
ans.sec -= b.sec;
|
||||
} else {
|
||||
/* 2nd arg is not hms, subtract scalar hours */
|
||||
ans.hour -= b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define hms_mul(a, b)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* hms object multiplication */
|
||||
if (istype(a, ans) && istype(b, ans)) {
|
||||
ans.hour = hms_abs(a) * hms_abs(b);
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
|
||||
/* scalar multiplication */
|
||||
} else if (istype(a, ans)) {
|
||||
ans.hour = a.hour * b;
|
||||
ans.min = a.min * b;
|
||||
ans.sec = a.sec * b;
|
||||
} else {
|
||||
ans.hour = b.hour * a;
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define hms_print(a)
|
||||
{
|
||||
local obj hms ans; /* temp object for hms type testing */
|
||||
|
||||
/* firewall - arg must be a hms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "hms_print called with non hms object";
|
||||
}
|
||||
|
||||
/* print in hms form */
|
||||
print a.hour : ':' : a.min : ':' : a.sec :;
|
||||
}
|
||||
|
||||
|
||||
define hms_abs(a)
|
||||
{
|
||||
local obj hms ans; /* temp object for hms type testing */
|
||||
local hour; /* return scalar value */
|
||||
|
||||
/* firewall - just absolute value non hms objects */
|
||||
if (! istype(a, ans)) {
|
||||
return abs(a);
|
||||
}
|
||||
|
||||
/* compute hours */
|
||||
hour = a.hour + a.min / 60 + a.sec / 3600;
|
||||
|
||||
/* return hours */
|
||||
return hour;
|
||||
}
|
||||
|
||||
|
||||
define hms_norm(a)
|
||||
{
|
||||
local obj hms ans; /* temp object for hms type testing */
|
||||
local hour; /* hours */
|
||||
|
||||
/* firewall - arg must be a hms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "hms_norm called with non hms object";
|
||||
}
|
||||
|
||||
/* square hours (norm is the square of absolute value */
|
||||
hour = hms_abs(a);
|
||||
|
||||
/* return hours */
|
||||
return hour*hour;
|
||||
}
|
||||
|
||||
|
||||
define hms_test(a)
|
||||
{
|
||||
local obj hms ans; /* temp value */
|
||||
|
||||
/* firewall - arg must be a hms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "hms_test called with non hms object";
|
||||
}
|
||||
|
||||
/* return false of non-zero */
|
||||
ans = fixhms(a);
|
||||
if (ans.hour == 0 && ans.min == 0 && ans.sec == 0) {
|
||||
/* false */
|
||||
return 0;
|
||||
}
|
||||
/* true */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
define hms_int(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* firewall - arg must be a hms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "hms_int called with non hms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
ans = fixhms(a);
|
||||
|
||||
/* truncate to the nearest second */
|
||||
ans.sec = int(ans.sec);
|
||||
|
||||
/* return value to the nearest second */
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define hms_frac(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* firewall - arg must be a hms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "hms_frac called with non hms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
ans = fixhms(a);
|
||||
|
||||
/* remove all but fractional seconds */
|
||||
ans.hour = 0;
|
||||
ans.min = 0;
|
||||
ans.sec = frac(ans.sec);
|
||||
|
||||
/* return value to the second fraction */
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define hms_rel(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = hms_abs(a);
|
||||
abs_b = hms_abs(b);
|
||||
|
||||
/* return the comparison */
|
||||
return cmp(abs_a, abs_b);
|
||||
}
|
||||
|
||||
|
||||
define hms_cmp(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = hms_abs(a);
|
||||
abs_b = hms_abs(b);
|
||||
|
||||
/* return the equality comparison */
|
||||
return (abs_a == abs_b);
|
||||
}
|
||||
|
||||
|
||||
define hms_inc(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* increment a hms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
++ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* increment a scalar */
|
||||
return a+1;
|
||||
}
|
||||
|
||||
|
||||
define hms_dec(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* decrement a hms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
--ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* decrement a scalar */
|
||||
return a-1;
|
||||
}
|
||||
|
||||
|
||||
define fixhms(a)
|
||||
{
|
||||
local obj hms ans; /* temp value */
|
||||
|
||||
/* firewall */
|
||||
if (! istype(a, ans)) {
|
||||
quit "attempt to fix a non hms object";
|
||||
}
|
||||
|
||||
/* force minutes to be intergral */
|
||||
a.min += frac(a.hour) * 60;
|
||||
a.hour = int(a.hour);
|
||||
|
||||
/* force hours to be intergral */
|
||||
a.sec += frac(a.min) * 60;
|
||||
a.min = int(a.min);
|
||||
|
||||
/* carry excess seconds into minutes */
|
||||
a.min += a.sec // 60;
|
||||
a.sec %= 60;
|
||||
|
||||
/* carry excess minutes into hours */
|
||||
a.hour += a.min // 60;
|
||||
a.min %= 60;
|
||||
|
||||
/* round hours by day */
|
||||
a.hour %= 24;
|
||||
|
||||
/* return normalized result */
|
||||
return a;
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj hms {hour, min, sec} defined";
|
||||
}
|
88
cal/infinities.cal
Normal file
88
cal/infinities.cal
Normal file
@@ -0,0 +1,88 @@
|
||||
/*
|
||||
* infinities - handle infinities symbolically, a little helper file
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
define isinfinite(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "cinf", 4) == 0
|
||||
|| strncmp(x, "pinf", 4) == 0 || strncmp(x, "ninf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define iscinf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "cinf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define ispinf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "pinf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define isninf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "ninf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
define cinf()
|
||||
{
|
||||
return "cinf";
|
||||
}
|
||||
|
||||
define ninf()
|
||||
{
|
||||
return "ninf";
|
||||
}
|
||||
|
||||
define pinf()
|
||||
{
|
||||
return "pinf";
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "isinfinite(x)";
|
||||
print "iscinf(x)";
|
||||
print "ispinf(x)";
|
||||
print "isninf(x)";
|
||||
print "cinf()";
|
||||
print "ninf()";
|
||||
print "pinf()";
|
||||
}
|
222
cal/intfile.cal
Normal file
222
cal/intfile.cal
Normal file
@@ -0,0 +1,222 @@
|
||||
/*
|
||||
* intfile - integer to file and file to integer conversion
|
||||
*
|
||||
* Copyright (C) 2001 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: intfile.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/intfile.cal,v $
|
||||
*
|
||||
* Under source code control: 2001/03/31 08:13:11
|
||||
* File existed as early as: 2001
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* NOTE: Because leading HALF values are trimmed from integer, a file
|
||||
* 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)
|
||||
* will be changed when the subsequent integer is written back.
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* file2be - convert a file into an big endian integer
|
||||
*
|
||||
* given:
|
||||
* filename filename to read
|
||||
*
|
||||
* returns:
|
||||
* integer read from its contents on big endian order
|
||||
*/
|
||||
define file2be(filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* open the file for reading
|
||||
*/
|
||||
fd = fopen(filename, "rb");
|
||||
if (!isfile(fd)) quit "file2be: cannot open file for reading";
|
||||
|
||||
/*
|
||||
* read the contents of the file
|
||||
*
|
||||
* The first octets become the most significant bits of the integer.
|
||||
*/
|
||||
ret = 0;
|
||||
while (! isnull(c = fgetc(fd))) {
|
||||
ret <<= 8;
|
||||
ret += ord(c);
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup and return the integer
|
||||
*/
|
||||
fclose(fd);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* file2le - convert a file into an little endian integer
|
||||
*
|
||||
* given:
|
||||
* filename filename to read
|
||||
*
|
||||
* returns:
|
||||
* integer read from its contents on little endian order
|
||||
*/
|
||||
define file2le(filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local shft; /* bit shift for the c value */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* open the file for reading
|
||||
*/
|
||||
fd = fopen(filename, "rb");
|
||||
if (!isfile(fd)) quit "file2le: cannot open file for reading";
|
||||
|
||||
/*
|
||||
* read the contents of the file into a string
|
||||
*
|
||||
* The first octets become are the least significant bits of the integer.
|
||||
*/
|
||||
ret = 0;
|
||||
shft = 0;
|
||||
while (! isnull(c = fgetc(fd))) {
|
||||
ret |= (ord(c) << shft);
|
||||
shft += 8;
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup and return the integer
|
||||
*/
|
||||
fclose(fd);
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* be2file - convert a big endian integer into a file
|
||||
*
|
||||
* given:
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
*
|
||||
* returns:
|
||||
* The number of octets written to the file.
|
||||
*
|
||||
* NOTE: The absolute value of the integer is written to the file.
|
||||
*/
|
||||
define be2file(v, filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local octlen; /* length of v in octets */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(v)) {
|
||||
quit "be2file: 1st arg not an integer";
|
||||
}
|
||||
v = abs(v);
|
||||
|
||||
/*
|
||||
* open the file for writing
|
||||
*/
|
||||
fd = fopen(filename, "wb");
|
||||
if (!isfile(fd)) quit "be2file: cannot open file for writing";
|
||||
|
||||
/*
|
||||
* write the octets to the file
|
||||
*
|
||||
* The most significant bits of the integer become the first file octets.
|
||||
*/
|
||||
octlen = int((highbit(v)+8) / 8);
|
||||
for (i=octlen-1; i >= 0; --i) {
|
||||
fputc(fd, char(v >> (i*8)));
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup
|
||||
*/
|
||||
fclose(fd);
|
||||
return octlen;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* le2file - convert a little endian integer into a file
|
||||
*
|
||||
* given:
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
*
|
||||
* returns:
|
||||
* The number of octets written to the file.
|
||||
*
|
||||
* NOTE: The absolute value of the integer is written to the file.
|
||||
*/
|
||||
define le2file(v, filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local cnt; /* octets written */
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(v)) {
|
||||
quit "be2file: 1st arg not an integer";
|
||||
}
|
||||
v = abs(v);
|
||||
|
||||
/*
|
||||
* open the file for writing
|
||||
*/
|
||||
fd = fopen(filename, "wb");
|
||||
if (!isfile(fd)) quit "le2file: cannot open file for writing";
|
||||
|
||||
/*
|
||||
* Write the octets to the file.
|
||||
*
|
||||
* The least significant bits of the integer become the first file octets.
|
||||
*/
|
||||
cnt = 0;
|
||||
while (v > 0) {
|
||||
fputc(fd, char(v));
|
||||
v >>= 8;
|
||||
++cnt;
|
||||
}
|
||||
|
||||
/*
|
||||
* cleanup
|
||||
*/
|
||||
fclose(fd);
|
||||
return cnt;
|
||||
}
|
728
cal/intnum.cal
Normal file
728
cal/intnum.cal
Normal file
@@ -0,0 +1,728 @@
|
||||
/*
|
||||
* intnum - implementation of tanhsinh- and Gauss-Legendre quadrature
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
read -once infinities;
|
||||
|
||||
static __CZ__tanhsinh_x;
|
||||
static __CZ__tanhsinh_w;
|
||||
static __CZ__tanhsinh_order;
|
||||
static __CZ__tanhsinh_prec;
|
||||
|
||||
define quadtsdeletenodes()
|
||||
{
|
||||
free(__CZ__tanhsinh_x);
|
||||
free(__CZ__tanhsinh_w);
|
||||
free(__CZ__tanhsinh_order);
|
||||
free(__CZ__tanhsinh_prec);
|
||||
}
|
||||
|
||||
define quadtscomputenodes(order, expo, eps)
|
||||
{
|
||||
local t cht sht chp sum k PI places;
|
||||
local h t0 x w;
|
||||
if (__CZ__tanhsinh_order == order && __CZ__tanhsinh_prec == eps)
|
||||
return 1;
|
||||
__CZ__tanhsinh_order = order;
|
||||
__CZ__tanhsinh_prec = eps;
|
||||
__CZ__tanhsinh_x = list();
|
||||
__CZ__tanhsinh_w = list();
|
||||
/* The tanhsinh algorithm needs a slightly higher precision than G-L */
|
||||
eps = epsilon(eps * 1e-2);
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
PI = pi();
|
||||
sum = 0;
|
||||
t0 = 2 ^ (-expo);
|
||||
h = 2 * t0;
|
||||
/*
|
||||
* The author wanted to use the mpmath trick here which was
|
||||
* advertised---and reasonably so!---to be faster. Didn't work out
|
||||
* so well with calc.
|
||||
* PI4 = PI/4;
|
||||
* expt0 = bround(exp(t0),places);
|
||||
* a = bround( PI4 * expt0,places);
|
||||
* b = bround(PI4 / expt0,places);
|
||||
* udelta = bround(exp(h),places);
|
||||
* urdelta = bround(1/udelta,places);
|
||||
*/
|
||||
/* make use of x(-t) = -x(t), w(-t) = w(t) */
|
||||
for (k = 0; k < 20 * order + 1; k++) {
|
||||
/*
|
||||
* x = tanh(pi/2 * sinh(t))
|
||||
* w = pi/2 * cosh(t) / cosh(pi/2 * sinh(t))^2
|
||||
*/
|
||||
t = bround(t0 + k * h, places);
|
||||
|
||||
cht = bround(cosh(t), places);
|
||||
sht = bround(sinh(t), places);
|
||||
chp = bround(cosh(0.5 * PI * sht), places);
|
||||
x = bround(tanh(0.5 * PI * sht), places);
|
||||
w = bround((PI * h * cht) / (2 * chp ^ 2), places);
|
||||
/*
|
||||
* c = bround(exp(a-b),places);
|
||||
* d = bround(1/c,places);
|
||||
* co =bround( (c+d)/2,places);
|
||||
* si =bround( (c-d)/2,places);
|
||||
* x = bround(si / co,places);
|
||||
* w = bround((a+b) / co^2,places);
|
||||
*/
|
||||
if (abs(x - 1) <= eps)
|
||||
break;
|
||||
|
||||
append(__CZ__tanhsinh_x, x);
|
||||
append(__CZ__tanhsinh_w, w);
|
||||
/*
|
||||
* a *= udelta;
|
||||
* b *= urdelta;
|
||||
*/
|
||||
}
|
||||
|
||||
/* Normalize the weights to make them add up to 2 (two) */
|
||||
/*
|
||||
* for(k=0;k < size(__CZ__tanhsinh_w);k++)
|
||||
* sum = bround(sum + __CZ__tanhsinh_w[k],places);
|
||||
* sum *= 2;
|
||||
* for(k=0;k < size(__CZ__tanhsinh_w);k++)
|
||||
* __CZ__tanhsinh_w[k] = bround(2.0 * __CZ__tanhsinh_w[k] / sum,places);
|
||||
*/
|
||||
|
||||
epsilon(eps);
|
||||
return 1;
|
||||
}
|
||||
|
||||
define quadtscore(a, b, n)
|
||||
{
|
||||
local k c d order eps places sum ret x x1 x2 xm w w1 w2 m sizel;
|
||||
|
||||
eps = epsilon(epsilon() * 1e-2);
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2;
|
||||
if (!isnull(n)) {
|
||||
order = n;
|
||||
m = ilog(order / 3, 2) + 1;
|
||||
} else
|
||||
order = 3 * 2 ^ (m - 1);
|
||||
|
||||
quadtscomputenodes(order, m, epsilon());
|
||||
sizel = size(__CZ__tanhsinh_w);
|
||||
|
||||
if (isinfinite(a) || isinfinite(b)) {
|
||||
/*
|
||||
* x
|
||||
* t = ------------
|
||||
* 2
|
||||
* sqrt(1 - y )
|
||||
*/
|
||||
if (isninf(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(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places);
|
||||
xm = bround(x2 * (1 - x2 ^ 2) ^ (-1 / 2), places);
|
||||
w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)),
|
||||
places);
|
||||
w2 = bround(w1 * (((1 - x2 ^ 2) ^ (-1 / 2)) / (1 - x2 ^ 2)),
|
||||
places);
|
||||
sum += bround(w * f(x), 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;
|
||||
} else {
|
||||
/* Avoid rounding errors */
|
||||
if (a == -1 && b == 1) {
|
||||
c = 1;
|
||||
d = 0;
|
||||
} else {
|
||||
c = (b - a) / 2;
|
||||
d = (b + a) / 2;
|
||||
}
|
||||
sum = 0;
|
||||
for (k = 0; k < sizel; k++) {
|
||||
sum +=
|
||||
bround(__CZ__tanhsinh_w[k] * f(c * __CZ__tanhsinh_x[k] + d),
|
||||
places);
|
||||
sum +=
|
||||
bround(__CZ__tanhsinh_w[k] * f(c * -__CZ__tanhsinh_x[k] + d),
|
||||
places);
|
||||
}
|
||||
ret = c * sum;
|
||||
}
|
||||
epsilon(eps);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static __CZ__quadts_error;
|
||||
|
||||
define quadts(a, b, points)
|
||||
{
|
||||
local k sp results epsbits nsect interval length segment slope C ;
|
||||
local x1 x2 y1 y2 sum D1 D2 D3 D4;
|
||||
if (param(0) < 2)
|
||||
return newerror("quadts: not enough arguments");
|
||||
epsbits = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (param(0) < 3 || isnull(points)) {
|
||||
/* return as given */
|
||||
return quadtscore(a, b);
|
||||
} else {
|
||||
if ((isinfinite(a) || isinfinite(b))
|
||||
&& (!ismat(points) && !islist(points)))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadts: segments of infinite length ",
|
||||
"are not yet supported"));
|
||||
if (ismat(points) || islist(points)) {
|
||||
sp = size(points);
|
||||
if (sp == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quadts: variable 'points` must be a list or ",
|
||||
"1d-matrix of a length > 0"));
|
||||
/* check if all points are numbers */
|
||||
for (k = 0; k < sp; k++) {
|
||||
if (!isnum(points[k]))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadts: elements of 'points` must be",
|
||||
" numbers only"));
|
||||
}
|
||||
/* We have n-1 intervals and a and b, hence n-1 + 2 results */
|
||||
results = mat[sp + 1];
|
||||
if (a != points[0]) {
|
||||
results[0] = quadtscore(a, points[0]);
|
||||
} else {
|
||||
results[0] = 0;
|
||||
}
|
||||
if (sp == 1) {
|
||||
if (b != points[0]) {
|
||||
results[1] = quadtscore(points[0], b);
|
||||
} else {
|
||||
results[1] = 0;
|
||||
}
|
||||
} else {
|
||||
for (k = 1; k < sp; k++) {
|
||||
results[k] = quadtscore(points[k - 1], points[k]);
|
||||
}
|
||||
if (b != points[k - 1]) {
|
||||
results[k] = quadtscore(points[k - 1], b);
|
||||
} else {
|
||||
results[k] = 0;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (!isint(points) || points <= 0)
|
||||
return newerror(strcat("quadts: variable 'points` must be a ",
|
||||
"list or a positive integer"));
|
||||
/* Taking "points" as the number of equally spaced intervals */
|
||||
results = mat[points + 1];
|
||||
/* It is easy if a,b lie on the real line */
|
||||
if (isreal(a) && isreal(b)) {
|
||||
length = abs(a - b);
|
||||
segment = length / points;
|
||||
|
||||
for (k = 1; k <= points; k++) {
|
||||
results[k - 1] =
|
||||
quadtscore(a + (k - 1) * segment, a + k * segment);
|
||||
}
|
||||
} else {
|
||||
/* We have at least one complex limit but treat "points" still
|
||||
* as the number of equally spaced intervals on a straight line
|
||||
* connecting a and b. Computing the segments here is a bit
|
||||
* more complicated but not much, it should have been taught in
|
||||
* highschool.
|
||||
* Other contours by way of a list of points */
|
||||
slope = (im(b) - im(a)) / (re(b) - re(a));
|
||||
C = (im(a) + slope) * re(a);
|
||||
length = abs(re(a) - re(b));
|
||||
segment = length / points;
|
||||
|
||||
/* y = mx+C where m is the slope, x is the real part and y the
|
||||
* imaginary part */
|
||||
if(re(a)>re(b))swap(a,b);
|
||||
for (k = re(a); k <= (re(b)); k+=segment) {
|
||||
x1 = slope*(k) + C;
|
||||
results[k] = quadtscore(k + x1 * 1i);
|
||||
}
|
||||
} /* else of isreal */
|
||||
} /* else of ismat|islist */
|
||||
} /* else of isnull(points) */
|
||||
/* With a bit of undeserved luck we have a result by now. */
|
||||
sp = size(results);
|
||||
for (k = 0; k < sp; k++) {
|
||||
sum += results[k];
|
||||
}
|
||||
return sum;
|
||||
}
|
||||
|
||||
static __CZ__gl_x;
|
||||
static __CZ__gl_w;
|
||||
static __CZ__gl_order;
|
||||
static __CZ__gl_prec;
|
||||
|
||||
define quadglcomputenodes(N)
|
||||
{
|
||||
local places k l x w t1 t2 t3 t4 t5 r tmp;
|
||||
|
||||
if (__CZ__gl_order == N && __CZ__gl_prec == epsilon())
|
||||
return;
|
||||
|
||||
__CZ__gl_x = mat[N];
|
||||
__CZ__gl_w = mat[N];
|
||||
__CZ__gl_order = N;
|
||||
__CZ__gl_prec = epsilon();
|
||||
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
|
||||
/*
|
||||
* Compute roots and weights (doing it inline seems to be fastest)
|
||||
* Trick shamelessly stolen from D. Bailey et .al (program "arprec")
|
||||
*/
|
||||
for (k = 1; k <= N//2; k++) {
|
||||
r = bround(cos(pi() * (k - .25) / (N + .5)), places);
|
||||
while (1) {
|
||||
t1 = 1, t2 = 0;
|
||||
for (l = 1; l <= N; l++) {
|
||||
t3 = t2;
|
||||
t2 = t1;
|
||||
t1 = bround(((2 * l - 1) * r * t2 - (l - 1) * t3) / l, places);
|
||||
}
|
||||
t4 = bround(N * (r * t1 - t2) / ((r ^ 2) - 1), places);
|
||||
t5 = r;
|
||||
tmp = t1 / t4;
|
||||
r = r - tmp;
|
||||
if (abs(tmp) <= epsilon())
|
||||
break;
|
||||
}
|
||||
x = r;
|
||||
w = bround(2 / ((1 - r ^ 2) * t4 ^ 2), places);
|
||||
|
||||
__CZ__gl_x[k - 1] = x;
|
||||
__CZ__gl_w[k - 1] = w;
|
||||
__CZ__gl_x[N - k] = -__CZ__gl_x[k - 1];
|
||||
__CZ__gl_w[N - k] = __CZ__gl_w[k - 1];
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
define quadgldeletenodes()
|
||||
{
|
||||
free(__CZ__gl_x);
|
||||
free(__CZ__gl_w);
|
||||
free(__CZ__gl_order);
|
||||
free(__CZ__gl_prec);
|
||||
}
|
||||
|
||||
define quadglcore(a, b, n)
|
||||
{
|
||||
local k c d digs order eps places sum ret err x x1 w w1 m;
|
||||
local phalf x2 px1 spx1 u b1 a1 half;
|
||||
|
||||
eps = epsilon(epsilon() * 1e-2);
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (!isnull(n))
|
||||
order = n;
|
||||
else {
|
||||
m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2;
|
||||
order = 3 * 2 ^ (m - 1);
|
||||
}
|
||||
|
||||
|
||||
quadglcomputenodes(order, 1);
|
||||
|
||||
if (isinfinite(a) || isinfinite(b)) {
|
||||
if (isninf(a) && ispinf(b)) {
|
||||
for (k = 0; k < order; k++) {
|
||||
x1 = __CZ__gl_x[k];
|
||||
w1 = __CZ__gl_w[k];
|
||||
|
||||
x = bround(x1 * (1 - x1 ^ 2) ^ (-1 / 2), places);
|
||||
w = bround(w1 * (((1 - x1 ^ 2) ^ (-1 / 2)) / (1 - x1 ^ 2)),
|
||||
places);
|
||||
sum += bround(w * f(x), places);
|
||||
}
|
||||
} else if (isninf(a) && !iscinf(b)) {
|
||||
for (k = 0; k < order; k++) {
|
||||
x1 = __CZ__gl_x[k];
|
||||
w1 = __CZ__gl_w[k];
|
||||
|
||||
x = bround((b + 1) - (2 / (x1 + 1)), places);
|
||||
w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places);
|
||||
sum += bround(w * f(x), places);
|
||||
}
|
||||
} else if (!iscinf(a) && ispinf(b)) {
|
||||
for (k = 0; k < order; k++) {
|
||||
x1 = __CZ__gl_x[k];
|
||||
w1 = __CZ__gl_w[k];
|
||||
x = bround((a - 1) + (2 / (x1 + 1)), places);
|
||||
w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places);
|
||||
sum += bround(w * f(x), places);
|
||||
}
|
||||
} else if (isninf(a) || isninf(b)) {
|
||||
/*TODO: swap(a,b) and negate(w)? Lookup! */
|
||||
return newerror("quadglcore: reverse limits?");
|
||||
} else
|
||||
return
|
||||
newerror("quadglcore: complex infinity not yet implemented");
|
||||
ret = sum;
|
||||
} else {
|
||||
/* Avoid rounding errors */
|
||||
if (a == -1 && b == 1) {
|
||||
c = 1;
|
||||
d = 0;
|
||||
} else {
|
||||
c = (b - a) / 2;
|
||||
d = (b + a) / 2;
|
||||
}
|
||||
sum = 0;
|
||||
for (k = 0; k < order; k++) {
|
||||
sum += bround(__CZ__gl_w[k] * f(c * __CZ__gl_x[k] + d), places);
|
||||
}
|
||||
ret = c * sum;
|
||||
}
|
||||
epsilon(eps);
|
||||
return ret;
|
||||
}
|
||||
|
||||
define quadgl(a, b, points)
|
||||
{
|
||||
local k sp results epsbits nsect interval length segment slope C x1 y1 x2
|
||||
y2;
|
||||
local sum D1 D2 D3 D4;
|
||||
if (param(0) < 2)
|
||||
return newerror("quadgl: not enough arguments");
|
||||
epsbits = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (isnull(points)) {
|
||||
/* return as given */
|
||||
return quadglcore(a, b);
|
||||
} else {
|
||||
/* But if we could half the time needed to execute a single operation
|
||||
* we could do all of it in just twice that time. */
|
||||
if (isinfinite(a) || isinfinite(b)
|
||||
&& (!ismat(points) && !islist(points)))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadgl: multiple segments of infinite length ",
|
||||
"are not yet supported"));
|
||||
if (ismat(points) || islist(points)) {
|
||||
sp = size(points);
|
||||
if (sp == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quadgl: variable 'points` must be a list or ",
|
||||
"1d-matrix of a length > 0"));
|
||||
/* check if all points are numbers */
|
||||
for (k = 0; k < sp; k++) {
|
||||
if (!isnum(points[k]))
|
||||
return
|
||||
newerror(strcat
|
||||
("quadgl: elements of 'points` must be ",
|
||||
"numbers only"));
|
||||
}
|
||||
/* We have n-1 intervals and a and b, hence n-1 + 2 results */
|
||||
results = mat[sp + 1];
|
||||
if (a != points[0]) {
|
||||
results[0] = quadglcore(a, points[0]);
|
||||
} else {
|
||||
results[0] = 0;
|
||||
}
|
||||
if (sp == 1) {
|
||||
if (b != points[0]) {
|
||||
results[1] = quadglcore(points[0], b);
|
||||
} else {
|
||||
results[1] = 0;
|
||||
}
|
||||
} else {
|
||||
for (k = 1; k < sp; k++) {
|
||||
results[k] = quadglcore(points[k - 1], points[k]);
|
||||
}
|
||||
if (b != points[k - 1]) {
|
||||
results[k] = quadglcore(points[k - 1], b);
|
||||
} else {
|
||||
results[k] = 0;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if (!isint(points) || points <= 0)
|
||||
return newerror(strcat("quadgl: variable 'points` must be a ",
|
||||
"list or a positive integer"));
|
||||
/* Taking "points" as the number of equally spaced intervals */
|
||||
results = mat[points + 1];
|
||||
/* It is easy if a,b lie on the real line */
|
||||
if (isreal(a) && isreal(b)) {
|
||||
length = abs(a - b);
|
||||
segment = length / points;
|
||||
|
||||
for (k = 1; k <= points; k++) {
|
||||
results[k - 1] =
|
||||
quadglcore(a + (k - 1) * segment, a + k * segment);
|
||||
}
|
||||
} else {
|
||||
/* Other contours by way of a list of points */
|
||||
slope = (im(b) - im(a)) / (re(b) - re(a));
|
||||
C = (im(a) + slope) * re(a);
|
||||
length = abs(re(a) - re(b));
|
||||
segment = length / points;
|
||||
|
||||
/* y = mx+C where m is the slope, x is the real part and y the
|
||||
* imaginary part */
|
||||
if(re(a)>re(b))swap(a,b);
|
||||
for (k = re(a); k <= (re(b)); k+=segment) {
|
||||
x1 = slope*(k) + C;
|
||||
results[k] = quadglcore(k + x1 * 1i);
|
||||
}
|
||||
} /* else of isreal */
|
||||
} /* else of ismat|islist */
|
||||
} /* else of isnull(points) */
|
||||
/* With a bit of undeserved luck we have a result by now. */
|
||||
sp = size(results);
|
||||
for (k = 0; k < sp; k++) {
|
||||
sum += results[k];
|
||||
}
|
||||
return sum;
|
||||
}
|
||||
|
||||
define quad(a, b, points = -1, method = "tanhsinh")
|
||||
{
|
||||
if (isnull(a) || isnull(b) || param(0) < 2)
|
||||
return newerror("quad: both limits must be given");
|
||||
if (isstr(a)) {
|
||||
if (strncmp(a, "cinf", 1) == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quad: complex infinity not yet supported, use",
|
||||
" 'pinf' or 'ninf' respectively"));
|
||||
}
|
||||
if (isstr(b)) {
|
||||
if (strncmp(b, "cinf", 1) == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quad: complex infinity not yet supported, use",
|
||||
" 'pinf' or 'ninf' respectively"));
|
||||
}
|
||||
|
||||
if (param(0) == 3) {
|
||||
if (isstr(points))
|
||||
method = points;
|
||||
}
|
||||
|
||||
if (strncmp(method, "tanhsinh", 1) == 0) {
|
||||
if (!isstr(points)) {
|
||||
if (points == -1) {
|
||||
return quadts(a, b);
|
||||
} else {
|
||||
return quadts(a, b, points);
|
||||
}
|
||||
} else {
|
||||
return quadts(a, b);
|
||||
}
|
||||
}
|
||||
|
||||
if (strncmp(method, "gausslegendre", 1) == 0) {
|
||||
if (!isstr(points)) {
|
||||
if (points == -1) {
|
||||
return quadgl(a, b);
|
||||
} else {
|
||||
return quadgl(a, b, points);
|
||||
}
|
||||
} else {
|
||||
return quadgl(a, b);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
define makerange(start, end, steps)
|
||||
{
|
||||
local ret k l step C length slope x1 x2 y1 y2;
|
||||
local segment;
|
||||
steps = int (steps);
|
||||
if (steps < 1) {
|
||||
return newerror("makerange: number of steps must be > 0");
|
||||
}
|
||||
if (!isnum(start) || !isnum(end)) {
|
||||
return newerror("makerange: only numbers are supported yet");
|
||||
}
|
||||
if (isreal(start) && isreal(end)) {
|
||||
step = (end - start) / (steps);
|
||||
print step;
|
||||
ret = mat[steps + 1];
|
||||
for (k = 0; k <= steps; k++) {
|
||||
ret[k] = k * step + start;
|
||||
}
|
||||
} else {
|
||||
ret = mat[steps + 1];
|
||||
if (re(start) > re(end)) {
|
||||
swap(start, end);
|
||||
}
|
||||
|
||||
slope = (im(end) - im(start)) / (re(end) - re(start));
|
||||
C = im(start) - slope * re(start);
|
||||
length = abs(re(start) - re(end));
|
||||
segment = length / (steps);
|
||||
|
||||
for (k = re(start), l = 0; k <= (re(end)); k += segment, l++) {
|
||||
x1 = slope * (k) + C;
|
||||
ret[l] = k + x1 * 1i;
|
||||
}
|
||||
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
define makecircle(radius, center, points)
|
||||
{
|
||||
local ret k a b twopi centerx centery;
|
||||
if (!isint(points) || points < 2) {
|
||||
return
|
||||
newerror("makecircle: number of points is not a positive integer");
|
||||
}
|
||||
if (!isnum(center)) {
|
||||
return newerror("makecircle: center does not lie on the complex plane");
|
||||
}
|
||||
if (!isreal(radius) || radius <= 0) {
|
||||
return newerror("makecircle: radius is not a real > 0");
|
||||
}
|
||||
ret = mat[points];
|
||||
twopi = 2 * pi();
|
||||
centerx = re(center);
|
||||
centery = im(center);
|
||||
for (k = 0; k < points; k++) {
|
||||
a = centerx + radius * cos(twopi * k / points);
|
||||
b = centery + radius * sin(twopi * k / points);
|
||||
ret[k] = a + b * 1i;
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
define makeellipse(angle, a, b, center, points)
|
||||
{
|
||||
local ret k x y twopi centerx centery;
|
||||
if (!isint(points) || points < 2) {
|
||||
return
|
||||
newerror("makeellipse: number of points is not a positive integer");
|
||||
}
|
||||
if (!isnum(center)) {
|
||||
return
|
||||
newerror("makeellipse: center does not lie on the complex plane");
|
||||
}
|
||||
if (!isreal(a) || a <= 0) {
|
||||
return newerror("makecircle: a is not a real > 0");
|
||||
}
|
||||
if (!isreal(b) || b <= 0) {
|
||||
return newerror("makecircle: b is not a real > 0");
|
||||
}
|
||||
if (!isreal(angle)) {
|
||||
return newerror("makecircle: angle is not a real");
|
||||
}
|
||||
ret = mat[points];
|
||||
twopi = 2 * pi();
|
||||
centerx = re(center);
|
||||
centery = im(center);
|
||||
for (k = 0; k < points; k++) {
|
||||
x = centerx + a * cos(twopi * k / points) * cos(angle)
|
||||
- b * sin(twopi * k / points) * sin(angle);
|
||||
y = centerx + a * cos(twopi * k / points) * sin(angle)
|
||||
+ b * sin(twopi * k / points) * cos(angle);
|
||||
ret[k] = x + y * 1i;
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
define makepoints()
|
||||
{
|
||||
local ret k;
|
||||
ret = mat[param(0)];
|
||||
for (k = 0; k < param(0); k++) {
|
||||
if (!isnum(param(k + 1))) {
|
||||
return
|
||||
newerror(strcat
|
||||
("makepoints: parameter number \"", str(k + 1),
|
||||
"\" is not a number"));
|
||||
}
|
||||
ret[k] = param(k + 1);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "quadtsdeletenodes()";
|
||||
print "quadtscomputenodes(order, expo, eps)";
|
||||
print "quadtscore(a,b,n)";
|
||||
print "quadts(a,b,points)";
|
||||
print "quadglcomputenodes(N)";
|
||||
print "quadgldeletenodes()";
|
||||
print "quadglcore(a,b,n)";
|
||||
print "quadgl(a,b,points)";
|
||||
print "quad(a,b,points=-1,method=\"tanhsinh\")";
|
||||
print "makerange(start, end, steps)";
|
||||
print "makecircle(radius, center, points)";
|
||||
print "makeellipse(angle, a, b, center, points)";
|
||||
print "makepoints(a1,[...])";
|
||||
}
|
288
cal/lambertw.cal
Normal file
288
cal/lambertw.cal
Normal file
@@ -0,0 +1,288 @@
|
||||
/*
|
||||
* lambertw - Lambert's W-function
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: lambertw.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lambertw.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
/*
|
||||
|
||||
R. M. Corless and G. H. Gonnet and D. E. G. Hare and D. J. Jeffrey and
|
||||
D. E. Knuth, "On the Lambert W Function", Advances n Computational
|
||||
Mathematics, 329--359, (1996)
|
||||
http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.112.6117
|
||||
|
||||
D. J. Jeffrey, D. E. G. Hare, R. M. Corless, "Unwinding the branches of the
|
||||
Lambert W function", The Mathematical Scientist, 21, pp 1-7, (1996)
|
||||
http://www.apmaths.uwo.ca/~djeffrey/Offprints/wbranch.pdf
|
||||
|
||||
Darko Verebic, "Having Fun with Lambert W(x) Function"
|
||||
arXiv:1003.1628v1, March 2010, http://arxiv.org/abs/1003.1628
|
||||
|
||||
Winitzki, S. "Uniform Approximations for Transcendental Functions",
|
||||
In Part 1 of Computational Science and its Applications - ICCSA 2003,
|
||||
Lecture Notes in Computer Science, Vol. 2667, Springer-Verlag,
|
||||
Berlin, 2003, 780-789. DOI 10.1007/3-540-44839-X_82
|
||||
A copy may be found by Google.
|
||||
|
||||
|
||||
*/
|
||||
static true = 1;
|
||||
static false = 0;
|
||||
|
||||
/* Branch 0, Winitzki (2003) , the well known Taylor series*/
|
||||
define __CZ__lambertw_0(z,eps){
|
||||
local a=2.344e0, b=0.8842e0, c=0.9294e0, d=0.5106e0, e=-1.213e0;
|
||||
local y=sqrt(2*exp(1)*z+2);
|
||||
return (2*ln(1+b*y)-ln(1+c*ln(1+d*y))+e)/(1+1/(2*ln(1+b*y)+2*a));
|
||||
}
|
||||
/* branch -1 */
|
||||
define __CZ__lambertw_m1(z,eps){
|
||||
local wn k;
|
||||
/* Cut-off found in Maxima */
|
||||
if(z < 0.3) return __CZ__lambertw_app(z,eps);
|
||||
wn = z;
|
||||
/* Verebic (2010) eqs. 16-18*/
|
||||
for(k=0;k<10;k++){
|
||||
wn = ln(-z)-ln(-wn);
|
||||
}
|
||||
return wn;
|
||||
}
|
||||
|
||||
/*
|
||||
generic approximation
|
||||
|
||||
series for 1+W((z-2)/(2 e))
|
||||
|
||||
Corless et al (1996) (4.22)
|
||||
Verebic (2010) eqs. 35-37; more coefficients given at the end of sect. 3.1
|
||||
or online
|
||||
http://www.wolframalpha.com/input/?
|
||||
i=taylor+%28+1%2Bproductlog%28+%28z-2%29%2F%282*e%29+%29+%29
|
||||
or by using the function lambertw_series_print() after running
|
||||
lambertw_series(z,eps,branch,terms) at least once with the wanted number of
|
||||
terms and z = 1 (which might throw an error because the series will not
|
||||
converge in anybodies lifetime for something that far from the branchpoint).
|
||||
|
||||
|
||||
*/
|
||||
define __CZ__lambertw_app(z,eps){
|
||||
local b0=-1, b1=1, b2=-1/3, b3=11/72;
|
||||
local y=sqrt(2*exp(1)*z+2);
|
||||
return b0 + ( y * (b1 + (y * (b2 + (b3 * y)))));
|
||||
}
|
||||
|
||||
static __CZ__Ws_a;
|
||||
static __CZ__Ws_c;
|
||||
static __CZ__Ws_len=0;
|
||||
|
||||
define lambertw_series_print(){
|
||||
local k;
|
||||
for(k=0;k<__CZ__Ws_len;k++){
|
||||
print num(__CZ__Ws_c[k]):"/":den(__CZ__Ws_c[k]):"*p^":k;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
The series is fast but only if _very_ close to the branchpoint
|
||||
The exact branch must be given explicitly, e.g.:
|
||||
|
||||
; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,0)
|
||||
-0.14758879113205794065490184399030194122136720202792-
|
||||
0.00000000000000000000000000000000000000000000000000i
|
||||
; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,1)
|
||||
0.00000000000000000000000000000000000000000000000000-
|
||||
0.00000000000000000000000000000000000000000000000000i
|
||||
*/
|
||||
define lambertw_series(z,eps,branch,terms){
|
||||
local k l limit tmp sum A C P PP epslocal;
|
||||
if(!isnull(terms))
|
||||
limit = terms;
|
||||
else
|
||||
limit = 100;
|
||||
|
||||
if(isnull(eps))
|
||||
eps = epsilon(epsilon()*1e-10);
|
||||
epslocal = epsilon(eps);
|
||||
|
||||
P = sqrt(2*(exp(1)*z+1));
|
||||
if(branch != 0) P = -P;
|
||||
tmp=0;sum=0;PP=P;
|
||||
|
||||
__CZ__Ws_a = mat[limit+1];
|
||||
__CZ__Ws_c = mat[limit+1];
|
||||
__CZ__Ws_len = limit;
|
||||
/*
|
||||
c0 = -1; c1 = 1
|
||||
a0 = 2; a1 =-1
|
||||
*/
|
||||
__CZ__Ws_c[0] = -1; __CZ__Ws_c[1] = 1;
|
||||
__CZ__Ws_a[0] = 2; __CZ__Ws_a[1] = -1;
|
||||
sum += __CZ__Ws_c[0];
|
||||
sum += __CZ__Ws_c[1] * P;
|
||||
PP *= P;
|
||||
for(k=2;k<limit;k++){
|
||||
for(l=2;l<k;l++){
|
||||
__CZ__Ws_a[k] += __CZ__Ws_c[l]*__CZ__Ws_c[k+1-l];
|
||||
}
|
||||
|
||||
__CZ__Ws_c[k] = (k-1) * ( __CZ__Ws_c[k-2]/2
|
||||
+__CZ__Ws_a[k-2]/4)/
|
||||
(k+1)-__CZ__Ws_a[k]/2-__CZ__Ws_c[k-1]/(k+1);
|
||||
tmp = __CZ__Ws_c[k] * PP;
|
||||
sum += tmp;
|
||||
if(abs(tmp) <= eps){
|
||||
epsilon(epslocal);
|
||||
return sum;
|
||||
}
|
||||
PP *= P;
|
||||
}
|
||||
epsilon(epslocal);
|
||||
return
|
||||
newerror(strcat("lambertw_series: does not converge in ",
|
||||
str(limit)," terms" ));
|
||||
}
|
||||
|
||||
/* */
|
||||
define lambertw(z,branch){
|
||||
local eps epslarge ret branchpoint bparea w we ew w1e wn k places m1e;
|
||||
local closeness;
|
||||
|
||||
eps = epsilon();
|
||||
if(branch == 0){
|
||||
if(!im(z)){
|
||||
if(abs(z) <= eps) return 0;
|
||||
if(abs(z-exp(1)) <= eps) return 1;
|
||||
if(abs(z - (-ln(2)/2)) <= eps ) return -ln(2);
|
||||
if(abs(z - (-pi()/2)) <= eps ) return 1i*pi()/2;
|
||||
}
|
||||
}
|
||||
|
||||
branchpoint = -exp(-1);
|
||||
bparea = .2;
|
||||
if(branch == 0){
|
||||
if(!im(z) && abs(z-branchpoint) == 0) return -1;
|
||||
ret = __CZ__lambertw_0(z,eps);
|
||||
/* Yeah, C&P, I know, sorry */
|
||||
##ret = ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
|
||||
}
|
||||
else if(branch == 1){
|
||||
if(im(z)<0 && abs(z-branchpoint) <= bparea)
|
||||
ret = __CZ__lambertw_app(z,eps);
|
||||
/* Does calc have a goto? Oh, it does! */
|
||||
ret =ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
|
||||
}
|
||||
else if(branch == -1){##print "-1";
|
||||
if(!im(z) && abs(z-branchpoint) == 0) return -1;
|
||||
if(!im(z) && z>branchpoint && z < 0){##print "0";
|
||||
ret = __CZ__lambertw_m1(z,eps);}
|
||||
if(im(z)>=0 && abs(z-branchpoint) <= bparea){##print "1";
|
||||
ret = __CZ__lambertw_app(z,eps);}
|
||||
ret =ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
|
||||
}
|
||||
else
|
||||
ret = ln(z) + 2*pi()*1i*branch - ln(ln(z)+2*pi()*1i*branch);
|
||||
|
||||
/*
|
||||
Such a high precision is only needed _very_ close to the branchpoint
|
||||
and might even be insufficient if z has not been computed with
|
||||
sufficient precision itself (M below was calculated by Mathematica and also
|
||||
with the series above with epsilon(1e-200)):
|
||||
; epsilon(1e-50)
|
||||
0.00000000000000000001
|
||||
; display(50)
|
||||
20
|
||||
; M=-0.9999999999999999999999997668356018402875796636464119050387
|
||||
; lambertw(-exp(-1)+1e-50,0)-M
|
||||
-0.00000000000000000000000002678416515423276355643684
|
||||
; epsilon(1e-60)
|
||||
0.0000000000000000000000000000000000000000000000000
|
||||
; A=-exp(-1)+1e-50
|
||||
; epsilon(1e-50)
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw(A,0)-M
|
||||
-0.00000000000000000000000000000000000231185460220585
|
||||
; lambertw_series(A,epsilon(),0)-M
|
||||
-0.00000000000000000000000000000000000132145133161626
|
||||
; epsilon(1e-100)
|
||||
0.00000000000000000000000000000000000000000000000001
|
||||
; A=-exp(-1)+1e-50
|
||||
; epsilon(1e-65)
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw_series(A,epsilon(),0)-M
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
|
||||
-0.00000000000000000000000000000000000000002959444084
|
||||
; epsilon(1e-74)
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
|
||||
-0.00000000000000000000000000000000000000000000000006
|
||||
*/
|
||||
closeness = abs(z-branchpoint);
|
||||
if( closeness< 1){
|
||||
if(closeness != 0)
|
||||
eps = epsilon(epsilon()*( closeness));
|
||||
else
|
||||
eps = epsilon(epsilon()^2);
|
||||
}
|
||||
else
|
||||
eps = epsilon(epsilon()*1e-2);
|
||||
|
||||
|
||||
epslarge =epsilon();
|
||||
|
||||
places = highbit(1 + int(1/epslarge)) + 1;
|
||||
w = ret;
|
||||
for(k=0;k<100;k++){
|
||||
ew = exp(w);
|
||||
we = w*ew;
|
||||
if(abs(we-z)<= 4*epslarge*abs(z))break;
|
||||
w1e = (1+w)*ew;
|
||||
wn = bround(w- ((we - z) / ( w1e - ( (w+2)*(we-z) )/(2*w+2) ) ),places++) ;
|
||||
if( abs(wn - w) <= epslarge*abs(wn)) break;
|
||||
else w = wn;
|
||||
}
|
||||
|
||||
if(k==100){
|
||||
epsilon(eps);
|
||||
return newerror("lambertw: Halley iteration does not converge");
|
||||
}
|
||||
/* The Maxima coders added a check if the iteration converged to the correct
|
||||
branch. This coder deems it superfluous. */
|
||||
|
||||
epsilon(eps);
|
||||
return wn;
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "lambertw(z,branch)";
|
||||
print "lambertw_series(z,eps,branch,terms)";
|
||||
print "lambertw_series_print()";
|
||||
}
|
56
cal/linear.cal
Normal file
56
cal/linear.cal
Normal file
@@ -0,0 +1,56 @@
|
||||
/*
|
||||
* linear - perform a simple two point 2D linear interpolation
|
||||
*
|
||||
* Copyright (C) 2005-2007 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: linear.cal,v 30.2 2007/03/17 05:57:42 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/linear.cal,v $
|
||||
*
|
||||
* Under source code control: 2005/12/12 06:41:50
|
||||
* File existed as early as: 2005
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* linear - perform a simple two point 2D linear interpolation
|
||||
*
|
||||
* given:
|
||||
* x0, y0 first known point on the line
|
||||
* x1, y1 second knonw point on the line
|
||||
* x a given point to interpolate on
|
||||
*
|
||||
* returns:
|
||||
* 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.
|
||||
*/
|
||||
define linear(x0, y0, x1, y1, x)
|
||||
{
|
||||
/* firewall */
|
||||
if (!isnum(x0) || ! isnum(y0) || !isnum(x1) || ! isnum(y1) || !isnum(x)) {
|
||||
quit "non-numeric argument passed to linear";
|
||||
}
|
||||
if (x0 == x1) {
|
||||
quit "linear given a line with an infinite slope";
|
||||
}
|
||||
|
||||
/* return y = y0 + (delta_Y/delta_X) * (x - x0) */
|
||||
return y0 + (((y1-y0)/(x1-x0)) * (x - x0));
|
||||
}
|
112
cal/lnseries.cal
Normal file
112
cal/lnseries.cal
Normal file
@@ -0,0 +1,112 @@
|
||||
/*
|
||||
* lnseries - special functions (e.g.: gamma, zeta, psi)
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: lnseries.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lnseries.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* hide internal function from resource debugging
|
||||
*/
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
static __CZ__int_logs;
|
||||
static __CZ__int_logs_limit;
|
||||
static __CZ__int_logs_prec;
|
||||
|
||||
|
||||
define deletelnseries(){
|
||||
free(__CZ__int_logs,__CZ__int_logs_limit,__CZ__int_logs_prec);
|
||||
}
|
||||
|
||||
define lnfromseries(n){
|
||||
if( isnull(__CZ__int_logs)
|
||||
|| __CZ__int_logs_limit < n
|
||||
|| __CZ__int_logs_prec < log(1/epsilon())){
|
||||
|
||||
lnseries(n+1);
|
||||
}
|
||||
return __CZ__int_logs[n,0];
|
||||
}
|
||||
|
||||
define lnseries(limit){
|
||||
local k j eps ;
|
||||
if( isnull(__CZ__int_logs)
|
||||
|| __CZ__int_logs_limit < limit
|
||||
|| __CZ__int_logs_prec < log(1/epsilon())){
|
||||
__CZ__int_logs = mat[limit+1,2];
|
||||
__CZ__int_logs_limit = limit;
|
||||
__CZ__int_logs_prec = log(1/epsilon());
|
||||
|
||||
/* probably still too much */
|
||||
eps = epsilon(epsilon()*10^(-(5+log(limit))));
|
||||
k =2;
|
||||
while(1){
|
||||
/* the prime itself, compute logarithm */
|
||||
__CZ__int_logs[k,0] = ln(k);
|
||||
__CZ__int_logs[k,1] = k;
|
||||
|
||||
for(j = 2*k;j<=limit;j+=k){
|
||||
/* multiples of prime k, add logarithm of k computed earlier */
|
||||
__CZ__int_logs[j,0] += __CZ__int_logs[k,0];
|
||||
/* First hit, set counter to number */
|
||||
if(__CZ__int_logs[j,1] ==0)
|
||||
__CZ__int_logs[j,1]=j;
|
||||
/* reduce counter by prime added */
|
||||
__CZ__int_logs[j,1] //= __CZ__int_logs[k,1];
|
||||
}
|
||||
|
||||
k++;
|
||||
if(k>=limit) break;
|
||||
/* Erastothenes-sieve: look for next prime. */
|
||||
while(__CZ__int_logs[k,0]!=0){
|
||||
k++;
|
||||
if(k>=limit) break;
|
||||
}
|
||||
}
|
||||
/* Second run to include the last factor */
|
||||
for(k=1;k<=limit;k++){
|
||||
if(__CZ__int_logs[k,1] != k){
|
||||
__CZ__int_logs[k,0] +=__CZ__int_logs[ __CZ__int_logs[k,1],0];
|
||||
__CZ__int_logs[k,1] = 0;
|
||||
}
|
||||
}
|
||||
|
||||
epsilon(eps);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* restore internal function from resource debugging
|
||||
*/
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "lnseries(limit)";
|
||||
print "lnfromseries(n)";
|
||||
print "deletelnseries()";
|
||||
}
|
@@ -1,32 +1,44 @@
|
||||
/*
|
||||
* Copyright (c) 1995 Landon Curt Noll
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
*/
|
||||
/*
|
||||
* lucas - perform a Lucas primality test on h*2^n-1
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: lucas.cal,v 30.2 2013/09/27 08:58:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/05/03 16:49:51
|
||||
* File existed as early as: 1990
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* NOTE: This is a standard calc resource file. For information on calc see:
|
||||
*
|
||||
* http://www.isthe.com/chongo/tech/comp/calc/index.html
|
||||
*
|
||||
* To obtain your own copy of calc, see:
|
||||
*
|
||||
* http://www.isthe.com/chongo/tech/comp/calc/calc-download.html
|
||||
*/
|
||||
|
||||
/*
|
||||
* HISTORICAL NOTE:
|
||||
*
|
||||
* On 6 August 1989 at 00:53 PDT, the 'Amdahl 6', a team consisting of
|
||||
@@ -50,12 +62,19 @@
|
||||
*
|
||||
* At the time of discovery, this was the largest known twin prime pair.
|
||||
*
|
||||
* See:
|
||||
*
|
||||
* http://www.isthe.com/chongo/tech/math/prime/amdahl6.html
|
||||
*
|
||||
* for more information on the Amdahl 6 group.
|
||||
*
|
||||
* NOTE: Both largest known and largest known twin prime records have been
|
||||
* broken. Rather than update this file each time, I'll just
|
||||
* congratulate the finders and encourage others to try for
|
||||
* larger finds. Records were made to be broken afterall!
|
||||
*
|
||||
* ON GAINING A WORLD RECORD:
|
||||
*/
|
||||
|
||||
/* ON GAINING A WORLD RECORD:
|
||||
*
|
||||
* The routines in calc were designed to be portable, and to work on
|
||||
* numbers of 'sane' size. The Amdahl 6 team used a 'ultra-high speed
|
||||
@@ -71,7 +90,7 @@
|
||||
*
|
||||
* test numbers of the form h*2^n-1
|
||||
* fix a value of n and vary the value h
|
||||
* n mod 128 == 0
|
||||
* n mod 2^x == 0 for some value of x, say > 7 or more
|
||||
* h*2^n-1 is not divisible by any small prime < 2^40
|
||||
* 0 < h < 2^39
|
||||
* h*2^n+1 is not divisible by any small prime < 2^40
|
||||
@@ -124,6 +143,7 @@
|
||||
* point is beyond the scope of this program.
|
||||
*/
|
||||
|
||||
|
||||
global pprod256; /* product of "primes up to 256" / "primes up to 46" */
|
||||
|
||||
/*
|
||||
@@ -422,7 +442,7 @@ lucas(h, n)
|
||||
* See the function gen_v1() for details on the value of v(1).
|
||||
*
|
||||
* input:
|
||||
* h - h as in h*2^n-1 (h mod 2 != 0)
|
||||
* h - h as in h*2^n-1
|
||||
* n - n as in h*2^n-1
|
||||
* v1 - gen_v1(h,n) (see function below)
|
||||
*
|
||||
@@ -455,13 +475,6 @@ gen_u0(h, n, v1)
|
||||
quit "bogus arg: v1 is <= 0";
|
||||
}
|
||||
|
||||
/*
|
||||
* enforce the h mod rules
|
||||
*/
|
||||
if (h%2 == 0) {
|
||||
quit "h must not be even";
|
||||
}
|
||||
|
||||
/*
|
||||
* enforce the h > 0 and n >= 2 rules
|
||||
*/
|
||||
@@ -1027,7 +1040,7 @@ gen_v1(h, n)
|
||||
define
|
||||
ldebug(funct, str)
|
||||
{
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "DEBUG:", funct:":", str;
|
||||
}
|
||||
return;
|
@@ -1,29 +1,33 @@
|
||||
/*
|
||||
* Copyright (c) 1995 Landon Curt Noll
|
||||
* lucas_chk - test all primes of the form h*2^n-1, 1<=h<200 and n <= high_n
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: lucas_chk.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas_chk.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/01/11 05:41:43
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* primes of the form h*2^n-1 for 1<=h<200 and 1<=n<1000
|
||||
*
|
||||
@@ -45,6 +49,7 @@
|
||||
* 199*2^221-1 is NOT prime
|
||||
*/
|
||||
|
||||
|
||||
static prime_cnt = 1145; /* number of primes in the list */
|
||||
|
||||
/* h = prime parameters */
|
||||
@@ -331,7 +336,7 @@ lucas_chk(high_n, quiet)
|
||||
|
||||
/* skip primes where h>=2^n */
|
||||
if (highbit(h_p[i]) >= n_p[i]) {
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "h>=2^n skip:", h_p[i]:"*2^":n_p[i]:"-1";
|
||||
}
|
||||
continue;
|
@@ -1,29 +1,33 @@
|
||||
/*
|
||||
* Copyright (c) 1995 Landon Curt Noll
|
||||
* lucas_tbl - lucasian criteria for primality tables
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: lucas_tbl.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/lucas_tbl.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/01/26 02:43:43
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Lucasian criteria for primality
|
||||
*
|
||||
@@ -45,6 +49,7 @@
|
||||
* is not found in Table 1.
|
||||
*/
|
||||
|
||||
|
||||
trymax = 100;
|
||||
mat d_val[trymax+1];
|
||||
mat a_val[trymax+1];
|
||||
@@ -152,7 +157,7 @@ d_val[97]=1045; a_val[97]=33; b_val[97]=1; r_val[97]=44;
|
||||
d_val[99]=9797; a_val[99]=97; b_val[99]=1; r_val[99]=388;
|
||||
d_val[100]= 51; a_val[100]= 7; b_val[100]=1; r_val[100]=2;
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "d_val[100] defined";
|
||||
print "a_val[100] defined";
|
||||
print "b_val[100] defined";
|
61
cal/mersenne.cal
Normal file
61
cal/mersenne.cal
Normal file
@@ -0,0 +1,61 @@
|
||||
/*
|
||||
* mersenne - perform a primality test of 2^p-1, for prime p>1
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell and Landon Curt Noll
|
||||
*
|
||||
* Primary author: David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: mersenne.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mersenne.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:36
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* NOTE: See lucas.cal for a more general routine.
|
||||
*/
|
||||
|
||||
|
||||
define mersenne(p)
|
||||
{
|
||||
local u, i, p_mask;
|
||||
|
||||
/* firewall */
|
||||
if (! isint(p))
|
||||
quit "p is not an integer";
|
||||
|
||||
/* two is a special case */
|
||||
if (p == 2)
|
||||
return 1;
|
||||
|
||||
/* if p is not prime, then 2^p-1 is not prime */
|
||||
if (! ptest(p,1))
|
||||
return 0;
|
||||
|
||||
/* lltest: u(i+1) = u(i)^2 - 2 mod 2^p-1 */
|
||||
u = 4;
|
||||
for (i = 2; i < p; ++i) {
|
||||
u = hnrmod(u^2 - 2, 1, p, -1);
|
||||
}
|
||||
|
||||
/* 2^p-1 is prime iff u(p) = 0 mod 2^p-1 */
|
||||
return (u == 0);
|
||||
}
|
@@ -1,31 +1,33 @@
|
||||
/*
|
||||
* Copyright (c) 1997 Landon Curt Noll
|
||||
* mfactor - return the lowest factor of 2^n-1, for n > 0
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: mfactor.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mfactor.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/07/06 06:09:40
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* hset method
|
||||
*
|
||||
@@ -259,7 +261,7 @@ define mfactor(n, start_k, rept_loop, p_elim)
|
||||
} else {
|
||||
/* report this loop */
|
||||
printf("at 2*%d*%d+1, cpu: %f\n",
|
||||
(q-1)/(2*n), n, runtime());
|
||||
(q-1)/(2*n), n, usertime());
|
||||
fflush(files(1));
|
||||
loop = 0;
|
||||
}
|
||||
@@ -272,7 +274,7 @@ define mfactor(n, start_k, rept_loop, p_elim)
|
||||
if (rept_loop <= ++loop) {
|
||||
/* report this loop */
|
||||
printf("at 2*%d*%d+1, cpu: %f\n",
|
||||
(q-1)/(2*n), n, runtime());
|
||||
(q-1)/(2*n), n, usertime());
|
||||
fflush(files(1));
|
||||
loop = 0;
|
||||
}
|
||||
@@ -312,6 +314,6 @@ define mfactor(n, start_k, rept_loop, p_elim)
|
||||
return q;
|
||||
}
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "mfactor(n [, start_k=1 [, rept_loop=10000 [, p_elim=17]]])"
|
||||
}
|
@@ -1,12 +1,33 @@
|
||||
/*
|
||||
* Copyright (c) 1995 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* mod - routines to handle numbers modulo a specified number
|
||||
*
|
||||
* Routines to handle numbers modulo a specified number.
|
||||
* a (mod N)
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: mod.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/mod.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj mod {a}; /* definition of the object */
|
||||
|
||||
global mod_value = 100; /* modulus value (value of N) */
|
||||
@@ -189,7 +210,7 @@ define mod_pow(a, b)
|
||||
}
|
||||
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj mod {a} defined";
|
||||
print "mod_value defined";
|
||||
print "set mod_value as needed";
|
@@ -1,10 +1,32 @@
|
||||
/*
|
||||
* Copyright (c) 1997 Ernest Bowen
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* natnumset - functions for sets of natural numbers not exceeding a fixed bound
|
||||
*
|
||||
* By: Ernest Bowen <ernie@neumann.une.edu.au>
|
||||
* Copyright (C) 1999 Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: natnumset.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/natnumset.cal,v $
|
||||
*
|
||||
* Under source code control: 1997/09/07 23:53:51
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Functions for sets of natural numbers not exceeding a fixed bound B.
|
||||
*
|
||||
@@ -449,7 +471,7 @@ define set_plus(a) = set_sum(a);
|
||||
define interval(a, b)
|
||||
{
|
||||
local i, j, s;
|
||||
static tail = str("\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))
|
||||
quit "Non-integer argument for interval";
|
94
cal/pell.cal
Normal file
94
cal/pell.cal
Normal file
@@ -0,0 +1,94 @@
|
||||
/*
|
||||
* pell - solve Pell's equation
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: pell.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pell.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Solve Pell's equation; Returns the solution X to: X^2 - D * Y^2 = 1.
|
||||
* Type the solution to pells equation for a particular D.
|
||||
*/
|
||||
|
||||
|
||||
define pell(D)
|
||||
{
|
||||
local X, Y;
|
||||
|
||||
X = pellx(D);
|
||||
if (isnull(X)) {
|
||||
print "D=":D:" is square";
|
||||
return;
|
||||
}
|
||||
Y = isqrt((X^2 - 1) / D);
|
||||
print X : "^2 - " : D : "*" : Y : "^2 = " : X^2 - D*Y^2;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Function to solve Pell's equation
|
||||
* Returns the solution X to:
|
||||
* X^2 - D * Y^2 = 1
|
||||
*/
|
||||
define pellx(D)
|
||||
{
|
||||
local R, Rp, U, Up, V, Vp, A, T, Q1, Q2, n;
|
||||
local mat ans[2,2];
|
||||
local mat tmp[2,2];
|
||||
|
||||
R = isqrt(D);
|
||||
Vp = D - R^2;
|
||||
if (Vp == 0)
|
||||
return;
|
||||
Rp = R + R;
|
||||
U = Rp;
|
||||
Up = U;
|
||||
V = 1;
|
||||
A = 0;
|
||||
n = 0;
|
||||
ans[0,0] = 1;
|
||||
ans[1,1] = 1;
|
||||
tmp[0,1] = 1;
|
||||
tmp[1,0] = 1;
|
||||
do {
|
||||
T = V;
|
||||
V = A * (Up - U) + Vp;
|
||||
Vp = T;
|
||||
A = U // V;
|
||||
Up = U;
|
||||
U = Rp - U % V;
|
||||
tmp[0,0] = A;
|
||||
ans *= tmp;
|
||||
n++;
|
||||
} while (A != Rp);
|
||||
Q2 = ans[[1]];
|
||||
Q1 = isqrt(Q2^2 * D + 1);
|
||||
if (isodd(n)) {
|
||||
T = Q1^2 + D * Q2^2;
|
||||
Q2 = Q1 * Q2 * 2;
|
||||
Q1 = T;
|
||||
}
|
||||
return Q1;
|
||||
}
|
@@ -1,12 +1,38 @@
|
||||
/*
|
||||
* Copyright (c) 1995 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* pi - various routines to calculate pi
|
||||
*
|
||||
* Copyright (C) 1999-2004 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: pi.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pi.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Calculate pi within the specified epsilon using the quartic convergence
|
||||
* iteration.
|
||||
*/
|
||||
|
||||
|
||||
define qpi(epsilon)
|
||||
{
|
||||
local niter, yn, ym, tm, an, am, t, tn, sqrt2, epsilon2, count, digits;
|
||||
@@ -35,7 +61,7 @@ define qpi(epsilon)
|
||||
yn = sqrt2 - 1;
|
||||
an = 6 - 4 * sqrt2;
|
||||
tn = 2;
|
||||
for (count = 0; count < niter; count++) {
|
||||
for (count = 0; count < niter; ++count) {
|
||||
ym = yn;
|
||||
am = an;
|
||||
tn *= 4;
|
||||
@@ -78,7 +104,7 @@ define piforever()
|
||||
* Next approximation
|
||||
*/
|
||||
p = k * k;
|
||||
q = k + k++;
|
||||
q = k + ++k;
|
||||
|
||||
a2 = a;
|
||||
b2 = b;
|
71
cal/pix.cal
Normal file
71
cal/pix.cal
Normal file
@@ -0,0 +1,71 @@
|
||||
/*
|
||||
* pix - iterative method of finding the number of primes less than x
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: pix.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pix.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/07/09 03:14:14
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* 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"
|
||||
* June 1996 issue of Scientific American.
|
||||
*
|
||||
* NOTE: For reasonable values of x, the builtin function pix(x) is
|
||||
* much faster. This code is provided because the method
|
||||
* is interesting.
|
||||
*/
|
||||
|
||||
|
||||
define pi_of_x(x)
|
||||
{
|
||||
local An; /* A(n) */
|
||||
local An1; /* A(n-1) */
|
||||
local An2; /* A(n-2) */
|
||||
local An3; /* A(n-3) */
|
||||
local primes; /* number of primes found */
|
||||
local n; /* loop counter */
|
||||
|
||||
/*
|
||||
* setup
|
||||
*/
|
||||
An1 = 2;
|
||||
An2 = 0;
|
||||
An3 = 3;
|
||||
primes = 1;
|
||||
|
||||
/*
|
||||
* main A(n+1)=A(n-1)+A(n-2) sequence loop
|
||||
*/
|
||||
for (n = 3; n < x; ++n) {
|
||||
An = An2 + An3;
|
||||
An3 = An2;
|
||||
An2 = An1;
|
||||
An1 = An;
|
||||
if (An % n == 0)
|
||||
++primes;
|
||||
}
|
||||
return primes;
|
||||
}
|
52
cal/pollard.cal
Normal file
52
cal/pollard.cal
Normal file
@@ -0,0 +1,52 @@
|
||||
/*
|
||||
* pollard - factor using Pollard's p-1 method
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: pollard.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/pollard.cal,v $
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
define pfactor(N, B, ai, af)
|
||||
{
|
||||
local a, k, i, d;
|
||||
|
||||
if (isnull(B))
|
||||
B = 1000;
|
||||
if (isnull(ai))
|
||||
ai = 2;
|
||||
if (isnull(af))
|
||||
af = ai + 20;
|
||||
k = lcmfact(B);
|
||||
d = lfactor(N, B);
|
||||
if (d > 1)
|
||||
return d;
|
||||
for (a = ai; a <= af; a++) {
|
||||
i = pmod(a, k, N);
|
||||
d = gcd(i - 1, N);
|
||||
if ((d > 1) && (d != N))
|
||||
return d;
|
||||
}
|
||||
return 1;
|
||||
}
|
@@ -1,3 +1,32 @@
|
||||
/*
|
||||
* poly - calculate with polynomials of one variable
|
||||
*
|
||||
* Copyright (C) 1999 Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: poly.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/poly.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* A collection of functions designed for calculations involving
|
||||
* polynomials in one variable (by Ernest W. Bowen).
|
||||
@@ -170,6 +199,7 @@
|
||||
* should return the zero m x m matrix.
|
||||
*/
|
||||
|
||||
|
||||
obj poly {p};
|
||||
|
||||
define pol() {
|
||||
@@ -688,6 +718,6 @@ a=pol(1,4,4,2,3,1);
|
||||
b=pol(5,16,8,1);
|
||||
c=pol(1+2i,3+4i,5+6i);
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj poly {p} defined";
|
||||
}
|
@@ -1,10 +1,32 @@
|
||||
/*
|
||||
* Copyright (c) 1995 Ernest Bowen
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* prompt - eemonstration of some uses of prompt() and eval()
|
||||
*
|
||||
* By: Ernest Bowen <ernie@neumann.une.edu.au>
|
||||
* Copyright (C) 1999 Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: prompt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/prompt.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/12/18 04:43:25
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Demonstration of some uses of prompt() and eval().
|
||||
*
|
||||
@@ -61,6 +83,7 @@
|
||||
* entering "end", "exit" or "quit".
|
||||
*/
|
||||
|
||||
|
||||
define adder() {
|
||||
global sum = 0;
|
||||
local s, t;
|
||||
@@ -78,7 +101,7 @@ define adder() {
|
||||
}
|
||||
}
|
||||
|
||||
global x;
|
||||
global prompt_x;
|
||||
|
||||
define showvalues(str) {
|
||||
local s;
|
||||
@@ -86,8 +109,8 @@ define showvalues(str) {
|
||||
s = prompt("? ");
|
||||
if (s == "end")
|
||||
break;
|
||||
x = eval(s);
|
||||
if (!isnum(x)) {
|
||||
prompt_x = eval(s);
|
||||
if (!isnum(prompt_x)) {
|
||||
print "Please enter a number";
|
||||
continue;
|
||||
}
|
74
cal/psqrt.cal
Normal file
74
cal/psqrt.cal
Normal file
@@ -0,0 +1,74 @@
|
||||
/*
|
||||
* psqrt - calculate square roots modulo a prime
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: psqrt.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/psqrt.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Returns null if number is not prime or if there is no square root.
|
||||
* The smaller square root is always returned.
|
||||
*/
|
||||
|
||||
|
||||
define psqrt(u, p)
|
||||
{
|
||||
local p1, q, n, y, r, v, w, t, k;
|
||||
|
||||
p1 = p - 1;
|
||||
r = lowbit(p1);
|
||||
q = p >> r;
|
||||
t = 1 << (r - 1);
|
||||
for (n = 2; ; n++) {
|
||||
if (ptest(n, 1) == 0)
|
||||
continue;
|
||||
y = pmod(n, q, p);
|
||||
k = pmod(y, t, p);
|
||||
if (k == 1)
|
||||
continue;
|
||||
if (k != p1)
|
||||
return;
|
||||
break;
|
||||
}
|
||||
t = pmod(u, (q - 1) / 2, p);
|
||||
v = (t * u) % p;
|
||||
w = (t^2 * u) % p;
|
||||
while (w != 1) {
|
||||
k = 0;
|
||||
t = w;
|
||||
do {
|
||||
k++;
|
||||
t = t^2 % p;
|
||||
} while (t != 1);
|
||||
if (k == r)
|
||||
return;
|
||||
t = pmod(y, 1 << (r - k - 1), p);
|
||||
y = t^2 % p;
|
||||
v = (v * t) % p;
|
||||
w = (w * y) % p;
|
||||
r = k;
|
||||
}
|
||||
return min(v, p - v);
|
||||
}
|
90
cal/qtime.cal
Normal file
90
cal/qtime.cal
Normal file
@@ -0,0 +1,90 @@
|
||||
/*
|
||||
* qtime - Display time as English sentence
|
||||
*
|
||||
* Copyright (C) 1999 Klaus Alexander Seistrup and Landon Curt Noll
|
||||
*
|
||||
* Written by: Klaus Alexander Seistrup <kseis@magnetic-ink.dk>
|
||||
* With mods by: Landon Curt Noll <http://www.isthe.com/chongo/>
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: qtime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/qtime.cal,v $
|
||||
*
|
||||
* Under source code control: 1999/10/13 04:10:33
|
||||
* File existed as early as: 1999
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* usage:
|
||||
* qtime(utc_hr_offset)
|
||||
*
|
||||
* utc_hr_offset Offset from UTC in hours.
|
||||
*
|
||||
* See:
|
||||
* http://www.magnetic-ink.dk/download/qtime.html
|
||||
*
|
||||
* for examples of qtime() written on other languages.
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* qtime - Display time as English sentence
|
||||
*/
|
||||
define qtime(utc_hr_offset)
|
||||
{
|
||||
static mat hr[12] = {
|
||||
"twelve", "one", "two", "three", "four", "five",
|
||||
"six", "seven", "eight", "nine", "ten", "eleven"
|
||||
};
|
||||
static mat mn[7] = {
|
||||
"", "five ", "ten ", "a quarter ", "twenty ", "twenty-five ", "half "
|
||||
};
|
||||
static mat ny[5] = {
|
||||
"nearly ", "almost ", "", "just after ", "after "
|
||||
};
|
||||
static mat up[3] = {
|
||||
"to ", "", "past "
|
||||
};
|
||||
local adj_mins = (((time() + utc_hr_offset*3600) % 86400) + 30)//60+27;
|
||||
local hours = (adj_mins // 60) % 12;
|
||||
local minutes = adj_mins % 60;
|
||||
local almost = minutes % 5;
|
||||
local divisions = (minutes // 5) - 5;
|
||||
local to_past_idx = divisions > 0 ? 1 : 0;
|
||||
|
||||
if (divisions < 0) {
|
||||
divisions = -divisions;
|
||||
to_past_idx = -1;
|
||||
}
|
||||
++to_past_idx;
|
||||
|
||||
/*
|
||||
* Print the English sentence
|
||||
*
|
||||
* We avoid forward and back quotes just to show that the char()
|
||||
* builtin function can be used in conjunction with a printf.
|
||||
*/
|
||||
printf("It%cs %s%s%s%s",
|
||||
char(0x27), ny[almost], mn[divisions],
|
||||
up[to_past_idx], hr[hours]);
|
||||
if (divisions == 0)
|
||||
printf(" o%cclock", char(0x27));
|
||||
print ".";
|
||||
}
|
@@ -1,8 +1,33 @@
|
||||
/*
|
||||
* Copyright (c) 1995 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* quat - alculate using quaternions of the form: a + bi + cj + dk
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: quat.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/quat.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Routines to handle quaternions of the form:
|
||||
* a + bi + cj + dk
|
||||
*
|
||||
@@ -11,6 +36,7 @@
|
||||
* Where s is a scalar and v is a vector of size 3.
|
||||
*/
|
||||
|
||||
|
||||
obj quat {s, v}; /* definition of the quaternion object */
|
||||
|
||||
|
||||
@@ -29,7 +55,8 @@ define quat(a,b,c,d)
|
||||
|
||||
define quat_print(a)
|
||||
{
|
||||
print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :;
|
||||
print "quat(" : a.s : ", " : a.v[0] : ", " :
|
||||
a.v[1] : ", " : a.v[2] : ")" :;
|
||||
}
|
||||
|
||||
|
||||
@@ -195,6 +222,6 @@ define quat_shift(a, b)
|
||||
return x.s;
|
||||
}
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj quat {s, v} defined";
|
||||
}
|
@@ -1,30 +1,38 @@
|
||||
/*
|
||||
* randbitrun - check rand bit run lengths of the a55 generator
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: randbitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randbitrun.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* We will use randbit(1) to generate a stream if single bits.
|
||||
* The odds that we will have n bits the same in a row is 1/2^n.
|
||||
*/
|
||||
/*
|
||||
* Copyright 1995 by Landon Curt Noll. All Rights Reserved.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice, and the
|
||||
* disclaimer below appear in all of the following:
|
||||
*
|
||||
* * supporting documentation
|
||||
* * source copies
|
||||
* * source works derived from this source
|
||||
* * binaries derived from this source or from derived source
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
|
||||
define randbitrun(run_cnt)
|
||||
{
|
@@ -1,32 +1,34 @@
|
||||
/*
|
||||
* randmprime - generate a random prime of the form h*2^n-1
|
||||
*
|
||||
* Copyright (c) 1997 by Landon Curt Noll. All Rights Reserved.
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: randmprime.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randmprime.cal,v $
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* Under source code control: 1994/03/14 23:11:21
|
||||
* File existed as early as: 1994
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/* obtain our required libs */
|
||||
read -once "lucas.cal"
|
||||
|
||||
@@ -86,8 +88,8 @@ randmprime(bits, seed, dbg)
|
||||
* loop until we find a prime
|
||||
*/
|
||||
if (dbg >= 1) {
|
||||
start = runtime();
|
||||
init = runtime();
|
||||
start = usertime();
|
||||
init = usertime();
|
||||
plush = 0;
|
||||
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
|
||||
}
|
||||
@@ -95,7 +97,7 @@ randmprime(bits, seed, dbg)
|
||||
|
||||
/* bump h, and n if needed */
|
||||
if (dbg >= 2) {
|
||||
stop = runtime();
|
||||
stop = usertime();
|
||||
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
|
||||
}
|
||||
if (dbg >= 1) {
|
||||
@@ -114,7 +116,7 @@ randmprime(bits, seed, dbg)
|
||||
|
||||
/* found a prime */
|
||||
if (dbg >= 2) {
|
||||
stop = runtime();
|
||||
stop = usertime();
|
||||
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
|
||||
print "DEBUG3: " : h : "*2^" : n : "-1 is prime";
|
||||
}
|
@@ -1,30 +1,38 @@
|
||||
/*
|
||||
* randombitrun - check rand bit run lengths of random()
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: randombitrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randombitrun.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* We will use randombit(1) to generate a stream if single bits.
|
||||
* The odds that we will have n bits the same in a row is 1/2^n.
|
||||
*/
|
||||
/*
|
||||
* Copyright 1997 by Landon Curt Noll. All Rights Reserved.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice, and the
|
||||
* disclaimer below appear in all of the following:
|
||||
*
|
||||
* * supporting documentation
|
||||
* * source copies
|
||||
* * source works derived from this source
|
||||
* * binaries derived from this source or from derived source
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
|
||||
define randombitrun(run_cnt)
|
||||
{
|
@@ -1,6 +1,34 @@
|
||||
/*
|
||||
* randomrun - perform a run test on random()
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: randomrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randomrun.cal,v $
|
||||
*
|
||||
* Under source code control: 1997/02/19 03:35:59
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* If X(j) < X(j+1) < ... X(j+k) >= X(j+k+1), then we have a run of 'k'.
|
||||
* We ignore the run breaker, X(j+k+1), and start with X(j+k+2) when
|
||||
* considering a new run in order to make our runs chi independent.
|
||||
@@ -13,27 +41,7 @@
|
||||
* We use the suggestion in problem #14 to allow an application of the
|
||||
* chi-square test and to make estimating the run length probs easy.
|
||||
*/
|
||||
/*
|
||||
* Copyright 1997 by Landon Curt Noll. All Rights Reserved.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice, and the
|
||||
* disclaimer below appear in all of the following:
|
||||
*
|
||||
* * supporting documentation
|
||||
* * source copies
|
||||
* * source works derived from this source
|
||||
* * binaries derived from this source or from derived source
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
|
||||
define randomrun(run_cnt)
|
||||
{
|
@@ -1,6 +1,33 @@
|
||||
/*
|
||||
* randrun - perform a run test on rand()
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: randrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/randrun.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/02/12 20:00:06
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* If X(j) < X(j+1) < ... X(j+k) >= X(j+k+1), then we have a run of 'k'.
|
||||
* We ignore the run breaker, X(j+k+1), and start with X(j+k+2) when
|
||||
* considering a new run in order to make our runs chi independent.
|
||||
@@ -13,27 +40,7 @@
|
||||
* We use the suggestion in problem #14 to allow an application of the
|
||||
* chi-square test and to make estimating the run length probs easy.
|
||||
*/
|
||||
/*
|
||||
* Copyright 1995 by Landon Curt Noll. All Rights Reserved.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice, and the
|
||||
* disclaimer below appear in all of the following:
|
||||
*
|
||||
* * supporting documentation
|
||||
* * source copies
|
||||
* * source works derived from this source
|
||||
* * binaries derived from this source or from derived source
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
|
||||
define randrun(run_cnt)
|
||||
{
|
||||
@@ -122,6 +129,6 @@ define randrun(run_cnt)
|
||||
printf("max length=%d\n", max_run);
|
||||
}
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "randrun([run_length]) defined";
|
||||
}
|
File diff suppressed because it is too large
Load Diff
53
cal/repeat.cal
Normal file
53
cal/repeat.cal
Normal file
@@ -0,0 +1,53 @@
|
||||
/*
|
||||
* repeat - return the value of a repeated set of digits
|
||||
*
|
||||
* Copyright (C) 2003 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: repeat.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/repeat.cal,v $
|
||||
*
|
||||
* Under source code control: 2003/01/05 00:00:01
|
||||
* File existed as early as: 2003
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* repeat - return the value of a repeated set of digits
|
||||
*
|
||||
* usage:
|
||||
* repeat(digit_set, repeat_count)
|
||||
*/
|
||||
define repeat(digit_set, repeat_count)
|
||||
{
|
||||
local digit_count; /* digits in the digit_set */
|
||||
|
||||
/* firewall */
|
||||
if (!isint(digit_set) || digit_set <= 0) {
|
||||
quit "digit set must be an integer > 0";
|
||||
}
|
||||
if (!isint(repeat_count) || repeat_count <= 0) {
|
||||
quit "repeat count must be an integer > 0";
|
||||
}
|
||||
|
||||
/* return repeated set of digits */
|
||||
digit_count = digits(digit_set);
|
||||
return digit_set * (10^(digit_count*repeat_count)-1) / (10^digit_count-1);
|
||||
}
|
61
cal/screen.cal
Normal file
61
cal/screen.cal
Normal file
@@ -0,0 +1,61 @@
|
||||
/*
|
||||
* screen - ANSI control sequences
|
||||
*
|
||||
* This file was created by Ernest Bowen <ebowen at une dot edu dot au>.
|
||||
*
|
||||
* This code has been placed in the public domain. Please do not
|
||||
* copyright this code.
|
||||
*
|
||||
* ERNEST BOWEN DISCLAIMS ALL WARRANTIES WITH REGARD TO
|
||||
* THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MER-
|
||||
* CHANTABILITY AND FITNESS. IN NO EVENT SHALL LANDON CURT
|
||||
* NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL
|
||||
* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
||||
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
||||
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: screen.cal,v 30.2 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/screen.cal,v $
|
||||
*
|
||||
* This file is not covered under version 2.1 of the GNU LGPL.
|
||||
*
|
||||
* Under source code control: 2006/03/08 05:54:09
|
||||
* File existed as early as: 2006
|
||||
*/
|
||||
|
||||
up = CUU ="\e[A";
|
||||
down = CUD = "\e[B}";
|
||||
forward = CUF = "\e[C";
|
||||
back = CUB = "\e[D";
|
||||
save = SCP = "\e[s";
|
||||
restore = RCP = "\e[u";
|
||||
cls = "\e[2J";
|
||||
home = "\e[F";
|
||||
eraseline = "\e[K";
|
||||
off = "\e[0m";
|
||||
bold = "\e[1m";
|
||||
faint = "\e[2m";
|
||||
italic = "\e[3m";
|
||||
blink = "\e[5m";
|
||||
rapidblink = "\e[6m";
|
||||
reverse = "\e[7m";
|
||||
concealed = "\e[8m";
|
||||
/* Lowercase indicates foreground, uppercase background" */
|
||||
black = "\e[30m";
|
||||
red = "\e[31m";
|
||||
green = "\e[32m";
|
||||
yellow = "\e[33m";
|
||||
blue = "\e[34m";
|
||||
magenta = "\e[35m";
|
||||
cyan = "\e[36m";
|
||||
white = "\e[37m";
|
||||
Black = "\e[40m";
|
||||
Red = "\e[41m";
|
||||
Green = "\e[42m";
|
||||
Yellow = "\e[43m";
|
||||
Blue = "\e[44m";
|
||||
Magenta = "\e[45m";
|
||||
Cyan = "\e[46m";
|
||||
White = "\e[47m";
|
@@ -1,35 +1,35 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Landon Curt Noll
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and
|
||||
* its documentation for any purpose and without fee is hereby granted,
|
||||
* provided that the above copyright, this permission notice and text
|
||||
* this comment, and the disclaimer below appear in all of the following:
|
||||
*
|
||||
* supporting documentation
|
||||
* source copies
|
||||
* source works derived from this source
|
||||
* binaries derived from this source or from derived source
|
||||
*
|
||||
* LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
|
||||
* INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
|
||||
* EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
|
||||
* CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
|
||||
* USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
|
||||
* OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
* PERFORMANCE OF THIS SOFTWARE.
|
||||
*
|
||||
* Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
*/
|
||||
|
||||
/*
|
||||
* seedrandom - seed the cryptographically strong Blum generator
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* The period of a Blum generators with modulus 'n=p*q' (where p and
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: seedrandom.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/seedrandom.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/01/01 08:21:00
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* The period of Blum generators with modulus 'n=p*q' (where p and
|
||||
* q are primes 3 mod 4) is:
|
||||
*
|
||||
* lambda(n) = lcm(factors of p-1 & q-1)
|
||||
@@ -53,6 +53,8 @@
|
||||
* 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.
|
||||
*/
|
||||
|
||||
|
||||
define seedrandom(seed1, seed2, size, trials)
|
||||
{
|
||||
local p; /* first Blum prime */
|
||||
@@ -113,7 +115,7 @@ define seedrandom(seed1, seed2, size, trials)
|
||||
p = 2*fp+1;
|
||||
} while (ptest(p,1,0) == 0);
|
||||
} while(ptest(p, trials) == 0 || ptest(fp, trials) == 0);
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 1st Blum prime */ p=", p;
|
||||
}
|
||||
|
||||
@@ -127,7 +129,7 @@ define seedrandom(seed1, seed2, size, trials)
|
||||
q = 2*fq+1;
|
||||
} while (ptest(q,1,0) == 0);
|
||||
} while(ptest(q, trials) == 0 || ptest(fq, trials) == 0);
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 2nd Blum prime */ q=", q;
|
||||
}
|
||||
|
||||
@@ -137,7 +139,7 @@ define seedrandom(seed1, seed2, size, trials)
|
||||
n = p*q; /* the Blum modulus */
|
||||
binsize = highbit(n)+1; /* smallest power of 2 > p*q */
|
||||
r = pmod(rand(1<<ceil(binsize*4/5), 1<<(binsize-2)), 2, n);
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* seed quadratic residue */ r=", r;
|
||||
print "/* newn", binsize, "bit quadratic residue*/ newn=", n;
|
||||
}
|
||||
@@ -154,6 +156,6 @@ define seedrandom(seed1, seed2, size, trials)
|
||||
return old_state;
|
||||
}
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "seedrandom(seed1, seed2, size [, trials]) defined";
|
||||
}
|
77
cal/set8700.cal
Normal file
77
cal/set8700.cal
Normal file
@@ -0,0 +1,77 @@
|
||||
/*
|
||||
* set8700 - environment for dotest line tests for the 8700 set of regress.cal
|
||||
*
|
||||
* Copyright (C) 2006 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: set8700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/set8700.cal,v $
|
||||
*
|
||||
* Under source code control: 2006/05/20 14:10:11
|
||||
* File existed as early as: 2006
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
* setup global variables for dotest() to use with set8700.set
|
||||
*/
|
||||
|
||||
global set8700_A;
|
||||
global set8700_B;
|
||||
global set8700_M;
|
||||
global set8700_M1;
|
||||
global set8700_M2;
|
||||
global set8700_L;
|
||||
global set8700_L1;
|
||||
global set8700_L2;
|
||||
global set8700_O;
|
||||
global set8700_P;
|
||||
global set8700_P1;
|
||||
global set8700_P2;
|
||||
global set8700_Q;
|
||||
global set8700_R;
|
||||
global set8700_S;
|
||||
global set8700_X;
|
||||
global set8700_Y;
|
||||
global set8700_x;
|
||||
global set8700_y;
|
||||
|
||||
define set8700_getA1() = set8700_A;
|
||||
|
||||
define set8700_getA2() { return set8700_A; }
|
||||
|
||||
define set8700_getvar() {local a = 42; protect(a,256); return a;}
|
||||
|
||||
define set8700_f(set8700_x) = set8700_x^2;
|
||||
|
||||
define set8700_g(set8700_x)
|
||||
{
|
||||
if (isodd(set8700_x)) protect(set8700_x, 256);
|
||||
return set8700_x;
|
||||
}
|
||||
|
||||
obj set8700_point {
|
||||
set8700_x, set8700_y, set8700_z
|
||||
}
|
||||
|
||||
global mat set8700_c[] = { 1, 2+3i, -5+4i, 5i+6, -7i };
|
||||
|
||||
global mat set8700_e[] = { 0, 1, 0, 0, 2, -3/2, 2, -1/2,
|
||||
-3, 0.5, -1.0, 0.5, 1.0, 0.0, 0.0, 0.0 };
|
429
cal/set8700.line
Normal file
429
cal/set8700.line
Normal file
@@ -0,0 +1,429 @@
|
||||
##
|
||||
## set8700 - dotest line tests for the 8700 set of regress.cal
|
||||
##
|
||||
## Copyright (C) 2006 Ernest Bowen and Landon Curt Noll
|
||||
##
|
||||
## Calc is open software; you can redistribute it and/or modify it under
|
||||
## the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
## as published by the Free Software Foundation.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
## distributed with calc under the filename COPYING-LGPL. You should have
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 30.1 $
|
||||
## @(#) $Id: set8700.line,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/bin/calc/cal/RCS/set8700.line,v $
|
||||
##
|
||||
## Under source code control: 2006/05/20 14:10:11
|
||||
## File existed as early as: 2006
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
|
||||
strcpy("", "") == ""
|
||||
strcpy("", "xyz") == ""
|
||||
strcpy("a", "xyz") == "x"
|
||||
strcpy("ab", "xyz") == "xy"
|
||||
strcpy("abc", "xyz") == "xyz"
|
||||
strcpy("abcd", "xyz") == "xyz\0" ## Result will print as "xyz"
|
||||
strcpy("abcde", "xyz") == "xyz\0e"
|
||||
strcpy("abcdef", "xyz") == "xyz\0ef"
|
||||
strcpy("abcdef", "x\0z") == "x\0z\0ef" ## Note z is copied
|
||||
strcpy("abc", "") == "\0bc"
|
||||
|
||||
strncpy("abcdef", "xyz", 0) == "abcdef" ## No characters copied
|
||||
strncpy("abcdef", "xyz", 1) == "xbcdef" ## One character copied, no '\0'
|
||||
strncpy("abcdef", "xyz", 2) == "xycdef"
|
||||
strncpy("abcdef", "xyz", 3) == "xyzdef"
|
||||
strncpy("abcdef", "xyz", 4) == "xyz\0ef"
|
||||
strncpy("abcdef", "xyz", 5) == "xyz\0\0f" ## Two nulls as in C
|
||||
strncpy("abcdef", "xyz", 6) == "xyz\0\0\0"
|
||||
strncpy("abcdef", "xyz", 7) == "xyz\0\0\0" ## Size of first string unchanged
|
||||
strncpy("a\0cdef", "\0yz", 4) == "\0yz\0ef"
|
||||
strncpy("ab", "xyz", 3) == "xy"
|
||||
|
||||
strcmp("", "") == 0
|
||||
strcmp("", "a") == -1
|
||||
strcmp("\n", "\n") == 0
|
||||
strcmp("\0", "") == 1 ## '\0' treated like other characters
|
||||
strcmp("ab", "") == 1
|
||||
strcmp("ab", "a") == 1
|
||||
strcmp("ab", "ab") == 0
|
||||
strcmp("ab", "abc") == -1
|
||||
strcmp("abc", "abb") == 1
|
||||
strcmp("abc", "abc") == 0
|
||||
strcmp("abc", "abd") == -1
|
||||
strcmp("abc\0", "abc") == 1
|
||||
|
||||
strncmp("abc", "xyz", 0) == 0
|
||||
strncmp("abc", "xyz", 1) == -1
|
||||
strncmp("abc", "", 1) == 1
|
||||
strncmp("abc", "a", 1) == 0
|
||||
strncmp("", "", 2) == 0
|
||||
strncmp("a", "a", 2) == 0
|
||||
strncmp("a", "b", 2) == -1
|
||||
strncmp("ab", "ab", 2) == 0
|
||||
strncmp("ab", "ac", 2) == -1
|
||||
strncmp("\0ac", "\0b", 2) == -1
|
||||
strncmp("ab", "abc", 2) == 0
|
||||
strncmp("abc", "abd", 2) == 0
|
||||
strncmp("a", "a\0", 2) == -1
|
||||
strncmp("a", "a", 3) == 0
|
||||
strncmp("abc", "abd", 3) == -1
|
||||
strncmp("\0\0\n", "\0\0\t", 3) == 1
|
||||
|
||||
str("abc") == "abc"
|
||||
str("ab\0") == "ab"
|
||||
str("a\0c") == "a"
|
||||
str("\0bc") == ""
|
||||
|
||||
size("") == 0
|
||||
size("a") == 1
|
||||
size("\0") == 1
|
||||
size("a\0") == 2
|
||||
size("a\0b") == 3
|
||||
|
||||
strlen("\0") == 0
|
||||
strlen("a\0") == 1
|
||||
strlen("a\0b") == 1
|
||||
|
||||
0 * "abc" == ""
|
||||
1 * "abc" == "abc"
|
||||
2 * "abc" == "abcabc"
|
||||
3 * "abc" == "abcabcabc"
|
||||
1 * "" == ""
|
||||
-1 * "abc" == "cba"
|
||||
-2 * "abc" == "cbacba"
|
||||
"abc" + "xyz" == "abcxyz"
|
||||
"abc" - "xyz" == "abczyx"
|
||||
|
||||
|
||||
substr("abcd",0,0) == ""
|
||||
substr("abcd",0,1) == "a"
|
||||
substr("abcd",0,2) == "ab"
|
||||
substr("abcd",1,0) == ""
|
||||
substr("abcd",1,1) == "a"
|
||||
substr("abcd",1,2) == "ab"
|
||||
substr("abcd",2,0) == ""
|
||||
substr("abcd",2,1) == "b"
|
||||
substr("abcd",2,2) == "bc";
|
||||
substr("abcd",2,3) == "bcd";
|
||||
substr("abcd",2,4) == "bcd";
|
||||
substr("abcd",2,5) == "bcd"; ## substr stops at end of string
|
||||
substr("abcd",4,0) == ""
|
||||
substr("abcd",4,1) == "d"
|
||||
substr("abcd",4,2) == "d"
|
||||
substr("abcd",4,3) == "d"
|
||||
substr("abcd",5,0) == ""
|
||||
substr("abcd",5,1) == ""
|
||||
substr("a\0c\0",2,2) == "\0c" ## '\0' treated like other characters
|
||||
substr("a\0c\0",2,3) == "\0c\0"
|
||||
|
||||
#"" == 0 ## # operator counts number of bits
|
||||
#"\0" == 0
|
||||
# "a" == 3
|
||||
# "ab" == 6 ## white space ignored
|
||||
# "abc" == 10
|
||||
# 27 == 4
|
||||
# 0b1010111011 == 7
|
||||
|
||||
7 # 9 == 2 ## 7 # 9 = abs(7 - 9)
|
||||
3/4 # 2/3 == 1/12
|
||||
|
||||
a = 5, a #= 2, a == 3
|
||||
a #= 4, a == 1
|
||||
|
||||
## Binary # operator not defined for strings
|
||||
|
||||
protect(set8700_A) == 0
|
||||
## Testing with one lvalue
|
||||
isnull(protect(set8700_A,65))
|
||||
protect(set8700_A) == 65
|
||||
isnull(protect(set8700_A, -1))
|
||||
protect(set8700_A) == 64
|
||||
protect(set8700_A,-2), protect(set8700_A) == 64
|
||||
protect(set8700_A,5), protect(set8700_A) == 69
|
||||
protect(set8700_A,-4), protect(set8700_A) == 65
|
||||
protect(set8700_A,0), protect(set8700_A) == 0
|
||||
protect(set8700_A,1234), protect(set8700_A) == 1234
|
||||
protect(set8700_A,-1234), protect(set8700_A) == 0
|
||||
protect(set8700_A,65535), protect(set8700_A) == 65535
|
||||
protect(set8700_A,-65535), protect(set8700_A) == 0
|
||||
|
||||
## Simple assignments
|
||||
set8700_A = 42, protect(set8700_A,1024), set8700_B = set8700_A, protect(set8700_B) == 1024
|
||||
set8700_A = 6 * 7, protect(set8700_A) == 1024
|
||||
set8700_A == set8700_B
|
||||
|
||||
## Testing matrix protectioon
|
||||
set8700_A = mat [3] = {1, 2, list(3,4)}; 1
|
||||
protect(set8700_A, 65, 1), protect(set8700_A) == 1089
|
||||
protect(set8700_A[0]) == 65
|
||||
protect(set8700_A[2]) == 65
|
||||
protect(set8700_A[2][1]) == 0
|
||||
protect(set8700_A, 65, 2), protect(set8700_A[2][1]) == 65
|
||||
protect(set8700_A,-1024), protect(set8700_A) == 65
|
||||
protect(set8700_A, -1, 1), protect(set8700_A) == 64
|
||||
protect(set8700_A[1]) == 64
|
||||
protect(set8700_A[2]) == 64
|
||||
protect(set8700_A[2][0]) == 65
|
||||
protect(set8700_A,0), protect(set8700_A) == 0
|
||||
protect(set8700_A[1]) == 64
|
||||
protect(set8700_A, 0, 2), protect(set8700_A) == 0
|
||||
protect(set8700_A[1]) == 0
|
||||
protect(set8700_A[2][1]) == 0
|
||||
protect(set8700_A,1024, 2), protect(set8700_A) == 1024
|
||||
protect(set8700_A[2]) == 1024
|
||||
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
|
||||
|
||||
## Testing simple assignment of matrix
|
||||
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][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## copying matrix to list
|
||||
set8700_B = list(5,6,7), protect(set8700_B) == 1024
|
||||
protect(set8700_B[0]) == 0
|
||||
protect(set8700_B[2]) == 0
|
||||
protect(set8700_A,0), protect(set8700_A) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## copying matrix to matrix
|
||||
set8700_B = mat[3], protect(set8700_B) == 1024
|
||||
protect(set8700_B[2]) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Testing list protection
|
||||
set8700_A = list(1, 2, list(3,4)), 1
|
||||
protect(set8700_A,1024, 2), protect(set8700_A) == 1024
|
||||
protect(set8700_A[2]) == 1024
|
||||
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
|
||||
|
||||
## Simple assignment of list
|
||||
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][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Copying list to list
|
||||
set8700_B = list(5,6,7), protect(set8700_B) == 1024
|
||||
protect(set8700_B[2]) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Copying list to matrix
|
||||
set8700_B = mat[3], protect(set8700_B) == 1024
|
||||
protect(set8700_B[2]) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Protecting one element of a list
|
||||
set8700_A = list(1,4,3,2), protect(set8700_A[1]) == 0
|
||||
protect(set8700_A[1], 1024), protect(set8700_A[1]) == 1024
|
||||
|
||||
## Testing sort
|
||||
set8700_A = sort(set8700_A), set8700_A == list(1,2,3,4)
|
||||
protect(set8700_A[1]) == 0
|
||||
protect(set8700_A[3]) == 1024 ## status of 4
|
||||
|
||||
## Testings reverse
|
||||
set8700_A = reverse(set8700_A), set8700_A == list(4,3,2,1)
|
||||
protect(set8700_A[0]) == 1024 ## status of 4
|
||||
|
||||
## Testing swap
|
||||
swap(set8700_A[0], set8700_A[1]), set8700_A == list(3,4,2,1)
|
||||
protect(set8700_A[0]) == 0 ## status moved
|
||||
protect(set8700_A[1]) == 1024 ## 4 retains protection
|
||||
|
||||
## Testing list with protected list argument
|
||||
protect(set8700_A, 0), protect(set8700_A) == 0
|
||||
protect(set8700_A, 512), protect(set8700_A) == 512
|
||||
protect(set8700_A[1]) == 1024
|
||||
set8700_L = list(1,set8700_A,3), protect(set8700_L) == 0
|
||||
protect(set8700_L[0]) == 0
|
||||
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
|
||||
## Testing list with "intialization"
|
||||
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
|
||||
set8700_L = {1,set8700_A}, set8700_L[1] == set8700_A
|
||||
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
set8700_L[1] = 2, protect(set8700_L[1]) == 512 ## Not changed
|
||||
|
||||
## Testing matrix with "initialization"
|
||||
set8700_M = mat[3] = {1,set8700_A}, protect(set8700_M) == 0
|
||||
protect(set8700_M[0]) == 0
|
||||
protect(set8700_M[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_M[2]) == 0
|
||||
protect(set8700_M[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
|
||||
## Testing push, pop, append, remove
|
||||
set8700_A = list(1,2), protect(set8700_A,0,1), protect(set8700_A[0]) == 0
|
||||
protect(set8700_A[0], 256), protect(set8700_A[0]) == 256
|
||||
protect(set8700_A[1]) == 0
|
||||
append(set8700_A, pop(set8700_A)), protect(set8700_A[0]) == 0
|
||||
protect(set8700_A[1]) == 256
|
||||
push(set8700_A, remove(set8700_A)), protect(set8700_A[0]) == 256
|
||||
protect(set8700_A[1]) == 0
|
||||
|
||||
## Testing operation-assignments
|
||||
set8700_A = 5, protect(set8700_A,1024), protect(set8700_A) == 1024
|
||||
protect(set8700_A, 1024), set8700_A = 7, protect(set8700_A) == 1024
|
||||
protect(set8700_A,1024), set8700_A += 2, protect(set8700_A) == 1024
|
||||
protect(set8700_A,1024), set8700_A *= 2, protect(set8700_A) == 1024
|
||||
protect(set8700_A,1024), set8700_A |= 2, protect(set8700_A) == 1024
|
||||
protect(set8700_A,1024), set8700_A &= 2, protect(set8700_A) == 1024
|
||||
protect(set8700_A,1024), set8700_A ^= 2, protect(set8700_A) == 1024
|
||||
|
||||
protect(set8700_B,0), set8700_B = set8700_getA1(), protect(set8700_B) == 1024
|
||||
protect(set8700_B,0), set8700_B = set8700_getA2(), protect(set8700_B) == 1024
|
||||
set8700_B = set8700_getvar(), protect(set8700_B) == 1024 + 256
|
||||
|
||||
set8700_x = 7, protect(set8700_x) == 0
|
||||
protect(7,2) == error(10234)
|
||||
protect(set8700_x,2.5) == error(10235)
|
||||
protect(set8700_x,"abc") == error(10235)
|
||||
protect(set8700_x, 1e6) == error(10235)
|
||||
protect(set8700_x,1), (set8700_x = 2) == error(10366)
|
||||
(set8700_x = 3 + 4) == error(10366)
|
||||
|
||||
protect(set8700_x,2), protect(set8700_x) == 3
|
||||
protect(set8700_x,-1), protect(set8700_x) == 2
|
||||
(set8700_x = 2) == error(10368)
|
||||
(set8700_x = 3 + 4) == 7
|
||||
protect(set8700_x,2), ++set8700_x == error(10379)
|
||||
set8700_x == 7
|
||||
--set8700_x == error(10382)
|
||||
set8700_x == 7
|
||||
set8700_x++ == error(10385)
|
||||
set8700_x == 7
|
||||
set8700_x-- == error(10388)
|
||||
|
||||
protect(set8700_A,0), protect(set8700_A,16), 1
|
||||
set8700_A = "abcdef", protect(set8700_A) == 16 ## No copy to set8700_A
|
||||
protect(set8700_B,0), set8700_B = "xyz", protect(set8700_B) == 0
|
||||
copy(set8700_B, set8700_A) == error(10226)
|
||||
set8700_A == "abcdef" ## set8700_A not changed
|
||||
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
|
||||
copy(set8700_B,set8700_A,,,3) == error(10225)
|
||||
set8700_A == "xyzdef"
|
||||
protect(set8700_B,0), copy(set8700_B,set8700_A,,,3), set8700_A == "xyzxyz"
|
||||
|
||||
set8700_A = "abcdef", protect(set8700_A, 16), swap(set8700_A[0], set8700_A[5]) == error(10371)
|
||||
set8700_A == "abcdef"
|
||||
protect(set8700_A,0), isnull(swap(set8700_A[0], set8700_A[5]))
|
||||
set8700_A == "fbcdea"
|
||||
protect(set8700_A,2), ++set8700_A[0] == error(10377)
|
||||
--set8700_A[1] == error(10380)
|
||||
set8700_A[2]++ == error(10383)
|
||||
set8700_A[3]-- == error(10386)
|
||||
set8700_A == "fbcdea"
|
||||
protect(set8700_A,0), ++set8700_A[0] == 'g'
|
||||
--set8700_A[1] == 'a'
|
||||
set8700_A[2]++ == ord('c')
|
||||
set8700_A[3]-- == ord('d')
|
||||
set8700_A == "gadcea"
|
||||
|
||||
protect(set8700_x,0), protect(set8700_y,0), protect(set8700_x,256), protect(set8700_y,512),1
|
||||
quomod(11,4,set8700_x,set8700_y), set8700_x == 2 && set8700_y == 3
|
||||
protect(set8700_x) == 256
|
||||
protect(set8700_y) == 512
|
||||
|
||||
set8700_A = mat[3]; protect(set8700_A[0], 1024); protect(set8700_A[0]) == 1024
|
||||
set8700_x = 7, protect(set8700_x,0), protect(set8700_x, 512), 1
|
||||
set8700_A = {set8700_x,,set8700_x}, protect(set8700_A[0]) == 1536
|
||||
protect(set8700_A[1]) == 0
|
||||
protect(set8700_A[2]) == 512
|
||||
protect(set8700_A,16), protect(set8700_A) == 16 ## No copy to
|
||||
set8700_A == (mat[3] = {7,0,7})
|
||||
set8700_A = {1,2,3}, errno() == 10390;
|
||||
set8700_A == (mat[3] = {7,0,7})
|
||||
|
||||
protect(set8700_A,0), set8700_A = {1,2,3}, set8700_A == (mat[3] = {1,2,3})
|
||||
protect(set8700_A[1],1), protect(set8700_A[1]) == 1
|
||||
set8700_A = {4,5,6}, errno() == 10394
|
||||
set8700_A == (mat[3] = {4,2,6})
|
||||
modify(7, "set8700_f") == error(10405)
|
||||
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,0), modify(set8700_A, "h") == error(10408)
|
||||
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
|
||||
protect(set8700_A,0,1), modify(set8700_A, "set8700_f") == null()
|
||||
set8700_A == list(4,9,25)
|
||||
modify(set8700_A,"set8700_g") == null()
|
||||
protect(set8700_A[0]) == 0
|
||||
protect(set8700_A[1]) == 256 && protect(set8700_A[2]) == 256
|
||||
|
||||
set8700_A = 0, protect(set8700_A,0), set8700_A = pop(2), set8700_A == error(10181)
|
||||
set8700_A = pop(list(1,2,3)), set8700_A == error(10181)
|
||||
set8700_B = set8700_A = pop(2), set8700_B == error(10181)
|
||||
set8700_A = 32, protect(set8700_A,8), (set8700_A = pop(2)) == error(10370)
|
||||
set8700_A == 32
|
||||
set8700_B = set8700_A = pop(2), set8700_B == error(10370)
|
||||
## Testing copying of protected elements and initialization
|
||||
set8700_M1 = mat[3], protect(set8700_M1,0), protect(set8700_M1[1],1), protect(set8700_M1[1]) == 1
|
||||
set8700_M2 = mat[3], protect(set8700_M2,0), protect(set8700_M2[2],4), protect(set8700_M2[2]) == 4
|
||||
set8700_L = list(set8700_M1, set8700_M2), protect(set8700_L[0][1]) == 1 && protect(set8700_L[1][2]) == 4
|
||||
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_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 == 10 ## All initialization terms evaluated
|
||||
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
|
||||
protect(set8700_P,16), set8700_Q = set8700_P, set8700_Q = {5,6,7}, set8700_Q == set8700_P
|
||||
set8700_P == (obj set8700_point = {1,2,3})
|
||||
set8700_L = list(mat[1] = {set8700_P}), protect(set8700_L[0][0]) == 16
|
||||
set8700_L = {{{4,5,6}}}, set8700_L[0][0] == set8700_P
|
||||
protect(set8700_L,0,2), set8700_L = {{{4,5,6}}}, set8700_L[0][0] == (obj set8700_point = {4,5,6})
|
||||
|
||||
## Testing quomod
|
||||
quomod(14,5,3,4) == error(10374)
|
||||
global set8700_a,set8700_b; quomod("abc", 4, set8700_a, set8700_b) == error(10375)
|
||||
quomod(14,5,set8700_a,set8700_b,0) == 1 && set8700_a == 2 && set8700_b == 4
|
||||
quomod(14,5,set8700_a,set8700_b,1) == 1 && set8700_a == 3 && set8700_b == -1
|
||||
quomod("abc",2,set8700_a,set8700_b) == error(10375)
|
||||
set8700_a = "abc"; quomod(14,5,set8700_a,set8700_b) == error(10375)
|
||||
set8700_a = null(); quomod(14,5,set8700_a,set8700_b,24) == 1; set8700_a == 3 && set8700_b == -1
|
||||
quomod(14,5,set8700_a,set8700_a) == error(10374)
|
||||
quomod(14,5,set8700_a,set8700_b,-1) == error(10375)
|
||||
protect(set8700_a,1); quomod(17,2,set8700_a,set8700_b) == error(10376)
|
||||
protect(set8700_a,0); quomod(17,2,set8700_a,set8700_b); set8700_a == 8 && set8700_b == 1
|
||||
set8700_p = &set8700_a, set8700_q = &set8700_b; quomod(14,5,*set8700_p,*set8700_q); *set8700_p == 2 && *set8700_q == 4
|
||||
|
||||
## Testing estr
|
||||
base(1/3) == 10
|
||||
strcmp(estr(null()), "\"\"") == 0
|
||||
strcmp(estr(bernoulli(48)), "-5609403368997817686249127547/46410") == 0
|
||||
strcmp(estr(sin(3i)), "1001787492740990189897i/100000000000000000000") == 0
|
||||
base(10) == 1/3
|
||||
strcmp(estr("fizzbin"), "\"fizzbin\"") == 0
|
||||
strcmp(estr(set8700_c), "mat[5]={1,2+3i,-5+4i,6+5i,-7i}") == 0
|
||||
strcmp(estr(set8700_e), "mat[16]={0,1,0,0,2,-3/2,2,-1/2,-3,1/2,-1,1/2,1,0,0,0}") == 0
|
||||
strcmp(estr(list(2,3,5)), "list(2,3,5)") == 0
|
71
cal/smallfactors.cal
Normal file
71
cal/smallfactors.cal
Normal file
@@ -0,0 +1,71 @@
|
||||
/*
|
||||
* smallfactors - find the factors of a number < 2^32
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
define smallfactors(x0)
|
||||
{
|
||||
local d q x flist tuple w;
|
||||
|
||||
if (x >= (2 ^ 32) - 1)
|
||||
return newerror("smallfactors: number must be < 2^32 -1");
|
||||
|
||||
tuple = mat[2];
|
||||
flist = list();
|
||||
x = x0;
|
||||
d = 2;
|
||||
q = 0;
|
||||
tuple[0] = d;
|
||||
if (x < 2)
|
||||
return 0;
|
||||
do {
|
||||
q = x // d;
|
||||
while (x == (q * d)) {
|
||||
tuple[0] = d;
|
||||
tuple[1]++;
|
||||
x = floor(q);
|
||||
q = x // d;
|
||||
}
|
||||
d = nextprime(d);
|
||||
if (tuple[1] > 0)
|
||||
append(flist, tuple);
|
||||
tuple = mat[2];
|
||||
} while (d <= x);
|
||||
return flist;
|
||||
}
|
||||
|
||||
define printsmallfactors(flist)
|
||||
{
|
||||
local k;
|
||||
for (k = 0; k < size(flist); k++) {
|
||||
print flist[k][0]:"^":flist[k][1];
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "smallfactors(x0)";
|
||||
print "printsmallfactors(flist)";
|
||||
|
||||
}
|
70
cal/solve.cal
Normal file
70
cal/solve.cal
Normal file
@@ -0,0 +1,70 @@
|
||||
/*
|
||||
* solve - solve f(x) = 0 to within the desired error value for x
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.3 $
|
||||
* @(#) $Id: solve.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/solve.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Solve the equation f(x) = 0 to within the desired error value for x.
|
||||
* The function 'f' must be defined outside of this routine, and the low
|
||||
* and high values are guesses which must produce values with opposite signs.
|
||||
*/
|
||||
|
||||
|
||||
define solve(low, high, epsilon)
|
||||
{
|
||||
local flow, fhigh, fmid, mid, places;
|
||||
|
||||
if (isnull(epsilon))
|
||||
epsilon = epsilon();
|
||||
if (epsilon <= 0)
|
||||
quit "Non-positive epsilon value";
|
||||
places = highbit(1 + int(1/epsilon)) + 1;
|
||||
flow = f(low);
|
||||
if (abs(flow) < epsilon)
|
||||
return low;
|
||||
fhigh = f(high);
|
||||
if (abs(fhigh) < epsilon)
|
||||
return high;
|
||||
if (sgn(flow) == sgn(fhigh))
|
||||
quit "Non-opposite signs";
|
||||
while (1) {
|
||||
mid = bround(high - fhigh * (high - low) / (fhigh - flow),
|
||||
places);
|
||||
if ((mid == low) || (mid == high))
|
||||
places++;
|
||||
fmid = f(mid);
|
||||
if (abs(fmid) < epsilon)
|
||||
return mid;
|
||||
if (sgn(fmid) == sgn(flow)) {
|
||||
low = mid;
|
||||
flow = fmid;
|
||||
} else {
|
||||
high = mid;
|
||||
fhigh = fmid;
|
||||
}
|
||||
}
|
||||
}
|
1469
cal/specialfunctions.cal
Normal file
1469
cal/specialfunctions.cal
Normal file
File diff suppressed because it is too large
Load Diff
502
cal/statistics.cal
Normal file
502
cal/statistics.cal
Normal file
@@ -0,0 +1,502 @@
|
||||
/*
|
||||
* statistics - Some assorted statistics functions.
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: statistics.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/statistics.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
/*
|
||||
* get dependencies
|
||||
*/
|
||||
read -once factorial2 brentsolve
|
||||
|
||||
|
||||
/*******************************************************************************
|
||||
*
|
||||
*
|
||||
* Continuous distributions
|
||||
*
|
||||
*
|
||||
******************************************************************************/
|
||||
|
||||
/* regularized incomplete gamma function like in Octave, hence the name */
|
||||
define gammaincoctave(z,a){
|
||||
local tmp;
|
||||
tmp = gamma(z);
|
||||
return (tmp-gammainc(a,z))/tmp;
|
||||
}
|
||||
|
||||
/* Inverse incomplete beta function. Old and slow. */
|
||||
static __CZ__invbeta_a;
|
||||
static __CZ__invbeta_b;
|
||||
static __CZ__invbeta_x;
|
||||
define __CZ__invbeta(x){
|
||||
return __CZ__invbeta_x-__CZ__ibetaas63(x,__CZ__invbeta_a,__CZ__invbeta_b);
|
||||
}
|
||||
|
||||
define invbetainc_slow(x,a,b){
|
||||
local flag ret eps;
|
||||
/* place checks and balances here */
|
||||
eps = epsilon();
|
||||
if(.5 < x){
|
||||
__CZ__invbeta_x = 1 - x;
|
||||
__CZ__invbeta_a = b;
|
||||
__CZ__invbeta_b = a;
|
||||
flag = 1;
|
||||
}
|
||||
else{
|
||||
__CZ__invbeta_x = x;
|
||||
__CZ__invbeta_a = a;
|
||||
__CZ__invbeta_b = b;
|
||||
flag = 0;
|
||||
}
|
||||
|
||||
ret = brentsolve2(0,1,1);
|
||||
|
||||
if(flag == 1)
|
||||
ret = 1-ret;
|
||||
epsilon(eps);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Inverse incomplete beta function. Still old but not as slow as the function
|
||||
above. */
|
||||
/*
|
||||
Purpose:
|
||||
|
||||
invbetainc computes inverse of the incomplete Beta function.
|
||||
|
||||
Licensing:
|
||||
|
||||
This code is distributed under the GNU LGPL license.
|
||||
|
||||
Modified:
|
||||
|
||||
10 August 2013
|
||||
|
||||
Author:
|
||||
|
||||
Original FORTRAN77 version by GW Cran, KJ Martin, GE Thomas.
|
||||
C version by John Burkardt.
|
||||
Calc version by Christoph Zurnieden
|
||||
|
||||
Reference:
|
||||
|
||||
GW Cran, KJ Martin, GE Thomas,
|
||||
Remark AS R19 and Algorithm AS 109:
|
||||
A Remark on Algorithms AS 63: The Incomplete Beta Integral
|
||||
and AS 64: Inverse of the Incomplete Beta Integeral,
|
||||
Applied Statistics,
|
||||
Volume 26, Number 1, 1977, pages 111-114.
|
||||
|
||||
Parameters:
|
||||
|
||||
Input, P, Q, the parameters of the incomplete
|
||||
Beta function.
|
||||
|
||||
Input, BETA, the logarithm of the value of
|
||||
the complete Beta function.
|
||||
|
||||
Input, ALPHA, the value of the incomplete Beta
|
||||
function. 0 <= ALPHA <= 1.
|
||||
|
||||
Output, the argument of the incomplete
|
||||
Beta function which produces the value ALPHA.
|
||||
|
||||
Local Parameters:
|
||||
|
||||
Local, SAE, the most negative decimal exponent
|
||||
which does not cause an underflow.
|
||||
*/
|
||||
define invbetainc(x,a,b){
|
||||
return __CZ__invbetainc(a,b,lnbeta(a,b),x);
|
||||
}
|
||||
|
||||
define __CZ__invbetainc(p,q,beta,alpha){
|
||||
local a acu adj fpu g h iex indx pp prev qq r s sae sq t tx value;
|
||||
local w xin y yprev places eps;
|
||||
|
||||
/* Dirty trick, don't try at home */
|
||||
eps= epsilon(epsilon()^2);
|
||||
sae = -((log(1/epsilon())/log(2))//2);
|
||||
fpu = 10.0^sae;
|
||||
|
||||
places = highbit(1 + int(1/epsilon())) + 1;
|
||||
value = alpha;
|
||||
if( p <= 0.0 ){
|
||||
epsilon(eps);
|
||||
return newerror("invbeta: argument p <= 0");
|
||||
}
|
||||
if( q <= 0.0 ){
|
||||
epsilon(eps);
|
||||
return newerror("invbeta: argument q <= 0");
|
||||
}
|
||||
|
||||
if( alpha < 0.0 || 1.0 < alpha ){
|
||||
epsilon(eps);
|
||||
return newerror("invbeta: argument alpha out of domain");
|
||||
}
|
||||
if( alpha == 0.0 ){
|
||||
epsilon(eps);
|
||||
return 0;
|
||||
}
|
||||
if( alpha == 1.0 ){
|
||||
epsilon(eps);
|
||||
return 1;
|
||||
}
|
||||
if ( 0.5 < alpha ){
|
||||
a = 1.0 - alpha;
|
||||
pp = q;
|
||||
qq = p;
|
||||
indx = 1;
|
||||
}
|
||||
else{
|
||||
a = alpha;
|
||||
pp = p;
|
||||
qq = q;
|
||||
indx = 0;
|
||||
}
|
||||
r = sqrt ( - ln ( a * a ) );
|
||||
|
||||
y = r-(2.30753+0.27061*r)/(1.0+(0.99229+0.04481*r)*r);
|
||||
|
||||
if ( 1.0 < pp && 1.0 < qq ){
|
||||
r = ( y * y - 3.0 ) / 6.0;
|
||||
s = 1.0 / ( pp + pp - 1.0 );
|
||||
t = 1.0 / ( qq + qq - 1.0 );
|
||||
h = 2.0 / ( s + t );
|
||||
w = y*sqrt(h+r)/h-(t-s)*(r+5.0/6.0-2.0/(3.0*h));
|
||||
value = pp / ( pp + qq * exp ( w + w ) );
|
||||
}
|
||||
else{
|
||||
r = qq + qq;
|
||||
t = 1.0 / ( 9.0 * qq );
|
||||
t = r * ( 1.0 - t + y * sqrt ( t )^ 3 );
|
||||
|
||||
if ( t <= 0.0 ){
|
||||
value = 1.0 - exp ( ( ln ( ( 1.0 - a ) * qq ) + beta ) / qq );
|
||||
}
|
||||
else{
|
||||
t = ( 4.0 * pp + r - 2.0 ) / t;
|
||||
|
||||
if ( t <= 1.0 ) {
|
||||
value = exp ( ( ln ( a * pp ) + beta ) / pp );
|
||||
}
|
||||
else{
|
||||
value = 1.0 - 2.0 / ( t + 1.0 );
|
||||
}
|
||||
}
|
||||
}
|
||||
r = 1.0 - pp;
|
||||
t = 1.0 - qq;
|
||||
yprev = 0.0;
|
||||
sq = 1.0;
|
||||
prev = 1.0;
|
||||
|
||||
if ( value < 0.0001 )
|
||||
value = 0.0001;
|
||||
|
||||
if ( 0.9999 < value )
|
||||
value = 0.9999;
|
||||
|
||||
acu = 10^sae;
|
||||
|
||||
for ( ; ; ){
|
||||
y = bround(__CZ__ibetaas63( value, pp, qq, beta),places);
|
||||
xin = value;
|
||||
y = bround(exp(ln(y-a)+(beta+r*ln(xin)+t*ln(1.0- xin ) )),places);
|
||||
|
||||
if ( y * yprev <= 0.0 ) {
|
||||
prev = max ( sq, fpu );
|
||||
}
|
||||
|
||||
g = 1.0;
|
||||
|
||||
for ( ; ; ){
|
||||
for ( ; ; ){
|
||||
adj = g * y;
|
||||
sq = adj * adj;
|
||||
if ( sq < prev ){
|
||||
tx = value - adj;
|
||||
if ( 0.0 <= tx && tx <= 1.0 ) break;
|
||||
}
|
||||
g = g / 3.0;
|
||||
}
|
||||
if ( prev <= acu ){
|
||||
if ( indx )
|
||||
value = 1.0 - value;
|
||||
epsilon(eps);
|
||||
return value;
|
||||
}
|
||||
if ( y * y <= acu ){
|
||||
if ( indx )
|
||||
value = 1.0 - value;
|
||||
epsilon(eps);
|
||||
return value;
|
||||
}
|
||||
if ( tx != 0.0 && tx != 1.0 )
|
||||
break;
|
||||
g = g / 3.0;
|
||||
}
|
||||
if ( tx == value ) break;
|
||||
value = tx;
|
||||
yprev = y;
|
||||
}
|
||||
if ( indx )
|
||||
value = 1.0 - value;
|
||||
|
||||
epsilon(eps);
|
||||
return value;
|
||||
}
|
||||
|
||||
/*******************************************************************************
|
||||
*
|
||||
*
|
||||
* Beta distribution
|
||||
*
|
||||
*
|
||||
******************************************************************************/
|
||||
|
||||
define betapdf(x,a,b){
|
||||
if(x<0 || x>1) return newerror("betapdf: parameter x out of domain");
|
||||
if(a<=0) return newerror("betapdf: parameter a out of domain");
|
||||
if(b<=0) return newerror("betapdf: parameter b out of domain");
|
||||
|
||||
return 1/beta(a,b) *x^(a-1)*(1-x)^(b-1);
|
||||
}
|
||||
|
||||
define betacdf(x,a,b){
|
||||
if(x<0 || x>1) return newerror("betacdf: parameter x out of domain");
|
||||
if(a<=0) return newerror("betacdf: parameter a out of domain");
|
||||
if(b<=0) return newerror("betacdf: parameter b out of domain");
|
||||
|
||||
return betainc(x,a,b);
|
||||
}
|
||||
|
||||
define betacdfinv(x,a,b){
|
||||
return invbetainc(x,a,b);
|
||||
}
|
||||
|
||||
define betamedian(a,b){
|
||||
local t106 t104 t103 t105 approx ret;
|
||||
if(a == b) return 1/2;
|
||||
if(a == 1 && b > 0) return 1-(1/2)^(1/b);
|
||||
if(a > 0 && b == 1) return (1/2)^(1/a);
|
||||
if(a == 3 && b == 2){
|
||||
/* Yes, the author is not ashamed to ask Maxima for the exact solution
|
||||
of a quartic equation. */
|
||||
t103 = ( (2^(3/2))/27 +4/27 )^(1/3);
|
||||
t104 = sqrt( ( 9*t103^2 + 4*t103 + 2 )/(t103) )/3;
|
||||
t105 = -t103-2/(9*t103) +8/9;
|
||||
t106 = sqrt( (27*t104*t105+16)/(t104) )/(2*3^(3/2));
|
||||
return -t106+t104/2+1/3;
|
||||
}
|
||||
if(a == 2 && b == 3){
|
||||
t103 = ( (2^(3/2))/27 +4/27 )^(1/3);
|
||||
t104 = sqrt( ( 9*t103^2 + 4*t103 + 2 )/(t103) )/3;
|
||||
t105 = -t103-2/(9*t103) +8/9;
|
||||
t106 = sqrt( (27*t104*t105+16)/(t104) )/(2*3^(3/2));
|
||||
return 1-(-t106+t104/2+1/3);
|
||||
}
|
||||
return invbetainc(1/2,a,b);
|
||||
}
|
||||
|
||||
define betamode(a,b){
|
||||
if(a + b == 2) return newerror("betamod: a + b = 2 = division by zero");
|
||||
return (a-1)/(a+b-2);
|
||||
}
|
||||
|
||||
define betavariance(a,b){
|
||||
return (a*b)/( (a+b)^2*(a+b+1) );
|
||||
}
|
||||
|
||||
define betalnvariance(a,b){
|
||||
return polygamma(1,a)-polygamma(a+b);
|
||||
}
|
||||
|
||||
define betaskewness(a,b){
|
||||
return (2*(b-a)*sqrt(a+b+1))/( (a+b+1)*sqrt(a*b) );
|
||||
}
|
||||
|
||||
define betakurtosis(a,b){
|
||||
local num denom;
|
||||
|
||||
num = 6*( (a-b)^2*(a+b+1)-a*b*(a+b+2));
|
||||
denom = a*b*(a+b+2)*(a+b+3);
|
||||
return num/denom;
|
||||
}
|
||||
|
||||
define betaentropy(a,b){
|
||||
return lnbeta(a,b)-(a-1)*psi(a)-(b-1)*psi(b)+(a+b+1)*psi(a+b);
|
||||
|
||||
}
|
||||
|
||||
/*******************************************************************************
|
||||
*
|
||||
*
|
||||
* Normal (Gaussian) distribution
|
||||
*
|
||||
*
|
||||
******************************************************************************/
|
||||
|
||||
|
||||
define normalpdf(x,mu,sigma){
|
||||
return 1/(sqrt(2*pi()*sigma^2))*exp( ( (x-mu)^2 )/( 2*sigma^2 ) );
|
||||
}
|
||||
|
||||
define normalcdf(x,mu,sigma){
|
||||
return 1/2*(1+erf( ( x-mu )/( sqrt(2*sigma^2) ) ) );
|
||||
}
|
||||
|
||||
define probit(p){
|
||||
if(p<0 || p > 1) return newerror("probit: p out of domain 0<=p<=1");
|
||||
return sqrt(2)*ervinv(2*p-1);
|
||||
}
|
||||
|
||||
define normalcdfinv(p,mu,sigma){
|
||||
if(p<0 || p > 1) return newerror("normalcdfinv: p out of domain 0<=p<=1");
|
||||
return mu+ sigma*probit(p);
|
||||
}
|
||||
|
||||
define normalmean(mu,sigma){return mu;}
|
||||
|
||||
define normalmedian(mu,sigma){return mu;}
|
||||
|
||||
define normalmode(mu,sigma){return mu;}
|
||||
|
||||
define normalvariance(mu,sigma){return sigma^2;}
|
||||
|
||||
define normalskewness(mu,sigma){return 0;}
|
||||
|
||||
define normalkurtosis(mu,sigma){return 0;}
|
||||
|
||||
define normalentropy(mu,sigma){
|
||||
return 1/3*ln( 2*pi()*exp(1)*sigma^2 );
|
||||
}
|
||||
|
||||
/* moment generating f. */
|
||||
define normalmgf(mu,sigma,t){
|
||||
return exp(mu*t+1/2*sigma^2*t^2);
|
||||
}
|
||||
|
||||
/* characteristic f. */
|
||||
define normalcf(mu,sigma,t){
|
||||
return exp(mu*t-1/2*sigma^2*t^2);
|
||||
}
|
||||
|
||||
|
||||
/*******************************************************************************
|
||||
*
|
||||
*
|
||||
* Chi-squared distribution
|
||||
*
|
||||
*
|
||||
******************************************************************************/
|
||||
|
||||
define chisquaredpdf(x,k){
|
||||
if(!isint(k) || k<0) return newerror("chisquaredpdf: k not in N");
|
||||
if(im(x) || x<0) return newerror("chisquaredpdf: x not in +R");
|
||||
/* The gamma function does not check for half integers, do it here? */
|
||||
return 1/(2^(k/2)*gamma(k/2))*x^((k/2)-1)*exp(-x/2);
|
||||
}
|
||||
|
||||
define chisquaredpcdf(x,k){
|
||||
if(!isint(k) || k<0) return newerror("chisquaredcdf: k not in N");
|
||||
if(im(x) || x<0) return newerror("chisquaredcdf: x not in +R");
|
||||
|
||||
return 1/(gamma(k/2))*gammainc(k/2,x/2);
|
||||
}
|
||||
|
||||
define chisquaredmean(x,k){return k;}
|
||||
|
||||
define chisquaredmedian(x,k){
|
||||
/* TODO: implement a FAST inverse incomplete gamma-{q,p} function */
|
||||
return k*(1-2/(9*k))^3;
|
||||
}
|
||||
|
||||
define chisquaredmode(x,k){return max(k-2,0);}
|
||||
define chisquaredvariance(x,k){return 2*k;}
|
||||
define chisquaredskewness(x,k){return sqrt(8/k);}
|
||||
define chisquaredkurtosis(x,k){return 12/k;}
|
||||
define chisquaredentropy(x,k){
|
||||
return k/2+ln(2*gamma(k/2)) + (1-k/2)*psi(k/2);
|
||||
}
|
||||
|
||||
define chisquaredmfg(k,t){
|
||||
if(t>=1/2)return newerror("chisquaredmfg: t >= 1/2");
|
||||
return (1-2*t)^(k/2);
|
||||
}
|
||||
|
||||
define chisquaredcf(k,t){
|
||||
return (1-2*1i*t)^(k/2);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* restore internal function from resource debugging
|
||||
*/
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "gammaincoctave(z,a)";
|
||||
print "invbetainc(x,a,b)";
|
||||
print "betapdf(x,a,b)";
|
||||
print "betacdf(x,a,b)";
|
||||
print "betacdfinv(x,a,b)";
|
||||
print "betamedian(a,b)";
|
||||
print "betamode(a,b)";
|
||||
print "betavariance(a,b)";
|
||||
print "betalnvariance(a,b)";
|
||||
print "betaskewness(a,b)";
|
||||
print "betakurtosis(a,b)";
|
||||
print "betaentropy(a,b)";
|
||||
print "normalpdf(x,mu,sigma)";
|
||||
print "normalcdf(x,mu,sigma)";
|
||||
print "probit(p)";
|
||||
print "normalcdfinv(p,mu,sigma)";
|
||||
print "normalmean(mu,sigma)";
|
||||
print "normalmedian(mu,sigma)";
|
||||
print "normalmode(mu,sigma)";
|
||||
print "normalvariance(mu,sigma)";
|
||||
print "normalskewness(mu,sigma)";
|
||||
print "normalkurtosis(mu,sigma)";
|
||||
print "normalentropy(mu,sigma)";
|
||||
print "normalmgf(mu,sigma,t)";
|
||||
print "normalcf(mu,sigma,t)";
|
||||
print "chisquaredpdf(x,k)";
|
||||
print "chisquaredpcdf(x,k)";
|
||||
print "chisquaredmean(x,k)";
|
||||
print "chisquaredmedian(x,k)";
|
||||
print "chisquaredmode(x,k)";
|
||||
print "chisquaredvariance(x,k)";
|
||||
print "chisquaredskewness(x,k)";
|
||||
print "chisquaredkurtosis(x,k)";
|
||||
print "chisquaredentropy(x,k)";
|
||||
print "chisquaredmfg(k,t)";
|
||||
print "chisquaredcf(k,t)";
|
||||
}
|
||||
|
41
cal/strings.cal
Normal file
41
cal/strings.cal
Normal file
@@ -0,0 +1,41 @@
|
||||
/*
|
||||
* strings - implementation of some of the macros in ctype.h
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*/
|
||||
|
||||
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
define isascii(c){
|
||||
c = ord(c);
|
||||
return (c >= 0 && c< 128);
|
||||
}
|
||||
|
||||
define isblank(c){
|
||||
c = ord(c);
|
||||
return ( c == 32 || c == 9 );
|
||||
}
|
||||
|
||||
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "isascii(c)";
|
||||
print "isblank(c)";
|
||||
}
|
||||
|
65
cal/sumsq.cal
Normal file
65
cal/sumsq.cal
Normal file
@@ -0,0 +1,65 @@
|
||||
/*
|
||||
* sumsq - find unique two positive integers whose squares sum to a given prime
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: sumsq.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/sumsq.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Determine the unique two positive integers whose squares sum to the
|
||||
* specified prime. This is always possible for all primes of the form
|
||||
* 4N+1, and always impossible for primes of the form 4N-1.
|
||||
*/
|
||||
|
||||
|
||||
define ss(p)
|
||||
{
|
||||
local a, b, i, p4;
|
||||
|
||||
if (p == 2) {
|
||||
print "1^2 + 1^2 = 2";
|
||||
return;
|
||||
}
|
||||
if ((p % 4) != 1) {
|
||||
print p, "is not of the form 4N+1";
|
||||
return;
|
||||
}
|
||||
if (!ptest(p, min(p-2, 10))) {
|
||||
print p, "is not a prime";
|
||||
return;
|
||||
}
|
||||
p4 = (p - 1) / 4;
|
||||
i = 2;
|
||||
do {
|
||||
a = pmod(i++, p4, p);
|
||||
} while ((a^2 % p) == 1);
|
||||
b = p;
|
||||
while (b^2 > p) {
|
||||
i = b % a;
|
||||
b = a;
|
||||
a = i;
|
||||
}
|
||||
print a : "^2 +" , b : "^2 =" , a^2 + b^2;
|
||||
}
|
186
cal/sumtimes.cal
Normal file
186
cal/sumtimes.cal
Normal file
@@ -0,0 +1,186 @@
|
||||
/*
|
||||
* sumtimes - runtimes evaluating sums & squares of large lists and mats
|
||||
*
|
||||
* Copyright (C) 2006 Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: sumtimes.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/sumtimes.cal,v $
|
||||
*
|
||||
* Under source code control: 2006/06/22 17:29
|
||||
* File existed as early as: 2006
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
global sumtimes_t0, sumtimes_t1, sumtimes_t2, sumtimes_t3;
|
||||
global sumtimes_A, sumtimes_B;
|
||||
config("tilde", 0),;
|
||||
|
||||
define timematsum(N) {
|
||||
local n, s, p, ptop;
|
||||
|
||||
sumtimes_A = mat[N];
|
||||
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
|
||||
ptop = &sumtimes_A[n-1];
|
||||
sumtimes_t0 = usertime();
|
||||
for (s = n = 0; n < N; n++) s += sumtimes_A[n];
|
||||
sumtimes_t1 = usertime();
|
||||
for (s = 0, p = &sumtimes_A[0]; p <= ptop; p++) s += *p;
|
||||
sumtimes_t2 = usertime();
|
||||
s = matsum(sumtimes_A);
|
||||
sumtimes_t3 = usertime();
|
||||
|
||||
print "Matrix sum runtimes";
|
||||
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
printf('\t"For" loop using pointers:\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
|
||||
printf('\tUsing builtin "matsum":\t\t%.4f\n', sumtimes_t3 - sumtimes_t2);
|
||||
}
|
||||
|
||||
define timelistsum(N) {
|
||||
local n, s;
|
||||
|
||||
sumtimes_A = makelist(N);
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
|
||||
sumtimes_t0 = usertime();
|
||||
for (s = n = 0; n < N; n++) s += sumtimes_A[n];
|
||||
sumtimes_t1 = usertime();
|
||||
s = sum(sumtimes_A);
|
||||
sumtimes_t2 = usertime();
|
||||
print "List sum runtimes";
|
||||
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
printf('\tUsing builtin "sum":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
|
||||
}
|
||||
|
||||
|
||||
define timematsort(N) {
|
||||
local n;
|
||||
|
||||
sumtimes_A = mat[N];
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
sumtimes_t0 = usertime();
|
||||
sort(sumtimes_A);
|
||||
sumtimes_t1 = usertime();
|
||||
printf('\tMatrix sort runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
}
|
||||
|
||||
|
||||
define timelistsort(N) {
|
||||
local n;
|
||||
|
||||
sumtimes_A = makelist(N);
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
sumtimes_t0 = usertime();
|
||||
sort(sumtimes_A);
|
||||
sumtimes_t1 = usertime();
|
||||
printf('\tList sort runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
}
|
||||
|
||||
define timematreverse(N) {
|
||||
local n;
|
||||
|
||||
sumtimes_A = mat[N];
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
sumtimes_t0 = usertime();
|
||||
reverse(sumtimes_A);
|
||||
sumtimes_t1 = usertime();
|
||||
printf('\tMatrix reverse runtime %.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
}
|
||||
|
||||
define timelistreverse(N) {
|
||||
local n;
|
||||
|
||||
sumtimes_A = makelist(N);
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
sumtimes_t0 = usertime();
|
||||
reverse(sumtimes_A);
|
||||
sumtimes_t1 = usertime();
|
||||
printf('\tList reverse runtime:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
}
|
||||
|
||||
define timematssq(N) {
|
||||
local n, s, p, ptop;
|
||||
|
||||
sumtimes_A = mat[N];
|
||||
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
|
||||
ptop = &sumtimes_A[n-1];
|
||||
sumtimes_t0 = usertime();
|
||||
for (s = n = 0; n < N; n++) s += sumtimes_A[n]^2;
|
||||
sumtimes_t1 = usertime();
|
||||
for (s = 0, p = &sumtimes_A[0]; p <= ptop; p++) s += (*p)^2;
|
||||
sumtimes_t2 = usertime();
|
||||
|
||||
print "Matrix sum of squares runtimes";
|
||||
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
printf('\t"For" loop using pointers:\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
|
||||
}
|
||||
|
||||
define timelistssq(N) {
|
||||
local n, s;
|
||||
|
||||
sumtimes_A = makelist(N);
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(N);
|
||||
|
||||
sumtimes_t0 = usertime();
|
||||
for (s = n = 0; n < N; n++) s += sumtimes_A[n]^2;
|
||||
sumtimes_t1 = usertime();
|
||||
s = ssq(sumtimes_A);
|
||||
sumtimes_t2 = usertime();
|
||||
print "List sum of squares runtimes";
|
||||
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
printf('\tUsing builtin "ssq":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
|
||||
}
|
||||
|
||||
define timehmean(N, M = 10) {
|
||||
local n, s, v1, v2;
|
||||
|
||||
sumtimes_A = makelist(N);
|
||||
for (n = 0; n < N; n++) sumtimes_A[n] = rand(1, M);
|
||||
|
||||
sumtimes_t0 = usertime();
|
||||
for (s = n = 0; n < N; n++) s += 1/sumtimes_A[n];
|
||||
v1 = N/s;
|
||||
sumtimes_t1 = usertime();
|
||||
v2 = hmean(sumtimes_A);
|
||||
sumtimes_t2 = usertime();
|
||||
print v1, v2;
|
||||
print "List harmonic meanruntimes";
|
||||
printf('\tStandard "for" loop:\t\t%.4f\n', sumtimes_t1 - sumtimes_t0);
|
||||
printf('\tUsing builtin "hmean":\t\t%.4f\n', sumtimes_t2 - sumtimes_t1);
|
||||
}
|
||||
|
||||
define doalltimes(N) {
|
||||
timematsum(N);
|
||||
print;
|
||||
timelistsum(N);
|
||||
print;
|
||||
timematssq(N);
|
||||
print;
|
||||
timelistssq(N);
|
||||
print;
|
||||
timematsort(N);
|
||||
timelistsort(N);
|
||||
timematreverse(N);
|
||||
timelistreverse(N);
|
||||
print;
|
||||
}
|
@@ -1,11 +1,33 @@
|
||||
/*
|
||||
* Copyright (c) 1995 David I. Bell
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* surd - calculate using quadratic surds of the form: a + b * sqrt(D).
|
||||
*
|
||||
* Calculate using quadratic surds of the form: a + b * sqrt(D).
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: surd.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/surd.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:38
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj surd {a, b}; /* definition of the surd object */
|
||||
|
||||
global surd_type = -1; /* type of surd (value of D) */
|
||||
@@ -261,7 +283,7 @@ define surd_rel(a, b)
|
||||
return sgn(x^2 - y^2 * surd_type) * sgn(x);
|
||||
}
|
||||
|
||||
if (config("lib_debug") & 3) {
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj surd {a, b} defined";
|
||||
print "surd_type defined";
|
||||
print "set surd_type as needed";
|
32
cal/test1700.cal
Normal file
32
cal/test1700.cal
Normal file
@@ -0,0 +1,32 @@
|
||||
/*
|
||||
* test1700 - 1700 series of the regress.cal test suite
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test1700.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test1700.cal,v $
|
||||
*
|
||||
* Under source code control: 1994/03/14 23:12:51
|
||||
* File existed as early as: 1994
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
++value;
|
@@ -1,14 +1,31 @@
|
||||
/*
|
||||
* Copyright (c) 1995 Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test2300 - 2300 series of the regress.cal test suite
|
||||
*
|
||||
* By: Landon Curt Noll
|
||||
* http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* chongo <was here> /\../\
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* This library is used by the 2300 series of the regress.cal test suite.
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test2300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2300.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/07/09 06:12:13
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
@@ -1,13 +1,34 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test2600 - 2600 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 2600 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.3 $
|
||||
* @(#) $Id: test2600.cal,v 30.3 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2600.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/10/13 00:13:14
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Stringent tests of some of calc's builtin functions.
|
||||
* Most of the tests are concerned with the accuracy of the value
|
||||
@@ -49,6 +70,7 @@
|
||||
* All functions return the number of errors that they detected.
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
|
||||
@@ -69,7 +91,8 @@ define testismult(str, n, verbose)
|
||||
if (!ismult(c,a)) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** Failure with:\na = %d\nb = %d\n", a,b);
|
||||
printf("*** Failure with:\na = %d\nb = %d\n",
|
||||
a,b);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -111,7 +134,8 @@ define testsqrt(str, n, eps, verbose)
|
||||
if (abs(c) > 1) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
|
||||
printf("*** Failure with:\na = %d\neps = %d\n",
|
||||
a,eps);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -156,7 +180,8 @@ define testexp(str, n, eps, verbose)
|
||||
if (abs(c) > 0.02) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
|
||||
printf("*** Failure with:\na = %d\neps = %d\n",
|
||||
a,eps);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -213,7 +238,8 @@ define testln(str, n, eps, verbose)
|
||||
if (abs(c) > 0.5) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
|
||||
printf("*** Failure with:\na = %d\neps = %d\n",
|
||||
a,eps);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -291,6 +317,102 @@ define testpower(str, n, b, eps, verbose)
|
||||
}
|
||||
|
||||
|
||||
define testpower2(str, n, eps, verbose)
|
||||
{
|
||||
local i, a, c, m, min, max;
|
||||
local b;
|
||||
local num;
|
||||
local c2;
|
||||
local oldeps;
|
||||
|
||||
if (isnull(verbose)) verbose = 2;
|
||||
if (verbose > 0) {
|
||||
print str:":",:;
|
||||
}
|
||||
if (isnull(eps))
|
||||
eps = epsilon();
|
||||
oldeps = epsilon(eps);
|
||||
epsilon(eps),;
|
||||
if (!isnum(b))
|
||||
quit "Second argument (exponent) to be a number";
|
||||
min = 1000;
|
||||
max = -1000;
|
||||
for (i = 1; i <= n; i++) {
|
||||
if (verbose > 2) print i,:;
|
||||
|
||||
/* real ^ real */
|
||||
a = rand(1,1e20);
|
||||
a = a / (int(a/2)+rand(1,1e20));
|
||||
b = rand(1,1e20);
|
||||
b = b / (int(b/2)+rand(1,1e20));
|
||||
c = a ^ b;
|
||||
c2 = power(a, b);
|
||||
if (c != c2) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** real^real failure for a = %d\n", a);
|
||||
}
|
||||
}
|
||||
|
||||
/* complex ^ real */
|
||||
a = rand(1,1e20);
|
||||
a = a / (int(a/2)+rand(1,1e20));
|
||||
b = rand(1,1e20);
|
||||
b = b / (int(b/2)+rand(1,1e20));
|
||||
c = (a*1i) ^ b;
|
||||
c2 = power(a*1i, b);
|
||||
if (c != c2) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** comp^real failure for a = %d\n", a);
|
||||
}
|
||||
}
|
||||
|
||||
/* real ^ complex */
|
||||
a = rand(1,1e20);
|
||||
a = a / (int(a/2)+rand(1,1e20));
|
||||
b = rand(1,1e20);
|
||||
b = b / (int(b/2)+rand(1,1e20));
|
||||
c = a ^ (b*1i);
|
||||
c2 = power(a, b*1i);
|
||||
if (c != c2) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** real^comp failure for a = %d\n", a);
|
||||
}
|
||||
}
|
||||
|
||||
/* complex ^ complex */
|
||||
a = rand(1,1e20);
|
||||
a = a / (int(a/2)+rand(1,1e20));
|
||||
b = rand(1,1e20);
|
||||
b = b / (int(b/2)+rand(1,1e20));
|
||||
c = (a*1i) ^ (b*1i);
|
||||
c2 = power(a*1i, b*1i);
|
||||
if (c != c2) {
|
||||
m++;
|
||||
if (verbose > 1) {
|
||||
printf("*** comp^comp failure for a = %d\n", a);
|
||||
}
|
||||
}
|
||||
}
|
||||
epsilon(oldeps),;
|
||||
if (verbose > 0) {
|
||||
if (m) {
|
||||
printf("*** %d error(s)\n", m);
|
||||
printf(" %s: rem/eps min=%d, max=%d\n",
|
||||
str, min, max);
|
||||
} else {
|
||||
printf("no errors\n");
|
||||
}
|
||||
}
|
||||
if (verbose > 1) {
|
||||
printf(" %s: rem/eps min=%0.4d, max=%0.4d\n", str, min, max);
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
|
||||
define cpow(a, b, eps) /* Find rem/eps for power(a,b,eps) */
|
||||
{
|
||||
local v, v1, c, n, d, h;
|
||||
@@ -482,6 +604,7 @@ define test2600(verbose, tnum)
|
||||
err += testsqrt(strcat(str(tnum++),": sqrt",str(i)), n*10,
|
||||
ep, verbose);
|
||||
}
|
||||
err += testpower2(strcat(str(tnum++),": power"), n*4, ep, verbose);
|
||||
if (verbose > 1) {
|
||||
if (err) {
|
||||
print "***", err, "error(s) found in test2600";
|
@@ -1,27 +1,47 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test2700 - 2700 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 2700 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: test2700.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test2700.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/11/01 22:52:25
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* The following script gives a severe test of sqrt(x,y,z) for
|
||||
* The following resource file gives a severe test of sqrt(x,y,z) for
|
||||
* all 128 values of z, randomly produced real and complex x, and randomly
|
||||
* produced nonzero values for y. After loading it, testcsqrt(n) will
|
||||
* test n combinations of x and y; testcsqrt(str,n,2) will print 1 2 3 ...
|
||||
* indicating work in process; testcsqrt(str,n,3) will give information about
|
||||
* errors detected and will print values of x and y used. The
|
||||
* number generators are essentially as in the script I sent yesterday.
|
||||
* errors detected and will print values of x and y used.
|
||||
* I've also defined a function iscomsq(x) which does for complex as well
|
||||
* as real x what issq(x) currently does for real x.
|
||||
*/
|
||||
|
||||
global defaultverbose = 1;
|
||||
global err;
|
||||
|
||||
defaultverbose = 1;
|
||||
|
||||
define mknonnegreal() {
|
||||
switch(rand(8)) {
|
||||
@@ -68,11 +88,11 @@ define mkfrac() = rand(2) ? mkposfrac() : -mkposfrac();
|
||||
define mksquarereal() = mknonnegreal()^2;
|
||||
|
||||
/*
|
||||
* XXX - Should be able to do better than the following. For nonsquare
|
||||
* positive integer less than 1e6, could use
|
||||
* We might be able to do better than the following. For nonsquare
|
||||
* positive integer less than 1e6, could use:
|
||||
* x = rand(1, 1000);
|
||||
* return rand(x^2 + 1, (x + 1)^2);
|
||||
* Maybe could do
|
||||
* Maybe could do:
|
||||
* do
|
||||
* x = mkreal_2700();
|
||||
* while
|
||||
@@ -107,7 +127,8 @@ define testcsqrt(str, n, verbose)
|
||||
if (p) {
|
||||
if (verbose > 0)
|
||||
printf(
|
||||
"*** Type %d failure for x = %r, y = %r, z = %d\n",
|
||||
"*** Type %d failure for x = %r, "
|
||||
"y = %r, z = %d\n",
|
||||
p, x, y, z);
|
||||
m++;
|
||||
}
|
40
cal/test3100.cal
Normal file
40
cal/test3100.cal
Normal file
@@ -0,0 +1,40 @@
|
||||
/*
|
||||
* test3100 - 3100 series of the regress.cal test suite
|
||||
*
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test3100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3100.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/11/28 11:56:57
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj res {r};
|
||||
global md;
|
||||
define res_test(a) = !ismult(a.r, md);
|
||||
define res_sub(a,b) {local obj res v = {(a.r - b.r) % md}; return v;};
|
||||
define res_mul(a,b) {local obj res v = {(a.r * b.r) % md}; return v;};
|
||||
define res_neg(a) {local obj res v = {(-a.r) % md}; return v;};
|
||||
define res_inv(a) {local obj res v = {minv(a.r, md)}; return v;};
|
||||
define res(x) {local obj res v = {x % md}; return v;};
|
@@ -1,16 +1,36 @@
|
||||
/*
|
||||
* Copyright (c) 1995 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test3300 - 3300 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 3300 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test3300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3300.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/12/02 04:27:41
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
define testi(str, n, N, verbose)
|
||||
{
|
||||
@@ -61,9 +81,9 @@ define testr(str, n, N, verbose)
|
||||
for (i = 0; i < n; i++)
|
||||
for (j = 0; j < n; j++)
|
||||
A[i,j] = rand(-(N^2), N^2)/rand(1, N);
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
d1 = det(A);
|
||||
t = runtime() - t;
|
||||
t = usertime() - t;
|
||||
d2 = det(A^2);
|
||||
if (d2 != d1^2) {
|
||||
if (verbose > 0) {
|
@@ -1,13 +1,34 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test3400 - 3400 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 3400 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test3400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3400.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/12/02 05:20:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* tests of performance of some trigonometric functions
|
||||
*
|
||||
@@ -32,8 +53,8 @@
|
||||
* that the two sides might differ by eps. [[test changed to test eps error]]
|
||||
*/
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
global pi1k = pi(1e-1000);
|
||||
|
@@ -1,13 +1,34 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test3500 - 3500 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 3500 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test3500.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test3500.cal,v $
|
||||
*
|
||||
* Under source code control: 1995/12/18 22:50:46
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Stringent tests of the functions frem, fcnt, gcdrem.
|
||||
*
|
||||
@@ -31,8 +52,8 @@
|
||||
*
|
||||
*/
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
define testfrem(x,y,verbose)
|
||||
{
|
@@ -1,13 +1,34 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test4000 - 4000 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 4000 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: test4000.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4000.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/03/13 02:38:45
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Functions for testing and timing ptest, nextcand, prevcand.
|
||||
*
|
||||
@@ -53,8 +74,8 @@
|
||||
* modulus to 1.
|
||||
*/
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* test defaults
|
||||
@@ -124,7 +145,7 @@ define ptimes(str, N, n, count, skip, verbose)
|
||||
mat A[n];
|
||||
for (i = 0; i < n; i++)
|
||||
A[i] = plen(N);
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++) {
|
||||
p = ptest(A[i], count, skip);
|
||||
if (!p) {
|
||||
@@ -138,7 +159,7 @@ define ptimes(str, N, n, count, skip, verbose)
|
||||
if (m) {
|
||||
printf("*** %d error(s)\n", m);
|
||||
} else {
|
||||
t = round(runtime() - t, 4);
|
||||
t = round(usertime() - t, 4);
|
||||
if (verbose > 1) {
|
||||
printf("%d probable primes: time = %d\n", n, t);
|
||||
} else {
|
||||
@@ -173,12 +194,13 @@ define ctimes(str, N, n, count, skip, verbose)
|
||||
mat A[n];
|
||||
for (i = 0; i < n; i++)
|
||||
A[i] = clen(N);
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++) {
|
||||
p = ptest(A[i], count, skip);
|
||||
if (p) {
|
||||
if (verbose > 0) {
|
||||
printf("*** Error, what should be rare has occurred for x = %d \n", A[i]);
|
||||
printf("*** Error, what should be rare "
|
||||
"has occurred for x = %d \n", A[i]);
|
||||
m++;
|
||||
}
|
||||
}
|
||||
@@ -187,7 +209,7 @@ define ctimes(str, N, n, count, skip, verbose)
|
||||
if (m) {
|
||||
printf("*** %d error(s)\n", m);
|
||||
} else {
|
||||
t = round(runtime() - t, 4);
|
||||
t = round(usertime() - t, 4);
|
||||
if (verbose > 1) {
|
||||
printf("%d probable primes: time = %d\n", n, t);
|
||||
} else {
|
||||
@@ -221,7 +243,7 @@ define crtimes(str, a, b, n, count, skip, verbose)
|
||||
A[i] = rand(a,b);
|
||||
P[i] = ptest(A[i], 20, 0);
|
||||
}
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++) {
|
||||
p = ptest(A[i], count, skip);
|
||||
if (p != P[i]) {
|
||||
@@ -236,7 +258,7 @@ define crtimes(str, a, b, n, count, skip, verbose)
|
||||
if (m) {
|
||||
printf("*** %d error(s)?\n", m);
|
||||
} else {
|
||||
t = round(runtime() - t, 4);
|
||||
t = round(usertime() - t, 4);
|
||||
if (verbose > 1) {
|
||||
printf("%d probable primes: time = %d\n", n, t);
|
||||
} else {
|
||||
@@ -274,18 +296,19 @@ define ntimes(str, N, n, count, skip, residue, modulus, verbose)
|
||||
mat A[n];
|
||||
for (i = 0; i < n; i++)
|
||||
A[i] = rlen(N);
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++) {
|
||||
p = nextcand(A[i], count, skip, residue, modulus);
|
||||
}
|
||||
tnext = round(runtime() - t, 4);
|
||||
t = runtime();
|
||||
tnext = round(usertime() - t, 4);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++) {
|
||||
p = prevcand(A[i], count, skip, residue, modulus);
|
||||
}
|
||||
tprev = round(runtime() - t, 4);
|
||||
tprev = round(usertime() - t, 4);
|
||||
if (verbose > 0) {
|
||||
printf("%d evaluations, nextcand: %d, prevcand: %d\n", n, tnext, tprev);
|
||||
printf("%d evaluations, nextcand: %d, "
|
||||
"prevcand: %d\n", n, tnext, tprev);
|
||||
}
|
||||
}
|
||||
|
@@ -1,13 +1,34 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test4100 - 4100 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 4100 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test4100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4100.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/03/13 03:53:22
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Some severe tests and timing functions for REDC functions and pmod.
|
||||
*
|
||||
@@ -48,18 +69,17 @@
|
||||
*
|
||||
*/
|
||||
|
||||
global defaultverbose = 1; /* default verbose value */
|
||||
global err;
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* test defaults
|
||||
*/
|
||||
global K1 = 2^17;
|
||||
global K2 = 2^12;
|
||||
global BASEB = 16;
|
||||
global BASE = 2^BASEB;
|
||||
global test4100_K1 = 2^17;
|
||||
global test4100_K2 = 2^12;
|
||||
global test4100_BASE = 2^config("baseb");
|
||||
|
||||
define rlen_4100(N) = rand(BASE^(N-1), BASE^N);
|
||||
define rlen_4100(N) = rand(test4100_BASE^(N-1), test4100_BASE^N);
|
||||
|
||||
define olen(N)
|
||||
{
|
||||
@@ -212,7 +232,7 @@ define times(str,N,n,verbose)
|
||||
m = olen(N);
|
||||
m2 = m^2;
|
||||
if (isnull(n)) {
|
||||
n = ceil(K1/power(N,1.585));
|
||||
n = ceil(test4100_K1/power(N,1.585));
|
||||
if (verbose > 1)
|
||||
printf("n = %d\n", n);
|
||||
}
|
||||
@@ -225,38 +245,38 @@ define times(str,N,n,verbose)
|
||||
C[i] = rand(m2);
|
||||
}
|
||||
z = rcin(0,m); /* to initialize redc and maybe lastmod information */
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z = rcin(A[i],m);
|
||||
trcin = round(runtime() - t, 3);
|
||||
t = runtime();
|
||||
trcin = round(usertime() - t, 3);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z = rcout(A[i],m);
|
||||
trcout = round(runtime() - t, 3);
|
||||
t = runtime();
|
||||
trcout = round(usertime() - t, 3);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z = rcmul(A[i],B[i],m);
|
||||
trcmul = round(runtime() - t, 3);
|
||||
t = runtime();
|
||||
trcmul = round(usertime() - t, 3);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z = rcsq(A[i],m);
|
||||
trcsq = round(runtime() - t, 3);
|
||||
t = runtime();
|
||||
trcsq = round(usertime() - t, 3);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z = A[i] * B[i];
|
||||
tmul = round(runtime() - t, 3);
|
||||
t = runtime();
|
||||
tmul = round(usertime() - t, 3);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z = A[i]^2;
|
||||
tsq = round(runtime() - t, 3);
|
||||
t = runtime();
|
||||
tsq = round(usertime() - t, 3);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z = C[i] % A[i];
|
||||
tmod = round(runtime() - t, 3);
|
||||
t = runtime();
|
||||
tmod = round(usertime() - t, 3);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
quomod(C[i], A[i], x, y);
|
||||
tquomod = round(runtime() - t,3);
|
||||
tquomod = round(usertime() - t,3);
|
||||
|
||||
if (verbose > 1) {
|
||||
printf("rcin: %d, rcout: %d, rcmul: %d, rcsq: %d\n",
|
||||
@@ -286,7 +306,7 @@ define powtimes(str, N1, N2, n, verbose)
|
||||
N2 = 1;
|
||||
|
||||
if (isnull(n)) {
|
||||
n = ceil(K2/power(N1, 1.585)/N2);
|
||||
n = ceil(test4100_K2/power(N1, 1.585)/N2);
|
||||
printf ("n = %d\n", n);
|
||||
}
|
||||
mat A[n];
|
||||
@@ -294,8 +314,8 @@ define powtimes(str, N1, N2, n, verbose)
|
||||
mat B[n];
|
||||
v = olen(N1);
|
||||
|
||||
cp = config("pow2", 1);
|
||||
crc = config("redc2", 1);
|
||||
cp = config("pow2", 2);
|
||||
crc = config("redc2", 2);
|
||||
|
||||
/* initialize redc and lastmod info */
|
||||
|
||||
@@ -306,29 +326,29 @@ define powtimes(str, N1, N2, n, verbose)
|
||||
Ar[i] = rcin(A[i], v);
|
||||
B[i] = rlen_4100(N2);
|
||||
}
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z1 += pmod(A[i], B[i], v);
|
||||
tbignum = round(runtime() - t, 4);
|
||||
tbignum = round(usertime() - t, 4);
|
||||
config("pow2", 1e6);
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z2 += pmod(A[i], B[i], v);
|
||||
tnormal = round(runtime() - t, 4);
|
||||
tnormal = round(usertime() - t, 4);
|
||||
config("redc2",1e6);
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z3 += pmod(A[i], B[i], v);
|
||||
tsmall = round(runtime() - t, 4);
|
||||
t = runtime();
|
||||
tsmall = round(usertime() - t, 4);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z4 += rcpow(Ar[i], B[i], v);
|
||||
trcsmall = round(runtime() - t, 4);
|
||||
config("redc2", 1);
|
||||
t = runtime();
|
||||
trcsmall = round(usertime() - t, 4);
|
||||
config("redc2", 2);
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
z5 += rcpow(Ar[i], B[i], v);
|
||||
trcbig = round(runtime() - t, 4);
|
||||
trcbig = round(usertime() - t, 4);
|
||||
|
||||
if (z1 != z2) {
|
||||
++m;
|
||||
@@ -386,7 +406,7 @@ define inittimes(str,N,n,verbose)
|
||||
}
|
||||
m = 0;
|
||||
if (isnull(n)) {
|
||||
n = ceil(K1/N^2);
|
||||
n = ceil(test4100_K1/N^2);
|
||||
if (verbose > 1) {
|
||||
printf ("n = %d\n", n);
|
||||
}
|
||||
@@ -399,13 +419,13 @@ define inittimes(str,N,n,verbose)
|
||||
M[i] = olen(N);
|
||||
A[i] = rand(M[i]);
|
||||
}
|
||||
t = runtime();
|
||||
t = usertime();
|
||||
for (i = 0; i < n; i++)
|
||||
R[i] = rcin(A[i], M[i]);
|
||||
trcin = round(runtime() - t, 4);
|
||||
trcin = round(usertime() - t, 4);
|
||||
for (i = 0; i < n; i++)
|
||||
B[i] = rcout(R[i], M[i]);
|
||||
trcout = round(runtime() - t, 4);
|
||||
trcout = round(usertime() - t, 4);
|
||||
for (i = 0; i < n; i++) {
|
||||
if (B[i] != A[i]) {
|
||||
++m;
|
@@ -1,17 +1,36 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test4600 - 4600 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 4600 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test4600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test4600.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/07/02 20:04:40
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
global defaultverbose = 1 /* default verbose value */
|
||||
global err;
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* test globals
|
||||
@@ -33,10 +52,10 @@ define stest(str, verbose)
|
||||
/*
|
||||
* do file operations
|
||||
*/
|
||||
f = fopen("junk4600", "w");
|
||||
f = fopen("junk4600", "wb");
|
||||
if (iserror(f)) {
|
||||
print 'failed';
|
||||
print '**** fopen("junk4600", "w") failed';
|
||||
print '**** fopen("junk4600", "wb") failed';
|
||||
return 1;
|
||||
}
|
||||
if (iserror(fputs(f,
|
||||
@@ -47,9 +66,9 @@ define stest(str, verbose)
|
||||
print '**** fputs(f, "Fourscore ... failed';
|
||||
return 1;
|
||||
}
|
||||
if (iserror(freopen(f, "r"))) {
|
||||
if (iserror(freopen(f, "rb"))) {
|
||||
print 'failed';
|
||||
print '**** iserror(freopen(f, "r")) failed';
|
||||
print '**** iserror(freopen(f, "rb")) failed';
|
||||
return 1;
|
||||
}
|
||||
if (iserror(rewind(f))) {
|
||||
@@ -153,7 +172,7 @@ define ttest(str, m, n, verbose)
|
||||
print str:":",:;
|
||||
}
|
||||
i = rm("-f", "junk4600");
|
||||
f = fopen("junk4600", "w");
|
||||
f = fopen("junk4600", "wb");
|
||||
|
||||
if (isnull(n))
|
||||
n = 4;
|
||||
@@ -178,7 +197,7 @@ define ttest(str, m, n, verbose)
|
||||
fflush(f);
|
||||
if (verbose > 1)
|
||||
printf("File has size %d\n", pos[i]);
|
||||
freopen(f, "r");
|
||||
freopen(f, "rb");
|
||||
if (size(f) != pos[i]) {
|
||||
print 'failed';
|
||||
printf("**** Failure 1 for file size\n");
|
70
cal/test5100.cal
Normal file
70
cal/test5100.cal
Normal file
@@ -0,0 +1,70 @@
|
||||
/*
|
||||
* test5100 - 5100 series of the regress.cal test suite
|
||||
*
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test5100.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test5100.cal,v $
|
||||
*
|
||||
* Under source code control: 1996/12/02 23:57:10
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* We test the new code generator declaration scope and order.
|
||||
*
|
||||
* In this function two static variables a5100 and b5100 are created,
|
||||
* with zero value, when the definition is read.
|
||||
*
|
||||
* The variable a5100 is initialized with the value x if and when this
|
||||
* function is first called with a positive even x. The varable b5100
|
||||
* is similarly initialized if and when this function is first called positive
|
||||
* odd x.
|
||||
*
|
||||
* Each time this function is called with positive integer x, a5100 or
|
||||
* b5100 is incremented.
|
||||
*
|
||||
* Finally the values of the static variables are assigned to the global
|
||||
* variables a5100 and b5100.
|
||||
*
|
||||
* Immediately after the last of several calls to this function
|
||||
* a5100 = 0 if none of the x's have been positive even, otherwise
|
||||
* a5100 = the first positive even x + the number of positive even x's,
|
||||
* and b5100 = 0 if none of the x's have been positive odd, otherwise
|
||||
* b5100 = the first positive odd x + the number of positive odd x's.
|
||||
*/
|
||||
define test5100(x)
|
||||
{
|
||||
if (isint(x) && x > 0) {
|
||||
if (iseven(x)) {
|
||||
static a5100 = x;
|
||||
a5100++;
|
||||
} else {
|
||||
static b5100 = x;
|
||||
b5100++;
|
||||
}
|
||||
}
|
||||
global a5100 = a5100, b5100 = b5100;
|
||||
}
|
52
cal/test5200.cal
Normal file
52
cal/test5200.cal
Normal file
@@ -0,0 +1,52 @@
|
||||
/*
|
||||
* test5200 - 5200 series of the regress.cal test suite
|
||||
*
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test5200.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test5200.cal,v $
|
||||
*
|
||||
* Under source code control: 1997/02/07 02:48:10
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
/*
|
||||
* test the fix of a global/static bug
|
||||
*
|
||||
* Given the following:
|
||||
*
|
||||
* global a = 10;
|
||||
* static a = 20;
|
||||
* define f(x) = a + x;
|
||||
* define g(x) {global a = 30; return a + x;}
|
||||
* define h(x) = a + x;
|
||||
*
|
||||
* Older versions of
|
||||
*/
|
||||
global a5200 = 10;
|
||||
static a5200 = 20;
|
||||
define f5200(x) = a5200 + x;
|
||||
define g5200(x) {global a5200 = 30; return a5200 + x;}
|
||||
define h5200(x) = a5200 + x;
|
48
cal/test8400.cal
Normal file
48
cal/test8400.cal
Normal file
@@ -0,0 +1,48 @@
|
||||
/*
|
||||
* test8400 - 8400 series of the regress.cal test suite
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test8400.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8400.cal,v $
|
||||
*
|
||||
* Under source code control: 1999/10/31 01:00:03
|
||||
* File existed as early as: 1999
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
print "8401: in test8400.cal";
|
||||
|
||||
/*
|
||||
* test8400 - dummy function to allow a check of quit-based memory leaks
|
||||
*/
|
||||
define test8400()
|
||||
{
|
||||
local x8401 = 19937; /* watch for lost memory */
|
||||
static s8401 = 44497; /* watch for lost memory */
|
||||
|
||||
return x8401+s8401;
|
||||
}
|
||||
print "8402: parsed test8400()";
|
||||
vrfy(test8400() == 64434, '8403: test8400() == 64434');
|
||||
|
||||
quit;
|
||||
prob('quit did not end test8400.cal');
|
@@ -1,17 +1,39 @@
|
||||
/*
|
||||
* Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
|
||||
* Permission is granted to use, distribute, or modify this source,
|
||||
* provided that this copyright notice remains intact.
|
||||
* test8500 - 8500 series of the regress.cal test suite
|
||||
*
|
||||
* By: Ernest Bowen and Landon Curt Noll
|
||||
* ernie@neumann.une.edu.au and http://reality.sgi.com/chongo/
|
||||
* Copyright (C) 1999 Ernest Bowen and Landon Curt Noll
|
||||
*
|
||||
* This library is used by the 8500 series of the regress.cal test suite.
|
||||
* Primary author: Ernest Bowen
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.2 $
|
||||
* @(#) $Id: test8500.cal,v 30.2 2013/08/11 08:41:38 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8500.cal,v $
|
||||
*
|
||||
* Under source code control: 1999/11/12 20:59:59
|
||||
* File existed as early as: 1999
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Tests of // and % operators
|
||||
*/
|
||||
|
||||
|
||||
global err_8500; /* divmod_8500 error count */
|
||||
global L_8500; /* list of problem values */
|
||||
global ver_8500; /* test verbosity - see setting comment near bottom */
|
||||
@@ -112,8 +134,8 @@ define onetest_8500(a,b,rnd) {
|
||||
* The rounding parameter is randomly chosen.
|
||||
*
|
||||
* After a run of divmod_8500 the a, b, rnd values which gave failure are
|
||||
* stored in the list L_8500. L_8500[0], L_8500[1], L_8500[2] are a, b, rnd for the first
|
||||
* test, etc.
|
||||
* stored in the list L_8500. L_8500[0], L_8500[1], L_8500[2] are a, b,
|
||||
* rnd for the first* test, etc.
|
||||
*/
|
||||
define divmod_8500(N = 10, M1 = 2^128, M2 = 2^64, testnum = 0)
|
||||
{
|
1406
cal/test8600.cal
Normal file
1406
cal/test8600.cal
Normal file
File diff suppressed because it is too large
Load Diff
3120
cal/test8900.cal
Normal file
3120
cal/test8900.cal
Normal file
File diff suppressed because it is too large
Load Diff
362
cal/toomcook.cal
Normal file
362
cal/toomcook.cal
Normal file
@@ -0,0 +1,362 @@
|
||||
/*
|
||||
* toomcook - implementation of Toom-Cook(3,4) multiplication algorithm
|
||||
*
|
||||
* Copyright (C) 2013 Christoph Zurnieden
|
||||
*
|
||||
* Calc is open software; you can redistribute it and/or modify it under
|
||||
* the terms of the version 2.1 of the GNU Lesser General Public License
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
* Public License for more details.
|
||||
*
|
||||
* A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
* distributed with calc under the filename COPYING-LGPL. You should have
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: toomcook.cal,v 30.4 2013/08/18 20:01:53 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/toomcook.cal,v $
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
/*
|
||||
* hide internal function from resource debugging
|
||||
*/
|
||||
static resource_debug_level;
|
||||
resource_debug_level = config("resource_debug", 0);
|
||||
|
||||
|
||||
/* */
|
||||
define toomcook3(a,b){
|
||||
local alen blen a0 a1 a2 b0 b1 b2 m ret sign mask;
|
||||
local S0 S1 S2 S3 S4 T1 T2;
|
||||
|
||||
if(!isint(a) || !isint(b))
|
||||
return newerror("toomcook3(a,b): a and/or b is not an integer");
|
||||
|
||||
alen = digits(a,2);
|
||||
blen = digits(b,2);
|
||||
|
||||
sign = sgn(a) * sgn(b);
|
||||
/* sgn(x) returns 0 if x = 0 */
|
||||
if(sign == 0) return 0;
|
||||
|
||||
m = min(alen,blen)//3;
|
||||
mask = ~-(1<<m);
|
||||
|
||||
/*
|
||||
Cut-off at about 4,000 dec. digits
|
||||
TODO: check
|
||||
*/
|
||||
if(isdefined("test8900")){
|
||||
if(m < 20) return a*b;
|
||||
}
|
||||
else{
|
||||
if(m < 4096 ) return a*b;
|
||||
}
|
||||
a = abs(a);
|
||||
b = abs(b);
|
||||
|
||||
a0 = a & mask;
|
||||
a1 = (a>>m) & mask;
|
||||
a2 = (a>>(2*m));
|
||||
|
||||
b0 = b & mask;
|
||||
b1 = (b>>m) & mask;
|
||||
b2 = (b>>(2*m));
|
||||
|
||||
/*
|
||||
Zimmermann
|
||||
*/
|
||||
|
||||
S0 = toomcook3(a0 , b0);
|
||||
S1 = toomcook3((a2+a1+a0) , (b2+b1+b0));
|
||||
S2 = toomcook3(((a2<<2)+(a1<<1)+a0) , ((b2<<2)+(b1<<1)+b0));
|
||||
S3 = toomcook3((a2-a1+a0) , (b2-b1+b0));
|
||||
S4 = toomcook3(a2,b2);
|
||||
T1 = (S3<<1) + S2;
|
||||
T1 /= 3;
|
||||
T1 += S0;
|
||||
T1 >>= 1;
|
||||
T1 -= S4<<1;
|
||||
T2 = (S1 + S3)>>1;
|
||||
S1 -= T1;
|
||||
S2 = T2 - S0 - S4;
|
||||
S3 = T1 - T2;
|
||||
|
||||
ret = (S4<<(4*m)) + (S3<<(3*m)) + (S2<<(2*m)) + (S1<<(1*m)) + S0;
|
||||
|
||||
|
||||
ret = sign *ret;
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
define toomcook3square(a){
|
||||
local alen a0 a1 a2 m tmp tmp2 ret sign S0 S1 S2 S3 S4 T1 mask;
|
||||
|
||||
if(!isint(a))return newerror("toomcook3square(a): a is not integer");
|
||||
|
||||
alen = digits(a,2);
|
||||
|
||||
sign = sgn(a) * sgn(a);
|
||||
if(sign == 0) return 0;
|
||||
|
||||
m = alen//3;
|
||||
mask = ~-(1<<m);
|
||||
/*
|
||||
Cut-off at about 5,000 dec. digits
|
||||
TODO: check
|
||||
*/
|
||||
|
||||
if(isdefined("test8900")){
|
||||
if(m < 20) return a^2;
|
||||
}
|
||||
else{
|
||||
if(m < 5000 ) return a^2;
|
||||
}
|
||||
|
||||
a = abs(a);
|
||||
|
||||
a0 = a & mask;
|
||||
a1 = (a>>m) & mask;
|
||||
a2 = (a>>(2*m));
|
||||
|
||||
/*
|
||||
Bodrato/Zanoni
|
||||
*/
|
||||
S0 = toomcook3square(a0);
|
||||
S1 = toomcook3square(a2+a1+a0);
|
||||
S2 = toomcook3square(a2-a1+a0);
|
||||
S3 = toomcook3(a1<<1,a2);
|
||||
S4 = toomcook3square(a2);
|
||||
|
||||
T1 = (S1 + S2)>>1;
|
||||
S1 = S1 - T1 - S3;
|
||||
S2 = T1 - S4 -S0;
|
||||
|
||||
|
||||
S1 = S1<<(1*m);
|
||||
S2 = S2<<(2*m);
|
||||
S3 = S3<<(3*m);
|
||||
S4 = S4<<(4*m);
|
||||
|
||||
ret = S0 + S1 + S2 + S3 + S4;
|
||||
ret = sign *ret;
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
define toomcook4(a,b)
|
||||
{
|
||||
|
||||
local a0 a1 a2 a3 b0 b1 b2 b3 b4 ret tmp tmp2 tmp3 sign;
|
||||
local m alen blen mask;
|
||||
local w1, w2, w3, w4, w5, w6, w7;
|
||||
|
||||
if(!isint(a) || !isint(b))
|
||||
return newerror("toomcook4(a,b): a and/or b is not integer");
|
||||
|
||||
alen = digits(a,2);
|
||||
blen = digits(b,2);
|
||||
|
||||
sign = sgn(a) * sgn(b);
|
||||
|
||||
if(sign == 0) return 0;
|
||||
|
||||
m = min(alen//4,blen//4);
|
||||
mask = ~-(1<<m);
|
||||
|
||||
if(isdefined("test8900")){
|
||||
if(m < 100) return toomcook3(a,b);
|
||||
}
|
||||
else{
|
||||
if(m < 256*3072) return toomcook3(a,b);
|
||||
}
|
||||
|
||||
a = abs(a);
|
||||
b = abs(b);
|
||||
|
||||
|
||||
a0 = a & mask;
|
||||
a1 = (a>>m) & mask;
|
||||
a2 = (a>>(2*m)) & mask;
|
||||
a3 = (a>>(3*m));
|
||||
|
||||
b0 = b & mask;
|
||||
b1 = (b>>m) & mask;
|
||||
b2 = (b>>(2*m)) & mask;
|
||||
b3 = (b>>(3*m));
|
||||
|
||||
/*
|
||||
Bodrato / Zanoni
|
||||
*/
|
||||
|
||||
w3 = a3 + (a1 + (a2 + a0));
|
||||
w7 = b3 + (b1 + (b2 + b0));
|
||||
|
||||
w4 = -a3 + (-a1 + (a2 + a0));
|
||||
w5 = -b3 + (-b1 + (b2 + b0));
|
||||
|
||||
w3 = toomcook4(w3, w7);
|
||||
w4 = toomcook4(w4, w5);
|
||||
|
||||
w5 = a3 + ((a1<<2) + ((a2<<1) + (a0<<3)));
|
||||
w2 = b3 + ((b1<<2) + ((b2<<1) + (b0<<3)));
|
||||
|
||||
w6 = -a3 + (-(a1<<2) + ((a2<<1) + (a0<<3)));
|
||||
w7 = -b3 + (-(b1<<2) + ((b2<<1) + (b0<<3)));
|
||||
|
||||
w5 = toomcook4(w5, w2);
|
||||
w6 = toomcook4(w6, w7);
|
||||
|
||||
|
||||
w2 = (a3<<3) + ((a1<<1) + ((a2<<2) + a0));
|
||||
w7 = (b3<<3) + ((b1<<1) + ((b2<<2) + b0));
|
||||
|
||||
|
||||
w2 = toomcook4(w2, w7);
|
||||
|
||||
w1 = toomcook4(a3, b3);
|
||||
w7 = toomcook4(a0, b0);
|
||||
|
||||
w2 = w2 + w5;
|
||||
w6 = w5 - w6;
|
||||
w4 = w3 - w4;
|
||||
w5 = w5 - w1;
|
||||
w5 -= w7 << 6;
|
||||
w4 = w4>>1;
|
||||
w3 = w3 - w4;
|
||||
w5 = w5<<1;
|
||||
w5 = w5 - w6;
|
||||
w2 -= w3 * 65;
|
||||
w3 = w3 - w7;
|
||||
w3 = w3 - w1;
|
||||
w2 += w3 * 45;
|
||||
w5 -= w3<<3;
|
||||
w5 = w5//24;
|
||||
w6 = w6 - w2;
|
||||
w2 -= w4<<4;
|
||||
w2 = w2//18;
|
||||
w3 = w3 - w5;
|
||||
w4 = w4 - w2;
|
||||
w6 += w2 * 30;
|
||||
w6 = w6//60;
|
||||
w2 = w2 - w6;
|
||||
|
||||
|
||||
ret = w7 + (w6<<m) + (w5<<(2*m)) + (w4<<(3*m))+ (w3<<(4*m))+
|
||||
(w2<<(5*m))+ (w1<<(6*m));
|
||||
|
||||
ret = sign *ret;
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
define toomcook4square(a){
|
||||
local a0 a1 a2 a3 ret S0 S1 S2 S3 S4 S5 S6 S7 tmp tmp2 tmp3;
|
||||
local sign m alen mask;
|
||||
local T0 T1 T2 T3 T4 T5 T6 T7 T8;
|
||||
|
||||
if(!isint(a) )return newerror("toomcook3square(a): a is not integer");
|
||||
|
||||
alen = digits(a,2);
|
||||
|
||||
sign = sgn(a) * sgn(a);
|
||||
/* sgn(x) returns 0 if x = 0 */
|
||||
if(sign == 0) return 0;
|
||||
|
||||
m = (alen)//4;
|
||||
mask = ~-( 1 << m );
|
||||
|
||||
/*
|
||||
cut-off at about 2 mio. dec. digits
|
||||
TODO: check!
|
||||
*/
|
||||
|
||||
if(isdefined("test8900")){
|
||||
if(m < 100) return toomcook3square(a);
|
||||
}
|
||||
else{
|
||||
if(m < 512*3072) return toomcook3square(a);
|
||||
}
|
||||
|
||||
a = abs(a);
|
||||
|
||||
a0 = a & mask;
|
||||
a1 = (a>>m) & mask;
|
||||
a2 = (a>>(2*m)) & mask;
|
||||
a3 = (a>>(3*m)) ;
|
||||
|
||||
/*
|
||||
Bodrato / Zanoni
|
||||
*/
|
||||
|
||||
S1 = toomcook4square(a0);
|
||||
S2 = toomcook4(a0<<1,a1);
|
||||
S3 = toomcook4((a0 + a1 - a2 - a3 ) , (a0 - a1 - a2 + a3 ));
|
||||
S4 = toomcook4square(a0 + a1 + a2 + a3 );
|
||||
S5 = toomcook4( (a0 - a2 )<<1 , (a1 - a3 ));
|
||||
S6 = toomcook4(a3<<1 , a2);
|
||||
S7 = toomcook4square(a3);
|
||||
|
||||
T1 = S3 + S4;
|
||||
T2 = (T1 + S5 )>>1;
|
||||
T3 = S2 + S6;
|
||||
T4 = T2 - T3;
|
||||
T5 = T3 - S5;
|
||||
T6 = T4 - S3;
|
||||
T7 = T4 - S1;
|
||||
T8 = T6 - S7;
|
||||
|
||||
ret = (S7<<(6*m)) + (S6<<(5*m)) + (T7<<(4*m))
|
||||
+ (T5<<(3*m)) + (T8<<(2*m)) + (S2<<(1*m)) + S1;
|
||||
|
||||
ret = sign *ret;
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
TODO: Implement the asymmetric variations
|
||||
*/
|
||||
|
||||
/*
|
||||
produce_long_random_number(n) returns large pseudorandom numbers. Really large
|
||||
numbers, e.g.:
|
||||
produce_long_random_number(16)
|
||||
is ca 4,128,561 bits (ca 1,242,821 dec. digits) large. Exact length is not
|
||||
predeterminable because of the chaotic output of the function random().
|
||||
*/
|
||||
define __CZ__produce_long_random_number(n)
|
||||
{
|
||||
local ret k;
|
||||
ret = 1;
|
||||
if(!isint(n) || n<1)
|
||||
return newerror("__CZ__produce_long_random_number(n): "
|
||||
"n is not an integer >=1");
|
||||
for(k=0;k<n;k++){
|
||||
ret += random();
|
||||
ret = toomcook4square(ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* restore internal function from resource debugging
|
||||
* report important interface functions
|
||||
*/
|
||||
config("resource_debug", resource_debug_level),;
|
||||
if (config("resource_debug") & 3) {
|
||||
print "toomcook3(a,b)";
|
||||
print "toomcook3square(a)";
|
||||
print "toomcook4(a,b)";
|
||||
print "toomcook4square(a)";
|
||||
}
|
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user