mirror of
https://github.com/lcn2/calc.git
synced 2025-08-19 01:13:27 +03:00
Compare commits
34 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
40fc854006 | ||
|
8dd7a3cd2a | ||
|
2726ae9d23 | ||
|
d25186fc52 | ||
|
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 |
72
BUGS
72
BUGS
@@ -32,16 +32,25 @@ 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
|
||||
and bug fixes reports to:
|
||||
|
||||
calc-bugs at asthe dot com
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
[[ NOTE: The EMail address uses 'asthe', the web site URL uses 'isthe' ]]
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
Your subject must contain the words:
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
calc bug report
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
You may have additional words in your 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:
|
||||
|
||||
@@ -68,6 +77,9 @@ of a context diff patch).
|
||||
|
||||
Known bugs:
|
||||
|
||||
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
|
||||
EMail your bug reports and hopefully patches to fix them.
|
||||
@@ -76,7 +88,7 @@ Known bugs:
|
||||
|
||||
mis-features in calc:
|
||||
|
||||
Some problems are not bugs but rarther mis-features / things that could
|
||||
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.
|
||||
|
||||
@@ -123,28 +135,32 @@ mis-features in calc:
|
||||
|
||||
=-=
|
||||
|
||||
Problems with old systems that have known work-a-rounds:
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
* 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.
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
* 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.
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
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:
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
LCC="cc -xarch=v9"
|
||||
CCWARN="-DFORCE_STDC -w"
|
||||
DEBUG="-fast -xarch=v9"
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
## Copyright (C) 1999-2006 Landon Curt Noll
|
||||
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
|
||||
@@ -158,11 +174,11 @@ Problems with old systems that have known work-a-rounds:
|
||||
## 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.
|
||||
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 29.26 $
|
||||
## @(#) $Id: BUGS,v 29.26 2007/01/03 21:26:22 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/BUGS,v $
|
||||
## @(#) $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
|
||||
|
98
COPYING
98
COPYING
@@ -6,17 +6,17 @@ This file is Copyrighted
|
||||
|
||||
This file is covered under the following Copyright:
|
||||
|
||||
Copyright (C) 1999 Landon Curt Noll
|
||||
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: 29.8 $
|
||||
# @(#) $Id: COPYING,v 29.8 2006/05/01 19:16:57 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/cmd/calc/RCS/COPYING,v $
|
||||
# @(#) $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
|
||||
--------------------------------------------------------
|
||||
@@ -45,55 +45,72 @@ Calc is covered by the GNU Lesser General Public License
|
||||
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:
|
||||
Public License with calc; if not, write to the following address:
|
||||
|
||||
Free Software Foundation, Inc.
|
||||
59 Temple Place
|
||||
Suite 330
|
||||
Boston, MA 02111-1307
|
||||
51 Franklin Street
|
||||
Fifth Floor
|
||||
Boston, MA 02110-1301
|
||||
USA
|
||||
|
||||
The contact addresses for calc is as follows:
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
Web: http://www.isthe.com/chongo/tech/comp/calc/email.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
To join the low volume calc mailing list. Send a EMail message to:
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
calc-tester-request at asthe dot com
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
Your subject must contain the words:
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
calc mailing list subscription
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
You may have additional words in your subject line.
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
Your message body (not the subject) should consist of:
|
||||
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:
|
||||
|
||||
subscribe calc-tester address
|
||||
end
|
||||
name your_full_name
|
||||
calc tester mailing list help
|
||||
|
||||
where ``address'' is your EMail address and ``your_full_name'' is
|
||||
your full name.
|
||||
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.
|
||||
|
||||
Feel free to follow the name line with additional EMail text as desired.
|
||||
|
||||
=-=
|
||||
-=-
|
||||
|
||||
Calc bug reports and calc bug fixes should be sent to:
|
||||
|
||||
calc-bugs at asthe dot com
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
[[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
Your subject must contain the words:
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
calc bug report
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
You may have additional words in your 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
|
||||
------------------------------------------------------------
|
||||
@@ -149,7 +166,7 @@ Calc's relationship to the GNU Lesser General Public License
|
||||
except for the exception files explicitly listed in the ``Calc
|
||||
copyrights and exception files'' section below.
|
||||
|
||||
=-=
|
||||
-=-
|
||||
|
||||
Calc copyrights and exception files
|
||||
-----------------------------------
|
||||
@@ -165,12 +182,12 @@ Calc copyrights and exception files
|
||||
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:
|
||||
|
||||
shs1.c shs1.h shs.c shs.h
|
||||
md5.c md5.h COPYING COPYING-LGPL
|
||||
cal/qtime.cal cal/screen.cal
|
||||
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
|
||||
@@ -182,15 +199,14 @@ Calc copyrights and exception files
|
||||
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
|
||||
exception files have non-LGPL Copyrights. Other files are under a
|
||||
LGPL Copyright but have different authors.
|
||||
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
|
||||
---------------------------------
|
||||
@@ -204,7 +220,7 @@ General Copyleft and License info
|
||||
http://www.gnu.org/copyleft/lesser.html
|
||||
http://www.gnu.org/copyleft/lesser.txt
|
||||
|
||||
=-=
|
||||
-=-
|
||||
|
||||
Why calc did not use the GNU General Public License
|
||||
---------------------------------------------------
|
||||
|
23
COPYING-LGPL
23
COPYING-LGPL
@@ -1,8 +1,8 @@
|
||||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
Version 2.1, February 1999
|
||||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
Version 2.1, February 1999
|
||||
|
||||
Copyright (C) 1991, 1999 Free Software Foundation, Inc.
|
||||
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
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.
|
||||
|
||||
@@ -10,7 +10,7 @@
|
||||
as the successor of the GNU Library Public License, version 2, hence
|
||||
the version number 2.1.]
|
||||
|
||||
Preamble
|
||||
Preamble
|
||||
|
||||
The licenses for most software are designed to take away your
|
||||
freedom to share and change it. By contrast, the GNU General Public
|
||||
@@ -112,7 +112,7 @@ modification follow. Pay close attention to the difference between a
|
||||
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
|
||||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||
|
||||
0. This License Agreement applies to any software library or other
|
||||
@@ -146,7 +146,7 @@ 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
|
||||
@@ -432,7 +432,7 @@ 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
|
||||
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.
|
||||
@@ -455,7 +455,7 @@ 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
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
How to Apply These Terms to Your New Libraries
|
||||
|
||||
@@ -476,7 +476,7 @@ convey the exclusion of warranty; and each file should have at least the
|
||||
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 of the License, or (at your option) any later version.
|
||||
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
|
||||
@@ -485,7 +485,8 @@ convey the exclusion of warranty; and each file should have at least the
|
||||
|
||||
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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
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.
|
||||
|
||||
@@ -500,5 +501,3 @@ necessary. Here is a sample; alter the names:
|
||||
Ty Coon, President of Vice
|
||||
|
||||
That's all there is to it!
|
||||
|
||||
|
||||
|
@@ -1,4 +1,4 @@
|
||||
Installing calc from the gziped tarball 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:
|
||||
|
||||
@@ -17,16 +17,30 @@ Installing calc from the gziped tarball in 4 easy steps:
|
||||
|
||||
The following 4 steps apply to calc source tree that comes from either:
|
||||
|
||||
gunzip -c calc-*.tar.gz | tar -xvf -
|
||||
bunzip2 -c calc-*.tar.bz2 | tar -xvf -
|
||||
|
||||
or from:
|
||||
|
||||
rpm -ivh calc-*.src.rpm
|
||||
cd /var/tmp
|
||||
gunzip -c /usr/src/redhat/SOURCES/calc-*.tar.gz | tar -xvf -
|
||||
bunzip2 -c /usr/src/redhat/SOURCES/calc-*.tar.bz2 | tar -xvf -
|
||||
|
||||
1) Look at the makefile, and adjust it to suit your needs.
|
||||
|
||||
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'
|
||||
@@ -126,12 +140,36 @@ Installing calc from the gziped tarball in 4 easy steps:
|
||||
|
||||
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
|
||||
@@ -139,6 +177,10 @@ Installing calc from the gziped tarball in 4 easy steps:
|
||||
==> 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:
|
||||
|
||||
make install
|
||||
@@ -146,7 +188,7 @@ Installing calc from the gziped tarball 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 Landon Curt Noll
|
||||
## 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
|
||||
@@ -160,11 +202,11 @@ the calc help subsystem. See the README file for 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.
|
||||
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 29.9 $
|
||||
## @(#) $Id: HOWTO.INSTALL,v 29.9 2006/09/18 13:11:57 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/HOWTO.INSTALL,v $
|
||||
## @(#) $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
|
||||
|
253
LIBRARY
253
LIBRARY
@@ -58,13 +58,18 @@ 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:
|
||||
|
||||
-L${LIBDIR} -lcalc
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
If custom functions are also used, they may want to compile with:
|
||||
|
||||
-L${LIBDIR} -lcalc -lcustcalc
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc
|
||||
|
||||
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:
|
||||
@@ -73,71 +78,215 @@ feeling pedantic you may want to force CALC_SRC to be undefined:
|
||||
|
||||
as well.
|
||||
|
||||
--------------
|
||||
ERROR HANDLING
|
||||
--------------
|
||||
-------------------
|
||||
MATH ERROR HANDLING
|
||||
-------------------
|
||||
|
||||
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:
|
||||
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:
|
||||
|
||||
math_error("Division by zero");
|
||||
void math_error(char *fmt, ...);
|
||||
|
||||
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.
|
||||
Your program must handle math errors in one of three ways:
|
||||
|
||||
For convenience, the link 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 link library, any calc errors will result in a
|
||||
error message on stderr followed by an exit.
|
||||
1) Print the error message and then exit
|
||||
|
||||
External programs that wish to use this math_error may want to compile with:
|
||||
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.
|
||||
|
||||
-I${LIBDIR} -L${LIBDIR} -lcalc
|
||||
2) Use setjmp and longjmp in your program
|
||||
|
||||
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.
|
||||
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.
|
||||
|
||||
For example:
|
||||
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.
|
||||
|
||||
#include <setjmp.h>
|
||||
For example:
|
||||
|
||||
extern jmp_buf calc_jmp_buf;
|
||||
extern int calc_jmp;
|
||||
extern char *calc_error;
|
||||
int error;
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
|
||||
...
|
||||
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_err_msg);
|
||||
|
||||
/* reinitialize calc after the longjmp */
|
||||
reinitialize();
|
||||
}
|
||||
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
|
||||
|
||||
/* report the error */
|
||||
printf("Ouch: %s\n", calc_error);
|
||||
}
|
||||
calc_jmp = 1;
|
||||
|
||||
---------------
|
||||
OUTPUT ROUTINES
|
||||
---------------
|
||||
|
||||
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.
|
||||
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.
|
||||
@@ -487,11 +636,11 @@ need call libcalc_call_me_last() only once.
|
||||
## 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.
|
||||
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 29.5 $
|
||||
## @(#) $Id: LIBRARY,v 29.5 2001/06/08 22:57:35 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/LIBRARY,v $
|
||||
## @(#) $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
|
||||
|
5582
Makefile.simple
Normal file
5582
Makefile.simple
Normal file
File diff suppressed because it is too large
Load Diff
70
README
70
README
@@ -73,52 +73,64 @@ for a wish/todo list. Code contributions are welcome.
|
||||
|
||||
=-=
|
||||
|
||||
To join the calc-tester mailing list. Send an EMail message to:
|
||||
To subscribe to the calc-tester mailing list, visit the following URL:
|
||||
|
||||
calc-tester-request at asthe dot com
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-tester.html
|
||||
|
||||
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
[[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
|
||||
This is a low volume moderated mailing list.
|
||||
|
||||
Your subject must contain the words:
|
||||
This mailing list replaces calc-tester at asthe dot com list.
|
||||
|
||||
calc mailing list subscription
|
||||
If you need a human to help you with your mailing list subscription,
|
||||
please send EMail to our special:
|
||||
|
||||
You may have additional words in your subject line.
|
||||
calc-tester-maillist-help at asthe dot com
|
||||
|
||||
Your message body (not the subject) should consist of:
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
subscribe calc-tester address
|
||||
end
|
||||
name your_full_name
|
||||
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:
|
||||
|
||||
where ``address'' is your EMail address and ``your_full_name'' is
|
||||
your full name.
|
||||
calc tester mailing list help
|
||||
|
||||
Feel free to follow the name line with additional EMail text as desired.
|
||||
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.
|
||||
|
||||
=-=
|
||||
-=-
|
||||
|
||||
Send Calc bug and bug fixes to:
|
||||
Calc bug reports and calc bug fixes should be sent to:
|
||||
|
||||
calc-bugs at asthe dot com
|
||||
calc-bug-report at asthe dot com
|
||||
|
||||
[[ NOTE: Replace 'at' with @, 'dot' is with . and remove the spaces ]]
|
||||
[[ NOTE: The EMail address uses 'asthe' and the web site URL uses 'isthe' ]]
|
||||
NOTE: Remove spaces and replace 'at' with @, 'dot' with .
|
||||
|
||||
but see the BUGS file first.
|
||||
This replaces the old calc-bugs at asthe dot com address.
|
||||
|
||||
Your subject must contain the words:
|
||||
To be sure we see your EMail reporting a calc bug, please use the
|
||||
following phase in your EMail Subject line:
|
||||
|
||||
calc bug report
|
||||
calc bug report
|
||||
|
||||
You may have additional words in your subject line.
|
||||
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/
|
||||
http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
## Copyright (C) 1999 Landon Curt Noll
|
||||
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
|
||||
@@ -132,11 +144,11 @@ The calc web site is located at:
|
||||
## 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.
|
||||
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 29.3 $
|
||||
## @(#) $Id: README,v 29.3 2001/06/01 11:26:53 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/README,v $
|
||||
## @(#) $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
|
||||
|
142
README.WINDOWS
142
README.WINDOWS
@@ -10,6 +10,63 @@ NOTE: The main developers do not have access to a Windoz based platform.
|
||||
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 =-=
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
@@ -56,7 +113,7 @@ recommends the following settings:
|
||||
CALCPATH= .;./cal;~/.cal;${CALC_SHAREDIR};${CUSTOMCALDIR}
|
||||
CALCRC= ${CALC_SHAREDIR}/startup;~/.calcrc;./.calcinit
|
||||
CALCPAGER= less.exe -ci
|
||||
DEBUG= -O2 -gstabs+
|
||||
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.
|
||||
@@ -68,81 +125,8 @@ Look for Makefile comments of the form:
|
||||
Follow those recommendations. In cases where they conflict with
|
||||
the above Makefile list, follow the recommendation in the Makefile.
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
=-= 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 was performed by Thomas Jones-Low
|
||||
(tjoneslo at softstart dot com). He said:
|
||||
|
||||
I had previous stated to this group that I have successfully managed
|
||||
to port a version of Calc to Windows, and promised some point to
|
||||
post what was required, so here it is.
|
||||
|
||||
One obvious manner of doing this port is to get the latest version
|
||||
of the Cygwin project (http://sources.redhat.com/cygwin/) with the
|
||||
GCC compiler and Un*x tools for Windows and recompile.
|
||||
|
||||
I built my working version using Calc ... I am using Visual C++
|
||||
version 7.0, which is an older version of the Microsoft development
|
||||
tools. The make file provided with Calc is not compatible with
|
||||
NMAKE, so I used the Visual Studio tools to generate another one
|
||||
(not included). Calc is built in two parts, calc.dll, which is the
|
||||
library, and calc.exe which is the command line interface.
|
||||
|
||||
He 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.
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
=-=-= calc maintenance folk =-=-=
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
||||
|
||||
People who maintain calc need to keep in mind the following:
|
||||
|
||||
The following was added to opcodes.h, config.h, zmath.h and value.h:
|
||||
|
||||
#if defined(_WIN32)
|
||||
#ifdef _EXPORTING
|
||||
#define DLL __declspec(dllexport)
|
||||
#else
|
||||
#define DLL __declspec(dllimport)
|
||||
#endif
|
||||
|
||||
#else /* Windoz free systems */
|
||||
|
||||
#define DLL
|
||||
|
||||
#endif /* Windoz free systems */
|
||||
|
||||
Then DLL was added in front of all the exported functions. For example:
|
||||
|
||||
extern int configtype(char*);
|
||||
|
||||
was changed to:
|
||||
|
||||
DLL extern int configtype(char*);
|
||||
|
||||
|
||||
## Copyright (C) 2002 Landon Curt Noll and Thomas Jones-Low
|
||||
## 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
|
||||
@@ -156,11 +140,11 @@ was changed to:
|
||||
## 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.
|
||||
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 29.12 $
|
||||
## @(#) $Id: README.WINDOWS,v 29.12 2004/07/28 12:52:01 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/RCS/README.WINDOWS,v $
|
||||
## @(#) $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
|
||||
|
34
addop.c
34
addop.c
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* addop - add opcodes to a function being compiled
|
||||
*
|
||||
* Copyright (C) 1999-2006 David I. Bell and Ernest Bowen
|
||||
* Copyright (C) 1999-2007 David I. Bell and Ernest Bowen
|
||||
*
|
||||
* Primary author: David I. Bell
|
||||
*
|
||||
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.13 $
|
||||
* @(#) $Id: addop.c,v 29.13 2006/06/20 10:28:06 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/addop.c,v $
|
||||
* @(#) $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
|
||||
@@ -33,7 +33,7 @@
|
||||
#include <stdio.h>
|
||||
#include "calc.h"
|
||||
#include "opcodes.h"
|
||||
#include "string.h"
|
||||
#include "str.h"
|
||||
#include "func.h"
|
||||
#include "token.h"
|
||||
#include "label.h"
|
||||
@@ -44,17 +44,17 @@
|
||||
#define OPCODEALLOCSIZE 100 /* reallocate size for opcodes in functions */
|
||||
|
||||
|
||||
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 */
|
||||
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 */
|
||||
|
||||
|
||||
/*
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: align32.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/align32.c,v $
|
||||
* @(#) $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
|
||||
|
73
alloc.h
73
alloc.h
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* alloc - storage allocation and storage debug macros
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
* 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
|
||||
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: alloc.h,v 29.4 2001/06/08 21:00:58 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/alloc.h,v $
|
||||
* @(#) $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
|
||||
@@ -28,59 +28,47 @@
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__ALLOC_H__)
|
||||
#define __ALLOC_H__
|
||||
#if !defined(INCLUDE_ALLOC_H)
|
||||
#define INCLUDE_ALLOC_H
|
||||
|
||||
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
# include "have_malloc.h"
|
||||
# include "have_newstr.h"
|
||||
# include "have_string.h"
|
||||
# include "have_memmv.h"
|
||||
#else
|
||||
# include <calc/have_malloc.h>
|
||||
# include <calc/have_newstr.h>
|
||||
# include <calc/have_string.h>
|
||||
# include <calc/have_memmv.h>
|
||||
#endif
|
||||
|
||||
#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
|
||||
#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
|
||||
|
||||
@@ -94,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 */
|
||||
|
36
assocfunc.c
36
assocfunc.c
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* assocfunc - association table routines
|
||||
*
|
||||
* Copyright (C) 1999 David I. Bell
|
||||
* 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
|
||||
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: assocfunc.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/assocfunc.c,v $
|
||||
* @(#) $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
|
||||
@@ -46,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);
|
||||
|
||||
|
||||
/*
|
||||
@@ -69,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;
|
||||
|
||||
@@ -83,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);
|
||||
|
||||
@@ -200,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;
|
||||
@@ -332,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;
|
||||
@@ -340,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;
|
||||
@@ -356,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;
|
||||
@@ -400,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;
|
||||
@@ -520,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;
|
||||
|
29
blkcpy.c
29
blkcpy.c
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* blkcpy - general values and related routines used by the calculator
|
||||
*
|
||||
* Copyright (C) 1999-2006 Landon Curt Noll and Ernest Bowen
|
||||
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.9 $
|
||||
* @(#) $Id: blkcpy.c,v 29.9 2006/05/20 08:43:55 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.c,v $
|
||||
* @(#) $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
|
||||
@@ -36,7 +36,7 @@
|
||||
#include "value.h"
|
||||
#include "file.h"
|
||||
#include "blkcpy.h"
|
||||
#include "string.h"
|
||||
#include "str.h"
|
||||
|
||||
|
||||
/*
|
||||
@@ -374,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;
|
||||
@@ -720,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;
|
||||
@@ -762,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;
|
||||
@@ -935,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
|
||||
@@ -982,7 +985,8 @@ 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)
|
||||
{
|
||||
size_t newlen;
|
||||
size_t newsize;
|
||||
@@ -1033,7 +1037,8 @@ 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)
|
||||
{
|
||||
size_t newlen;
|
||||
NUMBER *ret; /* cloned and modified numerator */
|
||||
|
52
blkcpy.h
52
blkcpy.h
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* blkcpy - general values and related routines used by the calculator
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
|
||||
* Copyright (C) 1999-2007,2014 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: blkcpy.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/blkcpy.h,v $
|
||||
* @(#) $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
|
||||
@@ -30,33 +30,33 @@
|
||||
*/
|
||||
|
||||
|
||||
#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 */
|
||||
|
24
block.c
24
block.c
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* block - fixed, dynamic, fifo and circular memory blocks
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
|
||||
* Copyright (C) 1999-2007 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: block.c,v 29.3 2006/05/01 19:16:57 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/block.c,v $
|
||||
* @(#) $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 $
|
||||
*
|
||||
* Under source code control: 1997/02/27 00:29:40
|
||||
* File existed as early as: 1997
|
||||
@@ -37,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*);
|
||||
|
||||
|
||||
/*
|
||||
@@ -154,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)
|
||||
{
|
||||
|
||||
|
50
block.h
50
block.h
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* block - fixed, dynamic, fifo and circular memory blocks
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll and Ernest Bowen
|
||||
* Copyright (C) 1999-2007,2014 Landon Curt Noll and Ernest Bowen
|
||||
*
|
||||
* Primary author: Landon Curt Noll
|
||||
*
|
||||
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: block.h,v 29.2 2000/06/07 14:02:13 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/block.h,v $
|
||||
* @(#) $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 $
|
||||
*
|
||||
* Under source code control: 1997/02/21 05:03:39
|
||||
* File existed as early as: 1997
|
||||
@@ -31,8 +31,8 @@
|
||||
*/
|
||||
|
||||
|
||||
#if !defined(__BLOCK_H__)
|
||||
#define __BLOCK_H__
|
||||
#if !defined(INCLUDE_BLOCK_H)
|
||||
#define INCLUDE_BLOCK_H
|
||||
|
||||
|
||||
/*
|
||||
@@ -160,7 +160,7 @@ typedef struct nblock NBLOCK;
|
||||
/*
|
||||
* block debug
|
||||
*/
|
||||
extern int blk_debug; /* 0 => debug off */
|
||||
EXTERN int blk_debug; /* 0 => debug off */
|
||||
|
||||
|
||||
/*
|
||||
@@ -204,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 */
|
||||
|
11
byteswap.c
11
byteswap.c
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: byteswap.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.c,v $
|
||||
* @(#) $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
|
||||
@@ -102,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*/
|
||||
}
|
||||
|
||||
|
16
byteswap.h
16
byteswap.h
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* byteswap - byte swapping macros
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
* 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
|
||||
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: byteswap.h,v 29.4 2001/06/08 21:00:58 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/RCS/byteswap.h,v $
|
||||
* @(#) $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
|
||||
@@ -29,8 +29,8 @@
|
||||
*/
|
||||
|
||||
|
||||
#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 */
|
||||
@@ -178,4 +178,4 @@
|
||||
#endif /* LONG_BITS == 64 */
|
||||
|
||||
|
||||
#endif /* !__BYTESWAP_H__ */
|
||||
#endif /* !INCLUDE_BYTESWAP_H */
|
||||
|
154
cal/Makefile
154
cal/Makefile
@@ -2,7 +2,7 @@
|
||||
#
|
||||
# cal - makefile for calc standard resource files
|
||||
#
|
||||
# Copyright (C) 1999-2006 Landon Curt Noll
|
||||
# Copyright (C) 1999-2006,2017 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
|
||||
@@ -16,11 +16,11 @@
|
||||
# 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.
|
||||
# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
#
|
||||
# @(#) $Revision: 29.24 $
|
||||
# @(#) $Id: Makefile,v 29.24 2006/09/18 13:13:25 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/Makefile,v $
|
||||
# @(#) $Revision: 30.12 $
|
||||
# @(#) $Id: Makefile,v 30.12 2017/05/19 16:09:14 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/bin/calc-RHEL7/cal/RCS/Makefile,v $
|
||||
#
|
||||
# Under source code control: 1991/07/21 05:00:54
|
||||
# File existed as early as: 1991
|
||||
@@ -34,13 +34,30 @@
|
||||
# required vars
|
||||
#
|
||||
SHELL= /bin/sh
|
||||
MAKE_FILE= Makefile
|
||||
|
||||
####
|
||||
# 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:
|
||||
@@ -94,9 +111,6 @@ CALC_SHAREDIR= /usr/share/calc
|
||||
# ---------------------------------------------------------------
|
||||
# ${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
|
||||
#
|
||||
# NOTE: The install rule prepends installation paths with ${T}, which
|
||||
@@ -107,16 +121,10 @@ CALC_SHAREDIR= /usr/share/calc
|
||||
#
|
||||
# HELPDIR= ${CALC_SHAREDIR}/help
|
||||
# CALC_INCDIR= ${INCDIR}/calc
|
||||
# CUSTOMCALDIR= ${CALC_SHAREDIR}/custom
|
||||
# CUSTOMHELPDIR= ${CALC_SHAREDIR}/custhelp
|
||||
# CUSTOMINCDIR= ${CALC_INCDIR}/custom
|
||||
# SCRIPTDIR= ${BINDIR}/cscript
|
||||
#
|
||||
HELPDIR= ${CALC_SHAREDIR}/help
|
||||
CALC_INCDIR= ${INCDIR}/calc
|
||||
CUSTOMCALDIR= ${CALC_SHAREDIR}/custom
|
||||
CUSTOMHELPDIR= ${CALC_SHAREDIR}/custhelp
|
||||
CUSTOMINCDIR= ${CALC_INCDIR}/custom
|
||||
SCRIPTDIR= ${BINDIR}/cscript
|
||||
|
||||
# T - top level directory under which calc will be installed
|
||||
@@ -171,21 +179,41 @@ MV= mv
|
||||
CO= co
|
||||
TRUE= true
|
||||
TOUCH= touch
|
||||
SED= sed
|
||||
SORT= sort
|
||||
FMT= fmt
|
||||
|
||||
# The calc files to install
|
||||
#
|
||||
CALC_FILES= README bigprime.cal deg.cal ellip.cal lucas.cal lucas_chk.cal \
|
||||
lucas_tbl.cal mersenne.cal mod.cal pell.cal pi.cal pix.cal \
|
||||
pollard.cal poly.cal psqrt.cal quat.cal regress.cal solve.cal \
|
||||
sumsq.cal surd.cal unitfrac.cal varargs.cal chrem.cal mfactor.cal \
|
||||
bindings randmprime.cal test1700.cal randrun.cal linear.cal \
|
||||
randbitrun.cal bernoulli.cal test2300.cal test2600.cal \
|
||||
test2700.cal test3100.cal test3300.cal test3400.cal prompt.cal \
|
||||
test3500.cal seedrandom.cal test4000.cal test4100.cal test4600.cal \
|
||||
beer.cal hello.cal test5100.cal test5200.cal randombitrun.cal \
|
||||
randomrun.cal repeat.cal xx_print.cal natnumset.cal qtime.cal \
|
||||
test8400.cal test8500.cal test8600.cal chi.cal intfile.cal screen.cal \
|
||||
dotest.cal set8700.cal set8700.line alg_config.cal sumtimes.cal
|
||||
# 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 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 calc files are now obsolete and are removed by the install rule.
|
||||
#
|
||||
DEAD_CALC_FILES= lucas_tbl.cal
|
||||
|
||||
# These files are found (but not built) in the distribution
|
||||
#
|
||||
@@ -233,6 +261,27 @@ calcliblist:
|
||||
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
|
||||
@@ -254,8 +303,25 @@ echo_inst_files:
|
||||
|
||||
clean:
|
||||
|
||||
clobber:
|
||||
clobber: clean
|
||||
${RM} -f .all
|
||||
-${Q} if [ -e .DS_Store ]; then \
|
||||
echo ${RM} -rf .DS_Store; \
|
||||
${RM} -rf .DS_Store; \
|
||||
fi
|
||||
-${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
if [ -e "./$$i" ]; then \
|
||||
echo "${RM} -f ./$$i"; \
|
||||
${RM} -f ./$$i; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
# install everything
|
||||
#
|
||||
@@ -263,8 +329,8 @@ clobber:
|
||||
#
|
||||
install: all
|
||||
-${Q} if [ ! -d ${T}${CALC_SHAREDIR} ]; then \
|
||||
echo ${MKDIR} ${T}${CALC_SHAREDIR}; \
|
||||
${MKDIR} ${T}${CALC_SHAREDIR}; \
|
||||
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}"; \
|
||||
@@ -284,16 +350,42 @@ install: all
|
||||
${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; \
|
||||
${MV} -f ${T}${CALC_SHAREDIR}/$$i.new ${T}${CALC_SHAREDIR}/$$i;\
|
||||
echo "installed ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
fi; \
|
||||
done
|
||||
${Q} for i in ${DEAD_CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
if [ -e "./$$i" ]; then \
|
||||
echo "${RM} -f ./$$i"; \
|
||||
${RM} -f ./$$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 ${DEAD_CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
fi; \
|
||||
if [ -e "${T}${CALC_SHAREDIR}/$$i" ]; then \
|
||||
echo "${RM} -f ${T}${CALC_SHAREDIR}/$$i"; \
|
||||
${RM} -f ${T}${CALC_SHAREDIR}/$$i; \
|
||||
fi; \
|
||||
if [ -e "./$$i" ]; then \
|
||||
echo "${RM} -f ./$$i"; \
|
||||
${RM} -f ./$$i; \
|
||||
fi; \
|
||||
done
|
||||
-${Q} for i in ${CALC_FILES} /dev/null; do \
|
||||
if [ "$$i" = "/dev/null" ]; then \
|
||||
continue; \
|
||||
|
888
cal/README
888
cal/README
File diff suppressed because it is too large
Load Diff
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* alg_config - help determine optimal values for algorithm levels
|
||||
*
|
||||
* Copyright (C) 2006 Landon Curt Noll
|
||||
* Copyright (C) 2006,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
|
||||
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.15 $
|
||||
* @(#) $Id: alg_config.cal,v 29.15 2006/12/16 11:18:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/alg_config.cal,v $
|
||||
* @(#) $Revision: 30.12 $
|
||||
* @(#) $Id: alg_config.cal,v 30.12 2016/02/06 08:38:56 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/alg_config.cal,v $
|
||||
*
|
||||
* Under source code control: 2006/06/07 14:10:11
|
||||
* File existed as early as: 2006
|
||||
@@ -28,8 +28,37 @@
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
static test_time; /* try for this many seconds in loop test */
|
||||
|
||||
global test_time; /* try for this many seconds in loop test */
|
||||
|
||||
/*
|
||||
* close_to_one - set to 1 if the ratio is close enough to 1
|
||||
*
|
||||
* given:
|
||||
* ratio the ratio of time between two algorithms
|
||||
*
|
||||
* retuns:
|
||||
* 1 When ratio is near 1.0
|
||||
* 0 otherwise
|
||||
*
|
||||
* We consider the range [0.995, 1.005] to be close enough to 1 to be call unity
|
||||
* because of the precision of the CPU timing.
|
||||
*/
|
||||
define close_to_one(ratio)
|
||||
{
|
||||
/* firewall */
|
||||
if (!isreal(ratio)) {
|
||||
quit "close: 1st arg: must be a real number";
|
||||
}
|
||||
|
||||
/* check if the ratio is far from unity */
|
||||
if ((ratio < 0.995) || (ratio > 1.005)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* we are close to unity */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
@@ -80,7 +109,8 @@ define mul_loop(repeat, x)
|
||||
len = sizeof((*x)[0]) / baseb_bytes;
|
||||
for (i=1; i < 4; ++i) {
|
||||
if ((sizeof((*x)[i]) / baseb_bytes) != len) {
|
||||
quit "mul_loop: 2nd arg matrix elements are not of equal BASEB-bit word length";
|
||||
quit "mul_loop: 2nd arg matrix elements are not of "
|
||||
"equal BASEB-bit word length";
|
||||
}
|
||||
}
|
||||
|
||||
@@ -142,7 +172,7 @@ define mul_loop(repeat, x)
|
||||
* len length in BASEB-bit words to multiply
|
||||
*
|
||||
* return:
|
||||
* ratio of (1st / 2nd) algorithm rate
|
||||
* ratio of (1st / 2nd) algorithm rate.
|
||||
*
|
||||
* When want to determine a rate to a precision of 1 part in 1000.
|
||||
* Most systems today return CPU time to at least 10 msec precision.
|
||||
@@ -165,6 +195,7 @@ define mul_ratio(len)
|
||||
local tover; /* est of time for loop overhead */
|
||||
local alg1_rate; /* loop rate of 1st algorithm */
|
||||
local alg2_rate; /* loop rate of 2nd algorithm */
|
||||
local ret; /* return ratio, or 1.0 */
|
||||
local i;
|
||||
|
||||
/*
|
||||
@@ -217,12 +248,12 @@ define mul_ratio(len)
|
||||
* determine the 1st algorithm rate
|
||||
*/
|
||||
loops = max(1, ceil(loops * test_time / tlen));
|
||||
if (loops < 8) {
|
||||
if (loops < 16) {
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" we must expand loop test time to more than %d secs\n",
|
||||
ceil(test_time * (8 / loops)));
|
||||
printf(" we must expand alg1 loop test time to about %d secs\n",
|
||||
ceil(test_time * (16 / loops)));
|
||||
}
|
||||
loops = 8;
|
||||
loops = 16;
|
||||
}
|
||||
if (config("user_debug") > 3) {
|
||||
printf("\t will try alg1 %d loops\n", loops);
|
||||
@@ -263,12 +294,12 @@ define mul_ratio(len)
|
||||
* determine the 2nd algorithm rate
|
||||
*/
|
||||
loops = max(1, ceil(loops * test_time / tlen));
|
||||
if (loops < 8) {
|
||||
if (loops < 16) {
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" we must expand loop test time to more than %d secs\n",
|
||||
ceil(test_time * (8 / loops)));
|
||||
printf(" we must expand alg2 loop test time to about %d secs\n",
|
||||
ceil(test_time * (16 / loops)));
|
||||
}
|
||||
loops = 8;
|
||||
loops = 16;
|
||||
}
|
||||
tlen = mul_loop(loops, &x);
|
||||
if (config("user_debug") > 3) {
|
||||
@@ -297,7 +328,12 @@ define mul_ratio(len)
|
||||
/*
|
||||
* return alg1 / alg2 rate ratio
|
||||
*/
|
||||
return (alg1_rate / alg2_rate);
|
||||
ret = alg1_rate / alg2_rate;
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tprecise ratio is: %.f mul_ratio will return: %.3f\n",
|
||||
alg1_rate / alg2_rate, ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
@@ -319,30 +355,40 @@ define best_mul2()
|
||||
{
|
||||
local ratio; /* previously calculated alg1/alg2 ratio */
|
||||
local low; /* low loop value tested */
|
||||
local high; /* low loop value tested */
|
||||
local high; /* high loop value tested */
|
||||
local mid; /* between low and high */
|
||||
local best_val; /* value found with ratio closest to unity */
|
||||
local best_ratio; /* cloest ratio found to unity */
|
||||
local expand; /* how fast to expand the length */
|
||||
|
||||
/*
|
||||
* setup
|
||||
*/
|
||||
test_time = 15.0;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("will start with loop test time of %d secs\n", test_time);
|
||||
printf("WARNING: This tool may not be computing the correct best value\n");
|
||||
test_time = 5.0;
|
||||
printf("The best_mul2() function will take a LONG time to run!\n");
|
||||
printf("It is important that best_mul2() run on an othwewise idle host!\n");
|
||||
if (config("user_debug") <= 0) {
|
||||
printf("To monitor progress, set user_debug to 2: "
|
||||
"config(\"user_debug\", 2)\n");
|
||||
}
|
||||
printf("Starting with loop test time of %d secs\n", test_time);
|
||||
|
||||
/*
|
||||
* firewall - must have a >1 ratio for the initial length
|
||||
*/
|
||||
high = 16;
|
||||
high = 8;
|
||||
best_val = high;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing multiply alg1/alg2 ratio for len = %d\n", high);
|
||||
}
|
||||
ratio = mul_ratio(high);
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" multiply alg1/alg2 ratio = %.3f\n", ratio);
|
||||
printf(" multiply alg1/alg2 ratio = %.6f\n", ratio);
|
||||
}
|
||||
if (ratio <= 1.0) {
|
||||
quit "best_mul2: tests imply config(\"mul2\") should be < 4";
|
||||
if (ratio < 1.0) {
|
||||
quit "best_mul2: tests imply mul2 should be < 16, which seems bogus";
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -355,7 +401,7 @@ define best_mul2()
|
||||
* We will multiplicatively expand our test level until
|
||||
* the ratio drops below 1.0.
|
||||
*/
|
||||
expand = ((ratio >= 3.5) ? 16 : 2^round(ratio));
|
||||
expand = 2;
|
||||
low = high;
|
||||
high *= expand;
|
||||
if (config("user_debug") > 1) {
|
||||
@@ -367,19 +413,63 @@ define best_mul2()
|
||||
* determine the alg1/alg2 test ratio for this new length
|
||||
*/
|
||||
if (high >= 2^31) {
|
||||
quit "best_mul2: tests imply config(\"mul2\") should be >= 2^31";
|
||||
quit "best_mul2: test implies mul2 >= 2^31, which seems bogus";
|
||||
}
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing multiply alg1/alg2 ratio for len = %d\n", high);
|
||||
}
|
||||
ratio = mul_ratio(high);
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" multiply alg1/alg2 ratio = %.3f\n", ratio);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = high;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
} while (ratio >= 1.0);
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" multiply alg1/alg2 ratio = %.6f\n", ratio);
|
||||
}
|
||||
} while (ratio > 1.0);
|
||||
|
||||
/*
|
||||
* If we previously expanded more than by a factor of 2, then
|
||||
* we may have jumped over the crossover point. So now
|
||||
* drop down powers of two until the ratio is again >= 1.0
|
||||
*/
|
||||
if (expand > 2) {
|
||||
do {
|
||||
|
||||
/*
|
||||
* contract by 2
|
||||
*/
|
||||
high /= 2;
|
||||
low = high / 2;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("retesting multiply alg1/alg2 ratio for len = %d\n",
|
||||
high);
|
||||
}
|
||||
ratio = mul_ratio(high);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = high;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" multiply alg1/alg2 ratio = %.6f\n", ratio);
|
||||
}
|
||||
|
||||
} while (ratio <= 1.0);
|
||||
|
||||
/* now that the ratio flipped again, use the previous range */
|
||||
low = high;
|
||||
high = high * 2;
|
||||
}
|
||||
if (config("user_debug") > 0) {
|
||||
printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n",
|
||||
low, high);
|
||||
printf("Starting binary search between %d and %d\n", low, high);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -388,30 +478,54 @@ define best_mul2()
|
||||
while (low+1 < high) {
|
||||
|
||||
/* try the mid-point */
|
||||
mid = int((low+high)/2);
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing multiply alg1/alg2 ratio for len = %d\n",
|
||||
int((low+high)/2));
|
||||
printf("testing multiply alg1/alg2 ratio for len = %d\n", mid);
|
||||
}
|
||||
ratio = mul_ratio(mid);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = mid;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
ratio = mul_ratio(int((low+high)/2));
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" multiply alg1/alg2 ratio = %.3f\n", ratio);
|
||||
printf(" len %d multiply alg1/alg2 ratio = %.6f\n", mid, ratio);
|
||||
}
|
||||
|
||||
/* stop search if near unity */
|
||||
if (close_to_one(ratio)) {
|
||||
low = mid;
|
||||
high = mid;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("\twe are close enough to unity ratio at: %d\n", mid);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
/* bump lower range up if we went over */
|
||||
if (ratio >= 1.0) {
|
||||
if (ratio > 1.0) {
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tmove low from %d up to %d\n",
|
||||
low, int((low+high)/2));
|
||||
low, mid);
|
||||
}
|
||||
low = int((low+high)/2);
|
||||
low = mid;
|
||||
|
||||
/* drop higher range down if we went under */
|
||||
} else {
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tmove high from %d down to %d\n",
|
||||
high, int((low+high)/2));
|
||||
high, mid);
|
||||
}
|
||||
high = int((low+high)/2);
|
||||
high = mid;
|
||||
}
|
||||
|
||||
/* report on test loop progress */
|
||||
if (config("user_debug") > 1) {
|
||||
printf("\tsetting low: %d high: %d diff: %d\n",
|
||||
low, high, high-low);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -419,10 +533,15 @@ define best_mul2()
|
||||
* return on the suggested config("mul2") value
|
||||
*/
|
||||
if (config("user_debug") > 0) {
|
||||
printf("best value of config(\"mul2\") is %d\n",
|
||||
(ratio >= 1.0) ? high : low);
|
||||
printf("Best value for multiply is near %d\n", best_val);
|
||||
printf("Best multiply alg1/alg2 ratio is: %.6f\n", best_ratio);
|
||||
printf("We suggest placing this line in your .calcrc:\n");
|
||||
printf("config(\"mul2\", %d),;\n", best_val);
|
||||
printf("WARNING: It is believed that the output "
|
||||
"of this resource file is bogus!\n");
|
||||
printf("WARNING: You may NOT wish to follow the above suggeston.\n");
|
||||
}
|
||||
return ((ratio >= 1.0) ? high : low);
|
||||
return mid;
|
||||
}
|
||||
|
||||
|
||||
@@ -472,7 +591,8 @@ define sq_loop(repeat, x)
|
||||
len = sizeof((*x)[0]) / baseb_bytes;
|
||||
for (i=1; i < 4; ++i) {
|
||||
if ((sizeof((*x)[i]) / baseb_bytes) != len) {
|
||||
quit "sq_loop: 2nd arg matrix elements are not of equal BASEB-bit word length";
|
||||
quit "sq_loop: 2nd arg matrix elements are not of equal "
|
||||
"BASEB-bit word length";
|
||||
}
|
||||
}
|
||||
|
||||
@@ -559,6 +679,7 @@ define sq_ratio(len)
|
||||
local tover; /* est of time for loop overhead */
|
||||
local alg1_rate; /* loop rate of 1st algorithm */
|
||||
local alg2_rate; /* loop rate of 2nd algorithm */
|
||||
local ret; /* return ratio, or 1.0 */
|
||||
local i;
|
||||
|
||||
/*
|
||||
@@ -611,12 +732,12 @@ define sq_ratio(len)
|
||||
* determine the 1st algorithm rate
|
||||
*/
|
||||
loops = max(1, ceil(loops * test_time / tlen));
|
||||
if (loops < 8) {
|
||||
if (loops < 16) {
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" we must expand loop test time to more than %d secs\n",
|
||||
ceil(test_time * (8 / loops)));
|
||||
printf(" we must expand alg1 loop test time to about %d secs\n",
|
||||
ceil(test_time * (16 / loops)));
|
||||
}
|
||||
loops = 8;
|
||||
loops = 16;
|
||||
}
|
||||
tlen = sq_loop(loops, &x);
|
||||
if (config("user_debug") > 3) {
|
||||
@@ -654,12 +775,12 @@ define sq_ratio(len)
|
||||
* determine the 2nd algorithm rate
|
||||
*/
|
||||
loops = max(1, ceil(loops * test_time / tlen));
|
||||
if (loops < 8) {
|
||||
if (loops < 16) {
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" we must expand loop test time to more than %d secs\n",
|
||||
ceil(test_time * (8 / loops)));
|
||||
printf(" we must expand alg2 loop test time to about %d secs\n",
|
||||
ceil(test_time * (16 / loops)));
|
||||
}
|
||||
loops = 8;
|
||||
loops = 16;
|
||||
}
|
||||
tlen = sq_loop(loops, &x);
|
||||
if (config("user_debug") > 3) {
|
||||
@@ -688,7 +809,12 @@ define sq_ratio(len)
|
||||
/*
|
||||
* return alg1 / alg2 rate ratio
|
||||
*/
|
||||
return (alg1_rate / alg2_rate);
|
||||
ret = alg1_rate / alg2_rate;
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tprecise ratio is: %.f sq_ratio will return: %.3f\n",
|
||||
alg1_rate / alg2_rate, ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
@@ -710,30 +836,40 @@ define best_sq2()
|
||||
{
|
||||
local ratio; /* previously calculated alg1/alg2 ratio */
|
||||
local low; /* low loop value tested */
|
||||
local high; /* low loop value tested */
|
||||
local high; /* high loop value tested */
|
||||
local mid; /* between low and high */
|
||||
local best_val; /* value found with ratio closest to unity */
|
||||
local best_ratio; /* cloest ratio found to unity */
|
||||
local expand; /* how fast to expand the length */
|
||||
|
||||
/*
|
||||
* setup
|
||||
*/
|
||||
test_time = 15.0;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("will start with loop test time of %d secs\n", test_time);
|
||||
printf("WARNING: This tool may not be computing the correct best value\n");
|
||||
test_time = 5.0;
|
||||
printf("The best_sq2() function will take a LONG time to run!\n");
|
||||
printf("It is important that best_sq2() run on an othwewise idle host!\n");
|
||||
if (config("user_debug") <= 0) {
|
||||
printf("To monitor progress, set user_debug to 2: "
|
||||
"config(\"user_debug\", 2)\n");
|
||||
}
|
||||
printf("Starting with loop test time of %d secs\n", test_time);
|
||||
|
||||
/*
|
||||
* firewall - must have a >1 ratio for the initial length
|
||||
*/
|
||||
high = 16;
|
||||
high = 8;
|
||||
best_val = high;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing square alg1/alg2 ratio for len = %d\n", high);
|
||||
}
|
||||
ratio = sq_ratio(high);
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" square alg1/alg2 ratio = %.3f\n", ratio);
|
||||
}
|
||||
if (ratio <= 1.0) {
|
||||
quit "best_sq2: tests imply config(\"sq2\") should be < 4";
|
||||
if (ratio < 1.0) {
|
||||
quit "best_sq2: test implies sq2 < 16, which seems bogus";
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -746,31 +882,75 @@ define best_sq2()
|
||||
* We will multiplicatively expand our test level until
|
||||
* the ratio drops below 1.0.
|
||||
*/
|
||||
expand = ((ratio >= 3.5) ? 16 : 2^round(ratio));
|
||||
expand = 2;
|
||||
low = high;
|
||||
high *= expand;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" expand the next test range by a factor of %d\n",
|
||||
expand);
|
||||
expand);
|
||||
}
|
||||
|
||||
/*
|
||||
* determine the alg1/alg2 test ratio for this new length
|
||||
*/
|
||||
if (high >= 2^31) {
|
||||
quit "best_sq2: tests imply config(\"sq2\") should be >= 2^31";
|
||||
quit "best_sq2: tests imply sq2 >= 2^31, which seems bogus";
|
||||
}
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing square alg1/alg2 ratio for len = %d\n", high);
|
||||
}
|
||||
ratio = sq_ratio(high);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = high;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" square alg1/alg2 ratio = %.3f\n", ratio);
|
||||
}
|
||||
} while (ratio >= 1.0);
|
||||
} while (ratio > 1.0);
|
||||
|
||||
/*
|
||||
* If we previously expanded more than by a factor of 2, then
|
||||
* we may have jumped over the crossover point. So now
|
||||
* drop down powers of two until the ratio is again >= 1.0
|
||||
*/
|
||||
if (expand > 2) {
|
||||
do {
|
||||
|
||||
/*
|
||||
* contract by 2
|
||||
*/
|
||||
high /= 2;
|
||||
low = high / 2;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("retesting multiply alg1/alg2 ratio for len = %d\n",
|
||||
high);
|
||||
}
|
||||
ratio = mul_ratio(high);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = high;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" multiply alg1/alg2 ratio = %.6f\n", ratio);
|
||||
}
|
||||
|
||||
} while (ratio <= 1.0);
|
||||
|
||||
/* now that the ratio flipped again, use the previous range */
|
||||
low = high;
|
||||
high = high * 2;
|
||||
}
|
||||
if (config("user_debug") > 0) {
|
||||
printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n",
|
||||
low, high);
|
||||
printf("Starting binary search between %d and %d\n", low, high);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -779,41 +959,71 @@ define best_sq2()
|
||||
while (low+1 < high) {
|
||||
|
||||
/* try the mid-point */
|
||||
mid = int((low+high)/2);
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing square alg1/alg2 ratio for len = %d\n",
|
||||
int((low+high)/2));
|
||||
printf("testing square alg1/alg2 ratio for len = %d\n", mid);
|
||||
}
|
||||
ratio = sq_ratio(mid);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = mid;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
ratio = sq_ratio(int((low+high)/2));
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" square alg1/alg2 ratio = %.3f\n", ratio);
|
||||
printf(" len %d square alg1/alg2 ratio = %.6f\n", mid, ratio);
|
||||
}
|
||||
|
||||
/* stop search if near unity */
|
||||
if (close_to_one(ratio)) {
|
||||
low = mid;
|
||||
high = mid;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("\twe are close enough to unity ratio at: %d\n", mid);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
/* bump lower range up if we went over */
|
||||
if (ratio >= 1.0) {
|
||||
if (ratio > 1.0) {
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tmove low from %d up to %d\n",
|
||||
low, int((low+high)/2));
|
||||
low, mid);
|
||||
}
|
||||
low = int((low+high)/2);
|
||||
low = mid;
|
||||
|
||||
/* drop higher range down if we went under */
|
||||
} else {
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tmove high from %d down to %d\n",
|
||||
high, int((low+high)/2));
|
||||
high, mid);
|
||||
}
|
||||
high = int((low+high)/2);
|
||||
high = mid;
|
||||
}
|
||||
|
||||
/* report on test loop progress */
|
||||
if (config("user_debug") > 1) {
|
||||
printf("\tsetting low: %d high: %d diff: %d\n",
|
||||
low, high, high-low);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* return on the suggested config("sq2") value
|
||||
*/
|
||||
mid = int((low+high)/2);
|
||||
if (config("user_debug") > 0) {
|
||||
printf("best value of config(\"sq2\") is %d\n",
|
||||
(ratio >= 1.0) ? high : low);
|
||||
printf("Best value for square is near %d\n", best_val);
|
||||
printf("Best square alg1/alg2 ratio is: %.6f\n", best_ratio);
|
||||
printf("We suggest placing this line in your .calcrc:\n");
|
||||
printf("config(\"sq2\", %d),;\n", best_val);
|
||||
printf("WARNING: It is believed that the output "
|
||||
"of this resource file is bogus!\n");
|
||||
printf("WARNING: You may NOT wish to follow the above suggeston.\n");
|
||||
}
|
||||
return ((ratio >= 1.0) ? high : low);
|
||||
return mid;
|
||||
}
|
||||
|
||||
|
||||
@@ -866,7 +1076,8 @@ define pow_loop(repeat, x, ex)
|
||||
len = sizeof((*x)[0]) / baseb_bytes;
|
||||
for (i=1; i < 4; ++i) {
|
||||
if ((sizeof((*x)[i]) / baseb_bytes) != len) {
|
||||
quit "pow_loop: 2nd arg matrix elements are not of equal BASEB-bit word length";
|
||||
quit "pow_loop: 2nd arg matrix elements are not of "
|
||||
"equal BASEB-bit word length";
|
||||
}
|
||||
}
|
||||
if (!isint(ex) || ex < 3) {
|
||||
@@ -963,6 +1174,7 @@ define pow_ratio(len)
|
||||
local alg1_rate; /* loop rate of 1st algorithm */
|
||||
local alg2_rate; /* loop rate of 2nd algorithm */
|
||||
local ex; /* exponent to use in pow_loop() */
|
||||
local ret; /* return ratio, or 1.0 */
|
||||
local i;
|
||||
|
||||
/*
|
||||
@@ -985,7 +1197,7 @@ define pow_ratio(len)
|
||||
/*
|
||||
* setup
|
||||
*/
|
||||
ex = 5;
|
||||
ex = 7;
|
||||
|
||||
/*
|
||||
* initialize x, the values we will pmod
|
||||
@@ -1021,12 +1233,12 @@ define pow_ratio(len)
|
||||
* determine the 1st algorithm rate
|
||||
*/
|
||||
loops = max(1, ceil(loops * test_time / tlen));
|
||||
if (loops < 8) {
|
||||
if (loops < 16) {
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" we must expand loop test time to more than %d secs\n",
|
||||
ceil(test_time * (8 / loops)));
|
||||
printf(" we must expand alg1 loop test time to about %d secs\n",
|
||||
ceil(test_time * (16 / loops)));
|
||||
}
|
||||
loops = 8;
|
||||
loops = 16;
|
||||
}
|
||||
tlen = pow_loop(loops, &x, ex);
|
||||
if (config("user_debug") > 3) {
|
||||
@@ -1065,12 +1277,12 @@ define pow_ratio(len)
|
||||
* determine the 2nd algorithm rate
|
||||
*/
|
||||
loops = max(1, ceil(loops * test_time / tlen));
|
||||
if (loops < 8) {
|
||||
if (loops < 16) {
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" we must expand loop test time to more than %d secs\n",
|
||||
ceil(test_time * (8 / loops)));
|
||||
printf(" we must expand alg2 loop test time to about %d secs\n",
|
||||
ceil(test_time * (16 / loops)));
|
||||
}
|
||||
loops = 8;
|
||||
loops = 16;
|
||||
}
|
||||
tlen = pow_loop(loops, &x, ex);
|
||||
if (config("user_debug") > 3) {
|
||||
@@ -1099,7 +1311,12 @@ define pow_ratio(len)
|
||||
/*
|
||||
* return alg1 / alg2 rate ratio
|
||||
*/
|
||||
return (alg1_rate / alg2_rate);
|
||||
ret = alg1_rate / alg2_rate;
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tprecise ratio is: %.f pow_ratio will return: %.3f\n",
|
||||
alg1_rate / alg2_rate, ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
@@ -1121,17 +1338,25 @@ define best_pow2()
|
||||
{
|
||||
local ratio; /* previously calculated alg1/alg2 ratio */
|
||||
local low; /* low loop value tested */
|
||||
local high; /* low loop value tested */
|
||||
local high; /* high loop value tested */
|
||||
local mid; /* between low and high */
|
||||
local best_val; /* value found with ratio closest to unity */
|
||||
local best_ratio; /* cloest ratio found to unity */
|
||||
local expand; /* how fast to expand the length */
|
||||
local looped; /* 1 ==> we have expanded lengths before */
|
||||
|
||||
/*
|
||||
* setup
|
||||
*/
|
||||
test_time = 15.0;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("will start with loop test time of %d secs\n", test_time);
|
||||
printf("WARNING: This tool may not be computing the correct best value\n");
|
||||
test_time = 60.0;
|
||||
printf("The best_pow2() function will take a LONG time to run!\n");
|
||||
printf("It is important that best_pow2() run on an othwewise idle host!\n");
|
||||
if (config("user_debug") <= 0) {
|
||||
printf("To monitor progress, set user_debug to 2: "
|
||||
"config(\"user_debug\", 2)\n");
|
||||
}
|
||||
printf("Starting with loop test time of %d secs\n", test_time);
|
||||
|
||||
/*
|
||||
* firewall - must have a >1.02 ratio for the initial length
|
||||
@@ -1142,16 +1367,27 @@ define best_pow2()
|
||||
*/
|
||||
low = 4;
|
||||
high = 4;
|
||||
best_val = high;
|
||||
best_ratio = 1e10; /* not a real value */
|
||||
do {
|
||||
high *= 4;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing pmod alg1/alg2 ratio for len = %d\n", high);
|
||||
}
|
||||
ratio = pow_ratio(high);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = high;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" pmod alg1/alg2 ratio = %.3f\n", ratio);
|
||||
if (ratio > 1.0 && ratio <= 1.02) {
|
||||
printf(" while alg1 is slightly better than alg2, it is not clearly better\n");
|
||||
printf(" while alg1 is slightly better than alg2, "
|
||||
"it is not clearly better\n");
|
||||
}
|
||||
}
|
||||
} while (ratio <= 1.02);
|
||||
@@ -1193,20 +1429,27 @@ define best_pow2()
|
||||
* determine the alg1/alg2 test ratio for this new length
|
||||
*/
|
||||
if (high >= 2^31) {
|
||||
quit "best_pow2: tests imply config(\"pow2\") should be >= 2^31";
|
||||
quit "best_pow2: test implies pow2 >= 2^31, which seems bogus";
|
||||
}
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing pmod alg1/alg2 ratio for len = %d\n", high);
|
||||
}
|
||||
ratio = pow_ratio(high);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = high;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" pmod alg1/alg2 ratio = %.3f\n", ratio);
|
||||
printf(" pmod alg1/alg2 ratio = %.6f\n", ratio);
|
||||
}
|
||||
looped = 1;
|
||||
} while (ratio >= 1.0);
|
||||
} while (ratio > 1.0);
|
||||
if (config("user_debug") > 0) {
|
||||
printf("alg1/alg2 ratio now < 1.0, starting binary search between %d and %d\n",
|
||||
low, high);
|
||||
printf("Starting binary search between %d and %d\n", low, high);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1215,39 +1458,69 @@ define best_pow2()
|
||||
while (low+1 < high) {
|
||||
|
||||
/* try the mid-point */
|
||||
mid = int((low+high)/2);
|
||||
if (config("user_debug") > 0) {
|
||||
printf("testing pmod alg1/alg2 ratio for len = %d\n",
|
||||
int((low+high)/2));
|
||||
printf("testing pow2 alg1/alg2 ratio for len = %d\n", mid);
|
||||
}
|
||||
ratio = pow_ratio(mid);
|
||||
if (abs(ratio - 1.0) < abs(best_ratio - 1.0)) {
|
||||
best_val = mid;
|
||||
best_ratio = ratio;
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" len %d has a new cloest ratio to unity: %.6f\n",
|
||||
best_val, best_ratio);
|
||||
}
|
||||
}
|
||||
ratio = pow_ratio(int((low+high)/2));
|
||||
if (config("user_debug") > 1) {
|
||||
printf(" pmod alg1/alg2 ratio = %.3f\n", ratio);
|
||||
printf(" len %d pmod alg1/alg2 ratio = %.6f\n", mid, ratio);
|
||||
}
|
||||
|
||||
/* stop search if near unity */
|
||||
if (close_to_one(ratio)) {
|
||||
low = mid;
|
||||
high = mid;
|
||||
if (config("user_debug") > 0) {
|
||||
printf("\twe are close enough to unity ratio at: %d\n", mid);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
/* bump lower range up if we went over */
|
||||
if (ratio >= 1.0) {
|
||||
if (ratio > 1.0) {
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tmove low from %d up to %d\n",
|
||||
low, int((low+high)/2));
|
||||
low, mid);
|
||||
}
|
||||
low = int((low+high)/2);
|
||||
low = mid;
|
||||
|
||||
/* drop higher range down if we went under */
|
||||
} else {
|
||||
if (config("user_debug") > 2) {
|
||||
printf("\tmove high from %d down to %d\n",
|
||||
high, int((low+high)/2));
|
||||
high, mid);
|
||||
}
|
||||
high = int((low+high)/2);
|
||||
high = mid;
|
||||
}
|
||||
|
||||
/* report on test loop progress */
|
||||
if (config("user_debug") > 1) {
|
||||
printf("\tsetting low: %d high: %d diff: %d\n",
|
||||
low, high, high-low);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* return on the suggested config("pow2") value
|
||||
*/
|
||||
mid = int((low+high)/2);
|
||||
if (config("user_debug") > 0) {
|
||||
printf("best value of config(\"pow2\") is %d\n",
|
||||
(ratio >= 1.0) ? high : low);
|
||||
printf("Best value for pmod is near %d\n", best_val);
|
||||
printf("Best pmod alg1/alg2 ratio is: %.6f\n", best_ratio);
|
||||
printf("We suggest placing this line in your .calcrc:\n");
|
||||
printf("config(\"pow2\", %d),;\n", best_val);
|
||||
printf("WARNING: It is believed that the output "
|
||||
"of this resource file is bogus!\n");
|
||||
printf("WARNING: You may NOT wish to follow the above suggeston.\n");
|
||||
}
|
||||
return ((ratio >= 1.0) ? high : low);
|
||||
return mid;
|
||||
}
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: beer.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/beer.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: bernoulli.cal,v 29.3 2000/12/17 12:26:04 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bernoulli.cal,v $
|
||||
* @(#) $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
|
||||
|
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)";
|
||||
}
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: bigprime.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bigprime.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -14,11 +14,11 @@
|
||||
# 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.
|
||||
# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
#
|
||||
# @(#) $Revision: 29.2 $
|
||||
# @(#) $Id: bindings,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
# @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bindings,v $
|
||||
# @(#) $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
|
||||
|
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)";
|
||||
}
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: chi.cal,v 29.2 2001/04/08 10:21:23 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chi.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: chrem.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/chrem.cal,v $
|
||||
* @(#) $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
|
||||
|
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()";
|
||||
}
|
42
cal/deg.cal
42
cal/deg.cal
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: deg.cal,v 29.4 2003/01/26 19:32:41 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/deg.cal,v $
|
||||
* @(#) $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
|
||||
@@ -28,9 +28,9 @@
|
||||
*/
|
||||
|
||||
|
||||
obj dms {deg, min, sec};
|
||||
obj deg {deg, min, sec};
|
||||
|
||||
define dms(deg, min, sec)
|
||||
define deg(deg, min, sec)
|
||||
{
|
||||
local ans;
|
||||
|
||||
@@ -38,18 +38,18 @@ define dms(deg, min, sec)
|
||||
sec = 0;
|
||||
if (isnull(min))
|
||||
min = 0;
|
||||
obj dms ans;
|
||||
obj deg ans;
|
||||
ans.deg = deg;
|
||||
ans.min = min;
|
||||
ans.sec = sec;
|
||||
fixdms(ans);
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_add(a, b)
|
||||
define deg_add(a, b)
|
||||
{
|
||||
local obj dms ans;
|
||||
local obj deg ans;
|
||||
|
||||
ans.deg = 0;
|
||||
ans.min = 0;
|
||||
@@ -66,14 +66,14 @@ define dms_add(a, b)
|
||||
ans.sec += b.sec;
|
||||
} else
|
||||
ans.deg += b;
|
||||
fixdms(ans);
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_neg(a)
|
||||
define deg_neg(a)
|
||||
{
|
||||
local obj dms ans;
|
||||
local obj deg ans;
|
||||
|
||||
ans.deg = -a.deg;
|
||||
ans.min = -a.min;
|
||||
@@ -82,15 +82,15 @@ define dms_neg(a)
|
||||
}
|
||||
|
||||
|
||||
define dms_sub(a, b)
|
||||
define deg_sub(a, b)
|
||||
{
|
||||
return a - b;
|
||||
}
|
||||
|
||||
|
||||
define dms_mul(a, b)
|
||||
define deg_mul(a, b)
|
||||
{
|
||||
local obj dms ans;
|
||||
local obj deg ans;
|
||||
|
||||
if (istype(a, ans) && istype(b, ans))
|
||||
quit "Cannot multiply degrees together";
|
||||
@@ -103,24 +103,24 @@ define dms_mul(a, b)
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
fixdms(ans);
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define dms_print(a)
|
||||
define deg_print(a)
|
||||
{
|
||||
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
|
||||
}
|
||||
|
||||
|
||||
define dms_abs(a)
|
||||
define deg_abs(a)
|
||||
{
|
||||
return a.deg + a.min / 60 + a.sec / 3600;
|
||||
}
|
||||
|
||||
|
||||
define fixdms(a)
|
||||
define fixdeg(a)
|
||||
{
|
||||
a.min += frac(a.deg) * 60;
|
||||
a.deg = int(a.deg);
|
||||
@@ -134,5 +134,5 @@ define fixdms(a)
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj dms {deg, min, sec} defined";
|
||||
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";
|
||||
}
|
@@ -16,9 +16,9 @@
|
||||
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
||||
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: dotest.cal,v 29.2 2006/05/21 00:55:27 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/dotest.cal,v $
|
||||
* @(#) $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.
|
||||
*
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: ellip.cal,v 29.4 2006/06/20 09:29:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/ellip.cal,v $
|
||||
* @(#) $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
|
||||
|
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;
|
||||
}
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: hello.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/hello.cal,v $
|
||||
* @(#) $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
|
||||
|
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()";
|
||||
}
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.5 $
|
||||
* @(#) $Id: intfile.cal,v 29.5 2001/04/10 22:09:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/intfile.cal,v $
|
||||
* @(#) $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
|
||||
|
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()";
|
||||
}
|
@@ -1,3 +1,33 @@
|
||||
/*
|
||||
* 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
|
||||
*
|
||||
|
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()";
|
||||
}
|
677
cal/lucas.cal
677
cal/lucas.cal
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* lucas - perform a Lucas primality test on h*2^n-1
|
||||
*
|
||||
* Copyright (C) 1999 Landon Curt Noll
|
||||
* Copyright (C) 1999,2017 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
|
||||
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.6 $
|
||||
* @(#) $Id: lucas.cal,v 29.6 2002/07/10 09:43:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas.cal,v $
|
||||
* @(#) $Revision: 30.4 $
|
||||
* @(#) $Id: lucas.cal,v 30.4 2017/05/20 21:54:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc-RHEL7/cal/RCS/lucas.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/05/03 16:49:51
|
||||
* File existed as early as: 1990
|
||||
@@ -28,6 +28,12 @@
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* For a general tutorial on how to find a new largest known prime, see:
|
||||
*
|
||||
* http://www.isthe.com/chongo/tech/math/prime/prime-tutorial.pdf
|
||||
*/
|
||||
|
||||
/*
|
||||
* NOTE: This is a standard calc resource file. For information on calc see:
|
||||
*
|
||||
@@ -71,10 +77,15 @@
|
||||
* 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!
|
||||
* larger finds. Records were made to be broken after all!
|
||||
*/
|
||||
|
||||
/* ON GAINING A WORLD RECORD:
|
||||
/*
|
||||
* ON GAINING A WORLD RECORD:
|
||||
*
|
||||
* For a general tutorial on how to find a new largest known prime, see:
|
||||
*
|
||||
* http://www.isthe.com/chongo/tech/math/prime/prime-tutorial.pdf
|
||||
*
|
||||
* 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
|
||||
@@ -83,6 +94,13 @@
|
||||
* The heart of the package was a multiplication and square routine that
|
||||
* was based on the PFA Fast Fourier Transform and on Winograd's radix FFTs.
|
||||
*
|
||||
* NOTE: While the PFA Fast Fourier Transform and Winograd's radix FFTs
|
||||
* might have been optimal for the Amdahl 6 team at the time,
|
||||
* they might not be optimal for your CPU architecture. See
|
||||
* the above mentioned tutorial for information on better
|
||||
* methods of performing multiplications and squares of very
|
||||
* large numbers.
|
||||
*
|
||||
* Having a fast computer, and a good multi-precision package are
|
||||
* critical, but one also needs to know where to look in order to have
|
||||
* a good chance at a record. Knowing what to test is beyond the scope
|
||||
@@ -139,12 +157,10 @@
|
||||
* be the factors of another candidate.
|
||||
*
|
||||
* Finally, one should eliminate all values of 'h*2^n-1' where
|
||||
* 'h*2^n+1' is divisible by a small primes. The ideas behind this
|
||||
* point is beyond the scope of this program.
|
||||
* 'h*2^n+1' is divisible by a small primes.
|
||||
*/
|
||||
|
||||
|
||||
global pprod256; /* product of "primes up to 256" / "primes up to 46" */
|
||||
pprod256 = 0; /* product of "primes up to 256" / "primes up to 46" */
|
||||
|
||||
/*
|
||||
* lucas - lucas primality test on h*2^n-1
|
||||
@@ -171,15 +187,33 @@ global pprod256; /* product of "primes up to 256" / "primes up to 46" */
|
||||
* "Introduction to Analytic Number Theory", by Tom A. Apostol,
|
||||
* Springer-Verlag, 1984, p 188.
|
||||
*
|
||||
* An excellent 5-page paper by Oystein J. Rodseth (we apologize that the
|
||||
* ASCII character set does not allow us to spell his name with the
|
||||
* umlaut marks on the O's):
|
||||
*
|
||||
* NOTE: The original Amdahl 6 method predates the publication of Ref4.
|
||||
* The gen_v1() function used by lucas() uses the Ref4 method.
|
||||
* See the 'Amdahl 6 legacy code' section below for the original
|
||||
* method of generating v(1).
|
||||
*
|
||||
* Ref4:
|
||||
*
|
||||
* "A note on primality tests for N = h*2^n-1", by Oystein J. Rodseth,
|
||||
* Department of Mathematics, University of Bergen, BIT Numerical
|
||||
* Mathematics. 34 (3): pp 451-454.
|
||||
*
|
||||
* http://folk.uib.no/nmaoy/papers/luc.pdf
|
||||
*
|
||||
* This test is performed as follows: (see Ref1, Theorem 5)
|
||||
*
|
||||
* a) generate u(0) (see the function gen_u0() below)
|
||||
* a) generate u(2) (see the function gen_u2() below)
|
||||
* (NOTE: some call this u(0))
|
||||
*
|
||||
* b) generate u(n-2) according to the rule:
|
||||
* b) generate u(n) according to the rule:
|
||||
*
|
||||
* u(i+1) = u(i)^2-2 mod h*2^n-1
|
||||
*
|
||||
* c) h*2^n-1 is prime if and only if u(n-2) == 0 Q.E.D. :-)
|
||||
* c) h*2^n-1 is prime if and only if u(n) == 0 Q.E.D. :-)
|
||||
*
|
||||
* Now the following conditions must be true for the test to work:
|
||||
*
|
||||
@@ -188,7 +222,7 @@ global pprod256; /* product of "primes up to 256" / "primes up to 46" */
|
||||
* h < 2^n
|
||||
* h mod 2 == 1
|
||||
*
|
||||
* A few misc notes:
|
||||
* A few miscellaneous notes:
|
||||
*
|
||||
* In order to reduce the number of tests, as attempt to eliminate
|
||||
* any number that is divisible by a prime less than 257. Valid prime
|
||||
@@ -222,7 +256,7 @@ lucas(h, n)
|
||||
local testval; /* h*2^n-1 */
|
||||
local shiftdown; /* the power of 2 that divides h */
|
||||
local u; /* the u(i) sequence value */
|
||||
local v1; /* the v(1) generator of u(0) */
|
||||
local v1; /* the v(1) generator of u(2) */
|
||||
local i; /* u sequence cycle number */
|
||||
local oldh; /* pre-reduced h */
|
||||
local oldn; /* pre-reduced n */
|
||||
@@ -364,18 +398,17 @@ lucas(h, n)
|
||||
}
|
||||
|
||||
/*
|
||||
* try to compute u(0)
|
||||
* try to compute u(2) (NOTE: some call this u(0))
|
||||
*
|
||||
* We will use gen_v1() to give us a v(1) using the values
|
||||
* of 'h' and 'n'. We will then use gen_u0() to convert
|
||||
* the v(1) into u(0).
|
||||
* of 'h' and 'n'. We will then use gen_u2() to convert
|
||||
* the v(1) into u(2).
|
||||
*
|
||||
* If gen_v1() returns a negative value, then we failed to
|
||||
* generate a test for h*2^n-1. This is because h mod 3 == 0
|
||||
* is hard to do, and in rare cases, exceed the tables found
|
||||
* in this program. We will generate an message and assume
|
||||
* the number is not prime, even though if we had a larger
|
||||
* table, we might have been able to show that it is prime.
|
||||
* generate a test for h*2^n-1. The legacy function,
|
||||
* legacy_gen_v1() used by the Amdahl 6 could have returned
|
||||
* -1. The new gen_v1() based on the method outlined in Ref4
|
||||
* will never return -1.
|
||||
*/
|
||||
v1 = gen_v1(h, n);
|
||||
if (v1 < 0) {
|
||||
@@ -384,10 +417,10 @@ lucas(h, n)
|
||||
ldebug("lucas", "unknown: no v(1)");
|
||||
return -1;
|
||||
}
|
||||
u = gen_u0(h, n, v1);
|
||||
u = gen_u2(h, n, v1);
|
||||
|
||||
/*
|
||||
* compute u(n-2)
|
||||
* compute u(n) (NOTE: some call this u(n-2))
|
||||
*/
|
||||
for (i=3; i <= n; ++i) {
|
||||
/* u = (u^2 - 2) % testval; */
|
||||
@@ -407,11 +440,19 @@ lucas(h, n)
|
||||
}
|
||||
|
||||
/*
|
||||
* gen_u0 - determine the initial Lucas sequence for h*2^n-1
|
||||
* gen_u2 - determine the initial Lucas sequence for h*2^n-1
|
||||
*
|
||||
* Historically many start the Lucas sequence with u(0).
|
||||
* Some, like the author of this code, prefer to start
|
||||
* with U(2). This is so one may say:
|
||||
*
|
||||
* 2^p-1 is prime if u(p) = 0 mod 2^p-1
|
||||
* or:
|
||||
* h*2^p-1 is prime if u(p) = 0 mod h*2^p-1
|
||||
*
|
||||
* According to Ref1, Theorem 5:
|
||||
*
|
||||
* u(0) = alpha^h + alpha^(-h)
|
||||
* u(2) = alpha^h + alpha^(-h) (NOTE: Ref1 calls it u(0))
|
||||
*
|
||||
* Now:
|
||||
*
|
||||
@@ -419,7 +460,7 @@ lucas(h, n)
|
||||
*
|
||||
* Therefore:
|
||||
*
|
||||
* u(0) = v(h)
|
||||
* u(2) = v(h) (NOTE: Ref1 calls it u(0))
|
||||
*
|
||||
* We calculate v(h) as follows: (Ref1, top of page 873)
|
||||
*
|
||||
@@ -442,16 +483,16 @@ 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)
|
||||
*
|
||||
* returns:
|
||||
* u(0) - initial value for Lucas test on h*2^n-1
|
||||
* -1 - failed to generate u(0)
|
||||
* u(2) - initial value for Lucas test on h*2^n-1
|
||||
* -1 - failed to generate u(2)
|
||||
*/
|
||||
define
|
||||
gen_u0(h, n, v1)
|
||||
gen_u2(h, n, v1)
|
||||
{
|
||||
local shiftdown; /* the power of 2 that divides h */
|
||||
local r; /* low value: v(n) */
|
||||
@@ -475,13 +516,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
|
||||
*/
|
||||
@@ -507,7 +541,7 @@ gen_u0(h, n, v1)
|
||||
* at least 2 bits long for the loop below to work.
|
||||
*/
|
||||
if (h == 1) {
|
||||
ldebug("gen_u0", "quick h == 1 case");
|
||||
ldebug("gen_u2", "quick h == 1 case");
|
||||
/* return r%(h*2^n-1); */
|
||||
return hnrmod(r, h, n, -1);
|
||||
}
|
||||
@@ -547,21 +581,502 @@ gen_u0(h, n, v1)
|
||||
return r;
|
||||
}
|
||||
|
||||
/*
|
||||
* gen_u0 - determine the initial Lucas sequence for h*2^n-1
|
||||
*
|
||||
* Historically many start the Lucas sequence with u(0).
|
||||
* Some, like the author of this code, prefer to start
|
||||
* with u(2). This is so one may say:
|
||||
*
|
||||
* 2^p-1 is prime if u(p) = 0 mod 2^p-1
|
||||
* or:
|
||||
* h*2^n-1 is prime if U(n) = 0 mod h*2^n-1
|
||||
*
|
||||
* For those using the old code with gen_u0(), we
|
||||
* simply call gen_u2() instead.
|
||||
*
|
||||
* See the function gen_u2() for details.
|
||||
*
|
||||
* input:
|
||||
* h - h as in h*2^n-1
|
||||
* n - n as in h*2^n-1
|
||||
* v1 - gen_v1(h,n) (see function below)
|
||||
*
|
||||
* returns:
|
||||
* u(2) - initial value for Lucas test on h*2^n-1
|
||||
* -1 - failed to generate u(2)
|
||||
*/
|
||||
define
|
||||
gen_u0(h, n, v1)
|
||||
{
|
||||
return gen_u2(h, n, v1);
|
||||
}
|
||||
|
||||
/*
|
||||
* rodseth_xhn - determine if v(1) == x for h*2^n-1
|
||||
*
|
||||
* For a given h*2^n-1, v(1) == x if:
|
||||
*
|
||||
* jacobi(x-2, h*2^n-1) == 1 (Ref4, condition 1) part 1
|
||||
* jacobi(x+2, h*2^n-1) == -1 (Ref4, condition 1) part 2
|
||||
*
|
||||
* Now when x-2 <= 0:
|
||||
*
|
||||
* jacobi(x-2, h*2^n-1) == 0
|
||||
*
|
||||
* because:
|
||||
*
|
||||
* jacobi(x,y) == 0 if x <= 0
|
||||
*
|
||||
* So for (Ref4, condition 1) part 1 to be true:
|
||||
*
|
||||
* x-2 > 0
|
||||
*
|
||||
* And therefore:
|
||||
*
|
||||
* x > 2
|
||||
*
|
||||
* input:
|
||||
* x - potential v(1) value
|
||||
* h - h as in h*2^n-1
|
||||
* n - n as in h*2^n-1
|
||||
*
|
||||
* returns:
|
||||
* 1 if v(1) == x for h*2^n-1
|
||||
* 0 otherwise
|
||||
*/
|
||||
define
|
||||
rodseth_xhn(x, h, n)
|
||||
{
|
||||
local testval; /* h*2^n-1 */
|
||||
|
||||
/*
|
||||
* check arg types
|
||||
*/
|
||||
if (!isint(h)) {
|
||||
quit "bad args: h must be an integer";
|
||||
}
|
||||
if (!isint(n)) {
|
||||
quit "bad args: n must be an integer";
|
||||
}
|
||||
if (!isint(x)) {
|
||||
quit "bad args: x must be an integer";
|
||||
}
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (x <= 2) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for jacobi(x-2, h*2^n-1) == 1 (Ref4, condition 1) part 1
|
||||
*/
|
||||
testval = h*2^n-1;
|
||||
if (jacobi(x-2, testval) != 1) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for jacobi(x+2, h*2^n-1) == -1 (Ref4, condition 1) part 2
|
||||
*/
|
||||
if (jacobi(x+2, testval) != -1) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* v(1) == x for this h*2^n-1
|
||||
*/
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Trial tables used by gen_v1()
|
||||
*
|
||||
* When h mod 3 == 0, one needs particular values of D, a and b (see gen_v1
|
||||
* documentation) in order to find a value of v(1).
|
||||
* When h mod 3 == 0, according to Ref4 we need to find the first value X where:
|
||||
*
|
||||
* This table defines 'quickmax' possible tests to be taken in ascending
|
||||
* order. The v1_qval[x] refers to a v(1) value from Ref1, Table 1. A
|
||||
* related D value is found in d_qval[x]. All D values expect d_qval[1]
|
||||
* are also taken from Ref1, Table 1. The case of D == 21 as listed in
|
||||
* Ref1, Table 1 can be changed to D == 7 for the sake of the test because
|
||||
* of {note 6}.
|
||||
* jacobi(X-2, h*2^n-1) == 1 (Ref4, condition 1) part 1
|
||||
* jacobi(X+2, h*2^n-1) == -1 (Ref4, condition 1) part 2
|
||||
*
|
||||
* We can show that X > 2. See the comments in the rodseth_xhn(x,h,n) above.
|
||||
*
|
||||
* Some values of X satisfy more often than others. For example a large sample
|
||||
* of odd h, h multiple of 3 and large n (some around 1e4, some near 1e6, others
|
||||
* near 3e7) where the sample size was 66 973 365, here is the count of the
|
||||
* smallest value of X that satisfies conditions in Ref4, condition 1:
|
||||
*
|
||||
* count X
|
||||
* ----------
|
||||
* 26791345 3
|
||||
* 17223016 5
|
||||
* 7829600 9
|
||||
* 6988774 11
|
||||
* 3301093 15
|
||||
* 1517149 17
|
||||
* 910346 21
|
||||
* 711791 29
|
||||
* 573403 20
|
||||
* 390395 27
|
||||
* 288637 35
|
||||
* 149751 36
|
||||
* 107733 39
|
||||
* 58743 41
|
||||
* 35619 45
|
||||
* 25052 32
|
||||
* 17775 51
|
||||
* 13031 44
|
||||
* 7563 56
|
||||
* 7540 49
|
||||
* 7060 59
|
||||
* 4407 57
|
||||
* 2948 65
|
||||
* 2502 55
|
||||
* 2388 69
|
||||
* 2094 71
|
||||
* 689 77
|
||||
* 626 81
|
||||
* 491 66
|
||||
* 426 95
|
||||
* 219 80
|
||||
* 203 67
|
||||
* 185 84
|
||||
* 152 99
|
||||
* 127 72
|
||||
* 102 74
|
||||
* 98 87
|
||||
* 67 90
|
||||
* 55 104
|
||||
* 48 101
|
||||
* 32 105
|
||||
* 17 109
|
||||
* 16 116
|
||||
* 15 111
|
||||
* 13 92
|
||||
* 12 125
|
||||
* 7 129
|
||||
* 3 146
|
||||
* 2 140
|
||||
* 2 120
|
||||
* 1 165
|
||||
* 1 161
|
||||
* 1 155
|
||||
*
|
||||
* The above distribution was found to hold fairly well over many values of
|
||||
* odd h that are a multiple of 3 and for many values of n where h < 2^n.
|
||||
*
|
||||
* Given this information, when odd h is a multiple of 3 we try, in order,
|
||||
* these values of X:
|
||||
*
|
||||
* 3, 5, 9, 11, 15, 17, 21, 29, 20, 27, 35, 36, 39, 41, 45, 32, 51, 44,
|
||||
* 56, 49, 59, 57, 65, 55, 69, 71, 77, 81, 66, 95, 80, 67, 84, 99, 72,
|
||||
* 74, 87, 90, 104, 101, 105, 109, 116, 111, 92
|
||||
*
|
||||
* And stop on the first value of X where:
|
||||
*
|
||||
* jacobi(X-2, h*2^n-1) == 1
|
||||
* jacobi(X+2, h*2^n-1) == -1
|
||||
*
|
||||
* If no value in that list works, we start simple search starting with X = 120
|
||||
* and incrementing by 1 until a value of X is found.
|
||||
*
|
||||
* The x_tbl[] matrix contains those common values of X to try in order.
|
||||
* If all x_tbl_len fail to satisfy Ref4 condition 1, then we begin a
|
||||
* linear search at next_x until we find a proper X value.
|
||||
*
|
||||
* IMPORTANT NOTE: Using this table will not find the smallest possible v(1)
|
||||
* for a given h and n. This is not a problem because using
|
||||
* a larger value of v(1) does not impact the primality test.
|
||||
* Furthermore after lucas(h, n) generates a few u(n) terms,
|
||||
* the values will wrap (due to computing mod h*2^n-1).
|
||||
* Finally on average, about 1/4 of the values of X work as
|
||||
* v(1) for a given n when h is a multiple of 3. Skipping
|
||||
* rarely used v(1) will not doom gen_v1() to a long search.
|
||||
*/
|
||||
x_tbl_len = 45;
|
||||
mat x_tbl[x_tbl_len];
|
||||
x_tbl = {
|
||||
3, 5, 9, 11, 15, 17, 21, 29, 20, 27, 35, 36, 39, 41, 45, 32, 51, 44,
|
||||
56, 49, 59, 57, 65, 55, 69, 71, 77, 81, 66, 95, 80, 67, 84, 99, 72,
|
||||
74, 87, 90, 104, 101, 105, 109, 116, 111, 92
|
||||
};
|
||||
next_x = 120;
|
||||
|
||||
/*
|
||||
* gen_v1 - compute the v(1) for a given h*2^n-1 if we can
|
||||
*
|
||||
* This function assumes:
|
||||
*
|
||||
* n > 2 (n==2 has already been eliminated)
|
||||
* h mod 2 == 1
|
||||
* h < 2^n
|
||||
* h*2^n-1 mod 3 != 0 (h*2^n-1 has no small factors, such as 3)
|
||||
*
|
||||
* The generation of v(1) depends on the value of h. There are two cases
|
||||
* to consider, h mod 3 != 0, and h mod 3 == 0.
|
||||
*
|
||||
***
|
||||
*
|
||||
* Case 1: (h mod 3 != 0)
|
||||
*
|
||||
* This case is easy.
|
||||
*
|
||||
* In Ref1, page 869, one finds that if: (or see Ref2, page 131-132)
|
||||
*
|
||||
* h mod 6 == +/-1
|
||||
* h*2^n-1 mod 3 != 0
|
||||
*
|
||||
* which translates, gives the functions assumptions, into the condition:
|
||||
*
|
||||
* h mod 3 != 0
|
||||
*
|
||||
* If this case condition is true, then:
|
||||
*
|
||||
* u(2) = (2+sqrt(3))^h + (2-sqrt(3))^h (see Ref1, page 869)
|
||||
* = (2+sqrt(3))^h + (2+sqrt(3))^(-h) (NOTE: some call this u(2))
|
||||
*
|
||||
* and since Ref1, Theorem 5 states:
|
||||
*
|
||||
* u(2) = alpha^h + alpha^(-h) (NOTE: some call this u(2))
|
||||
* r = abs(2^2 - 1^2*3) = 1
|
||||
*
|
||||
* and the bottom of Ref1, page 872 states:
|
||||
*
|
||||
* v(x) = alpha^x + alpha^(-x)
|
||||
*
|
||||
* If we let:
|
||||
*
|
||||
* alpha = (2+sqrt(3))
|
||||
*
|
||||
* then
|
||||
*
|
||||
* u(2) = v(h) (NOTE: some call this u(2))
|
||||
*
|
||||
* so we simply return
|
||||
*
|
||||
* v(1) = alpha^1 + alpha^(-1)
|
||||
* = (2+sqrt(3)) + (2-sqrt(3))
|
||||
* = 4
|
||||
*
|
||||
***
|
||||
*
|
||||
* Case 2: (h mod 3 == 0)
|
||||
*
|
||||
* For the case where h is a multiple of 3, we turn to Ref4.
|
||||
*
|
||||
* The central theorem on page 3 of that paper states that
|
||||
* we may set v(1) to the first value X that satisfies:
|
||||
*
|
||||
* jacobi(X-2, h*2^n-1) == 1 (Ref4, condition 1)
|
||||
* jacobi(X+2, h*2^n-1) == -1 (Ref4, condition 1)
|
||||
*
|
||||
* NOTE: Ref4 uses P, which we shall refer to as X.
|
||||
* Ref4 uses N, which we shall refer to as h*2^n-1.
|
||||
*
|
||||
* NOTE: Ref4 uses the term Legendre-Jacobi symbol, which
|
||||
* we shall refer to as the Jacobi symbol.
|
||||
*
|
||||
* Before we address the two conditions, we need some background information
|
||||
* on two symbols, Legendre and Jacobi. In Ref 2, pp 278, 284-285, we find
|
||||
* the following definitions of jacobi(a,b) and L(a,p):
|
||||
*
|
||||
* The Legendre symbol L(a,p) takes the value:
|
||||
*
|
||||
* L(a,p) == 1 => a is a quadratic residue of p
|
||||
* L(a,p) == -1 => a is NOT a quadratic residue of p
|
||||
*
|
||||
* when:
|
||||
*
|
||||
* p is prime
|
||||
* p mod 2 == 1
|
||||
* gcd(a,p) == 1
|
||||
*
|
||||
* The value a is a quadratic residue of b if there exists some integer z
|
||||
* such that:
|
||||
*
|
||||
* z^2 mod b == a
|
||||
*
|
||||
* The Jacobi symbol jacobi(a,b) takes the value:
|
||||
*
|
||||
* jacobi(a,b) == 1 => b is not prime,
|
||||
* or a is a quadratic residue of b
|
||||
* jacobi(a,b) == -1 => a is NOT a quadratic residue of b
|
||||
*
|
||||
* when
|
||||
*
|
||||
* b mod 2 == 1
|
||||
* gcd(a,b) == 1
|
||||
*
|
||||
* It is worth noting for the Legendre symbol, in order for L(X+/-2,
|
||||
* h*2^n-1) to be defined, we must ensure that neither X-2 nor X+2 are
|
||||
* factors of h*2^n-1. This is done by pre-screening h*2^n-1 to not
|
||||
* have small factors and keeping X+2 less than that small factor
|
||||
* limit. It is worth noting that in lucas(h, n), we first verify
|
||||
* that h*2^n-1 does not have a factor < 257 before performing the
|
||||
* primality test. So while X+/-2 < 257, we know that
|
||||
* gcd(X+/-2, h*2^n-1) == 1.
|
||||
*
|
||||
* Returning to the testing of conditions in Ref4, condition 1:
|
||||
*
|
||||
* jacobi(X-2, h*2^n-1) == 1
|
||||
* jacobi(X+2, h*2^n-1) == -1
|
||||
*
|
||||
* When such an X is found, we set:
|
||||
*
|
||||
* v(1) = X
|
||||
*
|
||||
***
|
||||
*
|
||||
* In conclusion, we can compute v,(1) by attempting to do the following:
|
||||
*
|
||||
* h mod 3 != 0
|
||||
*
|
||||
* we return:
|
||||
*
|
||||
* v(1) == 4
|
||||
*
|
||||
* h mod 3 == 0
|
||||
*
|
||||
* we return:
|
||||
*
|
||||
* v(1) = X
|
||||
*
|
||||
* where X > 2 in a integer such that:
|
||||
*
|
||||
* jacobi(X-2, h*2^n-1) == 1
|
||||
* jacobi(X+2, h*2^n-1) == -1
|
||||
*
|
||||
***
|
||||
*
|
||||
* input:
|
||||
* h h as in h*2^n-1
|
||||
* n n as in h*2^n-1
|
||||
*
|
||||
* output:
|
||||
* returns v(1), or -1 is there is no quick way
|
||||
*/
|
||||
define
|
||||
gen_v1(h, n)
|
||||
{
|
||||
local x; /* potential v(1) to test */
|
||||
local i; /* x_tbl index */
|
||||
|
||||
/*
|
||||
* check arg types
|
||||
*/
|
||||
if (!isint(h)) {
|
||||
quit "bad args: h must be an integer";
|
||||
}
|
||||
if (!isint(n)) {
|
||||
quit "bad args: n must be an integer";
|
||||
}
|
||||
|
||||
/*
|
||||
* check for Case 1: (h mod 3 != 0)
|
||||
*/
|
||||
if (h % 3 != 0) {
|
||||
/* v(1) is easy to compute */
|
||||
return 4;
|
||||
}
|
||||
|
||||
/*
|
||||
* What follow is Case 2: (h mod 3 == 0)
|
||||
*/
|
||||
|
||||
/*
|
||||
* We will look for x that satisfies conditions in Ref4, condition 1:
|
||||
*
|
||||
* jacobi(X-2, h*2^n-1) == 1 part 1
|
||||
* jacobi(X+2, h*2^n-1) == -1 part 2
|
||||
*/
|
||||
for (i=0; i < x_tbl_len; ++i) {
|
||||
|
||||
/*
|
||||
* test Ref4 condition 1:
|
||||
*/
|
||||
x = x_tbl[i];
|
||||
if (rodseth_xhn(x, h, n) == 1) {
|
||||
|
||||
/*
|
||||
* found a x that satisfies Ref4 condition 1
|
||||
*/
|
||||
ldebug("gen_v1", "h= " + str(h) + " n= " + str(n) +
|
||||
" v1= " + str(x) + " using tbl[ " +
|
||||
str(i) + " ]");
|
||||
return x;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* We are in that rare case (about 1 in 2 300 000) where none of the
|
||||
* common X values satisfy Ref4 condition 1. We start a linear search
|
||||
* at next_x from here on.
|
||||
*
|
||||
* However, we also need to keep in mind that when x+2 >= 257, we
|
||||
* need to verify that gcd(x-2, h*2^n-1) == 1 and
|
||||
* and to verify that gcd(x+2, h*2^n-1) == 1.
|
||||
*/
|
||||
x = next_x;
|
||||
while (rodseth_xhn(x, h, n) != 1) {
|
||||
++x;
|
||||
}
|
||||
/* finally found a v(1) value */
|
||||
ldebug("gen_v1", "h= " + str(h) + " n= " + str(n) +
|
||||
" v1= " + str(x) + " beyond tbl");
|
||||
return x;
|
||||
}
|
||||
|
||||
/*
|
||||
* ldebug - print a debug statement
|
||||
*
|
||||
* input:
|
||||
* funct name of calling function
|
||||
* str string to print
|
||||
*/
|
||||
define
|
||||
ldebug(funct, str)
|
||||
{
|
||||
if (config("resource_debug") & 8) {
|
||||
print "DEBUG:", funct:":", str;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
************************
|
||||
* Amdahl 6 legacy code *
|
||||
************************
|
||||
*
|
||||
* NOTE: What follows is legacy code based on the method used by the
|
||||
* Amdahl 6 group:
|
||||
*
|
||||
* John Brown, Landon Curt Noll, Bodo Parady, Gene Smith,
|
||||
* Joel Smith and Sergio Zarantonello
|
||||
*
|
||||
* This method generated v(1) for nearly all values, except for a
|
||||
* few rare cases when h mod 3 == 0. The code is NOT used by lucas.cal
|
||||
* above. The gen_v1() function above is based on an improved method
|
||||
* outlined in Ref4. That method generated v(1) for all h.
|
||||
*
|
||||
* The code below is kept for historical purposes only. The functions
|
||||
* and global variables of the Amdahl 6 legacy code all begin with legacy_.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Trial tables used by legacy_gen_v1()
|
||||
*
|
||||
* When h mod 3 == 0, one needs particular values of D, a and b (see
|
||||
* legacy_gen_v1 documentation) in order to find a value of v(1).
|
||||
*
|
||||
* This table defines 'legacy_quickmax' possible tests to be taken in ascending
|
||||
* order. The legacy_v1_qval[x] refers to a v(1) value from Ref1, Table 1. A
|
||||
* related D value is found in legacy_d_qval[x]. All D values expect
|
||||
* legacy_d_qval[1] are also taken from Ref1, Table 1. The case of D == 21 as
|
||||
* listed in Ref1, Table 1 can be changed to D == 7 for the sake of the test
|
||||
* because of {note 6}.
|
||||
*
|
||||
* It should be noted that the D values all satisfy the selection values
|
||||
* as outlined in the gen_v1() function comments. That is:
|
||||
* as outlined in the legacy_gen_v1() function comments. That is:
|
||||
*
|
||||
* D == P*(2^f)*(3^g)
|
||||
*
|
||||
@@ -578,20 +1093,20 @@ gen_u0(h, n, v1)
|
||||
* where Q == 1. No further processing is needed to compute v(1) when r
|
||||
* is of this form.
|
||||
*/
|
||||
quickmax = 8;
|
||||
mat d_qval[quickmax];
|
||||
mat v1_qval[quickmax];
|
||||
d_qval[0] = 5; v1_qval[0] = 3; /* a=1 b=1 r=4 */
|
||||
d_qval[1] = 7; v1_qval[1] = 5; /* a=3 b=1 r=12 D=21 */
|
||||
d_qval[2] = 13; v1_qval[2] = 11; /* a=3 b=1 r=4 */
|
||||
d_qval[3] = 11; v1_qval[3] = 20; /* a=3 b=1 r=2 */
|
||||
d_qval[4] = 29; v1_qval[4] = 27; /* a=5 b=1 r=4 */
|
||||
d_qval[5] = 53; v1_qval[5] = 51; /* a=53 b=1 r=4 */
|
||||
d_qval[6] = 17; v1_qval[6] = 66; /* a=17 b=1 r=1 */
|
||||
d_qval[7] = 19; v1_qval[7] = 74; /* a=38 b=1 r=2 */
|
||||
legacy_quickmax = 8;
|
||||
mat legacy_d_qval[legacy_quickmax];
|
||||
mat legacy_v1_qval[legacy_quickmax];
|
||||
legacy_d_qval[0] = 5; legacy_v1_qval[0] = 3; /* a=1 b=1 r=4 */
|
||||
legacy_d_qval[1] = 7; legacy_v1_qval[1] = 5; /* a=3 b=1 r=12 D=21 */
|
||||
legacy_d_qval[2] = 13; legacy_v1_qval[2] = 11; /* a=3 b=1 r=4 */
|
||||
legacy_d_qval[3] = 11; legacy_v1_qval[3] = 20; /* a=3 b=1 r=2 */
|
||||
legacy_d_qval[4] = 29; legacy_v1_qval[4] = 27; /* a=5 b=1 r=4 */
|
||||
legacy_d_qval[5] = 53; legacy_v1_qval[5] = 51; /* a=53 b=1 r=4 */
|
||||
legacy_d_qval[6] = 17; legacy_v1_qval[6] = 66; /* a=17 b=1 r=1 */
|
||||
legacy_d_qval[7] = 19; legacy_v1_qval[7] = 74; /* a=38 b=1 r=2 */
|
||||
|
||||
/*
|
||||
* gen_v1 - compute the v(1) for a given h*2^n-1 if we can
|
||||
* legacy_gen_v1 - compute the v(1) for a given h*2^n-1 if we can
|
||||
*
|
||||
* This function assumes:
|
||||
*
|
||||
@@ -620,12 +1135,12 @@ d_qval[7] = 19; v1_qval[7] = 74; /* a=38 b=1 r=2 */
|
||||
*
|
||||
* If this case condition is true, then:
|
||||
*
|
||||
* u(0) = (2+sqrt(3))^h + (2-sqrt(3))^h (see Ref1, page 869)
|
||||
* = (2+sqrt(3))^h + (2+sqrt(3))^(-h)
|
||||
* u(2) = (2+sqrt(3))^h + (2-sqrt(3))^h (see Ref1, page 869)
|
||||
* = (2+sqrt(3))^h + (2+sqrt(3))^(-h) (some call this u(0))
|
||||
*
|
||||
* and since Ref1, Theorem 5 states:
|
||||
*
|
||||
* u(0) = alpha^h + alpha^(-h)
|
||||
* u(2) = alpha^h + alpha^(-h)
|
||||
* r = abs(2^2 - 1^2*3) = 1
|
||||
*
|
||||
* and the bottom of Ref1, page 872 states:
|
||||
@@ -638,7 +1153,7 @@ d_qval[7] = 19; v1_qval[7] = 74; /* a=38 b=1 r=2 */
|
||||
*
|
||||
* then
|
||||
*
|
||||
* u(0) = v(h)
|
||||
* u(2) = v(h)
|
||||
*
|
||||
* so we simply return
|
||||
*
|
||||
@@ -673,7 +1188,7 @@ d_qval[7] = 19; v1_qval[7] = 74; /* a=38 b=1 r=2 */
|
||||
*
|
||||
* where L(x,y) is the Legendre symbol (see below), then:
|
||||
*
|
||||
* u(0) = alpha^h + alpha^(-h)
|
||||
* u(2) = alpha^h + alpha^(-h)
|
||||
*
|
||||
* The bottom of Ref1, page 872 states:
|
||||
*
|
||||
@@ -681,7 +1196,7 @@ d_qval[7] = 19; v1_qval[7] = 74; /* a=38 b=1 r=2 */
|
||||
*
|
||||
* thus since:
|
||||
*
|
||||
* u(0) = v(h)
|
||||
* u(2) = v(h)
|
||||
*
|
||||
* so we want to return:
|
||||
*
|
||||
@@ -936,7 +1451,7 @@ d_qval[7] = 19; v1_qval[7] = 74; /* a=38 b=1 r=2 */
|
||||
* returns v(1), or -1 is there is no quick way
|
||||
*/
|
||||
define
|
||||
gen_v1(h, n)
|
||||
legacy_gen_v1(h, n)
|
||||
{
|
||||
local d; /* the 'D' value to try */
|
||||
local val_mod; /* h*2^n-1 mod 'D' */
|
||||
@@ -954,10 +1469,10 @@ gen_v1(h, n)
|
||||
* We will try all 'D' values until we find a proper v(1)
|
||||
* or run out of 'D' values.
|
||||
*/
|
||||
for (i=0; i < quickmax; ++i) {
|
||||
for (i=0; i < legacy_quickmax; ++i) {
|
||||
|
||||
/* grab our 'D' value */
|
||||
d = d_qval[i];
|
||||
d = legacy_d_qval[i];
|
||||
|
||||
/* compute h*2^n-1 mod 'D' quickly */
|
||||
val_mod = (h*pmod(2,n%(d-1),d)-1) % d;
|
||||
@@ -972,13 +1487,13 @@ gen_v1(h, n)
|
||||
/* D mod 4 == 1, so check for J(D, h*2^n-1) == -1 */
|
||||
if (jacobi(val_mod, d) == -1) {
|
||||
/* it worked, return the related v(1) value */
|
||||
return v1_qval[i];
|
||||
return legacy_v1_qval[i];
|
||||
}
|
||||
} else {
|
||||
/* D mod 4 == -1, so check for J(D, h*2^n-1) == 1 */
|
||||
if (jacobi(val_mod, d) == 1) {
|
||||
/* it worked, return the related v(1) value */
|
||||
return v1_qval[i];
|
||||
return legacy_v1_qval[i];
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1036,19 +1551,3 @@ gen_v1(h, n)
|
||||
/* no quick and dirty v(1), so return -1 */
|
||||
return -1;
|
||||
}
|
||||
|
||||
/*
|
||||
* ldebug - print a debug statement
|
||||
*
|
||||
* input:
|
||||
* funct name of calling function
|
||||
* str string to print
|
||||
*/
|
||||
define
|
||||
ldebug(funct, str)
|
||||
{
|
||||
if (config("resource_debug") & 8) {
|
||||
print "DEBUG:", funct:":", str;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: lucas_chk.cal,v 29.3 2001/03/31 13:31:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/lucas_chk.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -1,165 +0,0 @@
|
||||
/*
|
||||
* lucas_tbl - lucasian criteria for primality tables
|
||||
*
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: lucas_tbl.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/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
|
||||
*
|
||||
* The following table is taken from:
|
||||
*
|
||||
* "Lucasian Criteria for the Primality of N=h*2^n-1", by Hans Riesel,
|
||||
* Mathematics of Computation, Vol 23 #108, p 872.
|
||||
*
|
||||
* The index of the *_val[] arrays correspond to the v(1) values found
|
||||
* in the table. That is, for v(1) == x:
|
||||
*
|
||||
* D == d_val[x]
|
||||
* a == a_val[x]
|
||||
* b == b_val[x]
|
||||
* r == r_val[x] (r == abs(a^2 - b^2*D))
|
||||
*
|
||||
*
|
||||
* Note that when *_val[i] is not a number, the related v(1) value
|
||||
* is not found in Table 1.
|
||||
*/
|
||||
|
||||
|
||||
trymax = 100;
|
||||
mat d_val[trymax+1];
|
||||
mat a_val[trymax+1];
|
||||
mat b_val[trymax+1];
|
||||
mat r_val[trymax+1];
|
||||
/* v1= 0 INVALID */
|
||||
/* v1= 1 INVALID */
|
||||
/* v1= 2 INVALID */
|
||||
d_val[ 3]= 5; a_val[ 3]= 1; b_val[ 3]=1; r_val[ 3]=4;
|
||||
d_val[ 4]= 3; a_val[ 4]= 1; b_val[ 4]=1; r_val[ 4]=2;
|
||||
d_val[ 5]= 21; a_val[ 5]= 3; b_val[ 5]=1; r_val[ 5]=12;
|
||||
d_val[ 6]= 2; a_val[ 6]= 1; b_val[ 6]=1; r_val[ 6]=1;
|
||||
/* v1= 7 INVALID */
|
||||
d_val[ 8]= 15; a_val[ 8]= 3; b_val[ 8]=1; r_val[ 8]=6;
|
||||
d_val[ 9]= 77; a_val[ 9]= 7; b_val[ 9]=1; r_val[ 9]=28;
|
||||
d_val[10]= 6; a_val[10]= 2; b_val[10]=1; r_val[10]=2;
|
||||
d_val[11]= 13; a_val[11]= 3; b_val[11]=1; r_val[11]=4;
|
||||
d_val[12]= 35; a_val[12]= 5; b_val[12]=1; r_val[12]=10;
|
||||
d_val[13]= 165; a_val[13]=11; b_val[13]=1; r_val[13]=44;
|
||||
/* v1=14 INVALID */
|
||||
d_val[15]= 221; a_val[15]=13; b_val[15]=1; r_val[15]=52;
|
||||
d_val[16]= 7; a_val[16]= 3; b_val[16]=1; r_val[16]=2;
|
||||
d_val[17]= 285; a_val[17]=15; b_val[17]=1; r_val[17]=60;
|
||||
/* v1=18 INVALID */
|
||||
d_val[19]= 357; a_val[19]=17; b_val[19]=1; r_val[19]=68;
|
||||
d_val[20]= 11; a_val[20]= 3; b_val[20]=1; r_val[20]=2;
|
||||
d_val[21]= 437; a_val[21]=19; b_val[21]=1; r_val[21]=76;
|
||||
d_val[22]= 30; a_val[22]= 5; b_val[22]=1; r_val[22]=5;
|
||||
/* v1=23 INVALID */
|
||||
d_val[24]= 143; a_val[24]=11; b_val[24]=1; r_val[24]=22;
|
||||
d_val[25]= 69; a_val[25]= 9; b_val[25]=1; r_val[25]=12;
|
||||
d_val[26]= 42; a_val[26]= 6; b_val[26]=1; r_val[26]=6;
|
||||
d_val[27]= 29; a_val[27]= 5; b_val[27]=1; r_val[27]=4;
|
||||
d_val[28]= 195; a_val[28]=13; b_val[28]=1; r_val[28]=26;
|
||||
d_val[29]= 93; a_val[29]= 9; b_val[29]=1; r_val[29]=12;
|
||||
d_val[30]= 14; a_val[30]= 4; b_val[30]=1; r_val[30]=2;
|
||||
d_val[31]= 957; a_val[31]=29; b_val[31]=1; r_val[31]=116;
|
||||
d_val[32]= 255; a_val[32]=15; b_val[32]=1; r_val[32]=30;
|
||||
d_val[33]=1085; a_val[33]=31; b_val[33]=1; r_val[33]=124;
|
||||
/* v1=34 INVALID */
|
||||
d_val[35]=1221; a_val[35]=33; b_val[35]=1; r_val[35]=132;
|
||||
d_val[36]= 323; a_val[36]=17; b_val[36]=1; r_val[36]=34;
|
||||
d_val[37]=1365; a_val[37]=35; b_val[37]=1; r_val[37]=140;
|
||||
d_val[38]= 10; a_val[38]= 3; b_val[38]=1; r_val[38]=1;
|
||||
d_val[39]=1517; a_val[39]=37; b_val[39]=1; r_val[39]=148;
|
||||
d_val[40]= 399; a_val[40]=19; b_val[40]=1; r_val[40]=38;
|
||||
d_val[41]=1677; a_val[41]=39; b_val[41]=1; r_val[41]=156;
|
||||
d_val[42]= 110; a_val[42]=10; b_val[42]=1; r_val[42]=10;
|
||||
d_val[43]= 205; a_val[43]=15; b_val[43]=1; r_val[43]=20;
|
||||
d_val[44]= 483; a_val[44]=21; b_val[44]=1; r_val[44]=42;
|
||||
d_val[45]=2021; a_val[45]=43; b_val[45]=1; r_val[45]=172;
|
||||
d_val[46]= 33; a_val[46]= 6; b_val[46]=1; r_val[46]=3;
|
||||
/* v1=47 INVALID */
|
||||
d_val[48]= 23; a_val[48]= 5; b_val[48]=1; r_val[48]=2;
|
||||
d_val[49]=2397; a_val[49]=47; b_val[49]=1; r_val[49]=188;
|
||||
d_val[50]= 39; a_val[50]= 6; b_val[50]=1; r_val[50]=3;
|
||||
d_val[51]= 53; a_val[51]= 7; b_val[51]=1; r_val[51]=4;
|
||||
/* v1=52 INVALID */
|
||||
d_val[53]=2805; a_val[53]=51; b_val[53]=1; r_val[53]=204;
|
||||
d_val[54]= 182; a_val[54]=13; b_val[54]=1; r_val[54]=13;
|
||||
d_val[55]=3021; a_val[55]=53; b_val[55]=1; r_val[55]=212;
|
||||
d_val[56]= 87; a_val[56]= 9; b_val[56]=1; r_val[56]=6;
|
||||
d_val[57]=3245; a_val[57]=55; b_val[57]=1; r_val[57]=220;
|
||||
d_val[58]= 210; a_val[58]=14; b_val[58]=1; r_val[58]=14;
|
||||
d_val[59]=3477; a_val[59]=57; b_val[59]=1; r_val[59]=228;
|
||||
d_val[60]= 899; a_val[60]=29; b_val[60]=1; r_val[60]=58;
|
||||
d_val[61]= 413; a_val[61]=21; b_val[61]=1; r_val[61]=28;
|
||||
/* v1=62 INVALID */
|
||||
d_val[63]=3965; a_val[63]=61; b_val[63]=1; r_val[63]=244;
|
||||
d_val[64]=1023; a_val[64]=31; b_val[64]=1; r_val[64]=62;
|
||||
d_val[65]= 469; a_val[65]=21; b_val[65]=1; r_val[65]=28;
|
||||
d_val[66]= 17; a_val[66]= 4; b_val[66]=1; r_val[66]=1;
|
||||
d_val[67]=4485; a_val[67]=65; b_val[67]=1; r_val[67]=260;
|
||||
d_val[68]=1155; a_val[68]=33; b_val[68]=1; r_val[68]=66;
|
||||
d_val[69]=4757; a_val[69]=67; b_val[69]=1; r_val[69]=268;
|
||||
d_val[70]= 34; a_val[70]= 6; b_val[70]=1; r_val[70]=2;
|
||||
d_val[71]=5037; a_val[71]=69; b_val[71]=1; r_val[71]=276;
|
||||
d_val[72]=1295; a_val[72]=35; b_val[72]=1; r_val[72]=70;
|
||||
d_val[73]= 213; a_val[73]=15; b_val[73]=1; r_val[73]=12;
|
||||
d_val[74]= 38; a_val[74]= 6; b_val[74]=1; r_val[74]=2;
|
||||
d_val[75]=5621; a_val[75]=73; b_val[75]=1; r_val[75]=292;
|
||||
d_val[76]=1443; a_val[76]=37; b_val[76]=1; r_val[76]=74;
|
||||
d_val[77]= 237; a_val[77]=15; b_val[77]=1; r_val[77]=12;
|
||||
d_val[78]= 95; a_val[78]=10; b_val[78]=1; r_val[78]=5;
|
||||
/* v1=79 INVALID */
|
||||
d_val[80]=1599; a_val[80]=39; b_val[80]=1; r_val[80]=78;
|
||||
d_val[81]=6557; a_val[81]=79; b_val[81]=1; r_val[81]=316;
|
||||
d_val[82]= 105; a_val[82]=10; b_val[82]=1; r_val[82]=5;
|
||||
d_val[83]= 85; a_val[83]= 9; b_val[83]=1; r_val[83]=4;
|
||||
d_val[84]=1763; a_val[84]=41; b_val[84]=1; r_val[84]=82;
|
||||
d_val[85]=7221; a_val[85]=83; b_val[85]=1; r_val[85]=332;
|
||||
d_val[86]= 462; a_val[86]=21; b_val[86]=1; r_val[86]=21;
|
||||
d_val[87]=7565; a_val[87]=85; b_val[87]=1; r_val[87]=340;
|
||||
d_val[88]= 215; a_val[88]=15; b_val[88]=1; r_val[88]=10;
|
||||
d_val[89]=7917; a_val[89]=87; b_val[89]=1; r_val[89]=348;
|
||||
d_val[90]= 506; a_val[90]=22; b_val[90]=1; r_val[90]=22;
|
||||
d_val[91]=8277; a_val[91]=89; b_val[91]=1; r_val[91]=356;
|
||||
d_val[92]= 235; a_val[92]=15; b_val[92]=1; r_val[92]=10;
|
||||
d_val[93]=8645; a_val[93]=91; b_val[93]=1; r_val[93]=364;
|
||||
d_val[94]= 138; a_val[94]=12; b_val[94]=1; r_val[94]=6;
|
||||
d_val[95]=9021; a_val[95]=93; b_val[95]=1; r_val[95]=372;
|
||||
d_val[96]= 47; a_val[96]= 7; b_val[96]=1; r_val[96]=2;
|
||||
d_val[97]=1045; a_val[97]=33; b_val[97]=1; r_val[97]=44;
|
||||
/* v1=98 INVALID */
|
||||
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("resource_debug") & 3) {
|
||||
print "d_val[100] defined";
|
||||
print "a_val[100] defined";
|
||||
print "b_val[100] defined";
|
||||
print "r_val[100] defined";
|
||||
}
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: mersenne.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mersenne.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: mfactor.cal,v 29.3 2006/12/16 11:18:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mfactor.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: mod.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/mod.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: natnumset.cal,v 29.3 2006/05/01 19:19:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/natnumset.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: pell.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pell.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.5 $
|
||||
* @(#) $Id: pi.cal,v 29.5 2004/02/23 14:04:01 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pi.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: pix.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pix.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: pollard.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pollard.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: poly.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/poly.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: prompt.cal,v 29.3 2006/06/20 09:29:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/prompt.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: psqrt.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/psqrt.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -18,11 +18,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: qtime.cal,v 29.4 2000/12/18 10:18:40 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/qtime.cal,v $
|
||||
* @(#) $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
|
||||
|
11
cal/quat.cal
11
cal/quat.cal
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: quat.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/quat.cal,v $
|
||||
* @(#) $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
|
||||
@@ -55,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] : ")" :;
|
||||
}
|
||||
|
||||
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: randbitrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randbitrun.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: randmprime.cal,v 29.3 2006/12/16 11:18:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randmprime.cal,v $
|
||||
* @(#) $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 $
|
||||
*
|
||||
* Under source code control: 1994/03/14 23:11:21
|
||||
* File existed as early as: 1994
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: randombitrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randombitrun.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: randomrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randomrun.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: randrun.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randrun.cal,v $
|
||||
* @(#) $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
|
||||
|
551
cal/regress.cal
551
cal/regress.cal
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* regress - calc regression and correctness test suite
|
||||
*
|
||||
* Copyright (C) 1999-2006 David I. Bell and Landon Curt Noll
|
||||
* Copyright (C) 1999-2017 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
|
||||
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.36 $
|
||||
* @(#) $Id: regress.cal,v 29.36 2006/12/16 11:18:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/regress.cal,v $
|
||||
* @(#) $Revision: 30.14 $
|
||||
* @(#) $Id: regress.cal,v 30.14 2017/05/19 16:09:14 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc-RHEL7/cal/RCS/regress.cal,v $
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:36
|
||||
* File existed as early as: before 1990
|
||||
@@ -403,14 +403,14 @@ define test_config()
|
||||
'512: config("trace") == 0');
|
||||
vrfy(config("maxprint") == 16,
|
||||
'513: config("maxprint") == 16');
|
||||
vrfy(config("mul2") == 1780,
|
||||
'514: config("mul2") == 1780');
|
||||
vrfy(config("sq2") == 3388,
|
||||
'515: config("sq2") == 3388');
|
||||
vrfy(config("pow2") == 176,
|
||||
'516: config("pow2") == 176');
|
||||
vrfy(config("redc2") == 220,
|
||||
'517: config("redc2") == 220');
|
||||
vrfy(config("mul2") == 28,
|
||||
'514: config("mul2") == 28');
|
||||
vrfy(config("sq2") == 28,
|
||||
'515: config("sq2") == 28');
|
||||
vrfy(config("pow2") == 20,
|
||||
'516: config("pow2") == 20');
|
||||
vrfy(config("redc2") == 25,
|
||||
'517: config("redc2") == 25');
|
||||
vrfy(config("tilde"),
|
||||
'518: config("tilde")');
|
||||
vrfy(config("tab"),
|
||||
@@ -596,12 +596,18 @@ print '012: parsed squarecheck(a, b, str)';
|
||||
define powercheck(a, p1, p2, str)
|
||||
{
|
||||
local a1, a2, a3;
|
||||
local b1, b2, b3;
|
||||
|
||||
a1 = (a^p1)^p2;
|
||||
a2 = (a^p2)^p1;
|
||||
a3 = a^(p1*p2);
|
||||
b1 = (a**p1)**p2;
|
||||
b2 = (a**p2)**p1;
|
||||
b3 = a**(p1*p2);
|
||||
if (a1 != a2) {print '**** (a^p1)^p2 != (a^p2)^p1:', str; ++prob;}
|
||||
if (a1 != a3) {print '**** (a^p1)^p2 != a^(p1*p2):', str; ++prob;}
|
||||
if (b1 != b2) {print '**** (b^p1)^p2 != (b^p2)^p1:', str; ++prob;}
|
||||
if (b1 != b3) {print '**** (b^p1)^p2 != b^(p1*p2):', str; ++prob;}
|
||||
print str;
|
||||
}
|
||||
print '013: parsed powercheck(a, p1, p2, str)';
|
||||
@@ -762,6 +768,8 @@ print '016: parsed test_bignums()';
|
||||
|
||||
/*
|
||||
* Test many of the built-in functions.
|
||||
*
|
||||
* See test_functionss() starting at test 9000 for more built-in function tests.
|
||||
*/
|
||||
define test_functions()
|
||||
{
|
||||
@@ -1391,7 +1399,8 @@ define test_functions()
|
||||
vrfy(quomod(10,-3,a,b,12) == 1, '1193: vrfy(quomod(10,-3,a,b,12) == 1');
|
||||
vrfy(a == -3, '1194: a == -3');
|
||||
vrfy(b == 1, '1195: b == 1');
|
||||
vrfy(quomod(-10,-3,a,b,13) == 1,'1196: vrfy(quomod(-10,-3,a,b,13) == 1');
|
||||
vrfy(quomod(-10,-3,a,b,13) == 1,
|
||||
'1196: vrfy(quomod(-10,-3,a,b,13) == 1');
|
||||
vrfy(a == 4, '1197: a == 4');
|
||||
vrfy(b == 2, '1198: b == 2');
|
||||
vrfy(quomod(10,3,a,b,14) == 1, '1199: vrfy(quomod(10,3,a,b,14) == 1');
|
||||
@@ -1406,7 +1415,44 @@ define test_functions()
|
||||
vrfy(isnum(systime()), '1206: isnum(systime())');
|
||||
vrfy(isnum(usertime()), '1207: isnum(usertime())');
|
||||
|
||||
print '1208: Ending test_functions';
|
||||
/* more jacobi tests */
|
||||
vrfy(jacobi(987897,987) == 0, '1208: jacobi(987897,987) == 0');
|
||||
vrfy(jacobi(897,987) == 0, '1209: jacobi(897,987) == 0');
|
||||
vrfy(jacobi(987,897) == 0, '1210: jacobi(987,897) == 0');
|
||||
vrfy(jacobi(90,897) == 0, '1211: jacobi(90,897) == 0');
|
||||
vrfy(jacobi(45,897) == 0, '1212: jacobi(45,897) == 0');
|
||||
vrfy(jacobi(897,45) == 0, '1213: jacobi(897,45) == 0');
|
||||
vrfy(jacobi(42,45) == 0, '1214: jacobi(42,45) == 0');
|
||||
vrfy(jacobi(21,45) == 0, '1215: jacobi(21,45) == 0');
|
||||
vrfy(jacobi(45,21) == 0, '1216: jacobi(45,21) == 0');
|
||||
vrfy(jacobi(3,21) == 0, '1217: jacobi(3,21) == 0');
|
||||
vrfy(jacobi(0,21) == 0, '1218: jacobi(0,21) == 0');
|
||||
vrfy(jacobi(0,20003) == 0, '1219: jacobi(0,20003) == 0');
|
||||
vrfy(jacobi(1,20003) == 1, '1220: jacobi(1,20003) == 1');
|
||||
vrfy(jacobi(1236,20003) == 1, '1221: jacobi(1236,20003) == 1');
|
||||
vrfy(jacobi(618,20003) == -1, '1222: jacobi(618,20003) == -1');
|
||||
vrfy(jacobi(309,20003) == 1, '1223: jacobi(309,20003) == 1');
|
||||
vrfy(jacobi(227,309) == 1, '1224: jacobi(227,309) == 1');
|
||||
vrfy(jacobi(82,227) == 1, '1225: jacobi(82,227) == 1');
|
||||
vrfy(jacobi(41,227) == -1, '1226: jacobi(41,227) == -1');
|
||||
vrfy(jacobi(22,41) == -1, '1227: jacobi(22,41) == -1');
|
||||
vrfy(jacobi(11,41) == -1, '1228: jacobi(11,41) == -1');
|
||||
vrfy(jacobi(8,11) == -1, '1229: jacobi(8,11) == -1');
|
||||
vrfy(jacobi(4,11) == 1, '1230: jacobi(4,11) == 1');
|
||||
vrfy(jacobi(2,11) == -1, '1231: jacobi(2,11) == -1');
|
||||
vrfy(jacobi(1,11) == 1, '1232: jacobi(1,11) == 1');
|
||||
vrfy(jacobi(0,11) == 0, '1233: jacobi(0,11) == 0');
|
||||
vrfy(jacobi(0,0) == 0, '1234: jacobi(0,0) == 0');
|
||||
vrfy(jacobi(-1,0) == 0, '1235: jacobi(-1,0) == 0');
|
||||
vrfy(jacobi(-1,-1) == 0, '1236: jacobi(-1,-1) == 0');
|
||||
vrfy(jacobi(0,-1) == 0, '1237: jacobi(0,-1) == 0');
|
||||
|
||||
/*
|
||||
* NOTE: Function tests are continued in test_functionss()
|
||||
* starting at test 9000.
|
||||
*/
|
||||
|
||||
print '1293: Ending test_functions';
|
||||
}
|
||||
print '017: parsed test_functions()';
|
||||
|
||||
@@ -1423,14 +1469,14 @@ define _test_underscore()
|
||||
local _a = 27;
|
||||
local __a = 23209;
|
||||
|
||||
print "1290: Beginning _test_underscore";
|
||||
print "1294: Beginning _test_underscore";
|
||||
|
||||
vrfy(_a == 27, '1291: _a == 27');
|
||||
vrfy(_ == 49, '1292: _ == 49');
|
||||
vrfy(__ == 63, '1293: __ == 63');
|
||||
vrfy(__a == 23209, '1294: __a == 23209');
|
||||
vrfy(_a == 27, '1295: _a == 27');
|
||||
vrfy(_ == 49, '1296: _ == 49');
|
||||
vrfy(__ == 63, '1297: __ == 63');
|
||||
vrfy(__a == 23209, '1298: __a == 23209');
|
||||
|
||||
print "1295: Ending _test_underscore";
|
||||
print "1299: Ending _test_underscore";
|
||||
}
|
||||
print '020: parsed _test_underscore';
|
||||
|
||||
@@ -1471,8 +1517,10 @@ define test_assoc()
|
||||
vrfy(isnull(search(a,16)), '1312: isnull(search(a,16))');
|
||||
a["curds","whey"] = "spider";
|
||||
print '1313: a["curds","whey"] = "spider"';
|
||||
vrfy(a["curds","whey"] == "spider", '1314: a["curds","whey"] == "spider"');
|
||||
vrfy(a[[rsearch(a,"spider")]] == "spider", '1315: a[[rsearch(a,"spider")]] == "spider"');
|
||||
vrfy(a["curds","whey"] == "spider",
|
||||
'1314: a["curds","whey"] == "spider"');
|
||||
vrfy(a[[rsearch(a,"spider")]] == "spider",
|
||||
'1315: a[[rsearch(a,"spider")]] == "spider"');
|
||||
b = a;
|
||||
print '1316: b = a';
|
||||
vrfy(b[17] == 19, '1317: b[17] == 19');
|
||||
@@ -2700,11 +2748,24 @@ define test_2600()
|
||||
vrfy(log(1e127) == 127,
|
||||
strcat(str(tnum++), ': log(1e127)) == 127'));
|
||||
vrfy(round(log(17^47),10) == 57.8310993048,
|
||||
strcat(str(tnum++),
|
||||
': round(log(17^47),10) == 57.8310993048'));
|
||||
strcat(str(tnum++),
|
||||
': round(log(17^47),10) == 57.8310993048'));
|
||||
vrfy(round(log(127),10) == 2.103803721,
|
||||
strcat(str(tnum++),
|
||||
': round(log(127),10) == 2.103803721'));
|
||||
strcat(str(tnum++),
|
||||
': round(log(127),10) == 2.103803721'));
|
||||
vrfy(round(log(0.25,0.00001),5) == -0.60206,
|
||||
strcat(str(tnum++),
|
||||
': round(log(0.25,0.00001),5) == -0.60206'));
|
||||
vrfy(round(log(0.25,1e-10),10) == -0.6020599913,
|
||||
strcat(str(tnum++),
|
||||
': round(log(0.25,1e-10),10) == -0.6020599913'));
|
||||
vrfy(round( log(1.2+1.2i,1e-5),5) == 0.2297+0.34109i,
|
||||
strcat(str(tnum++),
|
||||
': round(log(1.2+1.2i,1e-5),5) == 0.2297+0.34109i'));
|
||||
vrfy(round( log(1.2+1.2i,1e-10),10) == 0.2296962439+0.3410940885i,
|
||||
strcat(str(tnum++),
|
||||
': round(log(1.2+1.2i,1e-10),10) == ',
|
||||
'0.2296962439+0.3410940885i'));
|
||||
epsilon(i),;
|
||||
print tnum++: ': epsilon(i),;';
|
||||
|
||||
@@ -3259,7 +3320,7 @@ define test_error()
|
||||
'3654: scale(3,2^31) == error(10034)');
|
||||
vrfy("x" ^ 3 == error(10035), '3655: "x" ^ 3 == error(10035)');
|
||||
vrfy(2 ^ "x" == error(10036), '3656: 2 ^ "x" == error(10036)');
|
||||
vrfy(2 ^ 2.5 == error(10036), '3657: 2 ^ 2.5 == error(10036)');
|
||||
vrfy(2 ^ "2" == error(10036), '3657: 2 ^ "2" == error(10036)');
|
||||
vrfy(power("x",2.1) == error(10037),
|
||||
'3658: power("x",2.1) == error(10037)');
|
||||
vrfy(power(2,"x") == error(10038),
|
||||
@@ -4841,7 +4902,8 @@ define test_newsyn()
|
||||
vrfy(s5500 == 55, '5510: s5500 == 45');
|
||||
vrfy(i == 11, '5511: i == 11');
|
||||
}
|
||||
print "5512: { local i; for (s5500 = 0, i = 0; i < 10; i++) s5500 += i; ... }";
|
||||
print "5512: { local i; for (s5500 = 0, i = 0; i < 10; i++) ":
|
||||
"s5500 += i; ... }";
|
||||
vrfy(s5500 == 55, '5513: s5500 == 55');
|
||||
vrfy(i == 11, '5514: i == 11');
|
||||
|
||||
@@ -4976,7 +5038,7 @@ vrfy(i == 9, '151: i == 9');
|
||||
|
||||
|
||||
/*
|
||||
* test_commaeq - test changes to , and =
|
||||
* test_commaeq - test changes to = and ,
|
||||
*/
|
||||
obj xx5600 {} xx5600;
|
||||
print '152: obj xx5600 {} xx5600';
|
||||
@@ -5320,7 +5382,7 @@ define test_is()
|
||||
local nerr; /* new error value */
|
||||
local odd; /* odd integer */
|
||||
local even; /* even integer that is 10 times odd */
|
||||
local hash; /* sha hash value */
|
||||
local hash; /* sha1 hash value */
|
||||
local id; /* identity matrix */
|
||||
local list; /* list value */
|
||||
local matrix; /* non-identity matrix */
|
||||
@@ -5375,8 +5437,8 @@ define test_is()
|
||||
print '5911: odd = 23209';
|
||||
even = odd*10;
|
||||
print '5912: even = odd*10';
|
||||
hash = sha();
|
||||
print '5913: hash = sha()';
|
||||
hash = sha1();
|
||||
print '5913: hash = sha1()';
|
||||
mat id[3,3] = {1,0,0,0,1,0,0,0,1};
|
||||
print '5914: id[3,3] = {1,0,0,0,1,0,0,0,1}';
|
||||
list = list(2,3,4);
|
||||
@@ -5699,7 +5761,7 @@ define test_is()
|
||||
vrfy(ishash(nerr) == 0, '6178: ishash(nerr) == 0');
|
||||
vrfy(ishash(odd) == 0, '6179: ishash(odd) == 0');
|
||||
vrfy(ishash(even) == 0, '6180: ishash(even) == 0');
|
||||
vrfy(ishash(hash) == 1, '6181: ishash(hash) == 1');
|
||||
vrfy(ishash(hash) == 2, '6181: ishash(hash) == 2');
|
||||
vrfy(ishash(id) == 0, '6182: ishash(id) == 0');
|
||||
vrfy(ishash(list) == 0, '6183: ishash(list) == 0');
|
||||
vrfy(ishash(matrix) == 0, '6184: ishash(matrix) == 0');
|
||||
@@ -6455,7 +6517,8 @@ define test_blk()
|
||||
/* A second named block */
|
||||
|
||||
B1 = blk("+++6700", 15, 10) = {1,2,3,4,5};
|
||||
print '6746: B1 = blk("+++6700", 15 , 10) = {1,2,3,4,5};';
|
||||
print
|
||||
'6746: B1 = blk("+++6700", 15 , 10) = {1,2,3,4,5};';
|
||||
vrfy(size(B1) == 15, '6747: size(B1) == 15');
|
||||
vrfy(sizeof(B1) == 20, '6748: sizeof(B1) == 20');
|
||||
vrfy(test(B1) == 1, '6749: test(B1) == 1');
|
||||
@@ -6792,108 +6855,6 @@ define test_blkprintf()
|
||||
print '172: parsed test_blkprintf()';
|
||||
|
||||
|
||||
/*
|
||||
* test_sha - test the sha hash
|
||||
*/
|
||||
define test_sha()
|
||||
{
|
||||
local a, b, c, d, e, f, x, y, z, L, M, B1, B2, B;
|
||||
|
||||
print '7100: Beginning test_sha';
|
||||
y = sha();
|
||||
print '7101: y = sha();';
|
||||
z = sha();
|
||||
print '7102: z = sha();';
|
||||
vrfy(y == z, '7103: y == z');
|
||||
vrfy(sha("") == y, '7104: sha("") == y');
|
||||
y = sha(y,1);
|
||||
print '7105: y = sha(y,1);';
|
||||
vrfy(y == sha(1), '7106: y == sha(1)');
|
||||
vrfy(sha(y,2) == sha(1,2), '7107: sha(y,2) == sha(1,2)');
|
||||
|
||||
vrfy(sha(sha()) == 0xf96cea198ad1dd5617ac084a3d92c6107708c0ef,
|
||||
'7108: sha(sha()) == 0xf96cea198ad1dd5617ac084a3d92c6107708c0ef');
|
||||
|
||||
vrfy(sha(sha("a"))==0x37f297772fae4cb1ba39b6cf9cf0381180bd62f2,
|
||||
'7109: sha(sha("a"))==0x37f297772fae4cb1ba39b6cf9cf0381180bd62f2');
|
||||
|
||||
vrfy(sha(sha("ab"))==0x488373d362684af3d3f7a6a408b59dfe85419e09,
|
||||
'7110: sha(sha("ab"))==0x488373d362684af3d3f7a6a408b59dfe85419e09');
|
||||
vrfy(sha(sha("abc"))==0x0164b8a914cd2a5e74c4f7ff082c4d97f1edf880,
|
||||
'7111: sha(sha("abc"))==0x0164b8a914cd2a5e74c4f7ff082c4d97f1edf880');
|
||||
vrfy(sha(sha("abcd"))==0x082c73b06f71185d840fb4b28eb3abade67714bc,
|
||||
'7112: sha(sha("abcd"))==0x082c73b06f71185d840fb4b28eb3abade67714bc');
|
||||
vrfy(sha(sha("abcde"))==0xd624e34951bb800f0acae773001df8cffe781ba8,
|
||||
'7113: sha(sha("abcde"))==0xd624e34951bb800f0acae773001df8cffe781ba8');
|
||||
vrfy(sha(sha("abcdef"))==0x2a589f7750598dc0ea0a608719e04327f609279a,
|
||||
'7114: sha(sha("abcdef"))==0x2a589f7750598dc0ea0a608719e04327f609279a');
|
||||
vrfy(sha(sha("abcdefg"))==0x5bdf01f9298e9d19d3f8d15520fd74eed600b497,
|
||||
'7115: sha(sha("abcdefg"))==0x5bdf01f9298e9d19d3f8d15520fd74eed600b497');
|
||||
vrfy(sha(sha("abcdefgh"))==0x734ba8b31975d0dbae4d6e249f4e8da270796c94,
|
||||
'7116: sha(sha("abcdefgh"))==0x734ba8b31975d0dbae4d6e249f4e8da270796c94');
|
||||
|
||||
vrfy(sha(sha(1)) == 0x864c8d09e828c7c31d62693736a5a9302c282777,
|
||||
'7117: sha(sha(1)) == 0x864c8d09e828c7c31d62693736a5a9302c282777');
|
||||
|
||||
vrfy(sha(sha(2)) == 0x2c0b59c512cb20fad6bb0883b69c9f5a46545808,
|
||||
'7118: sha(sha(2)) == 0x2c0b59c512cb20fad6bb0883b69c9f5a46545808');
|
||||
|
||||
vrfy(sha(sha(22/7))==0x7ddb7f8a7e9d70757f157744fddea7a6c6a6bcc6,
|
||||
'7119: sha(sha(22/7)==0x7ddb7f8a7e9d70757f157744fddea7a6c6a6bcc6');
|
||||
vrfy(sha(sha(isqrt(2e1000))) ==
|
||||
0x6db8d9cf0b018b8f9cbbf5aa1edb8066d19e1bb0,
|
||||
'7120: sha(sha(isqrt(2e1000)==0x6db8d9cf0b018b8f9cbbf5aa1edb8066d19e1bb0');
|
||||
vrfy(sha("x", "y", "z") == sha("xyz"),
|
||||
'7121: sha("x", "y", "z") == sha("xyz")');
|
||||
|
||||
vrfy(sha(sha("this is", 7^19-8, "a composit", 3i+4.5, "hash")) ==
|
||||
0x21e42319a26787046c2b28b7ae70f1b54bf0ba2a,
|
||||
'7122: sha(sha("this is", 7^19-8, ..., "hash")) == 0x21e4...');
|
||||
|
||||
z = sha(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));
|
||||
print '7123: z = sha(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));';
|
||||
vrfy(sha(z) == 257075527903934749824451356785709876382198951165,
|
||||
'7124: sha(z) == 257075527903934749824451356785709876382198951165');
|
||||
|
||||
y = sha();
|
||||
print '7125: y = sha()';
|
||||
y = sha(y, list(1,2,3), "curds and whey");
|
||||
print '7126: y = sha(y, list(1,2,3), "curds and whey")';
|
||||
y = sha(y, 2^21701-1);
|
||||
print '7127: y = sha(y, 2^21701-1)';
|
||||
y = sha(y, pi(1e-100));
|
||||
print '7128: y = sha(y, pi(1e-100))';
|
||||
vrfy(y == z, '7129: y == z');
|
||||
|
||||
B = blk() = {"a", "b", "c"};
|
||||
print '7130: B = blk() = {"a", "b", "c"};';
|
||||
vrfy(sha(B) == sha("abc"), '7131: sha(B) == sha("abc")');
|
||||
|
||||
B1 = blk() = {1,2,3,4};
|
||||
print '7132: B1 = blk() = {1,2,3,4};';
|
||||
B2 = blk() = {5,6,7,8};
|
||||
print '7133: B2 = blk() = {5,6,7,8};';
|
||||
B = blk() = {1,2,3,4,5,6,7,8};
|
||||
print '7134: B = blk() = {1,2,3,4,5,6,7,8};';
|
||||
|
||||
vrfy(sha(B1, B2) == sha(B), '7135: sha(B1, B2) == sha(B)');
|
||||
vrfy(sha(B[1], B[3], B[5]) == sha("\02\04\06"),
|
||||
'7136: sha(B[1], B[3], B[5]) == sha("\02\04\06")');
|
||||
|
||||
L = list(1,2,3);
|
||||
print '7137: L = list(1,2,3)';
|
||||
mat M[3] = {4,5,6};
|
||||
print '7138: mat M[3] = {4,5,6}';
|
||||
vrfy(sha(sha(L), M, B) == sha(L, M, B),
|
||||
'7139: sha(sha(L), M, B) == sha(L, M, B)');
|
||||
vrfy(sha(sha(L,M), B) == sha(L, M, B),
|
||||
'7140: sha(sha(L, M), B) == sha(L, M, B)');
|
||||
|
||||
print '7141: Ending test_sha';
|
||||
}
|
||||
print '173: parsed test_sha()';
|
||||
|
||||
|
||||
/*
|
||||
* test_sha1 - test the sha1 hash
|
||||
*/
|
||||
@@ -6922,7 +6883,8 @@ define test_sha1()
|
||||
|
||||
|
||||
z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));
|
||||
print '7210: z = sha1(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));';
|
||||
print '7210: z = sha1(list(1,2,3), "curds and whey",',
|
||||
'2^21701-1, pi(1e-100));';
|
||||
vrfy(sha1(z) == 0x158cc87deeb9dd478ca14e3ab359205b0fb15b83,
|
||||
'7211: sha1(z) == 0x158cc87deeb9dd478ca14e3ab359205b0fb15b83');
|
||||
|
||||
@@ -6979,88 +6941,6 @@ define test_sha1()
|
||||
print '174: parsed test_sha1()';
|
||||
|
||||
|
||||
/*
|
||||
* test_md5 - test the md5 hash
|
||||
*/
|
||||
define test_md5()
|
||||
{
|
||||
local a, b, c, d, e, f, x, y, z, L, M, B;
|
||||
|
||||
print '7300: Beginning test_md5';
|
||||
y = md5();
|
||||
print '7301: y = md5();';
|
||||
z = md5();
|
||||
print '7302: z = md5();';
|
||||
vrfy(y == z, '7303: y == z');
|
||||
y = md5(y,1);
|
||||
print '7304: y = md5(y,1);';
|
||||
z = md5(1);
|
||||
print '7305: z = md5(1);';
|
||||
vrfy(y == z, '7306: y == z');
|
||||
vrfy(md5(z,2) == md5(1,2), '7307: md5(z,2) == md5(1,2)');
|
||||
|
||||
vrfy(md5(md5()) == 0xd41d8cd98f00b204e9800998ecf8427e,
|
||||
'7308: md5(md5()) == 0xd41d8cd98f00b204e9800998ecf8427e');
|
||||
vrfy(md5("x", "y", "z") == md5("xyz"),
|
||||
'7309: md5("x", "y", "z") == md5("xyz")');
|
||||
|
||||
vrfy(md5(md5("this is", 7^19-8, "a composit", 3i+4.5, "hash")) ==
|
||||
0x39a5a8e24a2eb65a51af462c8bdd5e3,
|
||||
'7310: md5(md5("this is", 7^19-8, "a composit", 3i+4.5, "hash")) == ...');
|
||||
|
||||
|
||||
z = md5(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));
|
||||
print '7311: z = md5(list(1,2,3), "curds and whey", 2^21701-1, pi(1e-100));';
|
||||
vrfy(md5(z) == 0x487462e577eabef0302dd13af6632546,
|
||||
'7312: md5(z) == 0x487462e577eabef0302dd13af6632546');
|
||||
y = md5();
|
||||
print '7313: y = md5();';
|
||||
y = md5(y, list(1,2,3), "curds and whey");
|
||||
print '7314: y = md5(y, list(1,2,3), "curds and whey")';
|
||||
y = md5(y, 2^21701-1);
|
||||
print '7315: y = md5(y, 2^21701-1);';
|
||||
y = md5(y, pi(1e-100));
|
||||
print '7316: y = md5(y, pi(1e-100));';
|
||||
vrfy(y == z, '7317: y == z');
|
||||
|
||||
vrfy(md5(md5("a")) == 0x0cc175b9c0f1b6a831c399e269772661,
|
||||
'7318: md5(md5("a")) == 0x0cc175b9c0f1b6a831c399e269772661');
|
||||
vrfy(md5(md5("ab")) == 0x187ef4436122d1cc2f40dc2b92f0eba0,
|
||||
'7319: md5(md5("ab")) == 0x187ef4436122d1cc2f40dc2b92f0eba0');
|
||||
vrfy(md5(md5("abc")) == 0x900150983cd24fb0d6963f7d28e17f72,
|
||||
'7320: md5(md5("abc")) == 0x900150983cd24fb0d6963f7d28e17f72');
|
||||
vrfy(md5(md5("abcd")) == 0xe2fc714c4727ee9395f324cd2e7f331f,
|
||||
'7321: md5(md5("abcd")) == 0xe2fc714c4727ee9395f324cd2e7f331f');
|
||||
vrfy(md5(md5("abcde")) == 0xab56b4d92b40713acc5af89985d4b786,
|
||||
'7322: md5(md5("abcde")) == 0xab56b4d92b40713acc5af89985d4b786');
|
||||
vrfy(md5(md5("abcdef")) == 0xe80b5017098950fc58aad83c8c14978e,
|
||||
'7323: md5(md5("abcdef")) == 0xe80b5017098950fc58aad83c8c14978e');
|
||||
vrfy(md5(md5("abcdefg")) == 0x7ac66c0f148de9519b8bd264312c4d64,
|
||||
'7324: md5(md5("abcdefg")) == 0x7ac66c0f148de9519b8bd264312c4d64');
|
||||
vrfy(md5(md5("abcdefgh")) == 0xe8dc4081b13434b45189a720b77b6818,
|
||||
'7325: md5(md5("abcdefgh")) == 0xe8dc4081b13434b45189a720b77b6818');
|
||||
vrfy(md5(md5(1)) == 0x44fe7987067ac45311c88772038f60d1,
|
||||
'7326: md5(md5(1)) == 0x44fe7987067ac45311c88772038f60d1');
|
||||
vrfy(md5(md5(22/7)) == 0x9274b951e1dfb9cba22af1c127daa8e7,
|
||||
'7327: md5(md5(22/7) == 0x9274b951e1dfb9cba22af1c127daa8e7');
|
||||
vrfy(md5(md5(isqrt(2e1000))) == 0xe56ac4b8cad869e738a04fedc97058f3,
|
||||
'7328: md5(md5(isqrt(2e1000))) == 0xe56ac4b8cad869e738a04fedc97058f3');
|
||||
L = list(1,2,3);
|
||||
print '7329: L = list(1,2,3)';
|
||||
mat M[3] = {4,5,6};
|
||||
print '7330: mat M[3] = {4,5,6}';
|
||||
B = blk() = {7,8,9};
|
||||
print '7331: B = blk() = {7,8,9}';
|
||||
vrfy(md5(md5(L), M, B) == md5(L, M, B),
|
||||
'7332: md5(md5(L), M, B) == md5(L, M, B)');
|
||||
vrfy(md5(md5(L,M), B) == md5(L, M, B),
|
||||
'7333: md5(md5(L, M), B) == md5(L, M, B)');
|
||||
|
||||
print '7334: Ending test_md5';
|
||||
}
|
||||
print '175: parsed test_md5()';
|
||||
|
||||
|
||||
/*
|
||||
* The 7400's contain tests for saveval and dot. These tests are
|
||||
* done inline near the bottom.
|
||||
@@ -7593,6 +7473,85 @@ define test_somenew()
|
||||
print '190: parsed test_somenew()';
|
||||
|
||||
|
||||
/*
|
||||
* test_exponentiation - test new exponentiation functionaltiy
|
||||
*/
|
||||
define test_exponentiation()
|
||||
{
|
||||
local a;
|
||||
|
||||
print '8800: Starting test_somenew';
|
||||
|
||||
/* unexpected help file cases */
|
||||
vrfy(2^3 == 8, '8801: 2^3 == 8');
|
||||
vrfy(2.5 ^ 3.5 == power(2.5, 3.5),
|
||||
'8802: 2.5 ^ 3.5 == power(2.5, 3.5)');
|
||||
vrfy(2.5 ^ 2.718i == power(2.5, 2.718i),
|
||||
'8803: 2.5 ^ 2.718i == power(2.5, 2.718i)');
|
||||
vrfy(3i^4 == 81, '8804: 3i^4 == 81');
|
||||
vrfy(0.5i ^ 0.25 == power(0.5i, 0.25),
|
||||
'8804: 0.5i ^ 0.25 == power(0.5i, 0.25)');
|
||||
vrfy(3.13145i^0.30103i == power(3.13145i, 0.30103i),
|
||||
'8806: 3.13145i^0.30103i == power(3.13145i, 0.30103i)');
|
||||
|
||||
/* deal with some corner error cases */
|
||||
ecnt += 12;
|
||||
print '8807: ecnt += 2';
|
||||
vrfy((1/0) ^ -1 == 0, '8808: (1/0) ^ -1 == 0');
|
||||
vrfy((1/0) ^ -2 == 0, '8809: (1/0) ^ -2 == 0');
|
||||
vrfy((1/0) ^ 0 == error(10001), '8810: (1/0) ^ 0 == error(10001)');
|
||||
vrfy((1/0) ^ 3 == error(10001), '8811: (1/0) ^ 3 == error(10001)');
|
||||
vrfy(0 ^ -2 == error(10001), '8812: 0 ^ -2 == error(10001)');
|
||||
vrfy((1/0) ^ 1i == error(10001),'8813: (1/0) ^ 1i == error(10001)');
|
||||
vrfy((1/0) ^ 0i == error(10001),'8814: (1/0) ^ 0i == error(10001)');
|
||||
|
||||
/* real ^ real */
|
||||
vrfy(5^6 == 15625, '8815: 5^6 == 15625');
|
||||
vrfy(10^31 == 1e31, '8816: 10^31 == 1e31');
|
||||
vrfy(10 ^ (127/31) == power(10, 127/31),
|
||||
'8817: 10 ^ (127/31) == power(10, 127/31)');
|
||||
vrfy((10^31) ^ 10 == 1e310, '8818: (10^31) ^ 10 == 1e310');
|
||||
|
||||
/* complex ^ real */
|
||||
vrfy(10i ^ 10 == -1e10, '8819: 10i ^ 10 == -1e10');
|
||||
vrfy((-10i) ^ 10 == -1e10, '8820: (-10i) ^ 10 == -1e10');
|
||||
vrfy((1+1i) ^ 4 == -4, '8821: (1+1i) ^ 4 == -4');
|
||||
vrfy((1+1i) ^ 65536 == 2^32768, '8822: (1+1i) ^ 65536 == 2^32768');
|
||||
vrfy((1+1i) ^ (2^20) == 2^(2^19),
|
||||
'8823: (1+1i) ^ (2^20) == 2^(2^19)');
|
||||
vrfy((31+17i) ^ pi() == power(31+17i, pi()),
|
||||
'8824: (31+17i) ^ pi() == power(31+17i, pi()');
|
||||
vrfy((5+7i) ^ exp(5) == power(5+7i, exp(5)),
|
||||
'8825: (5+7i) ^ exp(5) == power(5+7i, exp(5))');
|
||||
|
||||
/* real ^ complex */
|
||||
vrfy(10 ^ 1i == power(10, 1i), '8826: 10 ^ 1i == power(10, 1i)');
|
||||
vrfy(10 ^ (2+3i) == power(10, 2+3i),
|
||||
'8827: 10 ^ (2+3i) == power(10, 2+3i)');
|
||||
vrfy(pi() ^ (2+3i) == power(pi(), 2+3i),
|
||||
'8828: pi() ^ (2+3i) == power(pi(), 2+3i)');
|
||||
vrfy(exp(64) ^ (2+3i) == power(exp(64), 2+3i),
|
||||
'8828: exp(64) ^ (2+3i) == power(exp(64), 2+3i)');
|
||||
vrfy(pi() ^ (257+127i) == power(pi(), 257+127i),
|
||||
'8829: pi() ^ (257+127i) == power(pi(), 257+127i)');
|
||||
vrfy(pi() ^ asin(-2) == power(pi(), asin(-2)),
|
||||
'8830: pi() ^ asin(-2) == power(pi(), asin(-2)');
|
||||
|
||||
/* complex ^ complex */
|
||||
vrfy((3+4i) ^ (2+3i) == power(3+4i, 2+3i),
|
||||
'8831: (3+4i) ^ (2+3i) == power(3+4i, 2+3i)');
|
||||
vrfy(ln(-10) ^ (2+3i) == power(ln(-10), 2+3i),
|
||||
'8832: ln(-10) ^ (2+3i) == power(ln(-10), 2+3i)');
|
||||
vrfy((pi()*1i) ^ asin(-2) == power(pi()*1i, asin(-2)),
|
||||
'8833: (pi()*1i) ^ asin(-2) == power(pi()*1i, asin(-2))');
|
||||
vrfy((exp(1)+pi()*1i) ^ asin(-2) == power(exp(1)+pi()*1i, asin(-2)),
|
||||
'8834: (exp(1)+pi()*1i) ^ asin(-2) == power(exp(1)+pi()*1i, asin(-2))');
|
||||
|
||||
print '8835: Ending test_somenew';
|
||||
}
|
||||
print '191: parsed test_exponentiation()';
|
||||
|
||||
|
||||
/*
|
||||
* test_quit - test the QUIT functionality
|
||||
*/
|
||||
@@ -7820,12 +7779,8 @@ return test_name();
|
||||
print;
|
||||
return test_blkprintf();
|
||||
print;
|
||||
return test_sha();
|
||||
print;
|
||||
return test_sha1();
|
||||
print;
|
||||
return test_md5();
|
||||
print;
|
||||
|
||||
print '7400: Beginning test_savedot';
|
||||
print '7401: saveval(1);';
|
||||
@@ -7964,6 +7919,145 @@ vrfy(dotest("set8700.line", 8703) == 0,
|
||||
/* 87xx: Ending dotest runs is printed by set8700.test */
|
||||
|
||||
|
||||
/*
|
||||
* new exponentiation functionaltiy
|
||||
*/
|
||||
print;
|
||||
return test_exponentiation();
|
||||
/* 88xx: test exponentiation */
|
||||
|
||||
|
||||
/*
|
||||
* calc resource functions by Christoph Zurnieden
|
||||
*/
|
||||
print;
|
||||
print '8900: Starting test of calc resource functions by Christoph Zurnieden';
|
||||
print '8901: read -once "test8900"';
|
||||
read -once "test8900";
|
||||
print '8902: about to run test8900(1,,8903)';
|
||||
testnum = test8900(1,,8903);
|
||||
print '8999: ecnt = 203;'
|
||||
ecnt = 203;
|
||||
/* 89xx: test calc resource functions by Christoph Zurnieden */
|
||||
|
||||
|
||||
/*
|
||||
* Test more of the built-in functions.
|
||||
*
|
||||
* See test_functions() (test 700 - 1238) for other built-in function tests.
|
||||
*/
|
||||
define test_functions2()
|
||||
{
|
||||
print '9001: Beginning test_functions2';
|
||||
|
||||
/* ctype function tests */
|
||||
vrfy(isalnum("A") == 1, '9002: isalnum("A") == 1');
|
||||
vrfy(isalnum("a") == 1, '9003: isalnum("a") == 1');
|
||||
vrfy(isalnum("2") == 1, '9004: isalnum("2") == 1');
|
||||
vrfy(isalnum("\t") == 0, '9005: isalnum("\\t") == 0');
|
||||
|
||||
vrfy(isalpha("A") == 1, '9006: isalpha("A") == 1');
|
||||
vrfy(isalpha("a") == 1, '9007: isalpha("a") == 1');
|
||||
vrfy(isalpha("2") == 0, '9008: isalpha("2") == 0');
|
||||
vrfy(isalpha("\t") == 0, '9009: isalpha("\\t") == 0');
|
||||
|
||||
vrfy(iscntrl("A") == 0, '9010: iscntrl("A") == 0');
|
||||
vrfy(iscntrl("a") == 0, '9011: iscntrl("a") == 0');
|
||||
vrfy(iscntrl("2") == 0, '9012: iscntrl("2") == 0');
|
||||
vrfy(iscntrl("\t") == 1, '9013: iscntrl("\\t") == 1');
|
||||
|
||||
vrfy(isdigit("A") == 0, '9014: isdigit("A") == 0');
|
||||
vrfy(isdigit("a") == 0, '9015: isdigit("a") == 0');
|
||||
vrfy(isdigit("2") == 1, '9016: isdigit("2") == 1');
|
||||
vrfy(isdigit("\t") == 0, '9017: isdigit("\\t") == 0');
|
||||
|
||||
vrfy(isgraph("A") == 1, '9018: isgraph("A") == 1');
|
||||
vrfy(isgraph("a") == 1, '9019: isgraph("a") == 1');
|
||||
vrfy(isgraph("2") == 1, '9020: isgraph("2") == 1');
|
||||
vrfy(isgraph("\t") == 0, '9021: isgraph("\\t") == 0');
|
||||
|
||||
vrfy(islower("A") == 0, '9022: islower("A") == 0');
|
||||
vrfy(islower("a") == 1, '9023: islower("a") == 1');
|
||||
vrfy(islower("1") == 0, '9024: islower("1") == 0');
|
||||
|
||||
vrfy(isprint("A") == 1, '9025: isprint("A") == 1');
|
||||
vrfy(isprint("a") == 1, '9026: isprint("a") == 1');
|
||||
vrfy(isprint(" ") == 1, '9027: isprint(" ") == 1');
|
||||
vrfy(isprint("\t") == 0, '9028: isprint("\\t") == 0');
|
||||
|
||||
vrfy(ispunct("A") == 0, '9029: ispunct("A") == 0');
|
||||
vrfy(ispunct("a") == 0, '9030: ispunct("a") == 0');
|
||||
vrfy(ispunct(" ") == 0, '9031: ispunct(" ") == 0');
|
||||
vrfy(ispunct("?") == 1, '9032: ispunct("?") == 1');
|
||||
|
||||
vrfy(isspace("A") == 0, '9033: isspace("A") == 0');
|
||||
vrfy(isspace("Krik") == 0, '9034: isspace("Krik") == 0');
|
||||
vrfy(isspace(" ") == 1, '9035: isspace(" ") == 1');
|
||||
vrfy(isspace("?") == 0, '9036: isspace("?") == 0');
|
||||
|
||||
vrfy(isupper("A") == 1, '9037: isupper("A") == 1');
|
||||
vrfy(isupper("a") == 0, '9038: isupper("a") == 0');
|
||||
vrfy(isupper("1") == 0, '9039: isupper("1") == 0');
|
||||
|
||||
vrfy(isxdigit("A") == 1, '9040: isxdigit("A") == 1');
|
||||
vrfy(isxdigit("f") == 1, '9041: isxdigit("f") == 1');
|
||||
vrfy(isxdigit("2") == 1, '9042: isxdigit("2") == 1');
|
||||
vrfy(isxdigit("x") == 0, '9043: isxdigit("x") == 0');
|
||||
|
||||
vrfy(strcasecmp("ab", "aBc") == -1,
|
||||
'9044: strcasecmp("ab", "aBc") == -1');
|
||||
vrfy(strcasecmp("abc", "aBb") == 1,
|
||||
'9045: strcasecmp("abc", "aBb") == 1');
|
||||
vrfy(strcasecmp("abc", "abc") == 0,
|
||||
'9046: strcasecmp("abc", "abc") == 0');
|
||||
vrfy(strcasecmp("abc", "aBc") == 0,
|
||||
'9047: strcasecmp("abc", "aBc") == 0');
|
||||
vrfy(strcasecmp("abc", "aBd") == -1,
|
||||
'9048: strcasecmp("abc", "aBd") == -1');
|
||||
vrfy(strcasecmp("abc\0", "aBc") == 1,
|
||||
'9049: strcasecmp("a8c\\0", "aBc") == 1');
|
||||
vrfy(strcasecmp("a\0b", "A\0c") == -1,
|
||||
'9050: strcasecmp("a\\0b", "A\\0c") == -1');
|
||||
|
||||
vrfy(strncasecmp("abc", "xyz", 0) == 0,
|
||||
'9051: strncasecmp("abc", "xyz", 0) == 0');
|
||||
vrfy(strncasecmp("abc", "xyz", 1) == -1,
|
||||
'9052: strncasecmp("abc", "xyz", 1) == -1');
|
||||
vrfy(strncasecmp("abc", "", 1) == 1,
|
||||
'9053: strncasecmp("abc", "", 1) == 1');
|
||||
vrfy(strncasecmp("a", "b", 2) == -1,
|
||||
'9054: strncasecmp("a", "b", 2) == -1');
|
||||
vrfy(strncasecmp("ab", "Ac", 2) == -1,
|
||||
'9055: strncasecmp("ab", "Ac", 2) == -1');
|
||||
vrfy(strncasecmp("\0ac", "\0b", 2) == -1,
|
||||
'9056: strncasecmp("\\0ac", "\\0b", 2) == -1');
|
||||
vrfy(strncasecmp("ab", "aBc", 2) == 0,
|
||||
'9057: strncasecmp("ab", "aBc", 2) == 0');
|
||||
vrfy(strncasecmp("abc", "abd", 2) == 0,
|
||||
'9058: strncasecmp("abc", "abd", 2) == 0');
|
||||
|
||||
local s1 = " gnu lesser general public license";
|
||||
print '9059: local s1 = " gnu lesser general public license";';
|
||||
|
||||
vrfy(strcmp(strtolower(" GNU Lesser General Public License"), s1) == 0,
|
||||
'9060: strcmp(strtolower(" GNU Lesser General Public License"),' +
|
||||
' s1) == 0');
|
||||
|
||||
local s2 = " GNU LESSER GENERAL PUBLIC LICENSE";
|
||||
print '9061: local s2 = " GNU LESSER GENERAL PUBLIC LICENSE";';
|
||||
|
||||
vrfy(strcmp(strtoupper(" GNU Lesser General Public License"), s2) == 0,
|
||||
'9062: strcmp(strtoupper(" GNU Lesser General Public License"),' +
|
||||
' s2) == 0');
|
||||
|
||||
print '9063: Ending test_functions2';
|
||||
}
|
||||
print;
|
||||
print '9000: parsed test_functions2()';
|
||||
print;
|
||||
return test_functions2();
|
||||
|
||||
|
||||
/*
|
||||
* read various calc resource files
|
||||
*
|
||||
@@ -7974,7 +8068,6 @@ vrfy(dotest("set8700.line", 8703) == 0,
|
||||
* hello.cal - designed to go into an infinite loop
|
||||
* lucal.cal - already read by this file
|
||||
* lucas_chk.cal - already read by this file
|
||||
* lucas_tbl.cal - duplicatres code already read by another file
|
||||
* regress.cal - this file
|
||||
* surd.cal - already read by this file
|
||||
* test9999.cal - files of this form are already read by this file
|
||||
@@ -8047,8 +8140,6 @@ read -once intfile;
|
||||
print '9830: read -once intfile';
|
||||
read -once lucas;
|
||||
print '9831: read -once lucas';
|
||||
read -once lucas_tbl;
|
||||
print '9832: read -once lucas_tbl';
|
||||
read -once natnumset;
|
||||
print '9833: read -once natnumset';
|
||||
read -once repeat;
|
||||
@@ -8062,7 +8153,11 @@ print '9838: skipping read -once hello.cal because it is an infinite loop';
|
||||
print '9839: skipping read -once xx_print.cal because it is a printing demo';
|
||||
read -once sumtimes;
|
||||
print '9840: read -once sumtimes';
|
||||
print '9841: Ending read of selected calc resource files';
|
||||
read -once dms;
|
||||
print '9841: read -once dms';
|
||||
read -once hms;
|
||||
print '9842: read -once hms';
|
||||
print '9843: Ending read of selected calc resource files';
|
||||
|
||||
|
||||
/*
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: repeat.cal,v 29.4 2003/01/26 19:42:03 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/repeat.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,9 +15,9 @@
|
||||
* NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
||||
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: screen.cal,v 29.2 2006/05/01 19:21:18 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/screen.cal,v $
|
||||
* @(#) $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.
|
||||
*
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: seedrandom.cal,v 29.3 2001/03/31 13:31:34 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/seedrandom.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: set8700.cal,v 29.2 2006/08/20 16:16:11 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
## 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.
|
||||
## 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## @(#) $Revision: 29.4 $
|
||||
## @(#) $Id: set8700.line,v 29.4 2006/08/20 16:16:11 chongo Exp $
|
||||
## @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/set8700.line,v $
|
||||
## @(#) $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
|
||||
|
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)";
|
||||
|
||||
}
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: solve.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/solve.cal,v $
|
||||
* @(#) $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
|
||||
@@ -47,12 +47,13 @@ define solve(low, high, epsilon)
|
||||
if (abs(flow) < epsilon)
|
||||
return low;
|
||||
fhigh = f(high);
|
||||
if (abs(flow) < epsilon)
|
||||
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);
|
||||
mid = bround(high - fhigh * (high - low) / (fhigh - flow),
|
||||
places);
|
||||
if ((mid == low) || (mid == high))
|
||||
places++;
|
||||
fmid = f(mid);
|
||||
|
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)";
|
||||
}
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: sumsq.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/sumsq.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: sumtimes.cal,v 29.2 2006/12/16 11:18:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/sumtimes.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: surd.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/surd.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: test1700.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test1700.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: test2300.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2300.cal,v $
|
||||
* @(#) $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
|
||||
|
117
cal/test2600.cal
117
cal/test2600.cal
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: test2600.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2600.cal,v $
|
||||
* @(#) $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
|
||||
@@ -91,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);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -133,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);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -178,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);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -235,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);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -313,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;
|
||||
@@ -504,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";
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: test2700.cal,v 29.4 2006/06/25 22:06:23 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test2700.cal,v $
|
||||
* @(#) $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
|
||||
@@ -127,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++;
|
||||
}
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: test3100.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3100.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.5 $
|
||||
* @(#) $Id: test3300.cal,v 29.5 2006/12/16 11:19:45 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3300.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: test3400.cal,v 29.3 2006/06/20 09:29:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3400.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: test3500.cal,v 29.3 2006/06/20 09:29:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3500.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.4 $
|
||||
* @(#) $Id: test4000.cal,v 29.4 2006/12/16 11:18:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4000.cal,v $
|
||||
* @(#) $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
|
||||
@@ -199,7 +199,8 @@ define ctimes(str, N, n, count, skip, verbose)
|
||||
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++;
|
||||
}
|
||||
}
|
||||
@@ -306,7 +307,8 @@ define ntimes(str, N, n, count, skip, residue, modulus, verbose)
|
||||
}
|
||||
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);
|
||||
}
|
||||
}
|
||||
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.5 $
|
||||
* @(#) $Id: test4100.cal,v 29.5 2006/12/16 11:18:46 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4100.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.5 $
|
||||
* @(#) $Id: test4600.cal,v 29.5 2006/06/20 09:29:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4600.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: test5100.cal,v 29.3 2006/06/20 09:29:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5100.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.3 $
|
||||
* @(#) $Id: test5200.cal,v 29.3 2006/06/20 09:29:16 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test5200.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -15,11 +15,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: test8400.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8400.cal,v $
|
||||
* @(#) $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
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.2 $
|
||||
* @(#) $Id: test8500.cal,v 29.2 2000/06/07 14:02:25 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8500.cal,v $
|
||||
* @(#) $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
|
||||
@@ -134,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)
|
||||
{
|
||||
|
@@ -17,11 +17,11 @@
|
||||
* 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.
|
||||
* 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* @(#) $Revision: 29.1 $
|
||||
* @(#) $Id: test8600.cal,v 29.1 2000/12/04 19:57:02 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test8600.cal,v $
|
||||
* @(#) $Revision: 30.1 $
|
||||
* @(#) $Id: test8600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $
|
||||
* @(#) $Source: /usr/local/src/bin/calc/cal/RCS/test8600.cal,v $
|
||||
*
|
||||
* Under source code control: 2000/12/04 19:57:02
|
||||
* File existed as early as: 2000
|
||||
|
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