mirror of
https://github.com/lcn2/calc.git
synced 2025-08-19 01:13:27 +03:00
Compare commits
100 Commits
prod-2.15.
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f1a4cb6313 | ||
|
|
59d47e80fb | ||
|
|
95793c3150 | ||
|
|
077ba65285 | ||
|
|
f912da9427 | ||
|
|
753b101e54 | ||
|
|
db83b7383f | ||
|
|
d9245844aa | ||
|
|
8542143463 | ||
|
|
50cb6ec798 | ||
|
|
41951e2c09 | ||
|
|
b9cee333b2 | ||
|
|
e35bb7ffa6 | ||
|
|
c5b64c373b | ||
|
|
4017579aeb | ||
|
|
88fb6a4e47 | ||
|
|
7eb7e9de1f | ||
|
|
42d5749da2 | ||
|
|
bbcbb76369 | ||
|
|
232b3bddef | ||
|
|
5ac3e495b2 | ||
|
|
56153d6615 | ||
|
|
2a4f399593 | ||
|
|
160de4bb38 | ||
|
|
db77e29a23 | ||
|
|
fe9cefe6ef | ||
|
|
ea4c50ade0 | ||
|
|
7f72908b95 | ||
|
|
a547c36f0a | ||
|
|
1e2698b42d | ||
|
|
33815f49e6 | ||
|
|
732279bcc3 | ||
|
|
7f4e1eb68d | ||
|
|
1232b59949 | ||
|
|
90feefc622 | ||
|
|
c97ee188ad | ||
|
|
ae85846839 | ||
|
|
e096bd9ad8 | ||
|
|
884b1bc81b | ||
|
|
a30a518ba7 | ||
|
|
bb3b861090 | ||
|
|
0a3469125e | ||
|
|
9b37e79f21 | ||
|
|
18cd1f9067 | ||
|
|
43fc022dc8 | ||
|
|
29695028cd | ||
|
|
1d37930d22 | ||
|
|
60698d2130 | ||
|
|
3e7ccfd31c | ||
|
|
488d81b809 | ||
|
|
932d27053e | ||
|
|
8e8d6c852a | ||
|
|
54dd89dcf7 | ||
|
|
d91e966f19 | ||
|
|
8d6f83ad91 | ||
|
|
8dd380a9f7 | ||
|
|
fbaff69c92 | ||
|
|
c724227ef9 | ||
|
|
3fd64578a6 | ||
|
|
c9c4105ddc | ||
|
|
80b7cd34fe | ||
|
|
630947d35c | ||
|
|
45f62fd7b4 | ||
|
|
8ca980b2bb | ||
|
|
2ace631d00 | ||
|
|
41d339c60e | ||
|
|
cc3bb98fa0 | ||
|
|
2b506a74e7 | ||
|
|
826d2d8175 | ||
|
|
af8ffb3098 | ||
|
|
71dd30c4c6 | ||
|
|
8ca96a8c29 | ||
|
|
0bba80c92b | ||
|
|
c1882e2ea0 | ||
|
|
79964338d1 | ||
|
|
d809ce5cf0 | ||
|
|
daac7b35af | ||
|
|
40d6e22318 | ||
|
|
ab2038ecbc | ||
|
|
0b57d6b605 | ||
|
|
01f0605055 | ||
|
|
0e6016f429 | ||
|
|
2d2e1c5894 | ||
|
|
50ba5f9a3e | ||
|
|
850cdbef1d | ||
|
|
21cedfcae4 | ||
|
|
4fa137a638 | ||
|
|
6ebe707670 | ||
|
|
885db22315 | ||
|
|
06a9997da7 | ||
|
|
fae4b8e81b | ||
|
|
ddf0c8f1f5 | ||
|
|
d52cbcea14 | ||
|
|
d14d525a6a | ||
|
|
698f73cd3e | ||
|
|
e1888d9b9e | ||
|
|
b54f68a797 | ||
|
|
77d7e665e0 | ||
|
|
e96ef61718 | ||
|
|
0eee1a615d |
45
.github/workflows/codeql-analysis.yml
vendored
45
.github/workflows/codeql-analysis.yml
vendored
@@ -13,10 +13,10 @@ name: "CodeQL"
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [ master ]
|
||||
branches: [ "master" ]
|
||||
pull_request:
|
||||
# The branches below must be a subset of the branches above
|
||||
branches: [ master ]
|
||||
branches: [ "master" ]
|
||||
schedule:
|
||||
- cron: '41 1 * * 6'
|
||||
|
||||
@@ -33,39 +33,48 @@ jobs:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
language: [ 'cpp' ]
|
||||
# CodeQL supports [ 'cpp', 'csharp', 'go', 'java', 'javascript', 'python' ]
|
||||
# Learn more:
|
||||
# https://docs.github.com/en/free-pro-team@latest/github/finding-security-vulnerabilities-and-errors-in-your-code/configuring-code-scanning#changing-the-languages-that-are-analyzed
|
||||
# CodeQL supports [ 'cpp', 'csharp', 'go', 'java', 'javascript', 'python', 'ruby' ]
|
||||
# Use only 'java' to analyze code written in Java, Kotlin or both
|
||||
# Use only 'javascript' to analyze code written in JavaScript, TypeScript or both
|
||||
# Learn more about CodeQL language support at https://aka.ms/codeql-docs/language-support
|
||||
|
||||
steps:
|
||||
- name: Checkout repository
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v5
|
||||
- name: Setup node
|
||||
uses: actions/setup-node@v4
|
||||
with:
|
||||
node-version: '20'
|
||||
|
||||
# Initializes the CodeQL tools for scanning.
|
||||
- name: Initialize CodeQL
|
||||
uses: github/codeql-action/init@v2
|
||||
uses: github/codeql-action/init@v3
|
||||
with:
|
||||
languages: ${{ matrix.language }}
|
||||
# If you wish to specify custom queries, you can do so here or in a config file.
|
||||
# By default, queries listed here will override any specified in a config file.
|
||||
# Prefix the list here with "+" to use these queries and those in the config file.
|
||||
# queries: ./path/to/local/query, your-org/your-repo/queries@main
|
||||
|
||||
# Autobuild attempts to build any compiled languages (C/C++, C#, or Java).
|
||||
# Details on CodeQL's query packs refer to : https://docs.github.com/en/code-security/code-scanning/automatically-scanning-your-code-for-vulnerabilities-and-errors/configuring-code-scanning#using-queries-in-ql-packs
|
||||
# queries: security-extended,security-and-quality
|
||||
|
||||
|
||||
# Autobuild attempts to build any compiled languages (C/C++, C#, Go, or Java).
|
||||
# If this step fails, then you should remove it and run the build manually (see below)
|
||||
- name: Autobuild
|
||||
uses: github/codeql-action/autobuild@v2
|
||||
uses: github/codeql-action/autobuild@v3
|
||||
|
||||
# ℹ️ Command-line programs to run using the OS shell.
|
||||
# 📚 https://git.io/JvXDl
|
||||
# 📚 See https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions#jobsjob_idstepsrun
|
||||
|
||||
# ✏️ If the Autobuild fails above, remove it and uncomment the following three lines
|
||||
# and modify them (or add more) to build your code if your project
|
||||
# uses a compiled language
|
||||
# If the Autobuild fails above, remove it and uncomment the following three lines.
|
||||
# modify them (or add more) to build your code if your project, please refer to the EXAMPLE below for guidance.
|
||||
|
||||
#- run: |
|
||||
# make bootstrap
|
||||
# make release
|
||||
# - run: |
|
||||
# echo "Run, Build Application using script"
|
||||
# ./location_of_script_within_repo/buildscript.sh
|
||||
|
||||
- name: Perform CodeQL Analysis
|
||||
uses: github/codeql-action/analyze@v2
|
||||
uses: github/codeql-action/analyze@v3
|
||||
with:
|
||||
category: "/language:${{matrix.language}}"
|
||||
|
||||
14
.github/workflows/dependency-review.yml
vendored
Normal file
14
.github/workflows/dependency-review.yml
vendored
Normal file
@@ -0,0 +1,14 @@
|
||||
name: 'Dependency Review'
|
||||
on: [pull_request]
|
||||
|
||||
permissions:
|
||||
contents: read
|
||||
|
||||
jobs:
|
||||
dependency-review:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: 'Checkout Repository'
|
||||
uses: actions/checkout@v5
|
||||
- name: 'Dependency Review'
|
||||
uses: actions/dependency-review-action@v4
|
||||
36
.gitignore
vendored
36
.gitignore
vendored
@@ -1,48 +1,46 @@
|
||||
# generic excluded patterns
|
||||
#
|
||||
# We sort the list below via: sort -u -f
|
||||
# We sort the list below via: sort -d -u
|
||||
#
|
||||
*,v
|
||||
*~
|
||||
*.BAK
|
||||
core*
|
||||
.DS_Store
|
||||
*.dSYM/
|
||||
*.exe
|
||||
*.o.tmp
|
||||
*.[oa]
|
||||
*~
|
||||
*.o.tmp
|
||||
.*.swp
|
||||
.DS_Store
|
||||
core*
|
||||
*,v
|
||||
|
||||
# files and directories created during the building of calc and other Makefile actions
|
||||
#
|
||||
# NOTE: While many of these might be part of a released calc tarball, they are
|
||||
# not consider development source. Some other file(s) and/or programs
|
||||
# generate these files.
|
||||
# not consider development source. Some other file(s) and/or programs
|
||||
# generate these files.
|
||||
#
|
||||
# We sort the list below via: sort -u -f
|
||||
# We sort the list below via: sort -d -u
|
||||
#
|
||||
.dynamic
|
||||
.hsrc
|
||||
.static
|
||||
align32
|
||||
align32.h
|
||||
align32_tmp
|
||||
arc4random_tmp
|
||||
args.h
|
||||
cal/.all
|
||||
cal/test082.cal
|
||||
calc
|
||||
calc-static
|
||||
calc.1
|
||||
calc.cat1
|
||||
calc.spec
|
||||
calc-static
|
||||
calc.usage
|
||||
cal/test082.cal
|
||||
charbit.h
|
||||
chatbit
|
||||
chk_c
|
||||
conf.h
|
||||
const_tmp
|
||||
cscript/.all
|
||||
cscript/4dsphere
|
||||
cscript/.all
|
||||
cscript/fproduct
|
||||
cscript/mersenne
|
||||
cscript/piforever
|
||||
@@ -54,15 +52,16 @@ cscript/square
|
||||
custom/.all
|
||||
custom/libcustcalc*
|
||||
debug.out
|
||||
.dynamic
|
||||
endian
|
||||
endian_calc.h
|
||||
environ_tmp
|
||||
errcode
|
||||
errsym.h
|
||||
fpos_tmp
|
||||
fposval
|
||||
fposval.h
|
||||
fposval_tmp
|
||||
fpos_tmp
|
||||
func.show
|
||||
func.sort
|
||||
getpgid_tmp
|
||||
@@ -91,8 +90,6 @@ have_gettime
|
||||
have_gettime.h
|
||||
have_inttypes.h
|
||||
have_limits.h
|
||||
have_memmv
|
||||
have_memmv.h
|
||||
have_newstr
|
||||
have_newstr.h
|
||||
have_offscl
|
||||
@@ -156,13 +153,13 @@ help/releases
|
||||
help/resource
|
||||
help/type
|
||||
help/usage
|
||||
.hsrc
|
||||
libcalc.*
|
||||
libcustcalc.*
|
||||
ll_tmp
|
||||
longbits
|
||||
longbits.h
|
||||
Makefile.our
|
||||
memmv_tmp
|
||||
newstr_tmp
|
||||
NOTES
|
||||
offscl_tmp
|
||||
@@ -174,6 +171,7 @@ sample_many-static
|
||||
sample_rand
|
||||
sample_rand-static
|
||||
statfs_tmp
|
||||
.static
|
||||
status.chk_c.h
|
||||
strdup_tmp
|
||||
tags
|
||||
|
||||
66
BUGS
66
BUGS
@@ -66,13 +66,13 @@ Please include the following information in the new issue:
|
||||
|
||||
* Version of calc you are using
|
||||
|
||||
If you cannot compile calc, then look at version.c
|
||||
and report the #define that start with:
|
||||
If you cannot compile calc, then look at version.c
|
||||
and report the #define that start with:
|
||||
|
||||
#define MAJOR_VER
|
||||
#define MINOR_VER
|
||||
#define MAJOR_PATCH
|
||||
#define MINOR_PATCH
|
||||
#define MAJOR_VER
|
||||
#define MINOR_VER
|
||||
#define MAJOR_PATCH
|
||||
#define MINOR_PATCH
|
||||
|
||||
* If you modified calc from an official patch,
|
||||
send us the mods you made
|
||||
@@ -88,7 +88,7 @@ Please include the following information in the new issue:
|
||||
* cd to the calc source directory, and send the contents
|
||||
of debug.out.txt produced by this command:
|
||||
|
||||
make debug
|
||||
make debug
|
||||
|
||||
PLEASE attach the debug.out.txt file to your GitHub issue (bug report)!!
|
||||
|
||||
@@ -101,7 +101,9 @@ Known bugs in calc:
|
||||
The output of the alg_config.cal resource file is bogus.
|
||||
We would welcome a replacement for this code.
|
||||
|
||||
Calc may not compile natively under Windows 11. See README.WINDOWS.
|
||||
Calc may not compile natively under Windows 11, however with
|
||||
MSYS2 Software Distribution (a fork of Cygwin) people compile
|
||||
calc under Windiws just fine. See README.WINDOWS.
|
||||
|
||||
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
|
||||
@@ -120,16 +122,16 @@ mis-features in calc:
|
||||
|
||||
This works as expected:
|
||||
|
||||
if (expr) {
|
||||
...
|
||||
}
|
||||
if (expr) {
|
||||
...
|
||||
}
|
||||
|
||||
However this WILL NOT WORK AS EXPECTED:
|
||||
|
||||
if (expr)
|
||||
{
|
||||
...
|
||||
}
|
||||
if (expr)
|
||||
{
|
||||
...
|
||||
}
|
||||
|
||||
This needs to be changed. See also "help statement", "help unexpected",
|
||||
and "help todo".
|
||||
@@ -141,28 +143,28 @@ mis-features in calc:
|
||||
integers to/from files the hard way. It does NOT use blkcpy. The
|
||||
following code:
|
||||
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
b = blk()
|
||||
copy(i, b)
|
||||
fd = fopen("file", "w")
|
||||
copy(b, fd);
|
||||
fclose(fd)
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
b = blk()
|
||||
copy(i, b)
|
||||
fd = fopen("file", "w")
|
||||
copy(b, fd);
|
||||
fclose(fd)
|
||||
|
||||
will write an extra NUL octet to the file. Where as:
|
||||
|
||||
read intfile
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
be2file(i, "file2")
|
||||
read intfile
|
||||
i = (ord("\n") << 16) | (ord("i") << 8) | ord("H")
|
||||
be2file(i, "file2")
|
||||
|
||||
will not.
|
||||
|
||||
* The numerator is assumed
|
||||
|
||||
The numerator value of 1 appears to be assumed. In calc:
|
||||
The numerator value of 1 appears to be assumed. In calc:
|
||||
|
||||
/ 2
|
||||
/ 2
|
||||
|
||||
will produce a value of 0.5 as if the numerator 1 was given.
|
||||
will produce a value of 0.5 as if the numerator 1 was given.
|
||||
|
||||
|
||||
=-=
|
||||
@@ -175,7 +177,7 @@ mis-features in calc:
|
||||
##
|
||||
## 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
|
||||
## 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
|
||||
@@ -183,8 +185,8 @@ mis-features in calc:
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1994/03/18 14:06:13
|
||||
## File existed as early as: 1994
|
||||
## Under source code control: 1994/03/18 14:06:13
|
||||
## File existed as early as: 1994
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
10
CONTRIB-CODE
10
CONTRIB-CODE
@@ -49,7 +49,7 @@ See also the calc wishlist by running the calc command:
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -57,8 +57,8 @@ See also the calc wishlist by running the calc command:
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1997/03/09 16:33:22
|
||||
## File existed as early as: 1997
|
||||
## Under source code control: 1997/03/09 16:33:22
|
||||
## File existed as early as: 1997
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
146
COPYING
146
COPYING
@@ -1,4 +1,4 @@
|
||||
calc - arbitrary precision calculator
|
||||
calc - arbitrary precision calculator
|
||||
|
||||
This file is Copyrighted
|
||||
------------------------
|
||||
@@ -6,11 +6,11 @@ This file is Copyrighted
|
||||
This file is not covered under version 2.1 of the GNU LGPL.
|
||||
This file is covered under the following Copyright:
|
||||
|
||||
Copyright (C) 1999-2023 Landon Curt Noll
|
||||
All rights reserved.
|
||||
Copyright (C) 1999-2023 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.
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
-=-
|
||||
|
||||
@@ -33,21 +33,21 @@ Calc is covered by the GNU Lesser General Public License
|
||||
A copy of the GNU Lesser General Public License is distributed with
|
||||
calc under the filename:
|
||||
|
||||
COPYING-LGPL
|
||||
COPYING-LGPL
|
||||
|
||||
You may display this file by the calc command: help copying
|
||||
You may display this file by the calc command: help copying
|
||||
|
||||
You may display the GNU Lesser General
|
||||
Public License by the calc command: help copying-lgpl
|
||||
Public License by the calc command: help copying-lgpl
|
||||
|
||||
You should have received a copy of the version 2.1 GNU Lesser General
|
||||
Public License with calc; if not, write to the following address:
|
||||
|
||||
Free Software Foundation, Inc.
|
||||
51 Franklin Street
|
||||
Fifth Floor
|
||||
Boston, MA 02110-1301
|
||||
USA
|
||||
Free Software Foundation, Inc.
|
||||
51 Franklin Street
|
||||
Fifth Floor
|
||||
Boston, MA 02110-1301
|
||||
USA
|
||||
|
||||
Calc's relationship to the GNU Lesser General Public License
|
||||
------------------------------------------------------------
|
||||
@@ -55,22 +55,22 @@ Calc's relationship to the GNU Lesser General Public License
|
||||
In section 0 of the GNU Lesser General Public License, one finds
|
||||
the following definition:
|
||||
|
||||
The "Library", below, refers to any such software library or
|
||||
work which has been distributed under these terms.
|
||||
The "Library", below, refers to any such software library or
|
||||
work which has been distributed under these terms.
|
||||
|
||||
Calc is distributed under the terms of the GNU Lesser
|
||||
General Public License.
|
||||
|
||||
In the same section 0, one also find the following:
|
||||
|
||||
For a library, complete source code means all the source code
|
||||
for all modules it contains, plus any associated interface
|
||||
definition files, plus the scripts used to control compilation
|
||||
and installation of the library.
|
||||
For a library, complete source code means all the source code
|
||||
for all modules it contains, plus any associated interface
|
||||
definition files, plus the scripts used to control compilation
|
||||
and installation of the library.
|
||||
|
||||
There are at least two calc binary link libraries found in calc:
|
||||
|
||||
libcalc.a libcustcalc.a
|
||||
libcalc.a libcustcalc.a
|
||||
|
||||
Clearly all files that go into the creation of those binary link
|
||||
libraries are covered under the License.
|
||||
@@ -78,26 +78,26 @@ Calc's relationship to the GNU Lesser General Public License
|
||||
The "scripts used to control compilation and installation of the
|
||||
of the library" include:
|
||||
|
||||
* Makefiles
|
||||
* source files created by the Makefiles
|
||||
* source code used in the creation of intermediate source files
|
||||
* Makefiles
|
||||
* source files created by the Makefiles
|
||||
* source code used in the creation of intermediate source files
|
||||
|
||||
All of those files are covered under the License.
|
||||
|
||||
The "associated interface definition files" are those files that:
|
||||
|
||||
* show how the calc binary link libraries are used
|
||||
* test the validity of the binary link libraries
|
||||
* document routines found in the binary link libraries
|
||||
* show how one can interactively use the binary link libraries
|
||||
* show how the calc binary link libraries are used
|
||||
* test the validity of the binary link libraries
|
||||
* document routines found in the binary link libraries
|
||||
* show how one can interactively use the binary link libraries
|
||||
|
||||
Calc provides an extensive set of files that perform the above
|
||||
functions.
|
||||
|
||||
* files under the sample sub-directory
|
||||
* files under the help sub-directory
|
||||
* files under the lib sub-directory
|
||||
* the main calc.c file
|
||||
* files under the sample sub-directory
|
||||
* files under the help sub-directory
|
||||
* files under the lib sub-directory
|
||||
* the main calc.c file
|
||||
|
||||
The "complete source code" includes ALL files shipped with calc,
|
||||
except for the exception files explicitly listed in the "Calc
|
||||
@@ -111,22 +111,22 @@ Calc copyrights and exception files
|
||||
With the exception of the files listed below, Calc is covered under
|
||||
the following GNU Lesser General Public License Copyrights:
|
||||
|
||||
Copyright (C) year David I. Bell
|
||||
Copyright (C) year David I. Bell and Landon Curt Noll
|
||||
Copyright (C) year David I. Bell and Ernest Bowen
|
||||
Copyright (C) year David I. Bell, Landon Curt Noll and Ernest Bowen
|
||||
Copyright (C) year Landon Curt Noll
|
||||
Copyright (C) year Ernest Bowen and Landon Curt Noll
|
||||
Copyright (C) year Ernest Bowen
|
||||
Copyright (C) year Petteri Kettunen and Landon Curt Noll
|
||||
Copyright (C) year Christoph Zurnieden
|
||||
Copyright (C) year Landon Curt Noll and Thomas Jones-Low
|
||||
Copyright (C) year Klaus Alexander Seistrup and Landon Curt Noll
|
||||
Copyright (C) year David I. Bell
|
||||
Copyright (C) year David I. Bell and Landon Curt Noll
|
||||
Copyright (C) year David I. Bell and Ernest Bowen
|
||||
Copyright (C) year David I. Bell, Landon Curt Noll and Ernest Bowen
|
||||
Copyright (C) year Landon Curt Noll
|
||||
Copyright (C) year Ernest Bowen and Landon Curt Noll
|
||||
Copyright (C) year Ernest Bowen
|
||||
Copyright (C) year Petteri Kettunen and Landon Curt Noll
|
||||
Copyright (C) year Christoph Zurnieden
|
||||
Copyright (C) year Landon Curt Noll and Thomas Jones-Low
|
||||
Copyright (C) year Klaus Alexander Seistrup and Landon Curt Noll
|
||||
|
||||
These files are not covered under one of the Copyrights listed above:
|
||||
|
||||
sha1.c sha1.h COPYING
|
||||
COPYING-LGPL cal/screen.cal
|
||||
sha1.c sha1.h COPYING
|
||||
COPYING-LGPL 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
|
||||
@@ -140,37 +140,37 @@ Calc copyrights and exception files
|
||||
|
||||
These files are covered under "The Unlicense":
|
||||
|
||||
sha1.c
|
||||
sha1.h
|
||||
cal/dotest.cal
|
||||
cal/screen.cal
|
||||
sha1.c
|
||||
sha1.h
|
||||
cal/dotest.cal
|
||||
cal/screen.cal
|
||||
|
||||
"The Unlicense" is as follows:
|
||||
|
||||
This is free and unencumbered software released into the public domain.
|
||||
This is free and unencumbered software released into the public domain.
|
||||
|
||||
Anyone is free to copy, modify, publish, use, compile, sell, or
|
||||
distribute this software, either in source code form or as a compiled
|
||||
binary, for any purpose, commercial or non-commercial, and by any
|
||||
means.
|
||||
Anyone is free to copy, modify, publish, use, compile, sell, or
|
||||
distribute this software, either in source code form or as a compiled
|
||||
binary, for any purpose, commercial or non-commercial, and by any
|
||||
means.
|
||||
|
||||
In jurisdictions that recognize copyright laws, the author or authors
|
||||
of this software dedicate any and all copyright interest in the
|
||||
software to the public domain. We make this dedication for the benefit
|
||||
of the public at large and to the detriment of our heirs and
|
||||
successors. We intend this dedication to be an overt act of
|
||||
relinquishment in perpetuity of all present and future rights to this
|
||||
software under copyright law.
|
||||
In jurisdictions that recognize copyright laws, the author or authors
|
||||
of this software dedicate any and all copyright interest in the
|
||||
software to the public domain. We make this dedication for the benefit
|
||||
of the public at large and to the detriment of our heirs and
|
||||
successors. We intend this dedication to be an overt act of
|
||||
relinquishment in perpetuity of all present and future rights to this
|
||||
software under copyright law.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
|
||||
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
|
||||
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
||||
OTHER DEALINGS IN THE SOFTWARE.
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
|
||||
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
|
||||
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
||||
OTHER DEALINGS IN THE SOFTWARE.
|
||||
|
||||
For more information, please refer to <http://unlicense.org/>
|
||||
For more information, please refer to <http://unlicense.org/>
|
||||
|
||||
In all cases one may use and distribute these exception files freely.
|
||||
And because one may freely distribute the LGPL covered files, the
|
||||
@@ -183,12 +183,12 @@ General Copyleft and License info
|
||||
|
||||
For general information on Copylefts, see:
|
||||
|
||||
http://www.gnu.org/copyleft/
|
||||
http://www.gnu.org/copyleft/
|
||||
|
||||
For information on GNU Lesser General Public Licenses, see:
|
||||
|
||||
http://www.gnu.org/copyleft/lesser.html
|
||||
http://www.gnu.org/copyleft/lesser.txt
|
||||
http://www.gnu.org/copyleft/lesser.html
|
||||
http://www.gnu.org/copyleft/lesser.txt
|
||||
|
||||
-=-
|
||||
|
||||
@@ -198,10 +198,10 @@ Why calc did not use the GNU General Public License
|
||||
It has been suggested that one should consider using the GNU General
|
||||
Public License instead of the GNU Lesser General Public License:
|
||||
|
||||
http://www.gnu.org/philosophy/why-not-lgpl.html
|
||||
http://www.gnu.org/philosophy/why-not-lgpl.html
|
||||
|
||||
As you can read in the above URL, there are times where a library
|
||||
cannot give free software any particular advantage. One of those
|
||||
cannot give free software any particular advantage. One of those
|
||||
times is when there is significantly similar versions available
|
||||
that are not covered under a Copyleft such as the GNU General Public
|
||||
License.
|
||||
|
||||
@@ -10,7 +10,7 @@ Open up the 'Assets' tag below a given release and download these RPMs:
|
||||
|
||||
* calc*.rpm
|
||||
|
||||
- all that is needed if you just want to use calc
|
||||
- all that is needed if you just want to use calc
|
||||
|
||||
If your platform supports rpm and matches one of the "calc*.rpm" files, you
|
||||
may just install that "calc*.rpm". For exammple on an x86_64 system:
|
||||
@@ -25,7 +25,7 @@ files for use in other programs:
|
||||
|
||||
* calc-devel-*.rpm
|
||||
|
||||
- calc *.h header and *.a lib files for use in other programs
|
||||
- calc *.h header and *.a lib files for use in other programs
|
||||
|
||||
Alternately to the above github link, you might try looking at the RPMs under:
|
||||
|
||||
@@ -209,10 +209,10 @@ the standard Microsoft Windows developor environment to compile calc.
|
||||
|
||||
You should determine if these Makefile variables are reasonable:
|
||||
|
||||
INCDIR Where the system include (.h) files are kept.
|
||||
BINDIR Where to install calc binary files.
|
||||
LIBDIR Where to install calc link library (*.a) files.
|
||||
CALC_SHAREDIR Where to install calc help, .cal, startup, and config files.
|
||||
INCDIR Where the system include (.h) files are kept.
|
||||
BINDIR Where to install calc binary files.
|
||||
LIBDIR Where to install calc link library (*.a) files.
|
||||
CALC_SHAREDIR Where to install calc help, .cal, startup, and config files.
|
||||
|
||||
You may want to change the default installation locations for
|
||||
these values, which are based on the 4 values listed above:
|
||||
@@ -227,25 +227,25 @@ these values, which are based on the 4 values listed above:
|
||||
If you want to install calc files under a top level directory, then set the T value:
|
||||
|
||||
The calc install is performed under ${T}, the calc build is
|
||||
performed under /. The purpose for ${T} is to allow someone
|
||||
performed under /. The purpose for ${T} is to allow someone
|
||||
to install calc somewhere other than into the system area.
|
||||
|
||||
For example, if:
|
||||
|
||||
BINDIR= /usr/bin
|
||||
LIBDIR= /usr/lib
|
||||
CALC_SHAREDIR= /usr/share/calc
|
||||
BINDIR= /usr/bin
|
||||
LIBDIR= /usr/lib
|
||||
CALC_SHAREDIR= /usr/share/calc
|
||||
|
||||
and if:
|
||||
|
||||
T= /var/tmp/testing
|
||||
T= /var/tmp/testing
|
||||
|
||||
Then the installation locations will be:
|
||||
|
||||
calc binary files: /var/tmp/testing/usr/bin
|
||||
calc link library: /var/tmp/testing/usr/lib
|
||||
calc help, .cal ...: /var/tmp/testing/usr/share/calc
|
||||
... etc ... /var/tmp/testing/...
|
||||
calc binary files: /var/tmp/testing/usr/bin
|
||||
calc link library: /var/tmp/testing/usr/lib
|
||||
calc help, .cal ...: /var/tmp/testing/usr/share/calc
|
||||
... etc ... /var/tmp/testing/...
|
||||
|
||||
If ${T} is empty, calc is installed under /, which is the same
|
||||
top of tree for which it was built. If ${T} is non-empty, then
|
||||
@@ -341,7 +341,7 @@ before you install:
|
||||
Calc is distributed with an extensive collection of help files that
|
||||
are accessible from the command line. The following assume that you
|
||||
are running calc from the distribution directory or that you have
|
||||
installed calc. In these examples, the "; " is the calc prompt, not
|
||||
installed calc. In these examples, the "; " is the calc prompt, not
|
||||
something that you type.
|
||||
|
||||
For list of help topics:
|
||||
@@ -392,7 +392,7 @@ a numner of important make rules and thus fail to properly compile calc.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -400,8 +400,8 @@ a numner of important make rules and thus fail to properly compile calc.
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1999/09/27 20:48:44
|
||||
## File existed as early as: 1999
|
||||
## Under source code control: 1999/09/27 20:48:44
|
||||
## File existed as early as: 1999
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
472
LIBRARY
472
LIBRARY
@@ -19,9 +19,9 @@ FIRST THINGS FIRST
|
||||
------------------
|
||||
|
||||
...............................................................................
|
||||
. .
|
||||
. .
|
||||
. You MUST call libcalc_call_me_first() prior to using libcalc lib functions! .
|
||||
. .
|
||||
. .
|
||||
...............................................................................
|
||||
|
||||
The function libcalc_call_me_first() takes no args and returns void. You
|
||||
@@ -34,16 +34,16 @@ INCLUDE FILES
|
||||
To use any of these routines in your own programs, you need to include the
|
||||
appropriate include file. These include files are:
|
||||
|
||||
zmath.h (for integer arithmetic)
|
||||
qmath.h (for rational arithmetic)
|
||||
cmath.h (for complex number arithmetic)
|
||||
zmath.h (for integer arithmetic)
|
||||
qmath.h (for rational arithmetic)
|
||||
cmath.h (for complex number arithmetic)
|
||||
|
||||
You never need to include more than one of the above files, even if you wish
|
||||
to use more than one type of arithmetic, since qmath.h automatically includes
|
||||
zmath.h, and cmath.h automatically includes qmath.h.
|
||||
|
||||
The prototypes for the available routines are listed in the above include
|
||||
files. Some of these routines are meant for internal use, and so aren't
|
||||
files. Some of these routines are meant for internal use, and so aren't
|
||||
convenient for outside use. So you should read the source for a routine
|
||||
to see if it really does what you think it does. I won't guarantee that
|
||||
obscure internal routines won't change or disappear in future releases!
|
||||
@@ -61,20 +61,20 @@ to define CALC_SRC.
|
||||
You need to include the following file to get the symbols and variables
|
||||
related to error handling:
|
||||
|
||||
lib_calc.h
|
||||
lib_calc.h
|
||||
|
||||
External programs may want to compile with:
|
||||
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
If custom functions are also used, they may want to compile with:
|
||||
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc -lcustcalc
|
||||
|
||||
The CALC_SRC symbol should NOT be defined by default. However if you are
|
||||
feeling pedantic you may want to force CALC_SRC to be undefined:
|
||||
|
||||
-UCALC_SRC
|
||||
-UCALC_SRC
|
||||
|
||||
as well.
|
||||
|
||||
@@ -87,64 +87,64 @@ condition, such as malloc failures, division by zero, or some form of
|
||||
an internal computation error. The routine is called in the manner of
|
||||
printf, with a format string and optional arguments:
|
||||
|
||||
void math_error(char *fmt, ...);
|
||||
void math_error(char *fmt, ...);
|
||||
|
||||
Your program must handle math errors in one of three ways:
|
||||
|
||||
1) Print the error message and then exit
|
||||
|
||||
There is a math_error() function supplied with the calc library.
|
||||
By default, this routine simply prints a message to stderr and
|
||||
then exits. By simply linking in this link library, any calc
|
||||
errors will result in a error message on stderr followed by
|
||||
an exit.
|
||||
There is a math_error() function supplied with the calc library.
|
||||
By default, this routine simply prints a message to stderr and
|
||||
then exits. By simply linking in this link library, any calc
|
||||
errors will result in a error message on stderr followed by
|
||||
an exit.
|
||||
|
||||
2) Use setjmp and longjmp in your program
|
||||
|
||||
Use setjmp at some appropriate level in your program, and let
|
||||
the longjmp in math_error() return to that level and to allow you
|
||||
to recover from the error. This is what the calc program does.
|
||||
Use setjmp at some appropriate level in your program, and let
|
||||
the longjmp in math_error() return to that level and to allow you
|
||||
to recover from the error. This is what the calc program does.
|
||||
|
||||
If one sets up calc_matherr_jmpbuf, and then sets
|
||||
calc_use_matherr_jmpbuf to non-zero then math_error() will
|
||||
longjmp back with the return value of calc_use_matherr_jmpbuf.
|
||||
In addition, the last calc error message will be found in
|
||||
calc_err_msg; this error is not printed to stderr. The calc
|
||||
error message will not have a trailing newline.
|
||||
If one sets up calc_matherr_jmpbuf, and then sets
|
||||
calc_use_matherr_jmpbuf to non-zero then math_error() will
|
||||
longjmp back with the return value of calc_use_matherr_jmpbuf.
|
||||
In addition, the last calc error message will be found in
|
||||
calc_err_msg; this error is not printed to stderr. The calc
|
||||
error message will not have a trailing newline.
|
||||
|
||||
For example:
|
||||
For example:
|
||||
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
|
||||
int error;
|
||||
int error;
|
||||
|
||||
...
|
||||
...
|
||||
|
||||
if ((error = setjmp(calc_matherr_jmpbuf)) != 0) {
|
||||
if ((error = setjmp(calc_matherr_jmpbuf)) != 0) {
|
||||
|
||||
/* report the error */
|
||||
printf("Ouch: %s\n", calc_err_msg);
|
||||
/* report the error */
|
||||
printf("Ouch: %s\n", calc_err_msg);
|
||||
|
||||
/* reinitialize calc after the longjmp */
|
||||
reinitialize();
|
||||
}
|
||||
calc_use_matherr_jmpbuf = 1;
|
||||
/* 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.
|
||||
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, ...);
|
||||
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.
|
||||
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
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
-------------------------
|
||||
PARSE/SCAN ERROR HANDLING
|
||||
@@ -159,15 +159,15 @@ any parse/scan errors. By default, this variable it set to 1 and so
|
||||
parse/scan errors are printed to stderr. By setting this value to zero,
|
||||
parse/scan errors are not printed:
|
||||
|
||||
#include "lib_calc.h"
|
||||
#include "lib_calc.h"
|
||||
|
||||
/* do not print parse/scan errors to stderr */
|
||||
calc_print_scanerr_msg = 0;
|
||||
/* 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];
|
||||
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
|
||||
@@ -182,54 +182,54 @@ 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.
|
||||
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.
|
||||
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.
|
||||
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:
|
||||
For example:
|
||||
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
#include <setjmp.h>
|
||||
#include "lib_calc.h"
|
||||
|
||||
int scan_error;
|
||||
int scan_error;
|
||||
|
||||
...
|
||||
...
|
||||
|
||||
/* delay the printing of the parse/scan error */
|
||||
calc_use_scanerr_jmpbuf = 0; /* this is optional */
|
||||
/* delay the printing of the parse/scan error */
|
||||
calc_use_scanerr_jmpbuf = 0; /* this is optional */
|
||||
|
||||
if ((scan_error = setjmp(calc_scanerr_jmpbuf)) != 0) {
|
||||
if ((scan_error = setjmp(calc_scanerr_jmpbuf)) != 0) {
|
||||
|
||||
/* report the parse/scan */
|
||||
if (calc_use_scanerr_jmpbuf == 0) {
|
||||
printf("parse error: %s\n", calc_err_msg);
|
||||
}
|
||||
/* 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;
|
||||
/* 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.
|
||||
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
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
---------------------------
|
||||
PARSE/SCAN WARNING HANDLING
|
||||
@@ -239,22 +239,22 @@ Calc parse/scan warning message are printed to stderr by the warning()
|
||||
function. The routine is called in the manner of printf, with a format
|
||||
string and optional arguments:
|
||||
|
||||
void warning(char *fmt, ...);
|
||||
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"
|
||||
#include "lib_calc.h"
|
||||
|
||||
/* do not print parse/scan warnings to stderr */
|
||||
calc_print_scanwarn_msg = 0;
|
||||
/* 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];
|
||||
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
|
||||
@@ -264,19 +264,19 @@ 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.
|
||||
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, ...);
|
||||
void warning(char *fmt, ...);
|
||||
|
||||
Your warning function should simply return when it is finished.
|
||||
Your warning function should simply return when it is finished.
|
||||
|
||||
External programs can obtain the appropriate calc symbols by compiling with:
|
||||
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
-I${INCDIR} -L${LIBDIR} -lcalc
|
||||
|
||||
|
||||
---------------
|
||||
@@ -308,7 +308,7 @@ output strings with space filling, output formatted strings like printf, and
|
||||
flush the output. Output from these routines is diverted as described above.
|
||||
|
||||
You can change the default output mode by calling math_setmode, and you can
|
||||
change the default number of digits printed by calling math_setdigits. These
|
||||
change the default number of digits printed by calling math_setdigits. These
|
||||
routines return the previous values. The possible modes are described in
|
||||
zmath.h.
|
||||
|
||||
@@ -320,7 +320,7 @@ The arbitrary precision integer routines define a structure called a ZVALUE.
|
||||
This is defined in zmath.h. A ZVALUE contains a pointer to an array of
|
||||
integers, the length of the array, and a sign flag. The array is allocated
|
||||
using malloc, so you need to free this array when you are done with a
|
||||
ZVALUE. To do this, you should call zfree() with the ZVALUE as an argument
|
||||
ZVALUE. To do this, you should call zfree() with the ZVALUE as an argument
|
||||
and never try to free the array yourself using free(). The reason for this
|
||||
is that sometimes the pointer points to a statically allocated arrays which
|
||||
should NOT be freed.
|
||||
@@ -329,11 +329,11 @@ The ZVALUE structures are passed to routines by value, and are returned
|
||||
through pointers. For example, to multiply two small integers together,
|
||||
you could do the following:
|
||||
|
||||
ZVALUE z1, z2, z3;
|
||||
ZVALUE z1, z2, z3;
|
||||
|
||||
itoz(3L, &z1);
|
||||
itoz(4L, &z2);
|
||||
zmul(z1, z2, &z3);
|
||||
itoz(3L, &z1);
|
||||
itoz(4L, &z2);
|
||||
zmul(z1, z2, &z3);
|
||||
|
||||
Use zcopy to copy one ZVALUE to another. There is no sharing of arrays
|
||||
between different ZVALUEs even if they have the same value, so you MUST
|
||||
@@ -354,67 +354,67 @@ address to a routine as a destination value, otherwise memory will be
|
||||
lost. The following shows an example of the correct way to free memory
|
||||
over a long sequence of operations.
|
||||
|
||||
ZVALUE z1, z2, z3;
|
||||
ZVALUE z1, z2, z3;
|
||||
|
||||
z1 = _one_;
|
||||
str2z("12345678987654321", &z2);
|
||||
zadd(z1, z2, &z3);
|
||||
zfree(z1);
|
||||
zfree(z2);
|
||||
zsquare(z3, &z1);
|
||||
zfree(z3);
|
||||
itoz(17L, &z2);
|
||||
zsub(z1, z2, &z3);
|
||||
zfree(z1);
|
||||
zfree(z2);
|
||||
zfree(z3);
|
||||
z1 = _one_;
|
||||
str2z("12345678987654321", &z2);
|
||||
zadd(z1, z2, &z3);
|
||||
zfree(z1);
|
||||
zfree(z2);
|
||||
zsquare(z3, &z1);
|
||||
zfree(z3);
|
||||
itoz(17L, &z2);
|
||||
zsub(z1, z2, &z3);
|
||||
zfree(z1);
|
||||
zfree(z2);
|
||||
zfree(z3);
|
||||
|
||||
There are some quick checks you can make on integers. For example, whether
|
||||
or not they are zero, negative, even, and so on. These are all macros
|
||||
defined in zmath.h, and should be used instead of checking the parts of the
|
||||
ZVALUE yourself. Examples of such checks are:
|
||||
|
||||
ziseven(z) (number is even)
|
||||
zisodd(z) (number is odd)
|
||||
ziszero(z) (number is zero)
|
||||
zisneg(z) (number is negative)
|
||||
zispos(z) (number is positive)
|
||||
zisunit(z) (number is 1 or -1)
|
||||
zisone(z) (number is 1)
|
||||
zisnegone(z) (number is -1)
|
||||
zistwo(z) (number is 2)
|
||||
zisabstwo(z) (number is 2 or -2)
|
||||
zisabsleone(z) (number is -1, 0 or 1)
|
||||
zislezero(z) (number is <= 0)
|
||||
zisleone(z) (number is <= 1)
|
||||
zge16b(z) (number is >= 2^16)
|
||||
zge24b(z) (number is >= 2^24)
|
||||
zge31b(z) (number is >= 2^31)
|
||||
zge32b(z) (number is >= 2^32)
|
||||
zge64b(z) (number is >= 2^64)
|
||||
ziseven(z) (number is even)
|
||||
zisodd(z) (number is odd)
|
||||
ziszero(z) (number is zero)
|
||||
zisneg(z) (number is negative)
|
||||
zispos(z) (number is positive)
|
||||
zisunit(z) (number is 1 or -1)
|
||||
zisone(z) (number is 1)
|
||||
zisnegone(z) (number is -1)
|
||||
zistwo(z) (number is 2)
|
||||
zisabstwo(z) (number is 2 or -2)
|
||||
zisabsleone(z) (number is -1, 0 or 1)
|
||||
zislezero(z) (number is <= 0)
|
||||
zisleone(z) (number is <= 1)
|
||||
zge16b(z) (number is >= 2^16)
|
||||
zge24b(z) (number is >= 2^24)
|
||||
zge31b(z) (number is >= 2^31)
|
||||
zge32b(z) (number is >= 2^32)
|
||||
zge64b(z) (number is >= 2^64)
|
||||
|
||||
Typically the largest unsigned long is typedefed to FULL. The following
|
||||
macros are useful in dealing with this data type:
|
||||
|
||||
MAXFULL (largest positive FULL value)
|
||||
MAXUFULL (largest unsigned FULL value)
|
||||
zgtmaxfull(z) (number is > MAXFULL)
|
||||
zgtmaxufull(z) (number is > MAXUFULL)
|
||||
zgtmaxlong(z) (number is > MAXLONG, largest long value)
|
||||
zgtmaxulong(z) (number is > MAXULONG, largest unsigned long value)
|
||||
MAXFULL (largest positive FULL value)
|
||||
MAXUFULL (largest unsigned FULL value)
|
||||
zgtmaxfull(z) (number is > MAXFULL)
|
||||
zgtmaxufull(z) (number is > MAXUFULL)
|
||||
zgtmaxlong(z) (number is > MAXLONG, largest long value)
|
||||
zgtmaxulong(z) (number is > MAXULONG, largest unsigned long value)
|
||||
|
||||
If zgtmaxufull(z) is false, then one may quickly convert the absolute
|
||||
value of number into a full with the macro:
|
||||
|
||||
ztofull(z) (convert abs(number) to FULL)
|
||||
ztoulong(z) (convert abs(number) to an unsigned long)
|
||||
ztolong(z) (convert abs(number) to a long)
|
||||
ztofull(z) (convert abs(number) to FULL)
|
||||
ztoulong(z) (convert abs(number) to an unsigned long)
|
||||
ztolong(z) (convert abs(number) to a long)
|
||||
|
||||
If the value is too large for ztofull(), ztoulong() or ztolong(), only
|
||||
the low order bits converted.
|
||||
|
||||
There are two types of comparisons you can make on ZVALUEs. This is whether
|
||||
or not they are equal, or the ordering on size of the numbers. The zcmp
|
||||
or not they are equal, or the ordering on size of the numbers. The zcmp
|
||||
function tests whether two ZVALUEs are equal, returning true if they differ.
|
||||
The zrel function tests the relative sizes of two ZVALUEs, returning -1 if
|
||||
the first one is smaller, 0 if they are the same, and 1 if the first one
|
||||
@@ -422,11 +422,11 @@ is larger.
|
||||
|
||||
To determine if z is an integer power of 2, use zispowerof2:
|
||||
|
||||
ZVALUE z; /* value to check if it is a power of */
|
||||
FULL log2; /* set to log base 2 of z when is_power_of_2 is true */
|
||||
bool is_power_of_2;
|
||||
ZVALUE z; /* value to check if it is a power of */
|
||||
FULL log2; /* set to log base 2 of z when is_power_of_2 is true */
|
||||
bool is_power_of_2;
|
||||
|
||||
is_power_of_2 = zispowerof2(z, &log2)
|
||||
is_power_of_2 = zispowerof2(z, &log2)
|
||||
|
||||
Returns true if z an integer power of 2: set log2 to log base 2 of z.
|
||||
Returns false if z is NOT integer power of 2 and leave log2 untouched.
|
||||
@@ -445,35 +445,35 @@ is always positive. If the NUMBER is an integer, the denominator has the
|
||||
value 1.
|
||||
|
||||
Unlike ZVALUEs, NUMBERs are passed using pointers, and pointers to them are
|
||||
returned by functions. So the basic type for using fractions is not really
|
||||
returned by functions. So the basic type for using fractions is not really
|
||||
(NUMBER), but is (NUMBER *). NUMBERs are allocated using the qalloc routine.
|
||||
This returns a pointer to a number which has the value 1. Because of the
|
||||
special property of a ZVALUE of 1, the numerator and denominator of this
|
||||
returned value can simply be overwritten with new ZVALUEs without needing
|
||||
to free them first. The following illustrates this:
|
||||
|
||||
NUMBER *q;
|
||||
NUMBER *q;
|
||||
|
||||
q = qalloc();
|
||||
itoz(55L, &q->num);
|
||||
q = qalloc();
|
||||
itoz(55L, &q->num);
|
||||
|
||||
A better way to create NUMBERs with particular values is to use the itoq,
|
||||
iitoq, or str2q functions. Using itoq makes a long value into a NUMBER,
|
||||
using iitoq makes a pair of longs into the numerator and denominator of a
|
||||
NUMBER (reducing them first if needed), and str2q converts a string representing
|
||||
a number into the corresponding NUMBER. The str2q function accepts input in
|
||||
a number into the corresponding NUMBER. The str2q function accepts input in
|
||||
integral, fractional, real, or exponential formats. Examples of allocating
|
||||
numbers are:
|
||||
|
||||
NUMBER *q1, *q2, *q3, *q4;
|
||||
NUMBER *q1, *q2, *q3, *q4;
|
||||
|
||||
q1 = itoq(66L);
|
||||
q2 = iitoq(2L, 3L);
|
||||
q3 = str2q("456.78");
|
||||
q4 = utoq((FULL) 1234567890L);
|
||||
q1 = itoq(66L);
|
||||
q2 = iitoq(2L, 3L);
|
||||
q3 = str2q("456.78");
|
||||
q4 = utoq((FULL) 1234567890L);
|
||||
|
||||
Also unlike ZVALUEs, NUMBERs are quickly copied. This is because they contain
|
||||
a link count, which is the number of pointers there are to the NUMBER. The
|
||||
a link count, which is the number of pointers there are to the NUMBER. The
|
||||
qlink macro is used to copy a pointer to a NUMBER, and simply increments
|
||||
the link count and returns the same pointer. Since it is a macro, the
|
||||
argument should not be a function call, but a real pointer variable. The
|
||||
@@ -486,16 +486,16 @@ the ZVALUEs contained within the NUMBER, and then puts the NUMBER structure
|
||||
onto a free list for quick reuse. The following is an example of allocating
|
||||
NUMBERs, copying them, adding them, and finally deleting them again.
|
||||
|
||||
NUMBER *q1, *q2, *q3, *q4;
|
||||
NUMBER *q1, *q2, *q3, *q4;
|
||||
|
||||
q1 = itoq(111L);
|
||||
q2 = qlink(q1);
|
||||
q3 = qqadd(q1, q2);
|
||||
q4 = qnum(q2, q3);
|
||||
q1 = itoq(111L);
|
||||
q2 = qlink(q1);
|
||||
q3 = qqadd(q1, q2);
|
||||
q4 = qnum(q2, q3);
|
||||
|
||||
qfree(q1);
|
||||
qfree(q2);
|
||||
qfree(q3);
|
||||
qfree(q1);
|
||||
qfree(q2);
|
||||
qfree(q3);
|
||||
|
||||
Because of the passing of pointers and the ability to copy numbers easily,
|
||||
you might wish to use the rational number routines even for integral
|
||||
@@ -513,55 +513,55 @@ There are some transcendental functions in the link library, such as sin
|
||||
and cos. These cannot be evaluated exactly as fractions. Therefore,
|
||||
they accept another argument which tells how accurate you want the result.
|
||||
This is an "epsilon" value, and the returned value will be within that
|
||||
quantity of the correct value. This is usually an absolute difference,
|
||||
quantity of the correct value. This is usually an absolute difference,
|
||||
but for some functions (such as exp), this is a relative difference.
|
||||
For example, to calculate sin(0.5) to 100 decimal places, you could do:
|
||||
|
||||
NUMBER *q, *ans, *epsilon;
|
||||
NUMBER *q, *ans, *epsilon;
|
||||
|
||||
q = str2q("0.5");
|
||||
epsilon = str2q("1e-100");
|
||||
ans = qsin(q, epsilon);
|
||||
q = str2q("0.5");
|
||||
epsilon = str2q("1e-100");
|
||||
ans = qsin(q, epsilon);
|
||||
|
||||
There are many convenience macros similar to the ones for ZVALUEs which can
|
||||
give quick information about NUMBERs. In addition, there are some new ones
|
||||
applicable to fractions. These are all defined in qmath.h. Some of these
|
||||
macros are:
|
||||
|
||||
qiszero(q) (number is zero)
|
||||
qisneg(q) (number is negative)
|
||||
qispos(q) (number is positive)
|
||||
qisint(q) (number is an integer)
|
||||
qisfrac(q) (number is fractional)
|
||||
qisunit(q) (number is 1 or -1)
|
||||
qisone(q) (number is 1)
|
||||
qisnegone(q) (number is -1)
|
||||
qistwo(q) (number is 2)
|
||||
qiseven(q) (number is an even integer)
|
||||
qisodd(q) (number is an odd integer)
|
||||
qisreciprocal(q) (number is 1 / an integer and q != 0)
|
||||
qiszero(q) (number is zero)
|
||||
qisneg(q) (number is negative)
|
||||
qispos(q) (number is positive)
|
||||
qisint(q) (number is an integer)
|
||||
qisfrac(q) (number is fractional)
|
||||
qisunit(q) (number is 1 or -1)
|
||||
qisone(q) (number is 1)
|
||||
qisnegone(q) (number is -1)
|
||||
qistwo(q) (number is 2)
|
||||
qiseven(q) (number is an even integer)
|
||||
qisodd(q) (number is an odd integer)
|
||||
qisreciprocal(q) (number is 1 / an integer and q != 0)
|
||||
|
||||
The comparisons for NUMBERs are similar to the ones for ZVALUEs. You use the
|
||||
qcmp and qrel functions.
|
||||
|
||||
There are four predefined values for fractions. You should qlink them when
|
||||
There are four predefined values for fractions. You should qlink them when
|
||||
you want to use them. These are _qzero_, _qone_, _qnegone_, and _qonehalf_.
|
||||
These have the values 0, 1, -1, and 1/2. An example of using them is:
|
||||
|
||||
NUMBER *q1, *q2;
|
||||
NUMBER *q1, *q2;
|
||||
|
||||
q1 = qlink(&_qonehalf_);
|
||||
q2 = qlink(&_qone_);
|
||||
q1 = qlink(&_qonehalf_);
|
||||
q2 = qlink(&_qone_);
|
||||
|
||||
To determine if q is an integer power of 2, use qispowerof2:
|
||||
|
||||
NUMBER *q; /* value to check if it is a power of */
|
||||
NUMBER *qlog2; /* set to log base 2 of q when is_power_of_2 is true */
|
||||
bool is_power_of_2;
|
||||
NUMBER *q; /* value to check if it is a power of */
|
||||
NUMBER *qlog2; /* set to log base 2 of q when is_power_of_2 is true */
|
||||
bool is_power_of_2;
|
||||
|
||||
q = utoq((FULL) 1234567890L);
|
||||
qlog2 = qalloc();
|
||||
is_power_of_2 = qispowerof2(q, &qlog2);
|
||||
q = utoq((FULL) 1234567890L);
|
||||
qlog2 = qalloc();
|
||||
is_power_of_2 = qispowerof2(q, &qlog2);
|
||||
|
||||
Returns true if q an integer power of 2: set *qlog2 to log base 2 of q.
|
||||
Returns false if q is NOT integer power of 2 and leave *qlog2 untouched.
|
||||
@@ -572,7 +572,7 @@ USING COMPLEX NUMBERS
|
||||
---------------------
|
||||
|
||||
The arbitrary precision complex arithmetic routines define a structure
|
||||
called COMPLEX. This is defined in cmath.h. This contains two NUMBERs
|
||||
called COMPLEX. This is defined in cmath.h. This contains two NUMBERs
|
||||
for the real and imaginary parts of a complex number, and a count of the
|
||||
number of links there are to this COMPLEX number.
|
||||
|
||||
@@ -583,19 +583,19 @@ fractional parts using qqtoc. You can copy COMPLEX values using clink
|
||||
which increments the link count. And you free a COMPLEX value using cfree.
|
||||
The following example illustrates this:
|
||||
|
||||
NUMBER *q1, *q2;
|
||||
COMPLEX *c1, *c2, *c3;
|
||||
NUMBER *q1, *q2;
|
||||
COMPLEX *c1, *c2, *c3;
|
||||
|
||||
q1 = itoq(3L);
|
||||
q2 = itoq(4L);
|
||||
c1 = qqtoc(q1, q2);
|
||||
qfree(q1);
|
||||
qfree(q2);
|
||||
c2 = clink(c1);
|
||||
c3 = cmul(c1, c2);
|
||||
cfree(c1);
|
||||
cfree(c2);
|
||||
cfree(c3);
|
||||
q1 = itoq(3L);
|
||||
q2 = itoq(4L);
|
||||
c1 = qqtoc(q1, q2);
|
||||
qfree(q1);
|
||||
qfree(q2);
|
||||
c2 = clink(c1);
|
||||
c3 = cmul(c1, c2);
|
||||
cfree(c1);
|
||||
cfree(c2);
|
||||
cfree(c3);
|
||||
|
||||
As a shortcut, when you want to manipulate a COMPLEX value by a real value,
|
||||
you can use the caddq, csubq, cmulq, and cdivq routines. These accept one
|
||||
@@ -605,33 +605,33 @@ There is no direct routine to convert a string value into a COMPLEX value.
|
||||
But you can do this yourself by converting two strings into two NUMBERS,
|
||||
and then using the qqtoc routine.
|
||||
|
||||
COMPLEX values are always returned from these routines. To split out the
|
||||
COMPLEX values are always returned from these routines. To split out the
|
||||
real and imaginary parts into normal NUMBERs, you can simply qlink the
|
||||
two components, as shown in the following example:
|
||||
|
||||
COMPLEX *c;
|
||||
NUMBER *rp, *ip;
|
||||
COMPLEX *c;
|
||||
NUMBER *rp, *ip;
|
||||
|
||||
c = calloc();
|
||||
rp = qlink(c->real);
|
||||
ip = qlink(c->imag);
|
||||
c = calloc();
|
||||
rp = qlink(c->real);
|
||||
ip = qlink(c->imag);
|
||||
|
||||
There are many macros for checking quick things about complex numbers,
|
||||
similar to the ZVALUE and NUMBER macros. In addition, there are some
|
||||
only used for complex numbers. Examples of macros are:
|
||||
only used for complex numbers. Examples of macros are:
|
||||
|
||||
cisreal(c) (number is real)
|
||||
cisimag(c) (number is pure imaginary)
|
||||
ciszero(c) (number is zero)
|
||||
cisnegone(c) (number is -1)
|
||||
cisone(c) (number is 1)
|
||||
cisrunit(c) (number is 1 or -1)
|
||||
cisiunit(c) (number is i or -i)
|
||||
cisunit(c) (number is 1, -1, i, or -i)
|
||||
cistwo(c) (number is 2)
|
||||
cisint(c) (number is has integer real and imaginary parts)
|
||||
ciseven(c) (number is has even real and imaginary parts)
|
||||
cisodd(c) (number is has odd real and imaginary parts)
|
||||
cisreal(c) (number is real)
|
||||
cisimag(c) (number is pure imaginary)
|
||||
ciszero(c) (number is zero)
|
||||
cisnegone(c) (number is -1)
|
||||
cisone(c) (number is 1)
|
||||
cisrunit(c) (number is 1 or -1)
|
||||
cisiunit(c) (number is i or -i)
|
||||
cisunit(c) (number is 1, -1, i, or -i)
|
||||
cistwo(c) (number is 2)
|
||||
cisint(c) (number is has integer real and imaginary parts)
|
||||
ciseven(c) (number is has even real and imaginary parts)
|
||||
cisodd(c) (number is has odd real and imaginary parts)
|
||||
|
||||
There is only one comparison you can make for COMPLEX values, and that is
|
||||
for equality. The ccmp function returns true if two complex numbers differ.
|
||||
@@ -641,13 +641,13 @@ That is, the imaginary part of the COMPLEX is 0. You may convert the
|
||||
COMPLEX into a new allocated NUMBER that is real part of the COMPLEX value.
|
||||
For example:
|
||||
|
||||
COMPLEX *c;
|
||||
NUMBER *q;
|
||||
bool ok_to_free; /* true ==> free COMPLEX value, false ==> do not */
|
||||
COMPLEX *c;
|
||||
NUMBER *q;
|
||||
bool ok_to_free; /* true ==> free COMPLEX value, false ==> do not */
|
||||
|
||||
if (cisreal(c)) {
|
||||
q = c_to_q(c, ok_to_free);
|
||||
}
|
||||
if (cisreal(c)) {
|
||||
q = c_to_q(c, ok_to_free);
|
||||
}
|
||||
|
||||
The 2nd argument to c_to_q() determines if the complex argument should be freed
|
||||
or not. Pass a false value as the 2nd arg if you wish to continue to use the
|
||||
@@ -655,13 +655,13 @@ COMPLEX value.
|
||||
|
||||
To convert a NUMBER into a COMPLEX value, use:
|
||||
|
||||
COMPLEX *c;
|
||||
NUMBER *q;
|
||||
COMPLEX *c;
|
||||
NUMBER *q;
|
||||
|
||||
c = q_to_c(q);
|
||||
c = q_to_c(q);
|
||||
|
||||
There are three predefined values for complex numbers. You should clink
|
||||
them when you want to use them. They are _czero_, _cone_, and _conei_.
|
||||
There are three predefined values for complex numbers. You should clink
|
||||
them when you want to use them. They are _czero_, _cone_, and _conei_.
|
||||
These have the values 0, 1, and i.
|
||||
|
||||
----------------
|
||||
@@ -683,7 +683,7 @@ need call libcalc_call_me_last() only once.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -691,8 +691,8 @@ need call libcalc_call_me_last() only once.
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1993/07/30 19:44:49
|
||||
## File existed as early as: 1993
|
||||
## Under source code control: 1993/07/30 19:44:49
|
||||
## File existed as early as: 1993
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
110
Makefile.config
110
Makefile.config
@@ -2,7 +2,7 @@
|
||||
#
|
||||
# Makefile.config - Calc configuration and compile configuration values
|
||||
#
|
||||
# Copyright (C) 2023 Landon Curt Noll
|
||||
# Copyright (C) 2023,2025 Landon Curt Noll
|
||||
#
|
||||
# Suggestion: Read the HOWTO.INSTALL file.
|
||||
#
|
||||
@@ -436,18 +436,6 @@ HAVE_ARC4RANDOM=
|
||||
HAVE_NEWSTR=
|
||||
#HAVE_NEWSTR= -DHAVE_NO_NEWSTR
|
||||
|
||||
# Determine if we have memmove()
|
||||
#
|
||||
# If HAVE_MEMMOVE is empty, this Makefile will run the have_memmv program
|
||||
# to determine if memmove() is supported. If HAVE_MEMMOVE is set to
|
||||
# -DHAVE_NO_MEMMOVE, then calc will use internal functions to simulate
|
||||
# the memory move function that does correct overlapping memory moves.
|
||||
#
|
||||
# If in doubt, leave HAVE_MEMMOVE empty and this Makefile will figure it out.
|
||||
#
|
||||
HAVE_MEMMOVE=
|
||||
#HAVE_MEMMOVE= -DHAVE_NO_MEMMOVE
|
||||
|
||||
# Determine if we have ustat()
|
||||
#
|
||||
# If HAVE_USTAT is empty, this Makefile will run the have_ustat program
|
||||
@@ -852,12 +840,21 @@ endif # ($(target),Darwin)
|
||||
# BINDIR= /usr/bin
|
||||
# LIBDIR= /usr/lib
|
||||
# CALC_SHAREDIR= /usr/share/calc
|
||||
# CALC_INCDIR= /usr/include/calc
|
||||
#
|
||||
# Or if you prefer everything under /usr/local:
|
||||
#
|
||||
# BINDIR= /usr/local/bin
|
||||
# LIBDIR= /usr/local/lib
|
||||
# CALC_SHAREDIR= /usr/local/share/calc
|
||||
# CALC_INCDIR= /usr/local/include/calc
|
||||
#
|
||||
# However, if you are on macOS then set:
|
||||
#
|
||||
# BINDIR= ${PREFIX}/bin
|
||||
# LIBDIR= ${PREFIX}/lib
|
||||
# CALC_SHAREDIR= ${PREFIX}/share/calc
|
||||
# CALC_INCDIR= ${PREFIX}/include/calc
|
||||
#
|
||||
# NOTE: Starting with macOS El Capitan OS X 10.11, root by default
|
||||
# could not mkdir under system locations, so macOS must now
|
||||
@@ -988,9 +985,6 @@ endif # ($(target),Darwin)
|
||||
#
|
||||
# Use CATDIR= to disable installation of the calc cat (formatted) page.
|
||||
#
|
||||
# NOTE: If CATDIR is non-empty, then one should have either the
|
||||
# ${NROFF} executable and/or the ${MANMAKE} executable.
|
||||
#
|
||||
CATDIR=
|
||||
#CATDIR= ${PREFIX}/man/cat1
|
||||
#CATDIR= ${PREFIX}/catman/cat1
|
||||
@@ -1017,36 +1011,6 @@ CATEXT= 1
|
||||
#CATEXT= 0
|
||||
#CATEXT= l
|
||||
|
||||
# how to format a man page
|
||||
#
|
||||
# If CATDIR is non-empty, then
|
||||
#
|
||||
# If NROFF is non-empty, then
|
||||
#
|
||||
# ${NROFF} ${NROFF_ARG} calc.1 > ${CATDIR}/calc.${CATEXT}
|
||||
# is used to build and install the cat page
|
||||
#
|
||||
# else (NROFF is empty)
|
||||
#
|
||||
# ${MANMAKE} calc.1 ${CATDIR}
|
||||
# is used to build and install the cat page
|
||||
# else
|
||||
#
|
||||
# The cat page is not built or installed
|
||||
#
|
||||
# If in doubt and you don't want to fool with man pages, set MANDIR
|
||||
# and CATDIR to empty and ignore the NROFF, NROFF_ARG and MANMAKE
|
||||
# lines below.
|
||||
#
|
||||
#NROFF= nroff
|
||||
NROFF=
|
||||
#NROFF= groff
|
||||
NROFF_ARG= -man
|
||||
#NROFF_ARG= -mandoc
|
||||
MANMAKE= ${PREFIX}/bin/manmake
|
||||
#MANMAKE= manmake
|
||||
MANMODE= 0444
|
||||
CATMODE= 0444
|
||||
|
||||
# By default, custom builtin functions may only be executed if calc
|
||||
# is given the -C option. This is because custom builtin functions
|
||||
@@ -1136,6 +1100,9 @@ READLINE_EXTRAS= -lhistory -lncurses
|
||||
#READLINE_LIB= -L${PREFIX}/lib -lreadline
|
||||
#READLINE_EXTRAS= -lhistory -lncurses
|
||||
#
|
||||
#READLINE_LIB= -L/opt/local/lib -lreadline
|
||||
#READLINE_EXTRAS= -lhistory -lncurses
|
||||
#
|
||||
# For Apple OS X: install fink from http://fink.sourceforge.net
|
||||
# and then do a 'fink install readline' and then use:
|
||||
#
|
||||
@@ -1154,6 +1121,7 @@ READLINE_EXTRAS= -lhistory -lncurses
|
||||
READLINE_INCLUDE=
|
||||
#READLINE_INCLUDE= -I/usr/gnu/include
|
||||
#READLINE_INCLUDE= -I${PREFIX}/include
|
||||
#READLINE_INCLUDE= -I/opt/local/include
|
||||
|
||||
# Handle the case where macOS is being used with HomeBrew
|
||||
# # and using the readline, history, and ncurses libraries.
|
||||
@@ -1161,6 +1129,16 @@ READLINE_INCLUDE=
|
||||
ifneq ($(HOMEBREW_PREFIX),)
|
||||
READLINE_LIB:= -L${HOMEBREW_PREFIX}/opt/readline/lib -lreadline
|
||||
READLINE_INCLUDE:= -I${HOMEBREW_PREFIX}/opt/readline/include
|
||||
|
||||
# If not HomeBrew, then try to detect macports and/or using /opt/local/{lib,include}
|
||||
#
|
||||
else # perhaps macports and/or using /opt/local/{lib,include} ?
|
||||
ifneq ($(wildcard /opt/local/lib/*),)
|
||||
READLINE_LIB:= -L/opt/local/lib -lreadline
|
||||
endif
|
||||
ifneq ($(wildcard /opt/local/incliude/*),)
|
||||
READLINE_INCLUDE:= -I/opt/local/include
|
||||
endif
|
||||
endif # ($(HOMEBREW_PREFIX),)
|
||||
|
||||
# If $PAGER is not set, use this program to display a help file
|
||||
@@ -1267,11 +1245,11 @@ EXT=
|
||||
|
||||
# The calc version in the form of x.y.z.w
|
||||
#
|
||||
VERSION= 2.15.0.0
|
||||
VERSION= 2.16.0.0
|
||||
|
||||
# The calc major version in the form of x.y.z
|
||||
#
|
||||
VER= 2.15.0
|
||||
VER= 2.16.0
|
||||
|
||||
# Names of shared libraries with versions
|
||||
#
|
||||
@@ -1287,13 +1265,13 @@ CAT= cat
|
||||
CHMOD= chmod
|
||||
CMP= cmp
|
||||
CO= co
|
||||
COL= col
|
||||
CP= cp
|
||||
CTAGS= ctags
|
||||
DATE= date
|
||||
DIFF= diff
|
||||
FMT= fmt
|
||||
GREP= grep
|
||||
GZIP= gzip
|
||||
HOSTNAME= hostname
|
||||
LANG= C
|
||||
LDCONFIG= ldconfig
|
||||
@@ -1301,6 +1279,7 @@ LN= ln
|
||||
LS= ls
|
||||
MAKE= make
|
||||
MAKEDEPEND= makedepend
|
||||
MAN= man
|
||||
MKDIR= mkdir
|
||||
MV= mv
|
||||
PWDCMD= pwd
|
||||
@@ -1312,8 +1291,8 @@ SORT= sort
|
||||
SPLINT= splint
|
||||
SPLINT_OPTS=
|
||||
STRIP= strip
|
||||
TEE= tee
|
||||
TAIL= tail
|
||||
TEE= tee
|
||||
TOUCH= touch
|
||||
TRUE= true
|
||||
UNAME= uname
|
||||
@@ -1373,3 +1352,34 @@ endif # ($(ALLOW_CUSTOM),-DCUSTOM)
|
||||
# intermediate and final calc and calc related programs
|
||||
#
|
||||
COMMON_LDFLAGS= ${EXTRA_LDFLAGS}
|
||||
|
||||
# Common Address Sanitizer (ASAN)
|
||||
#
|
||||
# For more info see: https://github.com/google/sanitizers/wiki/AddressSanitizer
|
||||
# See also: https://developer.apple.com/documentation/xcode/diagnosing-memory-thread-and-crash-issues-early
|
||||
#
|
||||
# The following Address Sanitizer (ASAN) are common to both RHEL9.2 (Linux) and macOS 14.0.
|
||||
#
|
||||
# By default, the Address Sanitizer is NOT enabled, not compiled into calc.
|
||||
# To enable the Address Sanitizer, uncomment the appropriate lines in Makefile.local !!!
|
||||
#
|
||||
FSANITIZE:= -Wno-invalid-command-line-argument
|
||||
FSANITIZE+= -fsanitize=address
|
||||
FSANITIZE+= -fsanitize=alignment
|
||||
FSANITIZE+= -fsanitize=bool
|
||||
FSANITIZE+= -fsanitize=enum
|
||||
FSANITIZE+= -fsanitize=vptr
|
||||
FSANITIZE+= -fsanitize=integer-divide-by-zero
|
||||
FSANITIZE+= -fsanitize=float-divide-by-zero
|
||||
FSANITIZE+= -fsanitize=float-cast-overflow
|
||||
FSANITIZE+= -fsanitize=nonnull-attribute
|
||||
FSANITIZE+= -fsanitize=returns-nonnull-attribute
|
||||
FSANITIZE+= -fsanitize=null
|
||||
FSANITIZE+= -fsanitize=object-size
|
||||
FSANITIZE+= -fsanitize=shift
|
||||
FSANITIZE+= -fsanitize=signed-integer-overflow
|
||||
FSANITIZE+= -fsanitize=undefined
|
||||
FSANITIZE+= -fsanitize=unreachable
|
||||
FSANITIZE+= -fsanitize=vla-bound
|
||||
FSANITIZE+= -fno-omit-frame-pointer
|
||||
FSANITIZE+= -fno-common
|
||||
|
||||
@@ -50,64 +50,51 @@
|
||||
###################################################################
|
||||
|
||||
####
|
||||
# RHEL Diagnosing memory, thread, and crash issues:
|
||||
# Force calc to install under /usr/local
|
||||
#
|
||||
# For more info see: https://github.com/google/sanitizers/wiki/AddressSanitizer
|
||||
#
|
||||
# This comment block was tested under:
|
||||
#
|
||||
# RHEL9 gcc version 11.3.1 20221121 (Red Hat 11.3.1-4) (GCC)
|
||||
#
|
||||
# with:
|
||||
#
|
||||
# libasan-11.3.1-4.3.el9.x86_64 libubsan-11.3.1-4.3.el9.x86_64
|
||||
#
|
||||
# NOTE: With the above version, these are NOT supported:
|
||||
#
|
||||
# UNSUPPORTED_FSANITIZE:= -fsanitize=nullability-arg -fsanitize=nullability-assign
|
||||
#
|
||||
# Uncomment these lines:
|
||||
#
|
||||
# FSANITIZE:= -fsanitize=undefined -fsanitize=address -fsanitize=bool -fsanitize=bounds
|
||||
# FSANITIZE+= -fsanitize=enum -fsanitize=vptr -fsanitize=integer-divide-by-zero
|
||||
# FSANITIZE+= -fsanitize=float-divide-by-zero -fsanitize=float-cast-overflow
|
||||
# FSANITIZE+= -fsanitize=nonnull-attribute -fsanitize=returns-nonnull-attribute
|
||||
# FSANITIZE+= -fsanitize=null -fsanitize=shift -fsanitize=signed-integer-overflow
|
||||
# FSANITIZE+= -fsanitize=unreachable -fsanitize=vla-bound
|
||||
# CFLAGS+= -Wno-invalid-command-line-argument ${FSANITIZE} -fno-omit-frame-pointer
|
||||
# LDFLAGS+= -Wno-invalid-command-line-argument ${FSANITIZE} -fno-omit-frame-pointer
|
||||
# CALC_ENV+= ASAN_OPTIONS=detect_stack_use_after_return=1
|
||||
# DEBUG:= -O0 -g
|
||||
# PREFIX:= /usr/local
|
||||
# BINDIR:= ${PREFIX}/bin
|
||||
# LIBDIR:= ${PREFIX}/lib
|
||||
# CALC_SHAREDIR:= ${PREFIX}/share/calc
|
||||
# CALC_INCDIR:= ${PREFIX}/include/calc
|
||||
####
|
||||
|
||||
####
|
||||
# macOS Diagnosing memory, thread, and crash issues:
|
||||
#
|
||||
# For more info see: https://github.com/google/sanitizers/wiki/AddressSanitizer
|
||||
# macOS Address Sanitizer (ASAN)
|
||||
#
|
||||
# This comment block was tested under:
|
||||
#
|
||||
# macOS 13.5 with clang version 14.0.3 (clang-1403.0.22.14.1)
|
||||
# macOS 14.0 with Apple clang version 15.0.0 (clang-1500.0.40.1) for arm64
|
||||
#
|
||||
# For more info for clang to Diagnosing memory, thread, and crash issues early, see:
|
||||
# See the FSANITIZE comment block in Makefile.config for common FSANITIZE values and more info.
|
||||
#
|
||||
# https://developer.apple.com/documentation/xcode/diagnosing-memory-thread-and-crash-issues-early
|
||||
# To use the Address Sanitizer, uncomment this set set of lines and recompile (make clobber all):
|
||||
#
|
||||
# NOTE: With the above version, these are NOT supported:
|
||||
#
|
||||
# UNSUPPORTED_FSANITIZE:= -fsanitize-nullability-return
|
||||
#
|
||||
# Uncomment these lines:
|
||||
#
|
||||
# FSANITIZE:= -fsanitize=undefined -fsanitize=address -fsanitize=bool -fsanitize=bounds
|
||||
# FSANITIZE+= -fsanitize=enum -fsanitize=vptr -fsanitize=integer-divide-by-zero
|
||||
# FSANITIZE+= -fsanitize=float-divide-by-zero -fsanitize=float-cast-overflow
|
||||
# FSANITIZE+= -fsanitize=nonnull-attribute -fsanitize=nullability-arg
|
||||
# FSANITIZE+= -fsanitize=nullability-assign -fsanitize=returns-nonnull-attribute
|
||||
# FSANITIZE+= -fsanitize=null -fsanitize=object-size -fsanitize=shift
|
||||
# FSANITIZE+= -fsanitize=signed-integer-overflow -fsanitize=unreachable -fsanitize=vla-bound
|
||||
# CFLAGS+= -Wno-invalid-command-line-argument ${FSANITIZE} -fno-omit-frame-pointer
|
||||
# LDFLAGS+= -Wno-invalid-command-line-argument ${FSANITIZE} -fno-omit-frame-pointer
|
||||
# CALC_ENV+= ASAN_OPTIONS=detect_stack_use_after_return=1
|
||||
# FSANITIZE+= -fsanitize=nullability-arg
|
||||
# FSANITIZE+= -fsanitize=nullability-assign
|
||||
# FSANITIZE+= -fsanitize=nullability-return
|
||||
# CFLAGS+= ${FSANITIZE}
|
||||
# LDFLAGS+= ${FSANITIZE}
|
||||
# DEBUG:= -O0 -g3
|
||||
####
|
||||
|
||||
####
|
||||
# RHEL (Linux) Address Sanitizer (ASAN)
|
||||
#
|
||||
# This comment block was tested under:
|
||||
#
|
||||
# RHEL9.2 with clang version 15.0.7 (Red Hat 15.0.7-2.el9) for x86_64
|
||||
#
|
||||
# with these RPMs installed:
|
||||
#
|
||||
# libasan-11.3.1-4.3.el9.x86_64 libubsan-11.3.1-4.3.el9.x86_64
|
||||
#
|
||||
# See the FSANITIZE comment block in Makefile.config for common FSANITIZE values and more info.
|
||||
#
|
||||
# To use the Address Sanitizer, uncomment this set set of lines and recompile (make clobber all):
|
||||
#
|
||||
# FSANITIZE+= -fsanitize=bounds
|
||||
# CFLAGS+= ${FSANITIZE}
|
||||
# LDFLAGS+= ${FSANITIZE}
|
||||
# DEBUG:= -O0 -g3
|
||||
###
|
||||
|
||||
12
QUESTIONS
12
QUESTIONS
@@ -1,7 +1,7 @@
|
||||
If you have a general question about calc, consider opening
|
||||
a new Github discussion under:
|
||||
|
||||
https://github.com/lcn2/calc/discussions
|
||||
https://github.com/lcn2/calc/discussions
|
||||
|
||||
Look over the existing discussions to see of your question fits
|
||||
under one of those exiting discussions.
|
||||
@@ -30,7 +30,7 @@ Please be patient as we cannot always respond to discussion messages quickly.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -38,8 +38,8 @@ Please be patient as we cannot always respond to discussion messages quickly.
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 2021/02/10 00:15:05
|
||||
## File existed as early as: 2021
|
||||
## Under source code control: 2021/02/10 00:15:05
|
||||
## File existed as early as: 2021
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
14
README.FIRST
14
README.FIRST
@@ -4,7 +4,7 @@ See the HOWTO.INSTALL file for information on how to build and install calc.
|
||||
|
||||
To be sure that your version of calc is up to date, check out:
|
||||
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-download.html
|
||||
http://www.isthe.com/chongo/tech/comp/calc/calc-download.html
|
||||
|
||||
We are interested in any/all feedback on recent versions of calc.
|
||||
In particular we would like to hear about:
|
||||
@@ -27,7 +27,7 @@ If you run into problems, see the BUGS file.
|
||||
Calc is distributed with an extensive collection of help files that
|
||||
are accessible from the command line. The following assume that you
|
||||
are running calc from the distribution directory or that you have
|
||||
installed calc. In these examples, the "; " is the calc prompt, not
|
||||
installed calc. In these examples, the "; " is the calc prompt, not
|
||||
something that you type in.
|
||||
|
||||
For list of help topics:
|
||||
@@ -105,7 +105,7 @@ for information about how to ask a question.
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -113,8 +113,8 @@ for information about how to ask a question.
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1995/10/25 05:27:59
|
||||
## File existed as early as: 1995
|
||||
## Under source code control: 1995/10/25 05:27:59
|
||||
## File existed as early as: 1995
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
126
README.RELEASE
126
README.RELEASE
@@ -2,15 +2,15 @@ On calc versions and releases
|
||||
|
||||
Calc version numbers have 4 levels. For example:
|
||||
|
||||
++=== top 2 levels: calc builtin functions compatibility
|
||||
||
|
||||
vvvv
|
||||
++=== top 2 levels: calc builtin functions compatibility
|
||||
||
|
||||
vvvv
|
||||
|
||||
2.14.0.8
|
||||
\\\\\\
|
||||
^ \\\\----> top 3 levels: calc important code base change
|
||||
|
|
||||
+--- top version level: internal representation compatibility
|
||||
2.14.0.8
|
||||
\\\\\\
|
||||
^ \\\\----> top 3 levels: calc important code base change
|
||||
|
|
||||
+--- top version level: internal representation compatibility
|
||||
|
||||
The top version level (e.g., 2) refers to the internal representation
|
||||
of values. Any library or hardware linked/built for calc 2 will be able
|
||||
@@ -35,10 +35,10 @@ a top 3 level release.
|
||||
|
||||
The file, "version.h" defines the 4 version levels:
|
||||
|
||||
MAJOR_VER /* level 1: major library version */
|
||||
MINOR_VER /* level 2: minor library version */
|
||||
MAJOR_PATCH /* level 3: major software version level */
|
||||
MINOR_PATCH /* level 4: minor software version level */
|
||||
MAJOR_VER /* level 1: major library version */
|
||||
MINOR_VER /* level 2: minor library version */
|
||||
MAJOR_PATCH /* level 3: major software version level */
|
||||
MINOR_PATCH /* level 4: minor software version level */
|
||||
|
||||
|
||||
The program "ver_calc" will print information about the compiled
|
||||
@@ -46,8 +46,8 @@ calc version as defined "version.h" when "ver_calc" was compiled:
|
||||
|
||||
usage: ./ver_calc [-h] [-V]
|
||||
|
||||
-h print this message and exit non-zero
|
||||
-V print 3-level version (def: print 4-level version)
|
||||
-h print this message and exit non-zero
|
||||
-V print 3-level version (def: print 4-level version)
|
||||
|
||||
Also "calc -v" will print the calc version as defined "version.h" when
|
||||
"calc" was compiled.
|
||||
@@ -56,7 +56,7 @@ The master branch:
|
||||
|
||||
The public repository of calc source code is:
|
||||
|
||||
http://github.com/lcn2/calc
|
||||
http://github.com/lcn2/calc
|
||||
|
||||
On that GitHub site you may find released version of calc,
|
||||
"production", "tested" and "alpha". All commits on the master
|
||||
@@ -65,66 +65,66 @@ The master branch:
|
||||
Any "alpha" commit is likely future code for a future
|
||||
"tested" or "production" version of calc.
|
||||
|
||||
alpha ==> untagged GitHub commit
|
||||
alpha ==> untagged GitHub commit
|
||||
|
||||
Any untagged commit to the GitHub master branch should be
|
||||
considered as alpha code that may make calc unstable.
|
||||
Any untagged commit to the GitHub master branch should be
|
||||
considered as alpha code that may make calc unstable.
|
||||
|
||||
While we try to avoid breaking the calc code with commits,
|
||||
there is a risk that picking up such a change could
|
||||
negatively impact the code.
|
||||
While we try to avoid breaking the calc code with commits,
|
||||
there is a risk that picking up such a change could
|
||||
negatively impact the code.
|
||||
|
||||
NOTE: The calc version found in "version.h", and printed
|
||||
by both "ver_calc [-V]" and "calc -v" for an untagged
|
||||
commit is the previous "tested" or "production" version
|
||||
of calc. Any "alpha" changes that remain are code
|
||||
for some future version of calc.
|
||||
NOTE: The calc version found in "version.h", and printed
|
||||
by both "ver_calc [-V]" and "calc -v" for an untagged
|
||||
commit is the previous "tested" or "production" version
|
||||
of calc. Any "alpha" changes that remain are code
|
||||
for some future version of calc.
|
||||
|
||||
At the last stage of the release process, "version.h"
|
||||
will be updated as well as the top level version range
|
||||
listed in "CHANGES".
|
||||
At the last stage of the release process, "version.h"
|
||||
will be updated as well as the top level version range
|
||||
listed in "CHANGES".
|
||||
|
||||
tested ==> tagged GitHub pre-release commit
|
||||
tested ==> tagged GitHub pre-release commit
|
||||
|
||||
A new version of calc has been released and has recently passed
|
||||
regression testing on at least to different platforms and chip
|
||||
architectures.
|
||||
A new version of calc has been released and has recently passed
|
||||
regression testing on at least to different platforms and chip
|
||||
architectures.
|
||||
|
||||
The "tested" class was historically called "untested",
|
||||
however this term was misleading as such releases ARE tested.
|
||||
Since 2.14.0.13 we have used the term "tested".
|
||||
The "tested" class was historically called "untested",
|
||||
however this term was misleading as such releases ARE tested.
|
||||
Since 2.14.0.13 we have used the term "tested".
|
||||
|
||||
All tested releases are tagged with a new version number.
|
||||
Such releases have GitHub assets such as a source tarball,
|
||||
zip file, source rpm, development rpm and binary rpm. See the
|
||||
orange "Pre-release" GitHub releases under:
|
||||
All tested releases are tagged with a new version number.
|
||||
Such releases have GitHub assets such as a source tarball,
|
||||
zip file, source rpm, development rpm and binary rpm. See the
|
||||
orange "Pre-release" GitHub releases under:
|
||||
|
||||
https://github.com/lcn2/calc/releases
|
||||
https://github.com/lcn2/calc/releases
|
||||
|
||||
At the bottom of a given release is a "> Assets" that may
|
||||
be opened to reveal down-loadable files.
|
||||
At the bottom of a given release is a "> Assets" that may
|
||||
be opened to reveal down-loadable files.
|
||||
|
||||
production ==> tagged GitHub release commit
|
||||
production ==> tagged GitHub release commit
|
||||
|
||||
A new version of calc has been released and has undergone
|
||||
extensive testing over time over a number of platforms.
|
||||
Sometimes a "tested" release that is found work well over
|
||||
a period of time will be re-released with a new version
|
||||
number as a "production" release.
|
||||
A new version of calc has been released and has undergone
|
||||
extensive testing over time over a number of platforms.
|
||||
Sometimes a "tested" release that is found work well over
|
||||
a period of time will be re-released with a new version
|
||||
number as a "production" release.
|
||||
|
||||
The latest production GitHub release is marked with green
|
||||
"Latest" label under:
|
||||
The latest production GitHub release is marked with green
|
||||
"Latest" label under:
|
||||
|
||||
https://github.com/lcn2/calc/releases
|
||||
https://github.com/lcn2/calc/releases
|
||||
|
||||
A release that has neither an orange "Pre-release" nor
|
||||
a green "Latest" label is a prior production class release.
|
||||
A release that has neither an orange "Pre-release" nor
|
||||
a green "Latest" label is a prior production class release.
|
||||
|
||||
At the bottom of a given release is a "> Assets" that may
|
||||
be opened to reveal down-loadable files.
|
||||
At the bottom of a given release is a "> Assets" that may
|
||||
be opened to reveal down-loadable files.
|
||||
|
||||
Production class code where stability is critical should use a
|
||||
"production" release.
|
||||
Production class code where stability is critical should use a
|
||||
"production" release.
|
||||
|
||||
A historical note and apology:
|
||||
|
||||
@@ -143,7 +143,7 @@ A historical note and apology:
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -151,8 +151,8 @@ A historical note and apology:
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 2021/12/12 19:36:26
|
||||
## File existed as early as: 2021
|
||||
## Under source code control: 2021/12/12 19:36:26
|
||||
## File existed as early as: 2021
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
@@ -23,7 +23,7 @@ BTW: While we are unable to use Windows 11, we welcome Windows 11
|
||||
virtual machine). If you are able to compile Windows 11 natively,
|
||||
we would welcome GitHub pull requests showing any needed modifications:
|
||||
|
||||
https://github.com/lcn2/calc/pulls
|
||||
https://github.com/lcn2/calc/pulls
|
||||
|
||||
We were given this advice from a Windows 11 developer:
|
||||
|
||||
@@ -32,9 +32,9 @@ We were given this advice from a Windows 11 developer:
|
||||
https://cygwin.com/install.html
|
||||
|
||||
IMPORTANT: While installing Cygwin, and during Cygwin Setup, be sure to
|
||||
select all the MinGW64 packages relating to gcc.
|
||||
select all the MinGW64 packages relating to gcc.
|
||||
|
||||
See the "Compiling with Cygwin" section below.
|
||||
See the "Compiling with Cygwin" section below.
|
||||
|
||||
NOTE: Compiling calc under Windows 11 is work in progress. If you run into
|
||||
problems, consider the "Compiling with Cygwin" section below.
|
||||
@@ -79,11 +79,11 @@ compilation steps that GitHub user @Leoongithub recommends:
|
||||
0. Install the latest version of cygwin (https://cygwin.com/install.html).
|
||||
|
||||
NOTE: In addition to the default packages, you also need to check these
|
||||
three packages: gcc-core, make, and libreadline-devel. The version
|
||||
of these packages does not matter. Just choose the latest version.
|
||||
three packages: gcc-core, make, and libreadline-devel. The version
|
||||
of these packages does not matter. Just choose the latest version.
|
||||
|
||||
NOTE: The addition of "target=Cygwin" to make commands below
|
||||
is done just in case the target is not set properly by make.
|
||||
is done just in case the target is not set properly by make.
|
||||
|
||||
1. Change (cd) into the top of the source code directory of calc.
|
||||
|
||||
@@ -92,35 +92,35 @@ compilation steps that GitHub user @Leoongithub recommends:
|
||||
2. make clobber target=Cygwin
|
||||
|
||||
NOTE: This helps ensure that you are starting from a so-called "clean slate",
|
||||
and that you have nothing hanging around from previous attempts to compile.
|
||||
and that you have nothing hanging around from previous attempts to compile.
|
||||
|
||||
3. make all target=Cygwin
|
||||
|
||||
NOTE: If successful, you should have a calc executable. However that executable
|
||||
may not be working properly. Advance to step (4) to test.
|
||||
may not be working properly. Advance to step (4) to test.
|
||||
|
||||
4. make chk target=Cygwin
|
||||
|
||||
NOTE: If you want this command be be verbose, try:
|
||||
|
||||
make check target=Cygwin
|
||||
make check target=Cygwin
|
||||
|
||||
NOTE: This will run calc with the regress.cal regression suite. This step could take
|
||||
for a while to run, depending on the speed/performance of your machine.
|
||||
If all is well (all regression tests pass), you will see at the end:
|
||||
for a while to run, depending on the speed/performance of your machine.
|
||||
If all is well (all regression tests pass), you will see at the end:
|
||||
|
||||
chk OK
|
||||
chk OK
|
||||
|
||||
Otherwise you may see calc exit non-zero after it prints some lines with '****'
|
||||
error messages followed by a line including a final error count of the form:
|
||||
error messages followed by a line including a final error count of the form:
|
||||
|
||||
**** 2 error(s) found \/++\/
|
||||
**** 2 error(s) found \/++\/
|
||||
|
||||
If you see some errors that may relate to files and I/O, all may not be lost.
|
||||
It could simply mean that your Windows environment is not conforming to standard
|
||||
I/O and file operations. The calc mathematical engine may be just fine. On the
|
||||
other hand if you see mathematical related regression test failures, this is
|
||||
bad sign that your calc executable under Windows is not usable.
|
||||
It could simply mean that your Windows environment is not conforming to standard
|
||||
I/O and file operations. The calc mathematical engine may be just fine. On the
|
||||
other hand if you see mathematical related regression test failures, this is
|
||||
bad sign that your calc executable under Windows is not usable.
|
||||
|
||||
5. make install target=Cygwin
|
||||
|
||||
@@ -136,7 +136,7 @@ We would prefer a Windows 11 solution that does not require a Windows 11
|
||||
developer to install a Linux virtual machine. Nevertheless, a Windows 11
|
||||
user might want to use the Microsoft Windows Subsystem (WSL) for Linux:
|
||||
|
||||
https://docs.microsoft.com/en-us/windows/wsl/
|
||||
https://docs.microsoft.com/en-us/windows/wsl/
|
||||
|
||||
We have been told that you will need to turn on virtualization
|
||||
to use this WSL subsystem.
|
||||
@@ -168,7 +168,7 @@ NOTE: The use of calc under Windows 10 has been deprecated in favor of one
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -176,8 +176,8 @@ NOTE: The use of calc under Windows 10 has been deprecated in favor of one
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 2001/02/25 14:00:05
|
||||
## File existed as early as: 2001
|
||||
## Under source code control: 2001/02/25 14:00:05
|
||||
## File existed as early as: 2001
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
19
README.md
19
README.md
@@ -8,7 +8,7 @@ on Debian: sudo apt install calc
|
||||
on RHEL: sudo dnf install calc
|
||||
on Ubuntu: sudo apt install calc
|
||||
via Termux: apt install calc
|
||||
via src: sudo make clobber all chk instsll
|
||||
via src: sudo make clobber all chk install
|
||||
```
|
||||
|
||||
## TL;DR Run calc
|
||||
@@ -24,7 +24,7 @@ via zsh: calc
|
||||
|
||||
Calc is an interactive calculator which provides for easy large
|
||||
numeric calculations, but which also can be easily programmed
|
||||
for difficult or long calculations. It can accept a command line
|
||||
for difficult or long calculations. It can accept a command line
|
||||
argument, in which case it executes that single command and exits.
|
||||
Otherwise, it enters interactive mode. In this mode, it accepts
|
||||
commands one at a time, processes them, and displays the answers.
|
||||
@@ -189,12 +189,12 @@ followed by a function declaration very similar to C.
|
||||
```sh
|
||||
define f2(n)
|
||||
{
|
||||
local ans;
|
||||
local ans;
|
||||
|
||||
ans = 1;
|
||||
while (n > 1)
|
||||
ans *= (n -= 2);
|
||||
return ans;
|
||||
ans = 1;
|
||||
while (n > 1)
|
||||
ans *= (n -= 2);
|
||||
return ans;
|
||||
}
|
||||
```
|
||||
|
||||
@@ -283,3 +283,8 @@ help unexpected
|
||||
|
||||
It contains information about differences between C and calc
|
||||
that may surprise C programmers.
|
||||
|
||||
|
||||
# Reporting Security Issues
|
||||
|
||||
To report a security issue, please visit "[Reporting Security Issues](https://github.com/lcn2/calc/security/policy)".
|
||||
|
||||
22
SECURITY.md
22
SECURITY.md
@@ -1,4 +1,16 @@
|
||||
# Security Policy
|
||||
# Reporting Security Issues
|
||||
|
||||
We take security bugs seriously. We appreciate your efforts to responsibly
|
||||
disclose your findings, and will make every effort to acknowledge your
|
||||
contributions for any verified security issues when they have been fixed.
|
||||
|
||||
To report a security issue, click on: "[Open a draft security advisory](https://github.com/lcn2/calc/security/advisories/new)"
|
||||
|
||||
We will send a response indicating the next steps in handling your
|
||||
report. After the initial reply to your report, we will keep you informed
|
||||
of the progress towards a fix and full announcement, and may ask for
|
||||
additional information or guidance.
|
||||
|
||||
|
||||
## Supported Versions
|
||||
|
||||
@@ -9,11 +21,3 @@ If the most recent stable of calc is also supported with security updates.
|
||||
FYI: please review the BUGS file, or enter the calc command:
|
||||
|
||||
; help BUGS
|
||||
|
||||
## Reporting a Vulnerability
|
||||
|
||||
Please create a calc GitHub repo issue:
|
||||
|
||||
https://github.com/lcn2/calc/issues
|
||||
|
||||
Click on ((New issue)) and follow the issue template.
|
||||
|
||||
64
align32.c
64
align32.c
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/11/23 05:18:06
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/11/23 05:18:06
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -42,42 +42,42 @@
|
||||
#include "have_unused.h"
|
||||
|
||||
|
||||
#include "banned.h" /* include after system header <> includes */
|
||||
#include "banned.h" /* include after system header <> includes */
|
||||
|
||||
|
||||
static void buserr(int arg); /* catch alignment errors */
|
||||
static void buserr(int arg); /* catch alignment errors */
|
||||
|
||||
|
||||
int
|
||||
main(void)
|
||||
{
|
||||
char byte[2*sizeof(USB32)]; /* mis-alignment buffer */
|
||||
USB32 *p; /* mis-alignment pointer */
|
||||
unsigned long i;
|
||||
char byte[2*sizeof(USB32)]; /* mis-alignment buffer */
|
||||
USB32 *p; /* mis-alignment pointer */
|
||||
unsigned long i;
|
||||
|
||||
#if defined(MUST_ALIGN32)
|
||||
/* force alignment */
|
||||
printf("#define MUST_ALIGN32\t%c* forced to align 32 bit values *%c\n",
|
||||
'/', '/');
|
||||
/* force alignment */
|
||||
printf("#define MUST_ALIGN32\t%c* forced to align 32 bit values *%c\n",
|
||||
'/', '/');
|
||||
#else
|
||||
/* setup to catch alignment bus errors */
|
||||
signal(SIGBUS, buserr);
|
||||
signal(SIGSEGV, buserr); /* some systems will generate SEGV instead! */
|
||||
/* setup to catch alignment bus errors */
|
||||
signal(SIGBUS, buserr);
|
||||
signal(SIGSEGV, buserr); /* some systems will generate SEGV instead! */
|
||||
|
||||
/* mis-align our long fetches */
|
||||
for (i=0; i < sizeof(USB32); ++i) {
|
||||
p = (USB32 *)(byte+i);
|
||||
*p = i;
|
||||
*p += 1;
|
||||
}
|
||||
/* mis-align our long fetches */
|
||||
for (i=0; i < sizeof(USB32); ++i) {
|
||||
p = (USB32 *)(byte+i);
|
||||
*p = i;
|
||||
*p += 1;
|
||||
}
|
||||
|
||||
/* if we got here, then we can mis-align longs */
|
||||
printf("#undef MUST_ALIGN32\t%c* can mis-align 32 bit values *%c\n",
|
||||
'/', '/');
|
||||
/* if we got here, then we can mis-align longs */
|
||||
printf("#undef MUST_ALIGN32\t%c* can mis-align 32 bit values *%c\n",
|
||||
'/', '/');
|
||||
|
||||
#endif
|
||||
/* exit(0); */
|
||||
return 0;
|
||||
/* exit(0); */
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
@@ -85,14 +85,14 @@ main(void)
|
||||
* buserr - catch an alignment error
|
||||
*
|
||||
* given:
|
||||
* arg to keep ANSI C happy
|
||||
* arg to keep ANSI C happy
|
||||
*/
|
||||
/*ARGSUSED*/
|
||||
static void
|
||||
buserr(int UNUSED(arg))
|
||||
{
|
||||
/* alignment is required */
|
||||
printf("#define MUST_ALIGN32\t%c* must align 32 bit values *%c\n",
|
||||
'/', '/');
|
||||
exit(0);
|
||||
/* alignment is required */
|
||||
printf("#define MUST_ALIGN32\t%c* must align 32 bit values *%c\n",
|
||||
'/', '/');
|
||||
exit(0);
|
||||
}
|
||||
|
||||
29
alloc.h
29
alloc.h
@@ -1,7 +1,7 @@
|
||||
/*
|
||||
* alloc - storage allocation and storage debug macros
|
||||
*
|
||||
* Copyright (C) 1999-2007,2014 David I. Bell
|
||||
* Copyright (C) 1999-2007,2014,2025 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
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:48:29
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:48:29
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -28,14 +28,16 @@
|
||||
#define INCLUDE_ALLOC_H
|
||||
|
||||
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
# include "decl.h"
|
||||
# include "have_newstr.h"
|
||||
# include "have_string.h"
|
||||
# include "have_memmv.h"
|
||||
# include "have_const.h"
|
||||
#else
|
||||
# include <calc/decl.h>
|
||||
# include <calc/have_newstr.h>
|
||||
# include <calc/have_string.h>
|
||||
# include <calc/have_memmv.h>
|
||||
# include <calc/have_const.h>
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_STRING_H
|
||||
@@ -75,15 +77,4 @@ E_FUNC int strcmp();
|
||||
#define strchr(s, c) index(s, c)
|
||||
#endif /* HAVE_NEWSTR */
|
||||
|
||||
#if !defined(HAVE_MEMMOVE)
|
||||
# undef MEMMOVE_SIZE_T
|
||||
#if defined(FORCE_STDC) || \
|
||||
(defined(__STDC__) && __STDC__ != 0) || defined(__cplusplus)
|
||||
# define MEMMOVE_SIZE_T size_t
|
||||
# else
|
||||
# define MEMMOVE_SIZE_T long
|
||||
# endif
|
||||
E_FUNC void *memmove(void *s1, CONST void *s2, MEMMOVE_SIZE_T n);
|
||||
#endif
|
||||
|
||||
#endif /* !INCLUDE_ALLOC_H */
|
||||
|
||||
638
assocfunc.c
638
assocfunc.c
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1993/07/20 23:04:27
|
||||
* File existed as early as: 1993
|
||||
* Under source code control: 1993/07/20 23:04:27
|
||||
* File existed as early as: 1993
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -37,13 +37,13 @@
|
||||
|
||||
|
||||
#include "errtbl.h"
|
||||
#include "banned.h" /* include after system header <> includes */
|
||||
#include "banned.h" /* include after system header <> includes */
|
||||
|
||||
|
||||
#define MINHASHSIZE 31 /* minimum size of hash tables */
|
||||
#define GROWHASHSIZE 50 /* approximate growth for hash tables */
|
||||
#define CHAINLENGTH 10 /* desired number of elements on a hash chain */
|
||||
#define ELEMSIZE(n) (sizeof(ASSOCELEM) + (sizeof(VALUE) * ((n) - 1)))
|
||||
#define MINHASHSIZE 31 /* minimum size of hash tables */
|
||||
#define GROWHASHSIZE 50 /* approximate growth for hash tables */
|
||||
#define CHAINLENGTH 10 /* desired number of elements on a hash chain */
|
||||
#define ELEMSIZE(n) (sizeof(ASSOCELEM) + (sizeof(VALUE) * ((n) - 1)))
|
||||
|
||||
|
||||
S_FUNC ASSOCELEM *elemindex(ASSOC *ap, long index);
|
||||
@@ -59,75 +59,75 @@ S_FUNC void assoc_elemfree(ASSOCELEM *ep);
|
||||
* the index value doesn't exist, a pointer to a NULL value is returned.
|
||||
*
|
||||
* given:
|
||||
* ap association to index into
|
||||
* create whether to create the index value
|
||||
* dim dimension of the indexing
|
||||
* indices table of values being indexed by
|
||||
* ap association to index into
|
||||
* create whether to create the index value
|
||||
* dim dimension of the indexing
|
||||
* indices table of values being indexed by
|
||||
*/
|
||||
VALUE *
|
||||
associndex(ASSOC *ap, bool create, long dim, VALUE *indices)
|
||||
{
|
||||
ASSOCELEM **listhead;
|
||||
ASSOCELEM *ep;
|
||||
STATIC VALUE val;
|
||||
QCKHASH hash;
|
||||
int i;
|
||||
ASSOCELEM **listhead;
|
||||
ASSOCELEM *ep;
|
||||
STATIC VALUE val;
|
||||
QCKHASH hash;
|
||||
int i;
|
||||
|
||||
if (dim < 0) {
|
||||
math_error("Negative dimension for indexing association");
|
||||
not_reached();
|
||||
}
|
||||
if (dim < 0) {
|
||||
math_error("Negative dimension for indexing association");
|
||||
not_reached();
|
||||
}
|
||||
|
||||
/*
|
||||
* Calculate the hash value to use for this set of indices
|
||||
* so that we can first select the correct hash chain, and
|
||||
* also so we can quickly compare each element for a match.
|
||||
*/
|
||||
hash = QUICKHASH_BASIS;
|
||||
for (i = 0; i < dim; i++)
|
||||
hash = hashvalue(&indices[i], hash);
|
||||
/*
|
||||
* Calculate the hash value to use for this set of indices
|
||||
* so that we can first select the correct hash chain, and
|
||||
* also so we can quickly compare each element for a match.
|
||||
*/
|
||||
hash = QUICKHASH_BASIS;
|
||||
for (i = 0; i < dim; i++)
|
||||
hash = hashvalue(&indices[i], hash);
|
||||
|
||||
/*
|
||||
* Search the correct hash chain for the specified set of indices.
|
||||
* If found, return the address of the found element's value.
|
||||
*/
|
||||
listhead = &ap->a_table[hash % ap->a_size];
|
||||
for (ep = *listhead; ep; ep = ep->e_next) {
|
||||
if ((ep->e_hash != hash) || (ep->e_dim != dim))
|
||||
continue;
|
||||
if (compareindices(ep->e_indices, indices, dim))
|
||||
return &ep->e_value;
|
||||
}
|
||||
/*
|
||||
* Search the correct hash chain for the specified set of indices.
|
||||
* If found, return the address of the found element's value.
|
||||
*/
|
||||
listhead = &ap->a_table[hash % ap->a_size];
|
||||
for (ep = *listhead; ep; ep = ep->e_next) {
|
||||
if ((ep->e_hash != hash) || (ep->e_dim != dim))
|
||||
continue;
|
||||
if (compareindices(ep->e_indices, indices, dim))
|
||||
return &ep->e_value;
|
||||
}
|
||||
|
||||
/*
|
||||
* The set of indices was not found.
|
||||
* Either return a pointer to a NULL value for a read reference,
|
||||
* or allocate a new element in the list for a write reference.
|
||||
*/
|
||||
if (!create) {
|
||||
val.v_type = V_NULL;
|
||||
val.v_subtype = V_NOSUBTYPE;
|
||||
return &val;
|
||||
}
|
||||
/*
|
||||
* The set of indices was not found.
|
||||
* Either return a pointer to a NULL value for a read reference,
|
||||
* or allocate a new element in the list for a write reference.
|
||||
*/
|
||||
if (!create) {
|
||||
val.v_type = V_NULL;
|
||||
val.v_subtype = V_NOSUBTYPE;
|
||||
return &val;
|
||||
}
|
||||
|
||||
ep = (ASSOCELEM *) malloc(ELEMSIZE(dim));
|
||||
if (ep == NULL) {
|
||||
math_error("Cannot allocate association element");
|
||||
not_reached();
|
||||
}
|
||||
ep->e_dim = dim;
|
||||
ep->e_hash = hash;
|
||||
ep->e_value.v_type = V_NULL;
|
||||
ep->e_value.v_subtype = V_NOSUBTYPE;
|
||||
for (i = 0; i < dim; i++)
|
||||
copyvalue(&indices[i], &ep->e_indices[i]);
|
||||
ep->e_next = *listhead;
|
||||
*listhead = ep;
|
||||
ap->a_count++;
|
||||
ep = (ASSOCELEM *) malloc(ELEMSIZE(dim));
|
||||
if (ep == NULL) {
|
||||
math_error("Cannot allocate association element");
|
||||
not_reached();
|
||||
}
|
||||
ep->e_dim = dim;
|
||||
ep->e_hash = hash;
|
||||
ep->e_value.v_type = V_NULL;
|
||||
ep->e_value.v_subtype = V_NOSUBTYPE;
|
||||
for (i = 0; i < dim; i++)
|
||||
copyvalue(&indices[i], &ep->e_indices[i]);
|
||||
ep->e_next = *listhead;
|
||||
*listhead = ep;
|
||||
ap->a_count++;
|
||||
|
||||
resize(ap, ap->a_count / CHAINLENGTH);
|
||||
resize(ap, ap->a_count / CHAINLENGTH);
|
||||
|
||||
return &ep->e_value;
|
||||
return &ep->e_value;
|
||||
}
|
||||
|
||||
|
||||
@@ -139,25 +139,25 @@ associndex(ASSOC *ap, bool create, long dim, VALUE *indices)
|
||||
int
|
||||
assocsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
|
||||
{
|
||||
ASSOCELEM *ep;
|
||||
ASSOCELEM *ep;
|
||||
|
||||
if (i < 0 || j > ap->a_count) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
while (i < j) {
|
||||
ep = elemindex(ap, i);
|
||||
if (ep == NULL) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
if (acceptvalue(&ep->e_value, vp)) {
|
||||
utoz(i, index);
|
||||
return 0;
|
||||
}
|
||||
i++;
|
||||
}
|
||||
return 1;
|
||||
if (i < 0 || j > ap->a_count) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
while (i < j) {
|
||||
ep = elemindex(ap, i);
|
||||
if (ep == NULL) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
if (acceptvalue(&ep->e_value, vp)) {
|
||||
utoz(i, index);
|
||||
return 0;
|
||||
}
|
||||
i++;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@@ -169,26 +169,26 @@ assocsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
|
||||
int
|
||||
assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
|
||||
{
|
||||
ASSOCELEM *ep;
|
||||
ASSOCELEM *ep;
|
||||
|
||||
if (i < 0 || j > ap->a_count) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
j--;
|
||||
while (j >= i) {
|
||||
ep = elemindex(ap, j);
|
||||
if (ep == NULL) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
if (acceptvalue(&ep->e_value, vp)) {
|
||||
utoz(j, index);
|
||||
return 0;
|
||||
}
|
||||
j--;
|
||||
}
|
||||
return 1;
|
||||
if (i < 0 || j > ap->a_count) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
j--;
|
||||
while (j >= i) {
|
||||
ep = elemindex(ap, j);
|
||||
if (ep == NULL) {
|
||||
math_error("This should not happen in assocsearch");
|
||||
not_reached();
|
||||
}
|
||||
if (acceptvalue(&ep->e_value, vp)) {
|
||||
utoz(j, index);
|
||||
return 0;
|
||||
}
|
||||
j--;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@@ -197,29 +197,29 @@ assocrsearch(ASSOC *ap, VALUE *vp, long i, long j, ZVALUE *index)
|
||||
* double-bracket operation.
|
||||
*
|
||||
* given:
|
||||
* ap association to index into
|
||||
* index index of desired element
|
||||
* ap association to index into
|
||||
* index index of desired element
|
||||
*/
|
||||
S_FUNC ASSOCELEM *
|
||||
elemindex(ASSOC *ap, long index)
|
||||
{
|
||||
ASSOCELEM *ep;
|
||||
int i;
|
||||
ASSOCELEM *ep;
|
||||
int i;
|
||||
|
||||
if ((index < 0) || (index > ap->a_count))
|
||||
return NULL;
|
||||
if ((index < 0) || (index > ap->a_count))
|
||||
return NULL;
|
||||
|
||||
/*
|
||||
* This loop should be made more efficient by remembering
|
||||
* previously requested locations within the association.
|
||||
*/
|
||||
for (i = 0; i < ap->a_size; i++) {
|
||||
for (ep = ap->a_table[i]; ep; ep = ep->e_next) {
|
||||
if (index-- == 0)
|
||||
return ep;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
/*
|
||||
* This loop should be made more efficient by remembering
|
||||
* previously requested locations within the association.
|
||||
*/
|
||||
for (i = 0; i < ap->a_size; i++) {
|
||||
for (ep = ap->a_table[i]; ep; ep = ep->e_next) {
|
||||
if (index-- == 0)
|
||||
return ep;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
@@ -228,18 +228,18 @@ elemindex(ASSOC *ap, long index)
|
||||
* of an association. Returns NULL if there is no such element.
|
||||
*
|
||||
* given:
|
||||
* ap association to index into
|
||||
* index index of desired element
|
||||
* ap association to index into
|
||||
* index index of desired element
|
||||
*/
|
||||
VALUE *
|
||||
assocfindex(ASSOC *ap, long index)
|
||||
{
|
||||
ASSOCELEM *ep;
|
||||
ASSOCELEM *ep;
|
||||
|
||||
ep = elemindex(ap, index);
|
||||
if (ep == NULL)
|
||||
return NULL;
|
||||
return &ep->e_value;
|
||||
ep = elemindex(ap, index);
|
||||
if (ep == NULL)
|
||||
return NULL;
|
||||
return &ep->e_value;
|
||||
}
|
||||
|
||||
|
||||
@@ -250,17 +250,17 @@ assocfindex(ASSOC *ap, long index)
|
||||
LIST *
|
||||
associndices(ASSOC *ap, long index)
|
||||
{
|
||||
ASSOCELEM *ep;
|
||||
LIST *lp;
|
||||
int i;
|
||||
ASSOCELEM *ep;
|
||||
LIST *lp;
|
||||
int i;
|
||||
|
||||
ep = elemindex(ap, index);
|
||||
if (ep == NULL)
|
||||
return NULL;
|
||||
lp = listalloc();
|
||||
for (i = 0; i < ep->e_dim; i++)
|
||||
insertlistlast(lp, &ep->e_indices[i]);
|
||||
return lp;
|
||||
ep = elemindex(ap, index);
|
||||
if (ep == NULL)
|
||||
return NULL;
|
||||
lp = listalloc();
|
||||
for (i = 0; i < ep->e_dim; i++)
|
||||
insertlistlast(lp, &ep->e_indices[i]);
|
||||
return lp;
|
||||
}
|
||||
|
||||
|
||||
@@ -271,43 +271,43 @@ associndices(ASSOC *ap, long index)
|
||||
bool
|
||||
assoccmp(ASSOC *ap1, ASSOC *ap2)
|
||||
{
|
||||
ASSOCELEM **table1;
|
||||
ASSOCELEM *ep1;
|
||||
ASSOCELEM *ep2;
|
||||
long size1;
|
||||
long size2;
|
||||
QCKHASH hash;
|
||||
long dim;
|
||||
ASSOCELEM **table1;
|
||||
ASSOCELEM *ep1;
|
||||
ASSOCELEM *ep2;
|
||||
long size1;
|
||||
long size2;
|
||||
QCKHASH hash;
|
||||
long dim;
|
||||
|
||||
if (ap1 == ap2)
|
||||
return false;
|
||||
if (ap1->a_count != ap2->a_count)
|
||||
return true;
|
||||
if (ap1 == ap2)
|
||||
return false;
|
||||
if (ap1->a_count != ap2->a_count)
|
||||
return true;
|
||||
|
||||
table1 = ap1->a_table;
|
||||
size1 = ap1->a_size;
|
||||
size2 = ap2->a_size;
|
||||
while (size1-- > 0) {
|
||||
for (ep1 = *table1++; ep1; ep1 = ep1->e_next) {
|
||||
hash = ep1->e_hash;
|
||||
dim = ep1->e_dim;
|
||||
for (ep2 = ap2->a_table[hash % size2]; ;
|
||||
ep2 = ep2->e_next) {
|
||||
if (ep2 == NULL)
|
||||
return true;
|
||||
if (ep2->e_hash != hash)
|
||||
continue;
|
||||
if (ep2->e_dim != dim)
|
||||
continue;
|
||||
if (compareindices(ep1->e_indices,
|
||||
ep2->e_indices, dim))
|
||||
break;
|
||||
}
|
||||
if (comparevalue(&ep1->e_value, &ep2->e_value))
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
table1 = ap1->a_table;
|
||||
size1 = ap1->a_size;
|
||||
size2 = ap2->a_size;
|
||||
while (size1-- > 0) {
|
||||
for (ep1 = *table1++; ep1; ep1 = ep1->e_next) {
|
||||
hash = ep1->e_hash;
|
||||
dim = ep1->e_dim;
|
||||
for (ep2 = ap2->a_table[hash % size2]; ;
|
||||
ep2 = ep2->e_next) {
|
||||
if (ep2 == NULL)
|
||||
return true;
|
||||
if (ep2->e_hash != hash)
|
||||
continue;
|
||||
if (ep2->e_dim != dim)
|
||||
continue;
|
||||
if (compareindices(ep1->e_indices,
|
||||
ep2->e_indices, dim))
|
||||
break;
|
||||
}
|
||||
if (comparevalue(&ep1->e_value, &ep2->e_value))
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
@@ -317,39 +317,39 @@ assoccmp(ASSOC *ap1, ASSOC *ap2)
|
||||
ASSOC *
|
||||
assoccopy(ASSOC *oldap)
|
||||
{
|
||||
ASSOC *ap;
|
||||
ASSOCELEM *oldep;
|
||||
ASSOCELEM *ep;
|
||||
ASSOCELEM **listhead;
|
||||
int oldhi;
|
||||
int i;
|
||||
ASSOC *ap;
|
||||
ASSOCELEM *oldep;
|
||||
ASSOCELEM *ep;
|
||||
ASSOCELEM **listhead;
|
||||
int oldhi;
|
||||
int i;
|
||||
|
||||
ap = assocalloc(oldap->a_count / CHAINLENGTH);
|
||||
ap->a_count = oldap->a_count;
|
||||
ap = assocalloc(oldap->a_count / CHAINLENGTH);
|
||||
ap->a_count = oldap->a_count;
|
||||
|
||||
for (oldhi = 0; oldhi < oldap->a_size; oldhi++) {
|
||||
for (oldep = oldap->a_table[oldhi]; oldep;
|
||||
oldep = oldep->e_next) {
|
||||
ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim));
|
||||
if (ep == NULL) {
|
||||
math_error("Cannot allocate "
|
||||
"association element");
|
||||
not_reached();
|
||||
}
|
||||
ep->e_dim = oldep->e_dim;
|
||||
ep->e_hash = oldep->e_hash;
|
||||
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_value, &ep->e_value);
|
||||
listhead = &ap->a_table[ep->e_hash % ap->a_size];
|
||||
ep->e_next = *listhead;
|
||||
*listhead = ep;
|
||||
}
|
||||
}
|
||||
return ap;
|
||||
for (oldhi = 0; oldhi < oldap->a_size; oldhi++) {
|
||||
for (oldep = oldap->a_table[oldhi]; oldep;
|
||||
oldep = oldep->e_next) {
|
||||
ep = (ASSOCELEM *) malloc(ELEMSIZE(oldep->e_dim));
|
||||
if (ep == NULL) {
|
||||
math_error("Cannot allocate "
|
||||
"association element");
|
||||
not_reached();
|
||||
}
|
||||
ep->e_dim = oldep->e_dim;
|
||||
ep->e_hash = oldep->e_hash;
|
||||
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_value, &ep->e_value);
|
||||
listhead = &ap->a_table[ep->e_hash % ap->a_size];
|
||||
ep->e_next = *listhead;
|
||||
*listhead = ep;
|
||||
}
|
||||
}
|
||||
return ap;
|
||||
}
|
||||
|
||||
|
||||
@@ -361,41 +361,41 @@ assoccopy(ASSOC *oldap)
|
||||
S_FUNC void
|
||||
resize(ASSOC *ap, long newsize)
|
||||
{
|
||||
ASSOCELEM **oldtable;
|
||||
ASSOCELEM **newtable;
|
||||
ASSOCELEM **oldlist;
|
||||
ASSOCELEM **newlist;
|
||||
ASSOCELEM *ep;
|
||||
int i;
|
||||
ASSOCELEM **oldtable;
|
||||
ASSOCELEM **newtable;
|
||||
ASSOCELEM **oldlist;
|
||||
ASSOCELEM **newlist;
|
||||
ASSOCELEM *ep;
|
||||
int i;
|
||||
|
||||
if (newsize < ap->a_size + GROWHASHSIZE)
|
||||
return;
|
||||
if (newsize < ap->a_size + GROWHASHSIZE)
|
||||
return;
|
||||
|
||||
newsize = (long) next_prime((FULL)newsize);
|
||||
newtable = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * newsize);
|
||||
if (newtable == NULL) {
|
||||
math_error("No memory to grow association");
|
||||
not_reached();
|
||||
}
|
||||
for (i = 0; i < newsize; i++)
|
||||
newtable[i] = NULL;
|
||||
newsize = (long) next_prime((FULL)newsize);
|
||||
newtable = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * newsize);
|
||||
if (newtable == NULL) {
|
||||
math_error("No memory to grow association");
|
||||
not_reached();
|
||||
}
|
||||
for (i = 0; i < newsize; i++)
|
||||
newtable[i] = NULL;
|
||||
|
||||
oldtable = ap->a_table;
|
||||
oldlist = oldtable;
|
||||
for (i = 0; i < ap->a_size; i++) {
|
||||
while (*oldlist) {
|
||||
ep = *oldlist;
|
||||
*oldlist = ep->e_next;
|
||||
newlist = &newtable[ep->e_hash % newsize];
|
||||
ep->e_next = *newlist;
|
||||
*newlist = ep;
|
||||
}
|
||||
oldlist++;
|
||||
}
|
||||
oldtable = ap->a_table;
|
||||
oldlist = oldtable;
|
||||
for (i = 0; i < ap->a_size; i++) {
|
||||
while (*oldlist) {
|
||||
ep = *oldlist;
|
||||
*oldlist = ep->e_next;
|
||||
newlist = &newtable[ep->e_hash % newsize];
|
||||
ep->e_next = *newlist;
|
||||
*newlist = ep;
|
||||
}
|
||||
oldlist++;
|
||||
}
|
||||
|
||||
ap->a_table = newtable;
|
||||
ap->a_size = newsize;
|
||||
free((char *) oldtable);
|
||||
ap->a_table = newtable;
|
||||
ap->a_size = newsize;
|
||||
free((char *) oldtable);
|
||||
}
|
||||
|
||||
|
||||
@@ -405,14 +405,14 @@ resize(ASSOC *ap, long newsize)
|
||||
S_FUNC void
|
||||
assoc_elemfree(ASSOCELEM *ep)
|
||||
{
|
||||
int i;
|
||||
int i;
|
||||
|
||||
for (i = 0; i < ep->e_dim; i++)
|
||||
freevalue(&ep->e_indices[i]);
|
||||
freevalue(&ep->e_value);
|
||||
ep->e_dim = 0;
|
||||
ep->e_next = NULL;
|
||||
free((char *) ep);
|
||||
for (i = 0; i < ep->e_dim; i++)
|
||||
freevalue(&ep->e_indices[i]);
|
||||
freevalue(&ep->e_value);
|
||||
ep->e_dim = 0;
|
||||
ep->e_next = NULL;
|
||||
free((char *) ep);
|
||||
}
|
||||
|
||||
|
||||
@@ -423,27 +423,27 @@ assoc_elemfree(ASSOCELEM *ep)
|
||||
ASSOC *
|
||||
assocalloc(long initsize)
|
||||
{
|
||||
register ASSOC *ap;
|
||||
int i;
|
||||
register ASSOC *ap;
|
||||
int i;
|
||||
|
||||
if (initsize < MINHASHSIZE)
|
||||
initsize = MINHASHSIZE;
|
||||
ap = (ASSOC *) malloc(sizeof(ASSOC));
|
||||
if (ap == NULL) {
|
||||
math_error("No memory for association");
|
||||
not_reached();
|
||||
}
|
||||
ap->a_count = 0;
|
||||
ap->a_size = initsize;
|
||||
ap->a_table = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * initsize);
|
||||
if (ap->a_table == NULL) {
|
||||
free((char *) ap);
|
||||
math_error("No memory for association");
|
||||
not_reached();
|
||||
}
|
||||
for (i = 0; i < initsize; i++)
|
||||
ap->a_table[i] = NULL;
|
||||
return ap;
|
||||
if (initsize < MINHASHSIZE)
|
||||
initsize = MINHASHSIZE;
|
||||
ap = (ASSOC *) malloc(sizeof(ASSOC));
|
||||
if (ap == NULL) {
|
||||
math_error("No memory for association");
|
||||
not_reached();
|
||||
}
|
||||
ap->a_count = 0;
|
||||
ap->a_size = initsize;
|
||||
ap->a_table = (ASSOCELEM **) malloc(sizeof(ASSOCELEM *) * initsize);
|
||||
if (ap->a_table == NULL) {
|
||||
free((char *) ap);
|
||||
math_error("No memory for association");
|
||||
not_reached();
|
||||
}
|
||||
for (i = 0; i < initsize; i++)
|
||||
ap->a_table[i] = NULL;
|
||||
return ap;
|
||||
}
|
||||
|
||||
|
||||
@@ -453,25 +453,25 @@ assocalloc(long initsize)
|
||||
void
|
||||
assocfree(ASSOC *ap)
|
||||
{
|
||||
ASSOCELEM **listhead;
|
||||
ASSOCELEM *ep;
|
||||
ASSOCELEM *nextep;
|
||||
int i;
|
||||
ASSOCELEM **listhead;
|
||||
ASSOCELEM *ep;
|
||||
ASSOCELEM *nextep;
|
||||
int i;
|
||||
|
||||
listhead = ap->a_table;
|
||||
for (i = 0; i < ap->a_size; i++) {
|
||||
nextep = *listhead;
|
||||
*listhead = NULL;
|
||||
while (nextep) {
|
||||
ep = nextep;
|
||||
nextep = ep->e_next;
|
||||
assoc_elemfree(ep);
|
||||
}
|
||||
listhead++;
|
||||
}
|
||||
free((char *) ap->a_table);
|
||||
ap->a_table = NULL;
|
||||
free((char *) ap);
|
||||
listhead = ap->a_table;
|
||||
for (i = 0; i < ap->a_size; i++) {
|
||||
nextep = *listhead;
|
||||
*listhead = NULL;
|
||||
while (nextep) {
|
||||
ep = nextep;
|
||||
nextep = ep->e_next;
|
||||
assoc_elemfree(ep);
|
||||
}
|
||||
listhead++;
|
||||
}
|
||||
free((char *) ap->a_table);
|
||||
ap->a_table = NULL;
|
||||
free((char *) ap);
|
||||
}
|
||||
|
||||
|
||||
@@ -482,39 +482,39 @@ assocfree(ASSOC *ap)
|
||||
void
|
||||
assocprint(ASSOC *ap, long max_print)
|
||||
{
|
||||
ASSOCELEM *ep;
|
||||
long index;
|
||||
long i;
|
||||
int savemode;
|
||||
ASSOCELEM *ep;
|
||||
long index;
|
||||
long i;
|
||||
int savemode;
|
||||
|
||||
if (max_print <= 0) {
|
||||
math_fmt("assoc (%ld element%s)", ap->a_count,
|
||||
((ap->a_count == 1) ? "" : "s"));
|
||||
return;
|
||||
}
|
||||
math_fmt("\n assoc (%ld element%s):\n", ap->a_count,
|
||||
((ap->a_count == 1) ? "" : "s"));
|
||||
if (max_print <= 0) {
|
||||
math_fmt("assoc (%ld element%s)", ap->a_count,
|
||||
((ap->a_count == 1) ? "" : "s"));
|
||||
return;
|
||||
}
|
||||
math_fmt("\n assoc (%ld element%s):\n", ap->a_count,
|
||||
((ap->a_count == 1) ? "" : "s"));
|
||||
|
||||
for (index = 0; ((index < max_print) && (index < ap->a_count));
|
||||
index++) {
|
||||
ep = elemindex(ap, index);
|
||||
if (ep == NULL)
|
||||
continue;
|
||||
math_str(" [");
|
||||
for (i = 0; i < ep->e_dim; i++) {
|
||||
if (i)
|
||||
math_chr(',');
|
||||
savemode = math_setmode(MODE_FRAC);
|
||||
printvalue(&ep->e_indices[i],
|
||||
(PRINT_SHORT | PRINT_UNAMBIG));
|
||||
math_setmode(savemode);
|
||||
}
|
||||
math_str("] = ");
|
||||
printvalue(&ep->e_value, PRINT_SHORT | PRINT_UNAMBIG);
|
||||
math_chr('\n');
|
||||
}
|
||||
if (max_print < ap->a_count)
|
||||
math_str(" ...\n");
|
||||
for (index = 0; ((index < max_print) && (index < ap->a_count));
|
||||
index++) {
|
||||
ep = elemindex(ap, index);
|
||||
if (ep == NULL)
|
||||
continue;
|
||||
math_str(" [");
|
||||
for (i = 0; i < ep->e_dim; i++) {
|
||||
if (i)
|
||||
math_chr(',');
|
||||
savemode = math_setmode(MODE_FRAC);
|
||||
printvalue(&ep->e_indices[i],
|
||||
(PRINT_SHORT | PRINT_UNAMBIG));
|
||||
math_setmode(savemode);
|
||||
}
|
||||
math_str("] = ");
|
||||
printvalue(&ep->e_value, PRINT_SHORT | PRINT_UNAMBIG);
|
||||
math_chr('\n');
|
||||
}
|
||||
if (max_print < ap->a_count)
|
||||
math_str(" ...\n");
|
||||
}
|
||||
|
||||
|
||||
@@ -525,15 +525,15 @@ assocprint(ASSOC *ap, long max_print)
|
||||
S_FUNC bool
|
||||
compareindices(VALUE *v1, VALUE *v2, long dim)
|
||||
{
|
||||
int i;
|
||||
int i;
|
||||
|
||||
for (i = 0; i < dim; i++)
|
||||
if (v1[i].v_type != v2[i].v_type)
|
||||
return false;
|
||||
for (i = 0; i < dim; i++)
|
||||
if (v1[i].v_type != v2[i].v_type)
|
||||
return false;
|
||||
|
||||
while (dim-- > 0)
|
||||
if (comparevalue(v1++, v2++))
|
||||
return false;
|
||||
while (dim-- > 0)
|
||||
if (comparevalue(v1++, v2++))
|
||||
return false;
|
||||
|
||||
return true;
|
||||
return true;
|
||||
}
|
||||
|
||||
10
attribute.h
10
attribute.h
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2022/01/21 22:51:25
|
||||
* File existed as early as: 2022
|
||||
* Under source code control: 2022/01/21 22:51:25
|
||||
* File existed as early as: 2022
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
||||
38
banned.h
38
banned.h
@@ -27,18 +27,18 @@
|
||||
* function may lead to a fatal compiler complication.
|
||||
* If that happens, consider compiling as:
|
||||
*
|
||||
* make clobber all chk CCBAN=-DUNBAN
|
||||
* make clobber all chk CCBAN=-DUNBAN
|
||||
*
|
||||
* as see if this is a work-a-round.
|
||||
*
|
||||
* If YOU discover a need for the -DUNBAN work-a-round, PLEASE tell us!
|
||||
* Please send us a bug report. See the file:
|
||||
*
|
||||
* BUGS
|
||||
* BUGS
|
||||
*
|
||||
* or the URL:
|
||||
*
|
||||
* http://www.isthe.com/chongo/tech/comp/calc/calc-bugrept.html
|
||||
* http://www.isthe.com/chongo/tech/comp/calc/calc-bugrept.html
|
||||
*
|
||||
* for how to send us such a bug report.
|
||||
*
|
||||
@@ -50,7 +50,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -58,11 +58,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2021/03/06 21:07:31
|
||||
* File existed as early as: 2021
|
||||
* Under source code control: 2021/03/06 21:07:31
|
||||
* File existed as early as: 2021
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -82,7 +82,7 @@
|
||||
/*
|
||||
* In the spirit of:
|
||||
*
|
||||
* https://github.com/git/git/blob/master/banned.h
|
||||
* https://github.com/git/git/blob/master/banned.h
|
||||
*
|
||||
* we will ban the use of certain unsafe functions by turning
|
||||
* then into function calls that do not exist.
|
||||
@@ -157,22 +157,22 @@
|
||||
/*
|
||||
* XXX - As of 2021, functions such as:
|
||||
*
|
||||
* gmtime_s
|
||||
* localtime_s
|
||||
* ctime_s
|
||||
* asctime_s
|
||||
* gmtime_s
|
||||
* localtime_s
|
||||
* ctime_s
|
||||
* asctime_s
|
||||
*
|
||||
* are not universal. We cannot yet ban the following
|
||||
* functions because we do not have a portable AND
|
||||
* widely available alternative. Therefore we just
|
||||
* have to be extra careful when using:
|
||||
*
|
||||
* gmtime
|
||||
* localtime
|
||||
* ctime
|
||||
* ctime_r
|
||||
* asctime
|
||||
* asctime_r
|
||||
* gmtime
|
||||
* localtime
|
||||
* ctime
|
||||
* ctime_r
|
||||
* asctime
|
||||
* asctime_r
|
||||
*/
|
||||
|
||||
#endif /* !UNBAN */
|
||||
|
||||
8
blkcpy.h
8
blkcpy.h
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,10 +19,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/04/18 20:41:25
|
||||
* File existed as early as: 1997
|
||||
* Under source code control: 1997/04/18 20:41:25
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
||||
194
block.h
194
block.h
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,11 +19,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/02/21 05:03:39
|
||||
* File existed as early as: 1997
|
||||
* Under source code control: 1997/02/21 05:03:39
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -41,114 +41,114 @@
|
||||
*
|
||||
* Block functions and operations:
|
||||
*
|
||||
* x[i]
|
||||
* (i-1)th octet
|
||||
* x[i]
|
||||
* (i-1)th octet
|
||||
*
|
||||
* blk(len [, blkchunk])
|
||||
* unnamed block
|
||||
* len > 0
|
||||
* blkchunk defaults to BLK_CHUNKSIZE
|
||||
* blk(len [, blkchunk])
|
||||
* unnamed block
|
||||
* len > 0
|
||||
* blkchunk defaults to BLK_CHUNKSIZE
|
||||
*
|
||||
* blk(name, [len [, blkchunk]])
|
||||
* named block
|
||||
* len > 0
|
||||
* blkchunk defaults to BLK_CHUNKSIZE
|
||||
* blk(name, [len [, blkchunk]])
|
||||
* named block
|
||||
* len > 0
|
||||
* blkchunk defaults to BLK_CHUNKSIZE
|
||||
*
|
||||
* blkfree(x)
|
||||
* Reduce storage down to 0 octets.
|
||||
* blkfree(x)
|
||||
* Reduce storage down to 0 octets.
|
||||
*
|
||||
* size(x)
|
||||
* The length of data stored in the block.
|
||||
* size(x)
|
||||
* The length of data stored in the block.
|
||||
*
|
||||
* sizeof(x) == blk->maxsize
|
||||
* Allocation size in memory
|
||||
* sizeof(x) == blk->maxsize
|
||||
* Allocation size in memory
|
||||
*
|
||||
* isblk(x)
|
||||
* returns 0 is x is not a BLOCK, 1 if x is an
|
||||
* unnamed block, 2 if x is a named BLOCK
|
||||
* isblk(x)
|
||||
* returns 0 is x is not a BLOCK, 1 if x is an
|
||||
* unnamed block, 2 if x is a named BLOCK
|
||||
*
|
||||
* blkread(x, size, count, fd [, offset])
|
||||
* blkwrite(x, size, count, fd [, offset])
|
||||
* returns number of items written
|
||||
* offset is restricted in value by block type
|
||||
* blkread(x, size, count, fd [, offset])
|
||||
* blkwrite(x, size, count, fd [, offset])
|
||||
* returns number of items written
|
||||
* offset is restricted in value by block type
|
||||
*
|
||||
* blkset(x, val, length [, offset])
|
||||
* only the lower octet of val is used
|
||||
* offset is restricted in value by block type
|
||||
* blkset(x, val, length [, offset])
|
||||
* only the lower octet of val is used
|
||||
* offset is restricted in value by block type
|
||||
*
|
||||
* blkchr(x, val, length [, offset])
|
||||
* only the lower octet of val is used
|
||||
* offset is restricted in value by block type
|
||||
* blkchr(x, val, length [, offset])
|
||||
* only the lower octet of val is used
|
||||
* offset is restricted in value by block type
|
||||
*
|
||||
* blkcpy(dest, src, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
* dest may not == src
|
||||
* blkcpy(dest, src, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
* dest may not == src
|
||||
*
|
||||
* blkmove(dest, src, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
* overlapping moves are handled correctly
|
||||
* blkmove(dest, src, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
* overlapping moves are handled correctly
|
||||
*
|
||||
* blkccpy(dest, src, stopval, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
* blkccpy(dest, src, stopval, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
*
|
||||
* blkcmp(dest, src, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
* blkcmp(dest, src, length [, dest_offset [, src_offset]])
|
||||
* 0 <= length <= blksize(x)
|
||||
* offset's are restricted in value by block type
|
||||
*
|
||||
* blkswap(x, a, b)
|
||||
* swaps groups of 'a' octets within each 'b' octets
|
||||
* b == a is a noop
|
||||
* b = a*k for some integer k >= 1
|
||||
* blkswap(x, a, b)
|
||||
* swaps groups of 'a' octets within each 'b' octets
|
||||
* b == a is a noop
|
||||
* b = a*k for some integer k >= 1
|
||||
*
|
||||
* scatter(src, dest1, dest2 [, dest3 ] ...)
|
||||
* copy successive octets from src into dest1, dest2, ...
|
||||
* restarting with dest1 after end of list
|
||||
* stops at end of src
|
||||
* scatter(src, dest1, dest2 [, dest3 ] ...)
|
||||
* copy successive octets from src into dest1, dest2, ...
|
||||
* restarting with dest1 after end of list
|
||||
* stops at end of src
|
||||
*
|
||||
* gather(dest, src1, src2 [, src3 ] ...)
|
||||
* copy first octet from src1, src2, ...
|
||||
* copy next octet from src1, src2, ...
|
||||
* ...
|
||||
* copy last octet from src1, src2, ...
|
||||
* copy 0 when there is no more data from a given source
|
||||
* gather(dest, src1, src2 [, src3 ] ...)
|
||||
* copy first octet from src1, src2, ...
|
||||
* copy next octet from src1, src2, ...
|
||||
* ...
|
||||
* copy last octet from src1, src2, ...
|
||||
* copy 0 when there is no more data from a given source
|
||||
*
|
||||
* blkseek(x, offset, {"in","out"})
|
||||
* some seeks may not be allowed by block type
|
||||
* blkseek(x, offset, {"in","out"})
|
||||
* some seeks may not be allowed by block type
|
||||
*
|
||||
* config("blkmaxprint", count)
|
||||
* number of octets of a block to print, 0 means all
|
||||
* config("blkmaxprint", count)
|
||||
* number of octets of a block to print, 0 means all
|
||||
*
|
||||
* config("blkverbose", boolean)
|
||||
* true => print all lines, false => skip dup lines
|
||||
* config("blkverbose", boolean)
|
||||
* true => print all lines, false => skip dup lines
|
||||
*
|
||||
* config("blkbase", "base")
|
||||
* output block base = { "hex", "octal", "char", "binary", "raw" }
|
||||
* binary is base 2, raw is just octet values
|
||||
* config("blkbase", "base")
|
||||
* output block base = { "hex", "octal", "char", "binary", "raw" }
|
||||
* binary is base 2, raw is just octet values
|
||||
*
|
||||
* config("blkfmt", "style")
|
||||
* style of output = {
|
||||
* "line", lines in blkbase with no spaces between octets
|
||||
* "string", as one long line with no spaces between octets
|
||||
* "od_style", position, spaces between octets
|
||||
* "hd_style"} position, spaces between octets, chars on end
|
||||
* config("blkfmt", "style")
|
||||
* style of output = {
|
||||
* "line", lines in blkbase with no spaces between octets
|
||||
* "string", as one long line with no spaces between octets
|
||||
* "od_style", position, spaces between octets
|
||||
* "hd_style"} position, spaces between octets, chars on end
|
||||
*/
|
||||
struct block {
|
||||
LEN blkchunk; /* allocation chunk size */
|
||||
LEN maxsize; /* octets actually malloced for this block */
|
||||
LEN datalen; /* octets of data held this block */
|
||||
USB8 *data; /* pointer to the 1st octet of the allocated data */
|
||||
LEN blkchunk; /* allocation chunk size */
|
||||
LEN maxsize; /* octets actually malloced for this block */
|
||||
LEN datalen; /* octets of data held this block */
|
||||
USB8 *data; /* pointer to the 1st octet of the allocated data */
|
||||
};
|
||||
typedef struct block BLOCK;
|
||||
|
||||
|
||||
struct nblock {
|
||||
char *name;
|
||||
int subtype;
|
||||
int id;
|
||||
BLOCK *blk;
|
||||
char *name;
|
||||
int subtype;
|
||||
int id;
|
||||
BLOCK *blk;
|
||||
};
|
||||
typedef struct nblock NBLOCK;
|
||||
|
||||
@@ -156,26 +156,26 @@ typedef struct nblock NBLOCK;
|
||||
/*
|
||||
* block debug
|
||||
*/
|
||||
EXTERN int blk_debug; /* 0 => debug off */
|
||||
EXTERN int blk_debug; /* 0 => debug off */
|
||||
|
||||
|
||||
/*
|
||||
* block defaults
|
||||
*/
|
||||
#define BLK_CHUNKSIZE 256 /* default allocation chunk size for blocks */
|
||||
#define BLK_CHUNKSIZE 256 /* default allocation chunk size for blocks */
|
||||
|
||||
#define BLK_DEF_MAXPRINT 256 /* default octets to print */
|
||||
#define BLK_DEF_MAXPRINT 256 /* default octets to print */
|
||||
|
||||
#define BLK_BASE_HEX 0 /* output octets in a block in hex */
|
||||
#define BLK_BASE_OCT 1 /* output octets in a block in octal */
|
||||
#define BLK_BASE_CHAR 2 /* output octets in a block in characters */
|
||||
#define BLK_BASE_BINARY 3 /* output octets in a block in base 2 chars */
|
||||
#define BLK_BASE_RAW 4 /* output octets in a block in raw binary */
|
||||
#define BLK_BASE_HEX 0 /* output octets in a block in hex */
|
||||
#define BLK_BASE_OCT 1 /* output octets in a block in octal */
|
||||
#define BLK_BASE_CHAR 2 /* output octets in a block in characters */
|
||||
#define BLK_BASE_BINARY 3 /* output octets in a block in base 2 chars */
|
||||
#define BLK_BASE_RAW 4 /* output octets in a block in raw binary */
|
||||
|
||||
#define BLK_FMT_HD_STYLE 0 /* output in base with chars on end of line */
|
||||
#define BLK_FMT_LINE 1 /* output is lines of up to 79 chars */
|
||||
#define BLK_FMT_STRING 2 /* output is one long string */
|
||||
#define BLK_FMT_OD_STYLE 3 /* output in base with chars */
|
||||
#define BLK_FMT_HD_STYLE 0 /* output in base with chars on end of line */
|
||||
#define BLK_FMT_LINE 1 /* output is lines of up to 79 chars */
|
||||
#define BLK_FMT_STRING 2 /* output is one long string */
|
||||
#define BLK_FMT_OD_STYLE 3 /* output in base with chars */
|
||||
|
||||
|
||||
/*
|
||||
|
||||
12
bool.h
12
bool.h
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,11 +19,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2023/07/19 17:58:42
|
||||
* File existed as early as: 2023
|
||||
* Under source code control: 2023/07/19 17:58:42
|
||||
* File existed as early as: 2023
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -42,7 +42,7 @@
|
||||
#if !defined(HAVE_STDBOOL_H)
|
||||
|
||||
/* fake a <stdbool.h> header file */
|
||||
typedef unsigned char bool; /* fake boolean typedef */
|
||||
typedef unsigned char bool; /* fake boolean typedef */
|
||||
#undef true
|
||||
#define true ((bool)(1))
|
||||
#undef false
|
||||
|
||||
942
byteswap.c
942
byteswap.c
File diff suppressed because it is too large
Load Diff
126
byteswap.h
126
byteswap.h
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/10/11 04:44:01
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/10/11 04:44:01
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -29,7 +29,7 @@
|
||||
#define INCLUDE_BYTESWAP_H
|
||||
|
||||
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
#if defined(CALC_SRC) /* if we are building from the calc source tree */
|
||||
# include "longbits.h"
|
||||
#else
|
||||
# include <calc/longbits.h>
|
||||
@@ -39,42 +39,42 @@
|
||||
/*
|
||||
* SWAP_B8_IN_B16 - swap 8 bits in 16 bits
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 16 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 16 bit value to swap
|
||||
*
|
||||
* This macro will either switch to the opposite byte sex (Big Endian vs.
|
||||
* Little Endian) a 16 bit value.
|
||||
*/
|
||||
#define SWAP_B8_IN_B16(dest, src) ( \
|
||||
*((USB16*)(dest)) = \
|
||||
(((*((USB16*)(src))) << 8) | ((*((USB16*)(src))) >> 8)) \
|
||||
#define SWAP_B8_IN_B16(dest, src) ( \
|
||||
*((USB16*)(dest)) = \
|
||||
(((*((USB16*)(src))) << 8) | ((*((USB16*)(src))) >> 8)) \
|
||||
)
|
||||
|
||||
/*
|
||||
* SWAP_B16_IN_B32 - swap 16 bits in 32 bits
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 32 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 32 bit value to swap
|
||||
*/
|
||||
#define SWAP_B16_IN_B32(dest, src) ( \
|
||||
*((USB32*)(dest)) = \
|
||||
(((*((USB32*)(src))) << 16) | ((*((USB32*)(src))) >> 16)) \
|
||||
#define SWAP_B16_IN_B32(dest, src) ( \
|
||||
*((USB32*)(dest)) = \
|
||||
(((*((USB32*)(src))) << 16) | ((*((USB32*)(src))) >> 16)) \
|
||||
)
|
||||
|
||||
/*
|
||||
* SWAP_B8_IN_B32 - swap 8 & 16 bits in 32 bits
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 32 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 32 bit value to swap
|
||||
*
|
||||
* This macro will either switch to the opposite byte sex (Big Endian vs.
|
||||
* Little Endian) a 32 bit value.
|
||||
*/
|
||||
#define SWAP_B8_IN_B32(dest, src) ( \
|
||||
SWAP_B16_IN_B32(dest, src), \
|
||||
(*((USB32*)(dest)) = \
|
||||
((((*((USB32*)(dest))) & (USB32)0xff00ff00) >> 8) | \
|
||||
(((*((USB32*)(dest))) & (USB32)0x00ff00ff) << 8))) \
|
||||
#define SWAP_B8_IN_B32(dest, src) ( \
|
||||
SWAP_B16_IN_B32(dest, src), \
|
||||
(*((USB32*)(dest)) = \
|
||||
((((*((USB32*)(dest))) & (USB32)0xff00ff00) >> 8) | \
|
||||
(((*((USB32*)(dest))) & (USB32)0x00ff00ff) << 8))) \
|
||||
)
|
||||
|
||||
#if defined(HAVE_B64)
|
||||
@@ -82,41 +82,41 @@
|
||||
/*
|
||||
* SWAP_B32_IN_B64 - swap 32 bits in 64 bits
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
*/
|
||||
#define SWAP_B32_IN_B64(dest, src) ( \
|
||||
*((USB64*)(dest)) = \
|
||||
(((*((USB64*)(src))) << 32) | ((*((USB64*)(src))) >> 32)) \
|
||||
#define SWAP_B32_IN_B64(dest, src) ( \
|
||||
*((USB64*)(dest)) = \
|
||||
(((*((USB64*)(src))) << 32) | ((*((USB64*)(src))) >> 32)) \
|
||||
)
|
||||
|
||||
/*
|
||||
* SWAP_B16_IN_B64 - swap 16 & 32 bits in 64 bits
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
*/
|
||||
#define SWAP_B16_IN_B64(dest, src) ( \
|
||||
SWAP_B32_IN_B64(dest, src), \
|
||||
(*((USB64*)(dest)) = \
|
||||
((((*((USB64*)(dest))) & (USB64)0xffff0000ffff0000) >> 16) | \
|
||||
(((*((USB64*)(dest))) & (USB64)0x0000ffff0000ffff) << 16))) \
|
||||
#define SWAP_B16_IN_B64(dest, src) ( \
|
||||
SWAP_B32_IN_B64(dest, src), \
|
||||
(*((USB64*)(dest)) = \
|
||||
((((*((USB64*)(dest))) & (USB64)0xffff0000ffff0000) >> 16) | \
|
||||
(((*((USB64*)(dest))) & (USB64)0x0000ffff0000ffff) << 16))) \
|
||||
)
|
||||
|
||||
/*
|
||||
* SWAP_B8_IN_B64 - swap 16 & 32 bits in 64 bits
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
*
|
||||
* This macro will either switch to the opposite byte sex (Big Endian vs.
|
||||
* Little Endian) a 64 bit value.
|
||||
*/
|
||||
#define SWAP_B8_IN_B64(dest, src) ( \
|
||||
SWAP_B16_IN_B64(dest, src), \
|
||||
(*((USB64*)(dest)) = \
|
||||
((((*((USB64*)(dest))) & (USB64)0xff00ff00ff00ff00) >> 8) | \
|
||||
(((*((USB64*)(dest))) & (USB64)0x00ff00ff00ff00ff) << 8))) \
|
||||
#define SWAP_B8_IN_B64(dest, src) ( \
|
||||
SWAP_B16_IN_B64(dest, src), \
|
||||
(*((USB64*)(dest)) = \
|
||||
((((*((USB64*)(dest))) & (USB64)0xff00ff00ff00ff00) >> 8) | \
|
||||
(((*((USB64*)(dest))) & (USB64)0x00ff00ff00ff00ff) << 8))) \
|
||||
)
|
||||
|
||||
#else /* HAVE_B64 */
|
||||
@@ -124,52 +124,52 @@
|
||||
/*
|
||||
* SWAP_B32_IN_B64 - swap 32 bits in 64 bits (simulated by 2 32 bit values)
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
*/
|
||||
#define SWAP_B32_IN_B64(dest, src) ( \
|
||||
((USB32*)(dest))[1] = ((USB32*)(dest))[0], \
|
||||
((USB32*)(dest))[0] = ((USB32*)(dest))[1] \
|
||||
#define SWAP_B32_IN_B64(dest, src) ( \
|
||||
((USB32*)(dest))[1] = ((USB32*)(dest))[0], \
|
||||
((USB32*)(dest))[0] = ((USB32*)(dest))[1] \
|
||||
)
|
||||
|
||||
/*
|
||||
* SWAP_B16_IN_B64 - swap 16 & 32 bits in 64 bits (simulated by 2 32 bit vals)
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
*/
|
||||
#define SWAP_B16_IN_B64(dest, src) ( \
|
||||
SWAP_B16_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \
|
||||
SWAP_B16_IN_B32(((USB32*)dest), ((USB32*)src)+1) \
|
||||
#define SWAP_B16_IN_B64(dest, src) ( \
|
||||
SWAP_B16_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \
|
||||
SWAP_B16_IN_B32(((USB32*)dest), ((USB32*)src)+1) \
|
||||
)
|
||||
|
||||
/*
|
||||
* SWAP_B8_IN_B64 - swap 16 & 32 bits in 64 bits (simulated by 2 32 bit vals)
|
||||
*
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
* dest - pointer to where the swapped src will be put
|
||||
* src - pointer to a 64 bit value to swap
|
||||
*
|
||||
* This macro will either switch to the opposite byte sex (Big Endian vs.
|
||||
* Little Endian) a 64 bit value.
|
||||
*/
|
||||
#define SWAP_B8_IN_B64(dest, src) ( \
|
||||
SWAP_B8_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \
|
||||
SWAP_B8_IN_B32(((USB32*)dest), ((USB32*)src)+1) \
|
||||
#define SWAP_B8_IN_B64(dest, src) ( \
|
||||
SWAP_B8_IN_B32(((USB32*)dest)+1, ((USB32*)src)), \
|
||||
SWAP_B8_IN_B32(((USB32*)dest), ((USB32*)src)+1) \
|
||||
)
|
||||
|
||||
#endif /* HAVE_B64 */
|
||||
|
||||
#if LONG_BITS == 64
|
||||
|
||||
#define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B64(dest, src)
|
||||
#define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B64(dest, src)
|
||||
#define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B64(dest, src)
|
||||
#define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B64(dest, src)
|
||||
#define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B64(dest, src)
|
||||
#define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B64(dest, src)
|
||||
|
||||
#else /* LONG_BITS == 64 */
|
||||
|
||||
#define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B32(dest, src)
|
||||
#define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B32(dest, src)
|
||||
#define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B32(dest, src)
|
||||
#define SWAP_B32_IN_LONG(dest, src) SWAP_B32_IN_B32(dest, src)
|
||||
#define SWAP_B16_IN_LONG(dest, src) SWAP_B16_IN_B32(dest, src)
|
||||
#define SWAP_B8_IN_LONG(dest, src) SWAP_B8_IN_B32(dest, src)
|
||||
|
||||
#endif /* LONG_BITS == 64 */
|
||||
|
||||
|
||||
16
cal/Makefile
16
cal/Makefile
@@ -159,10 +159,11 @@ DISTLIST= ${CALC_FILES} ${MAKE_FILE}
|
||||
# These files are used to make (but not built) a calc .a link library
|
||||
#
|
||||
CALCLIBLIST=
|
||||
#
|
||||
|
||||
# rules that are not also names of files
|
||||
#
|
||||
PHONY= all clobber distlist install
|
||||
PHONY= all distlist buildlist distdir calcliblist calc_files_list echo_inst_files \
|
||||
clean clobber install uninstall
|
||||
|
||||
|
||||
############################################################
|
||||
@@ -182,14 +183,14 @@ all: ${CALC_FILES} ${MAKE_FILE} .all
|
||||
# additional Makefile targets #
|
||||
###############################
|
||||
|
||||
.PHONY: ${PHONY}
|
||||
|
||||
# used by the upper level Makefile to determine of we have done all
|
||||
#
|
||||
.all:
|
||||
${RM} -f .all
|
||||
${TOUCH} .all
|
||||
|
||||
.PHONY: ${PHONY}
|
||||
|
||||
##
|
||||
#
|
||||
# File list generation. You can ignore this section.
|
||||
@@ -210,6 +211,13 @@ distlist: ${DISTLIST}
|
||||
fi; \
|
||||
done
|
||||
|
||||
buildlist:
|
||||
${Q} for i in ${BUILD_ALL} /dev/null; do \
|
||||
if [ X"$$i" != X"/dev/null" ]; then \
|
||||
echo cal/$$i; \
|
||||
fi; \
|
||||
done | fgrep -v '.bak' | LANG=C ${SORT}
|
||||
|
||||
distdir:
|
||||
${Q} echo cal
|
||||
|
||||
|
||||
472
cal/README
472
cal/README
@@ -26,9 +26,9 @@ Executing the resource file will cause several functions to be defined.
|
||||
Executing the lucas function:
|
||||
|
||||
; lucas(149,60)
|
||||
1
|
||||
1
|
||||
; lucas(146,61)
|
||||
0
|
||||
0
|
||||
|
||||
shows that 149*2^60-1 is prime whereas 146*2^61-1 is not.
|
||||
|
||||
@@ -41,8 +41,8 @@ be useful!
|
||||
=-=
|
||||
|
||||
By convention, a resource file only defines and/or initializes functions,
|
||||
objects and variables. (The regress.cal and testxxx.cal regression test
|
||||
suite is an exception.) Also by convention, an additional usage message
|
||||
objects and variables. (The regress.cal and testxxx.cal regression test
|
||||
suite is an exception.) Also by convention, an additional usage message
|
||||
regarding important object and functions is printed.
|
||||
|
||||
If a resource file needs to load another resource file, it should use
|
||||
@@ -62,21 +62,21 @@ Zero value of config("resource_debug") means that no such information
|
||||
is displayed. For other values, the non-zero bits which currently
|
||||
have meanings are as follows:
|
||||
|
||||
n Meaning of bit n of config("resource_debug")
|
||||
n Meaning of bit n of config("resource_debug")
|
||||
|
||||
0 When a function is defined, redefined or undefined at
|
||||
interactive level, a message saying what has been done
|
||||
is displayed.
|
||||
0 When a function is defined, redefined or undefined at
|
||||
interactive level, a message saying what has been done
|
||||
is displayed.
|
||||
|
||||
1 When a function is defined, redefined or undefined during
|
||||
the reading of a file, a message saying what has been done
|
||||
is displayed.
|
||||
1 When a function is defined, redefined or undefined during
|
||||
the reading of a file, a message saying what has been done
|
||||
is displayed.
|
||||
|
||||
2 Show func will display more information about a functions
|
||||
arguments as well as more argument summary information.
|
||||
2 Show func will display more information about a functions
|
||||
arguments as well as more argument summary information.
|
||||
|
||||
3 During execution, allow calc standard resource files
|
||||
to output additional debugging information.
|
||||
3 During execution, allow calc standard resource files
|
||||
to output additional debugging information.
|
||||
|
||||
The value for config("resource_debug") in both oldstd and newstd is 3,
|
||||
but if calc is invoked with the -d flag, its initial value is zero.
|
||||
@@ -87,27 +87,27 @@ either interactively or during the reading of a file.
|
||||
Sometimes the information printed is not enough. In addition to the
|
||||
standard information, one might want to print:
|
||||
|
||||
* useful obj definitions
|
||||
* functions with optional args
|
||||
* functions with optional args where the param() interface is used
|
||||
* useful obj definitions
|
||||
* functions with optional args
|
||||
* functions with optional args where the param() interface is used
|
||||
|
||||
For these cases we suggest that you place at the bottom of your code
|
||||
something that prints extra information if config("resource_debug") has
|
||||
either of the bottom 2 bits set:
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj xyz defined";
|
||||
print "funcA([val1 [, val2]]) defined";
|
||||
print "funcB(size, mass, ...) defined";
|
||||
}
|
||||
if (config("resource_debug") & 3) {
|
||||
print "obj xyz defined";
|
||||
print "funcA([val1 [, val2]]) defined";
|
||||
print "funcB(size, mass, ...) defined";
|
||||
}
|
||||
|
||||
If your the resource file needs to output special debugging information,
|
||||
we recommend that you check for bit 3 of the config("resource_debug")
|
||||
before printing the debug statement:
|
||||
|
||||
if (config("resource_debug") & 8) {
|
||||
print "DEBUG: This a sample debug statement";
|
||||
}
|
||||
if (config("resource_debug") & 8) {
|
||||
print "DEBUG: This a sample debug statement";
|
||||
}
|
||||
|
||||
=-=
|
||||
|
||||
@@ -146,11 +146,11 @@ alg_config.cal
|
||||
|
||||
Here is a suggested way to use this resource file:
|
||||
|
||||
; read alg_config
|
||||
; config("user_debug",2),;
|
||||
; best_mul2(); best_sq2(); best_pow2();
|
||||
; best_mul2(); best_sq2(); best_pow2();
|
||||
; best_mul2(); best_sq2(); best_pow2();
|
||||
; read alg_config
|
||||
; config("user_debug",2),;
|
||||
; best_mul2(); best_sq2(); best_pow2();
|
||||
; best_mul2(); best_sq2(); best_pow2();
|
||||
; best_mul2(); best_sq2(); best_pow2();
|
||||
|
||||
NOTE: It is perfectly normal for the optimal value returned to differ
|
||||
slightly from run to run. Slight variations due to inaccuracy in
|
||||
@@ -161,9 +161,9 @@ alg_config.cal
|
||||
config("mul2"), config("sq2"), and config("pow2"). For example one
|
||||
can place into ~/.calcrc these lines:
|
||||
|
||||
config("mul2", 1780),;
|
||||
config("sq2", 3388),;
|
||||
config("pow2", 176),;
|
||||
config("mul2", 1780),;
|
||||
config("sq2", 3388),;
|
||||
config("pow2", 176),;
|
||||
|
||||
to automatically and silently change these config values.
|
||||
See help/config and CALCRC in help/environment for more information.
|
||||
@@ -174,7 +174,7 @@ beer.cal
|
||||
This calc resource is calc's contribution to the 99 Bottles of Beer
|
||||
web page:
|
||||
|
||||
http://www.ionet.net/~timtroyr/funhouse/beer.html#calc
|
||||
http://www.ionet.net/~timtroyr/funhouse/beer.html#calc
|
||||
|
||||
NOTE: This resource produces a lot of output. :-)
|
||||
|
||||
@@ -186,8 +186,8 @@ bernoulli.cal
|
||||
Calculate the nth Bernoulli number.
|
||||
|
||||
NOTE: There is now a bernoulli() builtin function. This file is
|
||||
left here for backward compatibility and now simply returns
|
||||
the builtin function.
|
||||
left here for backward compatibility and now simply returns
|
||||
the builtin function.
|
||||
|
||||
|
||||
bernpoly.cal
|
||||
@@ -272,53 +272,53 @@ comma.cal
|
||||
|
||||
str_comma(x, [group, [decimal]])
|
||||
|
||||
Convert x into a string.
|
||||
Convert x into a string.
|
||||
|
||||
If group is given and is a string, group will be used as
|
||||
the 3-digit group separator, otherwise the default 3-digit
|
||||
group separator will be used.
|
||||
If group is given and is a string, group will be used as
|
||||
the 3-digit group separator, otherwise the default 3-digit
|
||||
group separator will be used.
|
||||
|
||||
If decimal is given and is a string, group will be used as
|
||||
the integer-fraction separator, otherwise the default
|
||||
integer-fraction separator will be used.
|
||||
If decimal is given and is a string, group will be used as
|
||||
the integer-fraction separator, otherwise the default
|
||||
integer-fraction separator will be used.
|
||||
|
||||
The decimal and group arguments are optional.
|
||||
The decimal and group arguments are optional.
|
||||
|
||||
set_default_group_separator(group)
|
||||
|
||||
Change the default 3-digit group separator if group is a string,
|
||||
otherwise the default 3-digit group separator will not be
|
||||
changed. Return the old 3-digit group separator.
|
||||
Change the default 3-digit group separator if group is a string,
|
||||
otherwise the default 3-digit group separator will not be
|
||||
changed. Return the old 3-digit group separator.
|
||||
|
||||
set_default_decimal_separator(decimal)
|
||||
|
||||
Change the default 3-digit group separator if decimal is a
|
||||
string, otherwise the default integer-fraction separator
|
||||
will not be changed. Return the old integer-fraction separator.
|
||||
Change the default 3-digit group separator if decimal is a
|
||||
string, otherwise the default integer-fraction separator
|
||||
will not be changed. Return the old integer-fraction separator.
|
||||
|
||||
print_comma(x, [group, [decimal]])
|
||||
|
||||
Print the value produced by str_comma(x, [group, [decimal]])
|
||||
followed by a newline.
|
||||
Print the value produced by str_comma(x, [group, [decimal]])
|
||||
followed by a newline.
|
||||
|
||||
If the str_comma() does not return a string, nothing is printed.
|
||||
If the str_comma() does not return a string, nothing is printed.
|
||||
|
||||
The decimal and group arguments are optional.
|
||||
The decimal and group arguments are optional.
|
||||
|
||||
The value produced by str_comma() is returned.
|
||||
The value produced by str_comma() is returned.
|
||||
|
||||
fprint_comma(fd, x, [group, [decimal]])
|
||||
|
||||
Print the value produced by str_comma(x, [group, [decimal]]),
|
||||
without a trailing newline, on file fd.
|
||||
Print the value produced by str_comma(x, [group, [decimal]]),
|
||||
without a trailing newline, on file fd.
|
||||
|
||||
If the str_comma() does not return a string, nothing is printed.
|
||||
If the str_comma() does not return a string, nothing is printed.
|
||||
|
||||
If fd is not an open file, nothing is printed.
|
||||
If fd is not an open file, nothing is printed.
|
||||
|
||||
The decimal and group arguments are optional.
|
||||
The decimal and group arguments are optional.
|
||||
|
||||
The value produced by str_comma() is returned.
|
||||
The value produced by str_comma() is returned.
|
||||
|
||||
|
||||
deg.cal
|
||||
@@ -362,30 +362,30 @@ dotest.cal
|
||||
|
||||
dotest_file
|
||||
|
||||
Search along CALCPATH for dotest_file, which contains lines that
|
||||
should evaluate to 1. Comment lines and empty lines are ignored.
|
||||
Comment lines should use ## instead of the multi like /* ... */
|
||||
because lines are evaluated one line at a time.
|
||||
Search along CALCPATH for dotest_file, which contains lines that
|
||||
should evaluate to 1. Comment lines and empty lines are ignored.
|
||||
Comment lines should use ## instead of the multi like /* ... */
|
||||
because lines are evaluated one line at a time.
|
||||
|
||||
dotest_code
|
||||
|
||||
Assign the code number that is to be printed at the start of
|
||||
each non-error line and after **** in each error line.
|
||||
The default code number is 999.
|
||||
Assign the code number that is to be printed at the start of
|
||||
each non-error line and after **** in each error line.
|
||||
The default code number is 999.
|
||||
|
||||
dotest_maxcond
|
||||
|
||||
The maximum number of error conditions that may be detected.
|
||||
An error condition is not a sign of a problem, in some cases
|
||||
a line deliberately forces an error condition. A value of -1,
|
||||
the default, implies a maximum of 2147483647.
|
||||
The maximum number of error conditions that may be detected.
|
||||
An error condition is not a sign of a problem, in some cases
|
||||
a line deliberately forces an error condition. A value of -1,
|
||||
the default, implies a maximum of 2147483647.
|
||||
|
||||
Global variables and functions must be declared ahead of time because
|
||||
the dotest scope of evaluation is a line at a time. For example:
|
||||
|
||||
read dotest.cal
|
||||
read set8700.cal
|
||||
dotest("set8700.line");
|
||||
read dotest.cal
|
||||
read set8700.cal
|
||||
dotest("set8700.line");
|
||||
|
||||
|
||||
ellip.cal
|
||||
@@ -403,7 +403,7 @@ factorial.cal
|
||||
|
||||
See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Factorial
|
||||
http://en.wikipedia.org/wiki/Factorial
|
||||
|
||||
for information on the factorial. This function depends on the script
|
||||
toomcook.cal.
|
||||
@@ -416,7 +416,7 @@ factorial.cal
|
||||
the next lower prime is taking as the end point b. The end point b must
|
||||
not exceed 4294967291. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Primorial
|
||||
http://en.wikipedia.org/wiki/Primorial
|
||||
|
||||
for information on the primorial.
|
||||
|
||||
@@ -566,54 +566,54 @@ fnv_util.cal
|
||||
|
||||
find_fnv_prime(bits)
|
||||
|
||||
If bits == null(), this function will attempt to prompt stdin
|
||||
for a value and provide commends on the value of bits.
|
||||
If bits == null(), this function will attempt to prompt stdin
|
||||
for a value and provide commends on the value of bits.
|
||||
|
||||
given:
|
||||
bits number of bits in the hash, null() ==> prompt for value
|
||||
given:
|
||||
bits number of bits in the hash, null() ==> prompt for value
|
||||
|
||||
returns:
|
||||
0 ==> no FNV prime found
|
||||
>0 ==> FNV prime
|
||||
returns:
|
||||
0 ==> no FNV prime found
|
||||
>0 ==> FNV prime
|
||||
|
||||
deprecated_fnv0(bits, fnv_prime, string)
|
||||
|
||||
If fnv_prime == null(), this function will try to compute the FNV prime
|
||||
for a hash of size bits.
|
||||
If fnv_prime == null(), this function will try to compute the FNV prime
|
||||
for a hash of size bits.
|
||||
|
||||
given:
|
||||
bits number of bits in FNV hash
|
||||
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
string string to hash
|
||||
given:
|
||||
bits number of bits in FNV hash
|
||||
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
string string to hash
|
||||
|
||||
returns:
|
||||
FNV-0 hash, for size bytes, of string
|
||||
returns:
|
||||
FNV-0 hash, for size bytes, of string
|
||||
|
||||
NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
|
||||
fnv_offset_basis(bits, fnv_prime)
|
||||
|
||||
given:
|
||||
bits number of bits in FNV hash
|
||||
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
given:
|
||||
bits number of bits in FNV hash
|
||||
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
|
||||
returns:
|
||||
FNV offset basis for a hash size of bits and an FNV prime of fnv_prime
|
||||
returns:
|
||||
FNV offset basis for a hash size of bits and an FNV prime of fnv_prime
|
||||
|
||||
NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
|
||||
fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
|
||||
|
||||
given:
|
||||
bits number of bits in FNV hash
|
||||
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
prev_hash previous hash value, null() ==> generate FNV offset basis
|
||||
string string to hash
|
||||
given:
|
||||
bits number of bits in FNV hash
|
||||
fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
prev_hash previous hash value, null() ==> generate FNV offset basis
|
||||
string string to hash
|
||||
|
||||
returns:
|
||||
"FNV-style" hash of bits
|
||||
returns:
|
||||
"FNV-style" hash of bits
|
||||
|
||||
NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
|
||||
gvec.cal
|
||||
|
||||
@@ -626,8 +626,8 @@ hello.cal
|
||||
|
||||
Calc's contribution to the Hello World! page:
|
||||
|
||||
http://www.latech.edu/~acm/HelloWorld.shtml
|
||||
http://www.latech.edu/~acm/helloworld/calc.html
|
||||
http://www.latech.edu/~acm/HelloWorld.shtml
|
||||
http://www.latech.edu/~acm/helloworld/calc.html
|
||||
|
||||
NOTE: This resource produces a lot of output. :-)
|
||||
|
||||
@@ -671,27 +671,27 @@ intfile.cal
|
||||
|
||||
file2be(filename)
|
||||
|
||||
Read filename and return an integer that is built from the
|
||||
octets in that file in Big Endian order. The first octets
|
||||
of the file become the most significant bits of the integer.
|
||||
Read filename and return an integer that is built from the
|
||||
octets in that file in Big Endian order. The first octets
|
||||
of the file become the most significant bits of the integer.
|
||||
|
||||
file2le(filename)
|
||||
|
||||
Read filename and return an integer that is built from the
|
||||
octets in that file in Little Endian order. The first octets
|
||||
of the file become the most significant bits of the integer.
|
||||
Read filename and return an integer that is built from the
|
||||
octets in that file in Little Endian order. The first octets
|
||||
of the file become the most significant bits of the integer.
|
||||
|
||||
be2file(v, filename)
|
||||
|
||||
Write the absolute value of v into filename in Big Endian order.
|
||||
The v argument must be on integer. The most significant bits
|
||||
of the integer become the first octets of the file.
|
||||
Write the absolute value of v into filename in Big Endian order.
|
||||
The v argument must be on integer. The most significant bits
|
||||
of the integer become the first octets of the file.
|
||||
|
||||
le2file(v, filename)
|
||||
|
||||
Write the absolute value of v into filename in Little Endian order.
|
||||
The v argument must be on integer. The least significant bits
|
||||
of the integer become the last octets of the file.
|
||||
Write the absolute value of v into filename in Little Endian order.
|
||||
The v argument must be on integer. The least significant bits
|
||||
of the integer become the last octets of the file.
|
||||
|
||||
|
||||
intnum.cal
|
||||
@@ -733,9 +733,9 @@ intnum.cal
|
||||
; define f(x){return sin(x);}
|
||||
f(x) defined
|
||||
; quadts(0,pi()) - 2
|
||||
0.00000000000000000000
|
||||
0.00000000000000000000
|
||||
; quadgl(0,pi()) - 2
|
||||
0.00000000000000000000
|
||||
0.00000000000000000000
|
||||
|
||||
Sometimes rounding errors accumulate, it might be a good idea to crank up
|
||||
the working precision a notch or two.
|
||||
@@ -743,39 +743,39 @@ intnum.cal
|
||||
; define f(x){ return exp(-x^2);}
|
||||
f(x) redefined
|
||||
; quadts(0,pinf()) - pi()
|
||||
0.00000000000000000000
|
||||
0.00000000000000000000
|
||||
; quadgl(0,pinf()) - pi()
|
||||
0.00000000000000000001
|
||||
0.00000000000000000001
|
||||
|
||||
; define f(x){ return exp(-x^2);}
|
||||
f(x) redefined
|
||||
; quadgl(ninf(),pinf()) - sqrt(pi())
|
||||
0.00000000000000000000
|
||||
0.00000000000000000000
|
||||
; quadts(ninf(),pinf()) - sqrt(pi())
|
||||
-0.00000000000000000000
|
||||
-0.00000000000000000000
|
||||
|
||||
Using the "points" parameter is a bit tricky
|
||||
|
||||
; define f(x){ return 1/x; }
|
||||
f(x) redefined
|
||||
; quadts(1,1,mat[3]={1i,-1,-1i}) - 2i*pi()
|
||||
0.00000000000000000001i
|
||||
0.00000000000000000001i
|
||||
; quadgl(1,1,mat[3]={1i,-1,-1i}) - 2i*pi()
|
||||
0.00000000000000000001i
|
||||
0.00000000000000000001i
|
||||
|
||||
The make* functions make it a bit simpler
|
||||
|
||||
; quadts(1,1,makepoints(1i,-1,-1i)) - 2i*pi()
|
||||
0.00000000000000000001i
|
||||
0.00000000000000000001i
|
||||
; quadgl(1,1,makepoints(1i,-1,-1i)) - 2i*pi()
|
||||
0.00000000000000000001i
|
||||
0.00000000000000000001i
|
||||
|
||||
; define f(x){ return abs(sin(x));}
|
||||
f(x) redefined
|
||||
; quadts(0,2*pi(),makepoints(pi())) - 4
|
||||
0.00000000000000000000
|
||||
0.00000000000000000000
|
||||
; quadgl(0,2*pi(),makepoints(pi())) - 4
|
||||
0.00000000000000000000
|
||||
0.00000000000000000000
|
||||
|
||||
The quad*core functions do not offer anything fancy but the third parameter
|
||||
controls the so called "order" which is just the number of nodes computed.
|
||||
@@ -785,34 +785,34 @@ intnum.cal
|
||||
; define f(x){ return exp(x);}
|
||||
f(x) redefined
|
||||
; s=usertime();quadglcore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
0.00000000000000000001
|
||||
2.632164
|
||||
0.00000000000000000001
|
||||
2.632164
|
||||
; s=usertime();quadglcore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
0.00000000000000000001
|
||||
0.016001
|
||||
0.00000000000000000001
|
||||
0.016001
|
||||
; quadgldeletenodes()
|
||||
; s=usertime();quadglcore(-3,3,14)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
-0.00000000000000000000
|
||||
0.024001
|
||||
-0.00000000000000000000
|
||||
0.024001
|
||||
; s=usertime();quadglcore(-3,3,14)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
-0.00000000000000000000
|
||||
0
|
||||
-0.00000000000000000000
|
||||
0
|
||||
|
||||
It is not much but can sum up. The tanh-sinh algorithm is not optimizable
|
||||
as much as the Gauss-Legendre algorithm but is per se much faster.
|
||||
|
||||
; s=usertime();quadtscore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
-0.00000000000000000001
|
||||
0.128008
|
||||
-0.00000000000000000001
|
||||
0.128008
|
||||
; s=usertime();quadtscore(-3,3)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
-0.00000000000000000001
|
||||
0.036002
|
||||
-0.00000000000000000001
|
||||
0.036002
|
||||
; s=usertime();quadtscore(-3,3,49)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
-0.00000000000000000000
|
||||
0.036002
|
||||
-0.00000000000000000000
|
||||
0.036002
|
||||
; s=usertime();quadtscore(-3,3,49)- (exp(3)-exp(-3));e=usertime();e-s
|
||||
-0.00000000000000000000
|
||||
0.01200
|
||||
-0.00000000000000000000
|
||||
0.01200
|
||||
|
||||
|
||||
lambertw.cal
|
||||
@@ -885,7 +885,7 @@ lucas.cal
|
||||
prove that h*2^n-1 is prime or not prime.
|
||||
|
||||
NOTE: Some call this term u(0). The function gen_u0(h, n, v1)
|
||||
simply calls gen_u2(h, n, v1) for such people. :-)
|
||||
simply calls gen_u2(h, n, v1) for such people. :-)
|
||||
|
||||
gen_v1(h, v)
|
||||
|
||||
@@ -925,7 +925,7 @@ mfactor.cal
|
||||
By default, start_k == 1, rept_loop = 10000 and p_elim = 17.
|
||||
|
||||
The p_elim == 17 overhead takes ~3 minutes on an 200 MHz r4k CPU and
|
||||
requires about ~13 Megs of memory. The p_elim == 13 overhead
|
||||
requires about ~13 Megs of memory. The p_elim == 13 overhead
|
||||
takes about 3 seconds and requires ~1.5 Megs of memory.
|
||||
|
||||
The value p_elim == 17 is best for long factorizations. It is the
|
||||
@@ -1014,19 +1014,19 @@ palindrome.cal
|
||||
|
||||
Important functions are:
|
||||
|
||||
Find the next / previous palindrome:
|
||||
Find the next / previous palindrome:
|
||||
|
||||
nextpal(val)
|
||||
prevpal(val)
|
||||
nextpal(val)
|
||||
prevpal(val)
|
||||
|
||||
Test if a value is a palindrome:
|
||||
Test if a value is a palindrome:
|
||||
|
||||
ispal(val)
|
||||
ispal(val)
|
||||
|
||||
Find the next / previous palindrome that is a (highly probable) prime:
|
||||
Find the next / previous palindrome that is a (highly probable) prime:
|
||||
|
||||
nextprimepal(val)
|
||||
prevprimepal(val)
|
||||
nextprimepal(val)
|
||||
prevprimepal(val)
|
||||
|
||||
|
||||
pell.cal
|
||||
@@ -1073,7 +1073,7 @@ pollard.cal
|
||||
|
||||
poly.cal
|
||||
|
||||
Calculate with polynomials of one variable. There are many functions.
|
||||
Calculate with polynomials of one variable. There are many functions.
|
||||
Read the documentation in the resource file.
|
||||
|
||||
|
||||
@@ -1117,7 +1117,7 @@ quat.cal
|
||||
quat_scale(a, b)
|
||||
quat_shift(a, b)
|
||||
|
||||
Calculate using quaternions of the form: a + bi + cj + dk. In these
|
||||
Calculate using quaternions of the form: a + bi + cj + dk. In these
|
||||
functions, quaternions are manipulated in the form: s + v, where
|
||||
s is a scalar and v is a vector of size 3.
|
||||
|
||||
@@ -1199,17 +1199,17 @@ regress.cal
|
||||
screen.cal
|
||||
|
||||
up
|
||||
CUU /* same as up */
|
||||
CUU /* same as up */
|
||||
down = CUD
|
||||
CUD /* same as down */
|
||||
CUD /* same as down */
|
||||
forward
|
||||
CUF /* same as forward */
|
||||
CUF /* same as forward */
|
||||
back = CUB
|
||||
CUB /* same as back */
|
||||
CUB /* same as back */
|
||||
save
|
||||
SCP /* same as save */
|
||||
SCP /* same as save */
|
||||
restore
|
||||
RCP /* same as restore */
|
||||
RCP /* same as restore */
|
||||
cls
|
||||
home
|
||||
eraseline
|
||||
@@ -1246,8 +1246,8 @@ screen.cal
|
||||
|
||||
For example:
|
||||
|
||||
read screen
|
||||
print green:"This is green. ":red:"This is red.":black
|
||||
read screen
|
||||
print green:"This is green. ":red:"This is red.":black
|
||||
|
||||
|
||||
seedrandom.cal
|
||||
@@ -1255,13 +1255,13 @@ seedrandom.cal
|
||||
seedrandom(seed1, seed2, bitsize [,trials])
|
||||
|
||||
Given:
|
||||
seed1 - a large random value (at least 10^20 and perhaps < 10^93)
|
||||
seed2 - a large random value (at least 10^20 and perhaps < 10^93)
|
||||
size - min Blum modulus as a power of 2 (at least 100, perhaps > 1024)
|
||||
trials - number of ptest() trials (default 25) (optional arg)
|
||||
seed1 - a large random value (at least 10^20 and perhaps < 10^93)
|
||||
seed2 - a large random value (at least 10^20 and perhaps < 10^93)
|
||||
size - min Blum modulus as a power of 2 (at least 100, perhaps > 1024)
|
||||
trials - number of ptest() trials (default 25) (optional arg)
|
||||
|
||||
Returns:
|
||||
the previous random state
|
||||
the previous random state
|
||||
|
||||
Seed the cryptographically strong Blum generator. This functions allows
|
||||
one to use the raw srandom() without the burden of finding appropriate
|
||||
@@ -1299,7 +1299,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the beta function. See:
|
||||
|
||||
https://en.wikipedia.org/wiki/Beta_function
|
||||
https://en.wikipedia.org/wiki/Beta_function
|
||||
http://mathworld.wolfram.com/BetaFunction.html
|
||||
http://dlmf.nist.gov/5.12
|
||||
|
||||
@@ -1310,7 +1310,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the regularized incomplete beta function. See:
|
||||
|
||||
https://en.wikipedia.org/wiki/Beta_function
|
||||
https://en.wikipedia.org/wiki/Beta_function
|
||||
http://mathworld.wolfram.com/RegularizedBetaFunction.html
|
||||
http://dlmf.nist.gov/8.17
|
||||
|
||||
@@ -1322,7 +1322,7 @@ specialfunctions.cal
|
||||
Calculates the value of the exponential integral Ei(z) function at z.
|
||||
See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Exponential_integral
|
||||
http://en.wikipedia.org/wiki/Exponential_integral
|
||||
http://www.cs.utah.edu/~vpegorar/research/2011_JGT/
|
||||
|
||||
for information on the exponential integral Ei(z) function.
|
||||
@@ -1332,7 +1332,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the error function at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
|
||||
for information on the error function function.
|
||||
|
||||
@@ -1341,7 +1341,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the complementary error function at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
|
||||
for information on the complementary error function function.
|
||||
|
||||
@@ -1350,7 +1350,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the imaginary error function at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
|
||||
for information on the imaginary error function function.
|
||||
|
||||
@@ -1359,7 +1359,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the inverse of the error function at x. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
http://en.wikipedia.org/wiki/Error_function
|
||||
|
||||
for information on the inverse of the error function function.
|
||||
|
||||
@@ -1368,7 +1368,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the complex error function at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Faddeeva_function
|
||||
http://en.wikipedia.org/wiki/Faddeeva_function
|
||||
|
||||
for information on the complex error function function.
|
||||
|
||||
@@ -1377,7 +1377,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the Euler gamma function at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Gamma_function
|
||||
http://en.wikipedia.org/wiki/Gamma_function
|
||||
http://dlmf.nist.gov/5
|
||||
|
||||
for information on the Euler gamma function.
|
||||
@@ -1388,7 +1388,7 @@ specialfunctions.cal
|
||||
Calculates the value of the lower incomplete gamma function for
|
||||
arbitrary a, z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Incomplete_gamma_function
|
||||
http://en.wikipedia.org/wiki/Incomplete_gamma_function
|
||||
|
||||
for information on the lower incomplete gamma function.
|
||||
|
||||
@@ -1397,7 +1397,7 @@ specialfunctions.cal
|
||||
Calculates the value of the regularized lower incomplete gamma
|
||||
function for a, z with a not in -N. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Incomplete_gamma_function
|
||||
http://en.wikipedia.org/wiki/Incomplete_gamma_function
|
||||
|
||||
for information on the regularized lower incomplete gamma function.
|
||||
|
||||
@@ -1406,7 +1406,7 @@ specialfunctions.cal
|
||||
Calculates the value of the regularized upper incomplete gamma
|
||||
function for a, z with a not in -N. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Incomplete_gamma_function
|
||||
http://en.wikipedia.org/wiki/Incomplete_gamma_function
|
||||
|
||||
for information on the regularized upper incomplete gamma function.
|
||||
|
||||
@@ -1420,7 +1420,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates partial values of the harmonic series up to limit. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Harmonic_series_(mathematics)
|
||||
http://en.wikipedia.org/wiki/Harmonic_series_(mathematics)
|
||||
http://mathworld.wolfram.com/HarmonicSeries.html
|
||||
|
||||
for information on the harmonic series.
|
||||
@@ -1430,7 +1430,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the natural logarithm of the beta function. See:
|
||||
|
||||
https://en.wikipedia.org/wiki/Beta_function
|
||||
https://en.wikipedia.org/wiki/Beta_function
|
||||
http://mathworld.wolfram.com/BetaFunction.html
|
||||
http://dlmf.nist.gov/5.12
|
||||
|
||||
@@ -1441,7 +1441,7 @@ specialfunctions.cal
|
||||
Calculates the value of the logarithm of the Euler gamma function
|
||||
at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Gamma_function
|
||||
http://en.wikipedia.org/wiki/Gamma_function
|
||||
http://dlmf.nist.gov/5.15
|
||||
|
||||
for information on the derivatives of the the Euler gamma function.
|
||||
@@ -1452,7 +1452,7 @@ specialfunctions.cal
|
||||
Calculates the value of the m-th derivative of the Euler gamma
|
||||
function at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Polygamma
|
||||
http://en.wikipedia.org/wiki/Polygamma
|
||||
http://dlmf.nist.gov/5
|
||||
|
||||
for information on the n-th derivative of the Euler gamma function. This
|
||||
@@ -1464,7 +1464,7 @@ specialfunctions.cal
|
||||
Calculates the value of the first derivative of the Euler gamma
|
||||
function at z. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Digamma_function
|
||||
http://en.wikipedia.org/wiki/Digamma_function
|
||||
http://dlmf.nist.gov/5
|
||||
|
||||
for information on the first derivative of the Euler gamma function.
|
||||
@@ -1474,7 +1474,7 @@ specialfunctions.cal
|
||||
|
||||
Calculates the value of the Riemann Zeta function at s. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Riemann_zeta_function
|
||||
http://en.wikipedia.org/wiki/Riemann_zeta_function
|
||||
http://dlmf.nist.gov/25.2
|
||||
|
||||
for information on the Riemann zeta function. This function depends
|
||||
@@ -1492,7 +1492,7 @@ splitbits.cal
|
||||
|
||||
The number of elements in the returned list is:
|
||||
|
||||
ceil((highbit(x) + 1) / b)
|
||||
ceil((highbit(x) + 1) / b)
|
||||
|
||||
If x == 0, then a list of 1 element containing 0 is returned.
|
||||
|
||||
@@ -1502,17 +1502,17 @@ splitbits.cal
|
||||
the integer converted as if the integer was a two's compliment
|
||||
value. For example:
|
||||
|
||||
; L = splitbits(-1, 8);
|
||||
; print L[[0]]
|
||||
255
|
||||
; L = splitbits(-1, 8);
|
||||
; print L[[0]]
|
||||
255
|
||||
|
||||
; L = splitbits(-2, 8);
|
||||
; print L[[0]]
|
||||
254
|
||||
; L = splitbits(-2, 8);
|
||||
; print L[[0]]
|
||||
254
|
||||
|
||||
; L = splitbits(-3, 8);
|
||||
; print L[[0]]
|
||||
253
|
||||
; L = splitbits(-3, 8);
|
||||
; print L[[0]]
|
||||
253
|
||||
|
||||
The first element of the list contains the lowest order bits
|
||||
of x. The last element of the list contains the highest number
|
||||
@@ -1520,19 +1520,19 @@ splitbits.cal
|
||||
|
||||
For example:
|
||||
|
||||
; x = 2^23209-1
|
||||
; L = splitbits(x, 16);
|
||||
; print size(L), L[[0]]
|
||||
; x = 2^23209-1
|
||||
; L = splitbits(x, 16);
|
||||
; print size(L), L[[0]]
|
||||
|
||||
; print istype(2, 3i), istype(2, "2"), istype(2, null())
|
||||
0 0 0
|
||||
; print istype(2, 3i), istype(2, "2"), istype(2, null())
|
||||
0 0 0
|
||||
|
||||
; mat a[2]
|
||||
; b = list(1,2,3)
|
||||
; c = assoc()
|
||||
; obj chongo {was, here} d;
|
||||
; print istype(a,b), istype(b,c), istype(c,d)
|
||||
0 0 0
|
||||
; mat a[2]
|
||||
; b = list(1,2,3)
|
||||
; c = assoc()
|
||||
; obj chongo {was, here} d;
|
||||
; print istype(a,b), istype(b,c), istype(c,d)
|
||||
0 0 0
|
||||
|
||||
|
||||
statistics.cal
|
||||
@@ -1596,8 +1596,8 @@ strings.cal
|
||||
functions in calc.
|
||||
|
||||
WARNING: If the remaining functions in this calc resource file become
|
||||
calc builtin functions, then strings.cal may be removed in
|
||||
a future release.
|
||||
calc builtin functions, then strings.cal may be removed in
|
||||
a future release.
|
||||
|
||||
|
||||
sumsq.cal
|
||||
@@ -1627,7 +1627,7 @@ sumtimes.cal
|
||||
the list or matrix to use. The doalltimes() function will run
|
||||
all of the sumtimes tests. For example:
|
||||
|
||||
doalltimes(1e6);
|
||||
doalltimes(1e6);
|
||||
|
||||
|
||||
surd.cal
|
||||
@@ -1883,17 +1883,17 @@ test8900.special.cal
|
||||
This function tests a number of calc resource functions contributed
|
||||
by Christoph Zurnieden. These include:
|
||||
|
||||
bernpoly.cal
|
||||
brentsolve.cal
|
||||
constants.cal
|
||||
factorial2.cal
|
||||
factorial.cal
|
||||
lambertw.cal
|
||||
lnseries.cal
|
||||
specialfunctions.cal
|
||||
statistics.cal
|
||||
toomcook.cal
|
||||
zeta2.cal
|
||||
bernpoly.cal
|
||||
brentsolve.cal
|
||||
constants.cal
|
||||
factorial2.cal
|
||||
factorial.cal
|
||||
lambertw.cal
|
||||
lnseries.cal
|
||||
specialfunctions.cal
|
||||
statistics.cal
|
||||
toomcook.cal
|
||||
zeta2.cal
|
||||
|
||||
|
||||
test9300.frem.cal
|
||||
@@ -1920,14 +1920,14 @@ toomcook.cal
|
||||
Toom-Cook multiplication algorithm. Multiply two integers a,b by
|
||||
way of the Toom-Cook algorithm. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
|
||||
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
|
||||
|
||||
toomcook3square(a)
|
||||
toomcook4square(a)
|
||||
|
||||
Square the integer a by way of the Toom-Cook algorithm. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
|
||||
http://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication
|
||||
|
||||
The function toomCook4(a,b) calls the function toomCook3(a,b) which
|
||||
calls built-in multiplication at a specific cut-off point. The
|
||||
@@ -1981,7 +1981,7 @@ zeta2.cal
|
||||
|
||||
Calculate the value of the Hurwitz Zeta function. See:
|
||||
|
||||
http://en.wikipedia.org/wiki/Hurwitz_zeta_function
|
||||
http://en.wikipedia.org/wiki/Hurwitz_zeta_function
|
||||
http://dlmf.nist.gov/25.11
|
||||
|
||||
for information on this special zeta function.
|
||||
@@ -1997,7 +1997,7 @@ zeta2.cal
|
||||
##
|
||||
## Calc is distributed in the hope that it will be useful, but WITHOUT
|
||||
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
||||
## Public License for more details.
|
||||
##
|
||||
## A copy of version 2.1 of the GNU Lesser General Public License is
|
||||
@@ -2005,8 +2005,8 @@ zeta2.cal
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 1990/02/15 01:50:32
|
||||
## File existed as early as: before 1990
|
||||
## Under source code control: 1990/02/15 01:50:32
|
||||
## File existed as early as: before 1990
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
1512
cal/alg_config.cal
1512
cal/alg_config.cal
File diff suppressed because it is too large
Load Diff
32
cal/beer.cal
32
cal/beer.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/11/13 13:21:05
|
||||
* File existed as early as: 1996
|
||||
* Under source code control: 1996/11/13 13:21:05
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -30,17 +30,17 @@
|
||||
|
||||
|
||||
for (i=99; i > 0;) {
|
||||
/* current wall state */
|
||||
some_bottles = (i != 1) ? "bottles" : "bottle";
|
||||
print i, some_bottles, "of beer on the wall,",;
|
||||
print i, some_bottles, "of beer!";
|
||||
/* current wall state */
|
||||
some_bottles = (i != 1) ? "bottles" : "bottle";
|
||||
print i, some_bottles, "of beer on the wall,",;
|
||||
print i, some_bottles, "of beer!";
|
||||
|
||||
/* glug, glug */
|
||||
--i;
|
||||
print "Take one down and pass it around,",;
|
||||
/* glug, glug */
|
||||
--i;
|
||||
print "Take one down and pass it around,",;
|
||||
|
||||
/* new wall state */
|
||||
less = (i > 0) ? i : "no";
|
||||
bottles = (i!=1) ? "bottles" : "bottle";
|
||||
print less, bottles, "of beer on the wall!\n";
|
||||
/* new wall state */
|
||||
less = (i > 0) ? i : "no";
|
||||
bottles = (i!=1) ? "bottles" : "bottle";
|
||||
print less, bottles, "of beer on the wall!\n";
|
||||
}
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/09/30 11:18:41
|
||||
* File existed as early as: 1991
|
||||
* Under source code control: 1991/09/30 11:18:41
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -30,16 +30,16 @@
|
||||
*
|
||||
* The non-builtin code used the following symbolic formula to calculate B(n):
|
||||
*
|
||||
* (b+1)^(n+1) - b^(n+1) = 0
|
||||
* (b+1)^(n+1) - b^(n+1) = 0
|
||||
*
|
||||
* where b is a dummy value, and each power b^i gets replaced by B(i).
|
||||
* For example, for n = 3:
|
||||
*
|
||||
* (b+1)^4 - b^4 = 0
|
||||
* b^4 + 4*b^3 + 6*b^2 + 4*b + 1 - b^4 = 0
|
||||
* 4*b^3 + 6*b^2 + 4*b + 1 = 0
|
||||
* 4*B(3) + 6*B(2) + 4*B(1) + 1 = 0
|
||||
* B(3) = -(6*B(2) + 4*B(1) + 1) / 4
|
||||
* (b+1)^4 - b^4 = 0
|
||||
* b^4 + 4*b^3 + 6*b^2 + 4*b + 1 - b^4 = 0
|
||||
* 4*b^3 + 6*b^2 + 4*b + 1 = 0
|
||||
* 4*B(3) + 6*B(2) + 4*B(1) + 1 = 0
|
||||
* B(3) = -(6*B(2) + 4*B(1) + 1) / 4
|
||||
*
|
||||
* The combinatorial factors in the expansion of the above formula are
|
||||
* calculated interactively, and we use the fact that B(2i+1) = 0 if i > 0.
|
||||
@@ -56,38 +56,38 @@ static mat Bn[1001];
|
||||
define B(n)
|
||||
{
|
||||
/*
|
||||
local nn, np1, i, sum, mulval, divval, combval;
|
||||
local nn, np1, i, sum, mulval, divval, combval;
|
||||
|
||||
if (!isint(n) || (n < 0))
|
||||
quit "Non-negative integer required for Bernoulli";
|
||||
if (!isint(n) || (n < 0))
|
||||
quit "Non-negative integer required for Bernoulli";
|
||||
|
||||
if (n == 0)
|
||||
return 1;
|
||||
if (n == 1)
|
||||
return -1/2;
|
||||
if (isodd(n))
|
||||
return 0;
|
||||
if (n > 1000)
|
||||
quit "Very large Bernoulli";
|
||||
if (n == 0)
|
||||
return 1;
|
||||
if (n == 1)
|
||||
return -1/2;
|
||||
if (isodd(n))
|
||||
return 0;
|
||||
if (n > 1000)
|
||||
quit "Very large Bernoulli";
|
||||
|
||||
if (n <= Bnmax)
|
||||
return Bn[n];
|
||||
if (n <= Bnmax)
|
||||
return Bn[n];
|
||||
|
||||
for (nn = Bnmax + 2; nn <= n; nn+=2) {
|
||||
np1 = nn + 1;
|
||||
mulval = np1;
|
||||
divval = 1;
|
||||
combval = 1;
|
||||
sum = 1 - np1 / 2;
|
||||
for (i = 2; i < np1; i+=2) {
|
||||
combval = combval * mulval-- / divval++;
|
||||
combval = combval * mulval-- / divval++;
|
||||
sum += combval * Bn[i];
|
||||
}
|
||||
Bn[nn] = -sum / np1;
|
||||
}
|
||||
Bnmax = n;
|
||||
return Bn[n];
|
||||
for (nn = Bnmax + 2; nn <= n; nn+=2) {
|
||||
np1 = nn + 1;
|
||||
mulval = np1;
|
||||
divval = 1;
|
||||
combval = 1;
|
||||
sum = 1 - np1 / 2;
|
||||
for (i = 2; i < np1; i+=2) {
|
||||
combval = combval * mulval-- / divval++;
|
||||
combval = combval * mulval-- / divval++;
|
||||
sum += combval * Bn[i];
|
||||
}
|
||||
Bn[nn] = -sum / np1;
|
||||
}
|
||||
Bnmax = n;
|
||||
return Bn[n];
|
||||
*/
|
||||
return bernoulli(n);
|
||||
return bernoulli(n);
|
||||
}
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,29 +17,29 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:32
|
||||
* File existed as early as: 1991
|
||||
* Under source code control: 1991/05/22 21:56:32
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
define bigprime(a, m, p)
|
||||
{
|
||||
local n1, n;
|
||||
local n1, n;
|
||||
|
||||
n1 = 2^m * p;
|
||||
for (;;) {
|
||||
m++;
|
||||
n1 += n1;
|
||||
n = n1 + 1;
|
||||
if (isodd(m))
|
||||
continue;
|
||||
print m;
|
||||
if (pmod(a, n1 / 2, n) != n1)
|
||||
continue;
|
||||
if (pmod(a, n1 / p, n) == 1)
|
||||
continue;
|
||||
print " " : n;
|
||||
}
|
||||
n1 = 2^m * p;
|
||||
for (;;) {
|
||||
m++;
|
||||
n1 += n1;
|
||||
n = n1 + 1;
|
||||
if (isodd(m))
|
||||
continue;
|
||||
print m;
|
||||
if (pmod(a, n1 / 2, n) != n1)
|
||||
continue;
|
||||
if (pmod(a, n1 / p, n) == 1)
|
||||
continue;
|
||||
print " " : n;
|
||||
}
|
||||
}
|
||||
|
||||
92
cal/bindings
92
cal/bindings
@@ -8,7 +8,7 @@
|
||||
#
|
||||
# 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
|
||||
# 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
|
||||
@@ -16,56 +16,56 @@
|
||||
# received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
#
|
||||
# Under source code control: 1993/05/02 20:09:19
|
||||
# File existed as early as: 1993
|
||||
# Under source code control: 1993/05/02 20:09:19
|
||||
# File existed as early as: 1993
|
||||
#
|
||||
# Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
# NOTE: This facility is ignored if calc was compiled with GNU-readline.
|
||||
# In that case, the standard readline mechanisms (see readline(3))
|
||||
# are used in place of those found below.
|
||||
# In that case, the standard readline mechanisms (see readline(3))
|
||||
# are used in place of those found below.
|
||||
|
||||
|
||||
map base-map
|
||||
map base-map
|
||||
default insert-char
|
||||
^@ set-mark
|
||||
^A start-of-line
|
||||
^B backward-char
|
||||
^D delete-char
|
||||
^E end-of-line
|
||||
^F forward-char
|
||||
^H backward-kill-char
|
||||
^J new-line
|
||||
^K kill-line
|
||||
^L refresh-line
|
||||
^M new-line
|
||||
^N forward-history
|
||||
^O save-line
|
||||
^P backward-history
|
||||
^R reverse-search
|
||||
^T swap-chars
|
||||
^U flush-input
|
||||
^V quote-char
|
||||
^W kill-region
|
||||
^Y yank
|
||||
^? backward-kill-char
|
||||
^[ ignore-char esc-map
|
||||
^@ set-mark
|
||||
^A start-of-line
|
||||
^B backward-char
|
||||
^D delete-char
|
||||
^E end-of-line
|
||||
^F forward-char
|
||||
^H backward-kill-char
|
||||
^J new-line
|
||||
^K kill-line
|
||||
^L refresh-line
|
||||
^M new-line
|
||||
^N forward-history
|
||||
^O save-line
|
||||
^P backward-history
|
||||
^R reverse-search
|
||||
^T swap-chars
|
||||
^U flush-input
|
||||
^V quote-char
|
||||
^W kill-region
|
||||
^Y yank
|
||||
^? backward-kill-char
|
||||
^[ ignore-char esc-map
|
||||
|
||||
map esc-map
|
||||
default ignore-char base-map
|
||||
G start-of-line
|
||||
H backward-history
|
||||
P forward-history
|
||||
K backward-char
|
||||
M forward-char
|
||||
O end-of-line
|
||||
S delete-char
|
||||
g goto-line
|
||||
s backward-word
|
||||
t forward-word
|
||||
d forward-kill-word
|
||||
u uppercase-word
|
||||
l lowercase-word
|
||||
h list-history
|
||||
^[ flush-input
|
||||
[ arrow-key
|
||||
map esc-map
|
||||
default ignore-char base-map
|
||||
G start-of-line
|
||||
H backward-history
|
||||
P forward-history
|
||||
K backward-char
|
||||
M forward-char
|
||||
O end-of-line
|
||||
S delete-char
|
||||
g goto-line
|
||||
s backward-word
|
||||
t forward-word
|
||||
d forward-kill-word
|
||||
u uppercase-word
|
||||
l lowercase-word
|
||||
h list-history
|
||||
^[ flush-input
|
||||
[ arrow-key
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
|
||||
186
cal/chi.cal
186
cal/chi.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2001/03/27 14:10:11
|
||||
* File existed as early as: 2001
|
||||
* Under source code control: 2001/03/27 14:10:11
|
||||
* File existed as early as: 2001
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -29,20 +29,20 @@
|
||||
* Z(x)
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* Section 26.2.1, p931.
|
||||
*/
|
||||
define Z(x, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
local eps; /* error term */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/* compute Z(x) value */
|
||||
@@ -56,46 +56,46 @@ define Z(x, eps_term)
|
||||
* NOTE: If eps is omitted, the stored epsilon value is used.
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* 26.2.11, p932:
|
||||
*
|
||||
* P(x) = 1/2 + Z(x) * sum(n=0; n < infinity){x^(2*n+1)/(1*3*5*...(2*n+1)};
|
||||
* P(x) = 1/2 + Z(x) * sum(n=0; n < infinity){x^(2*n+1)/(1*3*5*...(2*n+1)};
|
||||
*
|
||||
* We continue the fraction until it is less than epsilon error term.
|
||||
*
|
||||
* Also note 26.2.5:
|
||||
*
|
||||
* P(x) + Q(x) = 1
|
||||
* P(x) + Q(x) = 1
|
||||
*/
|
||||
define P(x, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
local s; /* sum */
|
||||
local x2; /* x^2 */
|
||||
local x_term; /* x^(2*r+1) */
|
||||
local odd_prod; /* 1*3*5* ... */
|
||||
local odd_term; /* next odd value to multiply into odd_prod */
|
||||
local term; /* the recent term added to the sum */
|
||||
local eps; /* error term */
|
||||
local s; /* sum */
|
||||
local x2; /* x^2 */
|
||||
local x_term; /* x^(2*r+1) */
|
||||
local odd_prod; /* 1*3*5* ... */
|
||||
local odd_term; /* next odd value to multiply into odd_prod */
|
||||
local term; /* the recent term added to the sum */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/* firewall */
|
||||
if (x <= 0) {
|
||||
if (x == 0) {
|
||||
return 0; /* hack */
|
||||
} else {
|
||||
quit "Q(x[,eps]) 1st argument must be >= 0";
|
||||
}
|
||||
if (x == 0) {
|
||||
return 0; /* hack */
|
||||
} else {
|
||||
quit "Q(x[,eps]) 1st argument must be >= 0";
|
||||
}
|
||||
}
|
||||
if (eps <= 0) {
|
||||
quit "Q(x[,eps]) 2nd argument must be > 0";
|
||||
quit "Q(x[,eps]) 2nd argument must be > 0";
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -103,17 +103,17 @@ define P(x, eps_term)
|
||||
*/
|
||||
x2 = x*x;
|
||||
x_term = x;
|
||||
s = x_term; /* 1st term */
|
||||
s = x_term; /* 1st term */
|
||||
odd_term = 1;
|
||||
odd_prod = 1;
|
||||
do {
|
||||
|
||||
/* compute the term */
|
||||
odd_term += 2;
|
||||
odd_prod *= odd_term;
|
||||
x_term *= x2;
|
||||
term = x_term / odd_prod;
|
||||
s += term;
|
||||
/* compute the term */
|
||||
odd_term += 2;
|
||||
odd_prod *= odd_term;
|
||||
x_term *= x2;
|
||||
term = x_term / odd_prod;
|
||||
s += term;
|
||||
|
||||
} while (term >= eps);
|
||||
|
||||
@@ -133,68 +133,68 @@ define P(x, eps_term)
|
||||
* a sufficiently small error term as the degrees gets large (>100).
|
||||
*
|
||||
* NOTE: This function does not work well with odd degrees of freedom.
|
||||
* Can somebody help / find a bug / provide a better method of
|
||||
* this odd degrees of freedom case?
|
||||
* Can somebody help / find a bug / provide a better method of
|
||||
* this odd degrees of freedom case?
|
||||
*
|
||||
* NOTE: This function works well with even degrees of freedom. However
|
||||
* when the even degrees gets large (say, as you approach 100), you
|
||||
* need to increase your error term.
|
||||
* when the even degrees gets large (say, as you approach 100), you
|
||||
* need to increase your error term.
|
||||
*
|
||||
* From Handbook of Mathematical Functions
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
* 10th printing, Dec 1972 with corrections
|
||||
* National Bureau of Standards
|
||||
*
|
||||
* Section 26.4.4, p941:
|
||||
*
|
||||
* For odd v:
|
||||
*
|
||||
* Q(chi_sq, v) = 2*Q(chi) + 2*Z(chi) * (
|
||||
* sum(r=1, r<=(r-1)/2) {(chi_sq^r/chi) / (1*3*5*...(2*r-1)});
|
||||
* Q(chi_sq, v) = 2*Q(chi) + 2*Z(chi) * (
|
||||
* sum(r=1, r<=(r-1)/2) {(chi_sq^r/chi) / (1*3*5*...(2*r-1)});
|
||||
*
|
||||
* chi = sqrt(chi_sq)
|
||||
* chi = sqrt(chi_sq)
|
||||
*
|
||||
* NOTE: Q(x) = 1-P(x)
|
||||
* NOTE: Q(x) = 1-P(x)
|
||||
*
|
||||
* Section 26.4.5, p941.
|
||||
*
|
||||
* For even v:
|
||||
*
|
||||
* Q(chi_sq, v) = sqrt(2*pi()) * Z(chi) * ( 1 +
|
||||
* sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } );
|
||||
* Q(chi_sq, v) = sqrt(2*pi()) * Z(chi) * ( 1 +
|
||||
* sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } );
|
||||
*
|
||||
* chi = sqrt(chi_sq)
|
||||
* chi = sqrt(chi_sq)
|
||||
*
|
||||
* Observe that:
|
||||
*
|
||||
* Z(x) = exp(-x*x/2) / sqrt(2*pi()); (Section 26.2.1, p931)
|
||||
* Z(x) = exp(-x*x/2) / sqrt(2*pi()); (Section 26.2.1, p931)
|
||||
*
|
||||
* and thus:
|
||||
*
|
||||
* sqrt(2*pi()) * Z(chi) =
|
||||
* sqrt(2*pi()) * Z(sqrt(chi_sq)) =
|
||||
* sqrt(2*pi()) * exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) / sqrt(2*pi()) =
|
||||
* exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) =
|
||||
* exp(-sqrt(-chi_sq/2)
|
||||
* sqrt(2*pi()) * Z(chi) =
|
||||
* sqrt(2*pi()) * Z(sqrt(chi_sq)) =
|
||||
* sqrt(2*pi()) * exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) / sqrt(2*pi()) =
|
||||
* exp(-sqrt(chi_sq)*sqrt(chi_sq)/2) =
|
||||
* exp(-sqrt(-chi_sq/2)
|
||||
*
|
||||
* So:
|
||||
*
|
||||
* Q(chi_sq, v) = exp(-sqrt(-chi_sq/2) * ( 1 + sum(....){...} );
|
||||
* Q(chi_sq, v) = exp(-sqrt(-chi_sq/2) * ( 1 + sum(....){...} );
|
||||
*/
|
||||
define chi_prob(chi_sq, v, eps_term)
|
||||
{
|
||||
local eps; /* error term */
|
||||
local r; /* index in finite sum */
|
||||
local r_lim; /* limit value for r */
|
||||
local s; /* sum */
|
||||
local d; /* denominator (2*4*6*... or 1*3*5...) */
|
||||
local chi_term; /* chi_sq^r */
|
||||
local ret; /* return value */
|
||||
local eps; /* error term */
|
||||
local r; /* index in finite sum */
|
||||
local r_lim; /* limit value for r */
|
||||
local s; /* sum */
|
||||
local d; /* denominator (2*4*6*... or 1*3*5...) */
|
||||
local chi_term; /* chi_sq^r */
|
||||
local ret; /* return value */
|
||||
|
||||
/* obtain the error term */
|
||||
if (isnull(eps_term)) {
|
||||
eps = epsilon();
|
||||
eps = epsilon();
|
||||
} else {
|
||||
eps = eps_term;
|
||||
eps = eps_term;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -202,45 +202,45 @@ define chi_prob(chi_sq, v, eps_term)
|
||||
*/
|
||||
if (isodd(v)) {
|
||||
|
||||
local chi; /* sqrt(chi_sq) */
|
||||
local chi; /* sqrt(chi_sq) */
|
||||
|
||||
/* setup for sum */
|
||||
s = 1;
|
||||
d = 1;
|
||||
chi = sqrt(abs(chi_sq), eps);
|
||||
chi_term = chi;
|
||||
r_lim = (v-1)/2;
|
||||
/* setup for sum */
|
||||
s = 1;
|
||||
d = 1;
|
||||
chi = sqrt(abs(chi_sq), eps);
|
||||
chi_term = chi;
|
||||
r_lim = (v-1)/2;
|
||||
|
||||
/* compute sum(r=1, r=((v-1)/2)) {(chi_sq^r/chi) / (1*3*5...*(2r-1))} */
|
||||
for (r=2; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= (2*r)-1;
|
||||
s += chi_term/d;
|
||||
}
|
||||
/* compute sum(r=1, r=((v-1)/2)) {(chi_sq^r/chi) / (1*3*5...*(2r-1))} */
|
||||
for (r=2; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= (2*r)-1;
|
||||
s += chi_term/d;
|
||||
}
|
||||
|
||||
/* apply term and factor, Q(x) = 1-P(x) */
|
||||
ret = 2*(1-P(chi)) + 2*Z(chi)*s;
|
||||
/* apply term and factor, Q(x) = 1-P(x) */
|
||||
ret = 2*(1-P(chi)) + 2*Z(chi)*s;
|
||||
|
||||
/*
|
||||
* even degrees of freedom
|
||||
*/
|
||||
} else {
|
||||
|
||||
/* setup for sum */
|
||||
s =1;
|
||||
d = 1;
|
||||
chi_term = 1;
|
||||
r_lim = (v-2)/2;
|
||||
/* setup for sum */
|
||||
s =1;
|
||||
d = 1;
|
||||
chi_term = 1;
|
||||
r_lim = (v-2)/2;
|
||||
|
||||
/* compute sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } */
|
||||
for (r=1; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= r*2;
|
||||
s += chi_term/d;
|
||||
}
|
||||
/* compute sum(r=1, r=((v-2)/2)) { chi_sq^r / (2*4*...*(2r)) } */
|
||||
for (r=1; r <= r_lim; ++r) {
|
||||
chi_term *= chi_sq;
|
||||
d *= r*2;
|
||||
s += chi_term/d;
|
||||
}
|
||||
|
||||
/* apply factor - see observation in the main comment above */
|
||||
ret = exp(-chi_sq/2, eps) * s;
|
||||
/* apply factor - see observation in the main comment above */
|
||||
ret = exp(-chi_sq/2, eps) * s;
|
||||
}
|
||||
|
||||
return ret;
|
||||
|
||||
160
cal/chrem.cal
160
cal/chrem.cal
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,33 +19,33 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1992/09/26 01:00:47
|
||||
* File existed as early as: 1992
|
||||
* Under source code control: 1992/09/26 01:00:47
|
||||
* File existed as early as: 1992
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* When possible, chrem finds solutions for x of a set of congruence
|
||||
* of the form:
|
||||
*
|
||||
* x = r1 (mod m1)
|
||||
* x = r2 (mod m2)
|
||||
* ...
|
||||
* x = r1 (mod m1)
|
||||
* x = r2 (mod m2)
|
||||
* ...
|
||||
*
|
||||
* where the residues r1, r2, ... and the moduli m1, m2, ... are
|
||||
* given integers. The Chinese remainder theorem states that if
|
||||
* m1, m2, ... are relatively prime in pairs, the above congruence
|
||||
* have a unique solution modulo m1 * m2 * ... If m1, m2, ...
|
||||
* have a unique solution modulo m1 * m2 * ... If m1, m2, ...
|
||||
* are not relatively prime in pairs, it is possible that no solution
|
||||
* exists. If solutions exist, the general solution is expressible as:
|
||||
*
|
||||
* x = r (mod m)
|
||||
* x = r (mod m)
|
||||
*
|
||||
* where m = lcm(m1,m2,...), and if m > 0, 0 <= r < m. This
|
||||
* where m = lcm(m1,m2,...), and if m > 0, 0 <= r < m. This
|
||||
* solution may be interpreted as:
|
||||
*
|
||||
* x = r + k * m [[NOTE 1]]
|
||||
* x = r + k * m [[NOTE 1]]
|
||||
*
|
||||
* where k is an arbitrary integer.
|
||||
*
|
||||
@@ -53,19 +53,19 @@
|
||||
*
|
||||
* usage:
|
||||
*
|
||||
* chrem(r1,m1 [,r2,m2, ...])
|
||||
* chrem(r1,m1 [,r2,m2, ...])
|
||||
*
|
||||
* r1, r2, ... remainder integers or null values
|
||||
* m1, m2, ... moduli integers
|
||||
* r1, r2, ... remainder integers or null values
|
||||
* m1, m2, ... moduli integers
|
||||
*
|
||||
* chrem(r_list, [m_list])
|
||||
* chrem(r_list, [m_list])
|
||||
*
|
||||
* r_list list (r1,r2, ...)
|
||||
* m_list list (m1,m2, ...)
|
||||
* r_list list (r1,r2, ...)
|
||||
* m_list list (m1,m2, ...)
|
||||
*
|
||||
* If m_list is omitted, then 'defaultmlist' is used.
|
||||
* This default list is a global value that may be changed
|
||||
* by the user. Initially it is the first 8 primes.
|
||||
* If m_list is omitted, then 'defaultmlist' is used.
|
||||
* This default list is a global value that may be changed
|
||||
* by the user. Initially it is the first 8 primes.
|
||||
*
|
||||
* If a remainder is null(), then the corresponding congruence is
|
||||
* ignored. This is useful when working with a fixed list of moduli.
|
||||
@@ -75,17 +75,17 @@
|
||||
*
|
||||
* The moduli may be any integers, not necessarily relatively prime in
|
||||
* pairs (as required for the Chinese remainder theorem). Any moduli
|
||||
* may be zero; x = r (mod 0) has the meaning of x = r.
|
||||
* may be zero; x = r (mod 0) has the meaning of x = r.
|
||||
*
|
||||
* returns:
|
||||
*
|
||||
* If args were integer pairs:
|
||||
*
|
||||
* r ('r' is defined above, see [[NOTE 1]])
|
||||
* r ('r' is defined above, see [[NOTE 1]])
|
||||
*
|
||||
* If 1 or 2 list args were given:
|
||||
*
|
||||
* (r, m) ('r' and 'm' are defined above, see [[NOTE 1]])
|
||||
* (r, m) ('r' and 'm' are defined above, see [[NOTE 1]])
|
||||
*
|
||||
* NOTE: In all cases, null() is returned if there is no solution.
|
||||
*
|
||||
@@ -95,20 +95,20 @@
|
||||
*
|
||||
* Sun-Tsu, 1st century A.D.
|
||||
*
|
||||
* To find a number for which the reminders after division by 3, 5, 7
|
||||
* are 2, 3, 2, respectively:
|
||||
* To find a number for which the reminders after division by 3, 5, 7
|
||||
* are 2, 3, 2, respectively:
|
||||
*
|
||||
* chrem(2,3,3,5,2,7) ---> 23
|
||||
* chrem(2,3,3,5,2,7) ---> 23
|
||||
*
|
||||
* Fibonacci, 13th century A.D.
|
||||
*
|
||||
* To find a number divisible by 7 which leaves remainder 1 when
|
||||
* divided by 2, 3, 4, 5, or 6:
|
||||
* To find a number divisible by 7 which leaves remainder 1 when
|
||||
* divided by 2, 3, 4, 5, or 6:
|
||||
*
|
||||
*
|
||||
* chrem(list(0,1,1,1,1,1),list(7,2,3,4,5,6)) ---> (301,420)
|
||||
* chrem(list(0,1,1,1,1,1),list(7,2,3,4,5,6)) ---> (301,420)
|
||||
*
|
||||
* i.e., any value that is 301 mod 420.
|
||||
* i.e., any value that is 301 mod 420.
|
||||
*/
|
||||
|
||||
|
||||
@@ -116,10 +116,10 @@ static defaultmlist = list(2,3,5,7,11,13,17,19); /* The first eight primes */
|
||||
|
||||
define chrem()
|
||||
{
|
||||
local argc; /* number of args given */
|
||||
local rlist; /* reminder list - ri */
|
||||
local mlist; /* modulus list - mi */
|
||||
local list_args; /* true => args given are lists, not r1,m1, ... */
|
||||
local argc; /* number of args given */
|
||||
local rlist; /* reminder list - ri */
|
||||
local mlist; /* modulus list - mi */
|
||||
local list_args; /* true => args given are lists, not r1,m1, ... */
|
||||
local m,z,r,y,d,t,x,u,i;
|
||||
|
||||
/*
|
||||
@@ -127,25 +127,25 @@ define chrem()
|
||||
*/
|
||||
argc = param(0);
|
||||
if (argc == 0) {
|
||||
quit "usage: chrem(r1,m1 [,r2,m2 ...]) or chrem(r_list, m_list)";
|
||||
quit "usage: chrem(r1,m1 [,r2,m2 ...]) or chrem(r_list, m_list)";
|
||||
}
|
||||
list_args = islist(param(1));
|
||||
if (list_args) {
|
||||
rlist = param(1);
|
||||
mlist = (argc == 1) ? defaultmlist : param(2);
|
||||
if (size(rlist) > size(mlist)) {
|
||||
quit "too many residues";
|
||||
}
|
||||
rlist = param(1);
|
||||
mlist = (argc == 1) ? defaultmlist : param(2);
|
||||
if (size(rlist) > size(mlist)) {
|
||||
quit "too many residues";
|
||||
}
|
||||
} else {
|
||||
if (argc % 2 == 1) {
|
||||
quit "odd number integers given";
|
||||
}
|
||||
rlist = list();
|
||||
mlist = list();
|
||||
for (i=1; i <= argc; i+=2) {
|
||||
push(rlist, param(i));
|
||||
push(mlist, param(i+1));
|
||||
}
|
||||
if (argc % 2 == 1) {
|
||||
quit "odd number integers given";
|
||||
}
|
||||
rlist = list();
|
||||
mlist = list();
|
||||
for (i=1; i <= argc; i+=2) {
|
||||
push(rlist, param(i));
|
||||
push(mlist, param(i+1));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -154,46 +154,46 @@ define chrem()
|
||||
m = 1;
|
||||
z = 0;
|
||||
while (size(rlist)) {
|
||||
r=pop(rlist);
|
||||
y=abs(pop(mlist));
|
||||
if (r==null())
|
||||
continue;
|
||||
if (m) {
|
||||
if (y) {
|
||||
d = t = z - r;
|
||||
m = lcm(x=m, y);
|
||||
while (d % y) {
|
||||
u = x;
|
||||
x %= y;
|
||||
swap(x,y);
|
||||
if (y==0)
|
||||
return;
|
||||
z += (t *= -u/y);
|
||||
}
|
||||
} else {
|
||||
if ((r % m) != (z % m))
|
||||
return;
|
||||
else {
|
||||
m = 0;
|
||||
z = r;
|
||||
}
|
||||
}
|
||||
} else if (((y) && (r % y != z % y)) || (r != z))
|
||||
return;
|
||||
r=pop(rlist);
|
||||
y=abs(pop(mlist));
|
||||
if (r==null())
|
||||
continue;
|
||||
if (m) {
|
||||
if (y) {
|
||||
d = t = z - r;
|
||||
m = lcm(x=m, y);
|
||||
while (d % y) {
|
||||
u = x;
|
||||
x %= y;
|
||||
swap(x,y);
|
||||
if (y==0)
|
||||
return;
|
||||
z += (t *= -u/y);
|
||||
}
|
||||
} else {
|
||||
if ((r % m) != (z % m))
|
||||
return;
|
||||
else {
|
||||
m = 0;
|
||||
z = r;
|
||||
}
|
||||
}
|
||||
} else if (((y) && (r % y != z % y)) || (r != z))
|
||||
return;
|
||||
}
|
||||
if (m) {
|
||||
z %= m;
|
||||
if (z < 0)
|
||||
z += m;
|
||||
z %= m;
|
||||
if (z < 0)
|
||||
z += m;
|
||||
}
|
||||
|
||||
/*
|
||||
* return information as required
|
||||
*/
|
||||
if (list_args) {
|
||||
return list(z,m);
|
||||
return list(z,m);
|
||||
} else {
|
||||
return z;
|
||||
return z;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
260
cal/comma.cal
260
cal/comma.cal
@@ -7,53 +7,53 @@
|
||||
*
|
||||
* str_comma(x, [group, [decimal]])
|
||||
*
|
||||
* Convert x into a string.
|
||||
* Convert x into a string.
|
||||
*
|
||||
* If group is given and is a string, group will be used as
|
||||
* the 3-digit group separator, otherwise the default 3-digit
|
||||
* group separator will be used.
|
||||
* If group is given and is a string, group will be used as
|
||||
* the 3-digit group separator, otherwise the default 3-digit
|
||||
* group separator will be used.
|
||||
*
|
||||
* If decimal is given and is a string, group will be used as
|
||||
* the integer-fraction separator, otherwise the default
|
||||
* integer-fraction separator will be used.
|
||||
* If decimal is given and is a string, group will be used as
|
||||
* the integer-fraction separator, otherwise the default
|
||||
* integer-fraction separator will be used.
|
||||
*
|
||||
* The decimal and group arguments are optional.
|
||||
* The decimal and group arguments are optional.
|
||||
*
|
||||
* set_default_group_separator(group)
|
||||
*
|
||||
* Change the default 3-digit group separator if group is a string,
|
||||
* otherwise the default 3-digit group separator will not be
|
||||
* changed. Return the old 3-digit group separator.
|
||||
* Change the default 3-digit group separator if group is a string,
|
||||
* otherwise the default 3-digit group separator will not be
|
||||
* changed. Return the old 3-digit group separator.
|
||||
*
|
||||
* set_default_decimal_separator(decimal)
|
||||
*
|
||||
* Change the default 3-digit group separator if decimal is a
|
||||
* string, otherwise the default integer-fraction separator
|
||||
* will not be changed. Return the old integer-fraction separator.
|
||||
* Change the default 3-digit group separator if decimal is a
|
||||
* string, otherwise the default integer-fraction separator
|
||||
* will not be changed. Return the old integer-fraction separator.
|
||||
*
|
||||
* print_comma(x, [group, [decimal]])
|
||||
*
|
||||
* Print the value produced by str_comma(x, [group, [decimal]])
|
||||
* followed by a newline.
|
||||
* Print the value produced by str_comma(x, [group, [decimal]])
|
||||
* followed by a newline.
|
||||
*
|
||||
* If the str_comma() does not return a string, nothing is printed.
|
||||
* If the str_comma() does not return a string, nothing is printed.
|
||||
*
|
||||
* The decimal and group arguments are optional.
|
||||
* The decimal and group arguments are optional.
|
||||
*
|
||||
* The value produced by str_comma() is returned.
|
||||
* The value produced by str_comma() is returned.
|
||||
*
|
||||
* fprint_comma(fd, x, [group, [decimal]])
|
||||
*
|
||||
* Print the value produced by str_comma(x, [group, [decimal]]),
|
||||
* without a trailing newline, on file fd.
|
||||
* Print the value produced by str_comma(x, [group, [decimal]]),
|
||||
* without a trailing newline, on file fd.
|
||||
*
|
||||
* If the str_comma() does not return a string, nothing is printed.
|
||||
* If the str_comma() does not return a string, nothing is printed.
|
||||
*
|
||||
* If fd is not an open file, nothing is printed.
|
||||
* If fd is not an open file, nothing is printed.
|
||||
*
|
||||
* The decimal and group arguments are optional.
|
||||
* The decimal and group arguments are optional.
|
||||
*
|
||||
* The value produced by str_comma() is returned.
|
||||
* The value produced by str_comma() is returned.
|
||||
*
|
||||
* Copyright (C) 2022 Landon Curt Noll
|
||||
*
|
||||
@@ -78,8 +78,8 @@
|
||||
*/
|
||||
|
||||
|
||||
static default_group_separator = ","; /* default 3-digit group separator */
|
||||
static default_decimal_separator = "."; /* default integer-fraction separator */
|
||||
static default_group_separator = ","; /* default 3-digit group separator */
|
||||
static default_decimal_separator = "."; /* default integer-fraction separator */
|
||||
|
||||
|
||||
/*
|
||||
@@ -92,9 +92,9 @@ static default_decimal_separator = "."; /* default integer-fraction separator */
|
||||
*
|
||||
* For example:
|
||||
*
|
||||
* string = str_comma(x);
|
||||
* string = str_comma(x), " ", ".");
|
||||
* string = str_comma(x), ".", ",");
|
||||
* string = str_comma(x);
|
||||
* string = str_comma(x), " ", ".");
|
||||
* string = str_comma(x), ".", ",");
|
||||
*
|
||||
* Internally the function calls:
|
||||
*
|
||||
@@ -109,37 +109,37 @@ static default_decimal_separator = "."; /* default integer-fraction separator */
|
||||
*
|
||||
* given:
|
||||
*
|
||||
* x number to convert
|
||||
* x number to convert
|
||||
*
|
||||
* optional args:
|
||||
*
|
||||
* group use this 3-digit group separator
|
||||
* decimal use this integer-fraction separator
|
||||
* group use this 3-digit group separator
|
||||
* decimal use this integer-fraction separator
|
||||
*
|
||||
* returns:
|
||||
*
|
||||
* string containing the base 10 digits with group and decimal separators, OR
|
||||
* null() if x is not a number, OR
|
||||
* null() if group is neither null() (not given) nor a string, OR
|
||||
* null() if group is null() (not given) AND default_group_separator is not a string, OR
|
||||
* null() if decimal is neither null() (not given) nor a string, OR
|
||||
* null() if decimal is null() (not given) AND default_decimal_separator is not a string.
|
||||
* string containing the base 10 digits with group and decimal separators, OR
|
||||
* null() if x is not a number, OR
|
||||
* null() if group is neither null() (not given) nor a string, OR
|
||||
* null() if group is null() (not given) AND default_group_separator is not a string, OR
|
||||
* null() if decimal is neither null() (not given) nor a string, OR
|
||||
* null() if decimal is null() (not given) AND default_decimal_separator is not a string.
|
||||
*/
|
||||
define str_comma(x, group, decimal)
|
||||
{
|
||||
local group_separator; /* 3-digit group separator */
|
||||
local decimal_separator; /* separator between decimal integer and decimal fraction */
|
||||
local sign_str; /* leading - if x < 0 or empty if x >= 0 */
|
||||
local integer; /* integer part of absolute value of x */
|
||||
local int_str; /* integer as a string */
|
||||
local int_len; /* number of digits in int_str */
|
||||
local first_group_len; /* length of 1st group before the 1st 3-digit group separator */
|
||||
local fraction; /* factional part of absolute value of x */
|
||||
local frac_str; /* fraction as a string */
|
||||
local frac_len; /* number of digits in frac_str including leading 0. */
|
||||
local ret; /* string to return */
|
||||
local config_leadzero; /* config("leadzero") to restore */
|
||||
local config_tilde; /* config("tilde") to restore */
|
||||
local group_separator; /* 3-digit group separator */
|
||||
local decimal_separator; /* separator between decimal integer and decimal fraction */
|
||||
local sign_str; /* leading - if x < 0 or empty if x >= 0 */
|
||||
local integer; /* integer part of absolute value of x */
|
||||
local int_str; /* integer as a string */
|
||||
local int_len; /* number of digits in int_str */
|
||||
local first_group_len; /* length of 1st group before the 1st 3-digit group separator */
|
||||
local fraction; /* factional part of absolute value of x */
|
||||
local frac_str; /* fraction as a string */
|
||||
local frac_len; /* number of digits in frac_str including leading 0. */
|
||||
local ret; /* string to return */
|
||||
local config_leadzero; /* config("leadzero") to restore */
|
||||
local config_tilde; /* config("tilde") to restore */
|
||||
local i;
|
||||
|
||||
/*
|
||||
@@ -148,28 +148,28 @@ define str_comma(x, group, decimal)
|
||||
* Return null() if args or conditions are bogus.
|
||||
*/
|
||||
if (!isreal(x)) {
|
||||
return null();
|
||||
return null();
|
||||
}
|
||||
group_separator = isnull(group) ? default_group_separator : group;
|
||||
decimal_separator = isnull(decimal) ? default_decimal_separator : decimal;
|
||||
if (!isstr(group_separator)) {
|
||||
return null();
|
||||
return null();
|
||||
}
|
||||
if (!isstr(decimal_separator)) {
|
||||
return null();
|
||||
return null();
|
||||
}
|
||||
|
||||
/*
|
||||
* split number
|
||||
*/
|
||||
if (x < 0) {
|
||||
sign_str = "-";
|
||||
integer = int(-x);
|
||||
fraction = frac(-x);
|
||||
sign_str = "-";
|
||||
integer = int(-x);
|
||||
fraction = frac(-x);
|
||||
} else {
|
||||
sign_str = "";
|
||||
integer = int(x);
|
||||
fraction = frac(x);
|
||||
sign_str = "";
|
||||
integer = int(x);
|
||||
fraction = frac(x);
|
||||
}
|
||||
ret = sign_str;
|
||||
|
||||
@@ -199,32 +199,32 @@ define str_comma(x, group, decimal)
|
||||
* case: integer is 3 or fewer digits
|
||||
*/
|
||||
if (integer < 1000) {
|
||||
ret += int_str;
|
||||
ret += int_str;
|
||||
|
||||
/*
|
||||
* case: integer is 4 or more digits
|
||||
*/
|
||||
} else {
|
||||
|
||||
/*
|
||||
* form a decimal string using group separators
|
||||
*/
|
||||
/*
|
||||
* form a decimal string using group separators
|
||||
*/
|
||||
|
||||
/*
|
||||
* form the initial leading digits before 1st group separator
|
||||
*/
|
||||
first_group_len = int_len % 3;
|
||||
if (first_group_len == 0) {
|
||||
first_group_len = 3;
|
||||
}
|
||||
ret += substr(int_str, 1, first_group_len);
|
||||
/*
|
||||
* form the initial leading digits before 1st group separator
|
||||
*/
|
||||
first_group_len = int_len % 3;
|
||||
if (first_group_len == 0) {
|
||||
first_group_len = 3;
|
||||
}
|
||||
ret += substr(int_str, 1, first_group_len);
|
||||
|
||||
/*
|
||||
* until end of digits, print group separator followed by 3 more digits
|
||||
*/
|
||||
for (i = first_group_len+1; i < int_len; i += 3) {
|
||||
ret += group_separator + substr(int_str, i, 3);
|
||||
}
|
||||
/*
|
||||
* until end of digits, print group separator followed by 3 more digits
|
||||
*/
|
||||
for (i = first_group_len+1; i < int_len; i += 3) {
|
||||
ret += group_separator + substr(int_str, i, 3);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -236,24 +236,24 @@ define str_comma(x, group, decimal)
|
||||
*/
|
||||
if (fraction == 0) {
|
||||
|
||||
/* no fraction, nothing more to do */
|
||||
/* no fraction, nothing more to do */
|
||||
|
||||
/*
|
||||
* case: x is not an integer
|
||||
*/
|
||||
} else {
|
||||
|
||||
/*
|
||||
* add integer-fraction separator
|
||||
*/
|
||||
ret += decimal_separator;
|
||||
/*
|
||||
* add integer-fraction separator
|
||||
*/
|
||||
ret += decimal_separator;
|
||||
|
||||
/*
|
||||
* add remaining digits
|
||||
*
|
||||
* Skip over the leading 0. in frac_str
|
||||
*/
|
||||
ret += substr(frac_str, 2, frac_len-1);
|
||||
/*
|
||||
* add remaining digits
|
||||
*
|
||||
* Skip over the leading 0. in frac_str
|
||||
*/
|
||||
ret += substr(frac_str, 2, frac_len-1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -269,19 +269,19 @@ define str_comma(x, group, decimal)
|
||||
* If group is not a string, then the default 3-digit group separator
|
||||
* is not changed. Thus, this will only return the default 3-digit group separator:
|
||||
*
|
||||
* set_default_group_separator(null());
|
||||
* set_default_group_separator(null());
|
||||
*
|
||||
* given:
|
||||
*
|
||||
* group 3-digit group separator
|
||||
* group 3-digit group separator
|
||||
*
|
||||
* returns:
|
||||
*
|
||||
* previous 3-digit group separator value
|
||||
* previous 3-digit group separator value
|
||||
*/
|
||||
define set_default_group_separator(group)
|
||||
{
|
||||
local old_default_group_separator; /* previous default 3-digit group separator to return */
|
||||
local old_default_group_separator; /* previous default 3-digit group separator to return */
|
||||
|
||||
/*
|
||||
* save current 3-digit group separator
|
||||
@@ -292,7 +292,7 @@ define set_default_group_separator(group)
|
||||
* change 3-digit group separator if group is a string
|
||||
*/
|
||||
if (isstr(group)) {
|
||||
default_group_separator = group;
|
||||
default_group_separator = group;
|
||||
}
|
||||
return old_default_group_separator;
|
||||
}
|
||||
@@ -304,19 +304,19 @@ define set_default_group_separator(group)
|
||||
* If decimal is not a string, then the default integer-fraction separator
|
||||
* is not changed. Thus, this will only return the integer-fraction separator:
|
||||
*
|
||||
* set_default_decimal_separator(null());
|
||||
* set_default_decimal_separator(null());
|
||||
*
|
||||
* given:
|
||||
*
|
||||
* decimal separator between decimal integer and decimal fraction (def: ".")
|
||||
* decimal separator between decimal integer and decimal fraction (def: ".")
|
||||
*
|
||||
* returns:
|
||||
*
|
||||
* previous integer-fraction separator value
|
||||
* previous integer-fraction separator value
|
||||
*/
|
||||
define set_default_decimal_separator(decimal)
|
||||
{
|
||||
local old_default_decimal_separator; /* previous default integer-fraction separator */
|
||||
local old_default_decimal_separator; /* previous default integer-fraction separator */
|
||||
|
||||
/*
|
||||
* save current integer-fraction separator
|
||||
@@ -327,7 +327,7 @@ define set_default_decimal_separator(decimal)
|
||||
* change 3-digit decimal integer-fraction if decimal is a string
|
||||
*/
|
||||
if (isstr(decimal)) {
|
||||
default_decimal_separator = decimal;
|
||||
default_decimal_separator = decimal;
|
||||
}
|
||||
return old_default_decimal_separator;
|
||||
}
|
||||
@@ -339,34 +339,34 @@ define set_default_decimal_separator(decimal)
|
||||
* This function prints the result of str_comma(x, group, decimal) followed by a newline.
|
||||
* For example:
|
||||
*
|
||||
* print_comma(x);
|
||||
* print_comma(x), " ", ".");
|
||||
* print_comma(x), ".", ",");
|
||||
* print_comma(x);
|
||||
* print_comma(x), " ", ".");
|
||||
* print_comma(x), ".", ",");
|
||||
*
|
||||
* If str_comma() does not return a string, this function prints nothing.
|
||||
*
|
||||
* NOTE: To print without a newline, use fprint_comma(fd, x, group, decimal).
|
||||
*
|
||||
* given:
|
||||
* x number to convert
|
||||
* x number to convert
|
||||
*
|
||||
* optional args:
|
||||
*
|
||||
* group use this 3-digit group separator
|
||||
* decimal use this integer-fraction separator
|
||||
* group use this 3-digit group separator
|
||||
* decimal use this integer-fraction separator
|
||||
*
|
||||
* returns:
|
||||
*
|
||||
* string containing the base 10 digits with group and decimal separators, OR
|
||||
* null() if x is not a number, OR
|
||||
* null() if group is neither null() (not given) nor a string, OR
|
||||
* null() if group is null() (not given) AND default_group_separator is not a string, OR
|
||||
* null() if decimal is neither null() (not given) nor a string, OR
|
||||
* null() if decimal is null() (not given) AND default_decimal_separator is not a string.
|
||||
* string containing the base 10 digits with group and decimal separators, OR
|
||||
* null() if x is not a number, OR
|
||||
* null() if group is neither null() (not given) nor a string, OR
|
||||
* null() if group is null() (not given) AND default_group_separator is not a string, OR
|
||||
* null() if decimal is neither null() (not given) nor a string, OR
|
||||
* null() if decimal is null() (not given) AND default_decimal_separator is not a string.
|
||||
*/
|
||||
define print_comma(x, group, decimal)
|
||||
{
|
||||
local ret; /* base 10 string with 3-digit group and integer-fraction separators */
|
||||
local ret; /* base 10 string with 3-digit group and integer-fraction separators */
|
||||
|
||||
/*
|
||||
* convert to string
|
||||
@@ -377,7 +377,7 @@ define print_comma(x, group, decimal)
|
||||
* print converted string
|
||||
*/
|
||||
if (isstr(ret)) {
|
||||
printf("%s\n", ret);
|
||||
printf("%s\n", ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
@@ -389,9 +389,9 @@ define print_comma(x, group, decimal)
|
||||
* This function prints the result of str_comma(x, group, decimal) on an open file, without a trailing newline.
|
||||
* For example:
|
||||
*
|
||||
* fprint_comma(files(1), x);
|
||||
* fprint_comma(fd, x), " ", ".");
|
||||
* fprint_comma(files(2), x), ".", ",");
|
||||
* fprint_comma(files(1), x);
|
||||
* fprint_comma(fd, x), " ", ".");
|
||||
* fprint_comma(files(2), x), ".", ",");
|
||||
*
|
||||
* If str_comma() does not return a string, this function prints nothing.
|
||||
*
|
||||
@@ -400,26 +400,26 @@ define print_comma(x, group, decimal)
|
||||
* NOTE: To print with a newline, use print_comma(x, group, decimal).
|
||||
*
|
||||
* given:
|
||||
* fd open file
|
||||
* x number to convert
|
||||
* fd open file
|
||||
* x number to convert
|
||||
*
|
||||
* optional args:
|
||||
*
|
||||
* group use this 3-digit group separator
|
||||
* decimal use this integer-fraction separator
|
||||
* group use this 3-digit group separator
|
||||
* decimal use this integer-fraction separator
|
||||
*
|
||||
* returns:
|
||||
*
|
||||
* string containing the base 10 digits with group and integer-fraction separators, OR
|
||||
* null() if x is not a number, OR
|
||||
* null() if group is neither null() (not given) nor a string, OR
|
||||
* null() if group is null() (not given) AND default_group_separator is not a string, OR
|
||||
* null() if decimal is neither null() (not given) nor a string, OR
|
||||
* null() if decimal is null() (not given) AND default_decimal_separator is not a string.
|
||||
* string containing the base 10 digits with group and integer-fraction separators, OR
|
||||
* null() if x is not a number, OR
|
||||
* null() if group is neither null() (not given) nor a string, OR
|
||||
* null() if group is null() (not given) AND default_group_separator is not a string, OR
|
||||
* null() if decimal is neither null() (not given) nor a string, OR
|
||||
* null() if decimal is null() (not given) AND default_decimal_separator is not a string.
|
||||
*/
|
||||
define fprint_comma(fd, x, group, decimal)
|
||||
{
|
||||
local ret; /* base 10 string with 3-digit group and integer-fraction separators */
|
||||
local ret; /* base 10 string with 3-digit group and integer-fraction separators */
|
||||
|
||||
/*
|
||||
* convert to string
|
||||
@@ -430,8 +430,8 @@ define fprint_comma(fd, x, group, decimal)
|
||||
* print converted string
|
||||
*/
|
||||
if (isstr(ret) && isfile(fd)) {
|
||||
fprintf(fd, "%s", ret);
|
||||
fflush(fd);
|
||||
fprintf(fd, "%s", ret);
|
||||
fflush(fd);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
|
||||
128
cal/deg.cal
128
cal/deg.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
* 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/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -28,105 +28,105 @@ obj deg {deg, min, sec};
|
||||
|
||||
define deg(deg, min, sec)
|
||||
{
|
||||
local ans;
|
||||
local ans;
|
||||
|
||||
if (isnull(sec))
|
||||
sec = 0;
|
||||
if (isnull(min))
|
||||
min = 0;
|
||||
obj deg ans;
|
||||
ans.deg = deg;
|
||||
ans.min = min;
|
||||
ans.sec = sec;
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
if (isnull(sec))
|
||||
sec = 0;
|
||||
if (isnull(min))
|
||||
min = 0;
|
||||
obj deg ans;
|
||||
ans.deg = deg;
|
||||
ans.min = min;
|
||||
ans.sec = sec;
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_add(a, b)
|
||||
{
|
||||
local obj deg ans;
|
||||
local obj deg ans;
|
||||
|
||||
ans.deg = 0;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
if (istype(a, ans)) {
|
||||
ans.deg += a.deg;
|
||||
ans.min += a.min;
|
||||
ans.sec += a.sec;
|
||||
} else
|
||||
ans.deg += a;
|
||||
if (istype(b, ans)) {
|
||||
ans.deg += b.deg;
|
||||
ans.min += b.min;
|
||||
ans.sec += b.sec;
|
||||
} else
|
||||
ans.deg += b;
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
ans.deg = 0;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
if (istype(a, ans)) {
|
||||
ans.deg += a.deg;
|
||||
ans.min += a.min;
|
||||
ans.sec += a.sec;
|
||||
} else
|
||||
ans.deg += a;
|
||||
if (istype(b, ans)) {
|
||||
ans.deg += b.deg;
|
||||
ans.min += b.min;
|
||||
ans.sec += b.sec;
|
||||
} else
|
||||
ans.deg += b;
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_neg(a)
|
||||
{
|
||||
local obj deg ans;
|
||||
local obj deg ans;
|
||||
|
||||
ans.deg = -a.deg;
|
||||
ans.min = -a.min;
|
||||
ans.sec = -a.sec;
|
||||
return ans;
|
||||
ans.deg = -a.deg;
|
||||
ans.min = -a.min;
|
||||
ans.sec = -a.sec;
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_sub(a, b)
|
||||
{
|
||||
return a - b;
|
||||
return a - b;
|
||||
}
|
||||
|
||||
|
||||
define deg_mul(a, b)
|
||||
{
|
||||
local obj deg ans;
|
||||
local obj deg ans;
|
||||
|
||||
if (istype(a, ans) && istype(b, ans))
|
||||
quit "Cannot multiply degrees together";
|
||||
if (istype(a, ans)) {
|
||||
ans.deg = a.deg * b;
|
||||
ans.min = a.min * b;
|
||||
ans.sec = a.sec * b;
|
||||
} else {
|
||||
ans.deg = b.deg * a;
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
if (istype(a, ans) && istype(b, ans))
|
||||
quit "Cannot multiply degrees together";
|
||||
if (istype(a, ans)) {
|
||||
ans.deg = a.deg * b;
|
||||
ans.min = a.min * b;
|
||||
ans.sec = a.sec * b;
|
||||
} else {
|
||||
ans.deg = b.deg * a;
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
fixdeg(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
|
||||
define deg_print(a)
|
||||
{
|
||||
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
|
||||
print a.deg : 'd' : a.min : 'm' : a.sec : 's' :;
|
||||
}
|
||||
|
||||
|
||||
define deg_abs(a)
|
||||
{
|
||||
return a.deg + a.min / 60 + a.sec / 3600;
|
||||
return a.deg + a.min / 60 + a.sec / 3600;
|
||||
}
|
||||
|
||||
|
||||
define fixdeg(a)
|
||||
{
|
||||
a.min += frac(a.deg) * 60;
|
||||
a.deg = int(a.deg);
|
||||
a.sec += frac(a.min) * 60;
|
||||
a.min = int(a.min);
|
||||
a.min += a.sec // 60;
|
||||
a.sec %= 60;
|
||||
a.deg += a.min // 60;
|
||||
a.min %= 60;
|
||||
a.deg %= 360;
|
||||
a.min += frac(a.deg) * 60;
|
||||
a.deg = int(a.deg);
|
||||
a.sec += frac(a.min) * 60;
|
||||
a.min = int(a.min);
|
||||
a.min += a.sec // 60;
|
||||
a.sec %= 60;
|
||||
a.deg += a.min // 60;
|
||||
a.min %= 60;
|
||||
a.deg %= 360;
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
|
||||
176
cal/dms.cal
176
cal/dms.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
* 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/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -28,14 +28,14 @@ obj dms {deg, min, sec};
|
||||
|
||||
define dms(deg, min, sec)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* default missing args to 0 */
|
||||
if (isnull(sec)) {
|
||||
sec = 0;
|
||||
sec = 0;
|
||||
}
|
||||
if (isnull(min)) {
|
||||
min = 0;
|
||||
min = 0;
|
||||
}
|
||||
|
||||
/* load object */
|
||||
@@ -51,30 +51,30 @@ define dms(deg, min, sec)
|
||||
|
||||
define dms_add(a, b)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* initialize 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 2nd arg is not dms, add scalar degrees */
|
||||
ans.deg += b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -85,19 +85,19 @@ define dms_add(a, b)
|
||||
|
||||
define dms_neg(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
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;
|
||||
/* 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;
|
||||
/* 2nd arg is not dms, negate scalar degrees */
|
||||
ans.deg = -a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -108,30 +108,30 @@ define dms_neg(a)
|
||||
|
||||
define dms_sub(a, b)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* initialize 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 2nd arg is not dms, subtract scalar degrees */
|
||||
ans.deg -= b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -142,23 +142,23 @@ define dms_sub(a, b)
|
||||
|
||||
define dms_mul(a, b)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
ans.deg = b.deg * a;
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -169,11 +169,11 @@ define dms_mul(a, b)
|
||||
|
||||
define dms_print(a)
|
||||
{
|
||||
local obj dms ans; /* temp object for dms type testing */
|
||||
local obj dms ans; /* temp object for dms type testing */
|
||||
|
||||
/* firewall - arg must be a dms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "dms_print called with non dms object";
|
||||
quit "dms_print called with non dms object";
|
||||
}
|
||||
|
||||
/* print in dms form */
|
||||
@@ -183,12 +183,12 @@ define dms_print(a)
|
||||
|
||||
define dms_abs(a)
|
||||
{
|
||||
local obj dms ans; /* temp object for dms type testing */
|
||||
local deg; /* return scalar value */
|
||||
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);
|
||||
return abs(a);
|
||||
}
|
||||
|
||||
/* compute degrees */
|
||||
@@ -201,12 +201,12 @@ define dms_abs(a)
|
||||
|
||||
define dms_norm(a)
|
||||
{
|
||||
local obj dms ans; /* temp object for dms type testing */
|
||||
local deg; /* degrees */
|
||||
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";
|
||||
quit "dms_norm called with non dms object";
|
||||
}
|
||||
|
||||
/* square degrees (norm is the square of absolute value */
|
||||
@@ -219,18 +219,18 @@ define dms_norm(a)
|
||||
|
||||
define dms_test(a)
|
||||
{
|
||||
local obj dms ans; /* temp value */
|
||||
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";
|
||||
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;
|
||||
/* false */
|
||||
return 0;
|
||||
}
|
||||
/* true */
|
||||
return 1;
|
||||
@@ -239,11 +239,11 @@ define dms_test(a)
|
||||
|
||||
define dms_int(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
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";
|
||||
quit "dms_int called with non dms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
@@ -259,11 +259,11 @@ define dms_int(a)
|
||||
|
||||
define dms_frac(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
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";
|
||||
quit "dms_frac called with non dms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
@@ -281,7 +281,7 @@ define dms_frac(a)
|
||||
|
||||
define dms_rel(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = dms_abs(a);
|
||||
@@ -294,7 +294,7 @@ define dms_rel(a,b)
|
||||
|
||||
define dms_cmp(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = dms_abs(a);
|
||||
@@ -307,16 +307,16 @@ define dms_cmp(a,b)
|
||||
|
||||
define dms_inc(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* increment a dms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
++ans.sec;
|
||||
ans = a;
|
||||
++ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* increment a scalar */
|
||||
@@ -326,16 +326,16 @@ define dms_inc(a)
|
||||
|
||||
define dms_dec(a)
|
||||
{
|
||||
local obj dms ans; /* return value */
|
||||
local obj dms ans; /* return value */
|
||||
|
||||
/* decrement a dms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
--ans.sec;
|
||||
ans = a;
|
||||
--ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
/* return normalized result */
|
||||
ans = fixdms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* decrement a scalar */
|
||||
@@ -345,11 +345,11 @@ define dms_dec(a)
|
||||
|
||||
define fixdms(a)
|
||||
{
|
||||
local obj dms ans; /* temp value */
|
||||
local obj dms ans; /* temp value */
|
||||
|
||||
/* firewall */
|
||||
if (! istype(a, ans)) {
|
||||
quit "attempt to fix a non dms object";
|
||||
quit "attempt to fix a non dms object";
|
||||
}
|
||||
|
||||
/* use builtin d2dms function */
|
||||
|
||||
158
cal/dotest.cal
158
cal/dotest.cal
@@ -7,7 +7,7 @@
|
||||
* This file is not covered under version 2.1 of the GNU LGPL.
|
||||
* This file is covered under "The unlicense":
|
||||
*
|
||||
* https://unlicense.org
|
||||
* https://unlicense.org
|
||||
*
|
||||
* In particular:
|
||||
*
|
||||
@@ -36,8 +36,8 @@
|
||||
*
|
||||
* For more information, please refer to <http://unlicense.org/>
|
||||
*
|
||||
* Under source dotest_code control: 2006/03/08 05:54:09
|
||||
* File existed as early as: 2006
|
||||
* Under source dotest_code control: 2006/03/08 05:54:09
|
||||
* File existed as early as: 2006
|
||||
*/
|
||||
|
||||
|
||||
@@ -45,29 +45,29 @@
|
||||
* dotest - perform tests from dotest_testline file
|
||||
*
|
||||
* given:
|
||||
* dotest_file filename containing single test lines
|
||||
* dotest_code regress.cal test number to use (def: 0)
|
||||
* dotest_maxcond max error conditions allowed (def: <0 ==> 2^31-1)
|
||||
* dotest_file filename containing single test lines
|
||||
* dotest_code regress.cal test number to use (def: 0)
|
||||
* dotest_maxcond max error conditions allowed (def: <0 ==> 2^31-1)
|
||||
*
|
||||
* returns:
|
||||
* number of line test failures
|
||||
* number of line test failures
|
||||
*
|
||||
* NOTE: All variables used by the dotest() function start with "dotest_".
|
||||
* The dotest_file and dotest_read should not use any variable
|
||||
* that starts with "dotest_".
|
||||
* The dotest_file and dotest_read should not use any variable
|
||||
* that starts with "dotest_".
|
||||
*/
|
||||
define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
|
||||
{
|
||||
local dotest_f_file; /* open file containing test lines */
|
||||
local dotest_testline; /* test line */
|
||||
local dotest_testeval; /* eval value from dotest_testline test line */
|
||||
local dotest_tmperrcnt; /* temp error count after line test */
|
||||
local dotest_errcnt; /* total number of errors */
|
||||
local dotest_failcnt; /* number of line tests failed */
|
||||
local dotest_testnum; /* number of test lines evaluated */
|
||||
local dotest_linenum; /* test line number */
|
||||
local dotest_old_errmax; /* value of errmax() prior to calling */
|
||||
local dotest_old_errcount; /* value of errcount() prior to calling */
|
||||
local dotest_f_file; /* open file containing test lines */
|
||||
local dotest_testline; /* test line */
|
||||
local dotest_testeval; /* eval value from dotest_testline test line */
|
||||
local dotest_tmperrcnt; /* temp error count after line test */
|
||||
local dotest_errcnt; /* total number of errors */
|
||||
local dotest_failcnt; /* number of line tests failed */
|
||||
local dotest_testnum; /* number of test lines evaluated */
|
||||
local dotest_linenum; /* test line number */
|
||||
local dotest_old_errmax; /* value of errmax() prior to calling */
|
||||
local dotest_old_errcount; /* value of errcount() prior to calling */
|
||||
|
||||
/*
|
||||
* preserve calling stats
|
||||
@@ -87,9 +87,9 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
|
||||
* setup error accounting for dotest
|
||||
*/
|
||||
if (dotest_maxcond >= 0 && dotest_maxcond < 2147483647) {
|
||||
errmax(dotest_maxcond + dotest_old_errcount + 1),;
|
||||
errmax(dotest_maxcond + dotest_old_errcount + 1),;
|
||||
} else {
|
||||
errmax(2147483647),;
|
||||
errmax(2147483647),;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -98,9 +98,9 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
|
||||
printf("%d-: opening line file: %d", dotest_code, dotest_file);
|
||||
dotest_f_file = fpathopen(dotest_file, "r");
|
||||
if (!isfile(dotest_f_file)) {
|
||||
printf("**** Unable to file or open file \"%s\"\n",
|
||||
dotest_file);
|
||||
quit;
|
||||
printf("**** Unable to file or open file \"%s\"\n",
|
||||
dotest_file);
|
||||
quit;
|
||||
}
|
||||
printf('%d: testing "%s"\n', dotest_code, dotest_file);
|
||||
|
||||
@@ -109,73 +109,73 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
|
||||
*/
|
||||
for (;;) {
|
||||
|
||||
/* get the next test line */
|
||||
dotest_testline = fgets(dotest_f_file);
|
||||
++dotest_linenum;
|
||||
if (iserror(dotest_testline)) {
|
||||
quit "**** Error while reading file";
|
||||
} else if (isnull(dotest_testline)) {
|
||||
/* EOF - end of test file */
|
||||
break;
|
||||
}
|
||||
/* get the next test line */
|
||||
dotest_testline = fgets(dotest_f_file);
|
||||
++dotest_linenum;
|
||||
if (iserror(dotest_testline)) {
|
||||
quit "**** Error while reading file";
|
||||
} else if (isnull(dotest_testline)) {
|
||||
/* EOF - end of test file */
|
||||
break;
|
||||
}
|
||||
|
||||
/* skip empty lines */
|
||||
if (dotest_testline == "\n") {
|
||||
continue;
|
||||
}
|
||||
/* skip empty lines */
|
||||
if (dotest_testline == "\n") {
|
||||
continue;
|
||||
}
|
||||
|
||||
/* evaluate the test line */
|
||||
dotest_testeval = eval(dotest_testline);
|
||||
/* evaluate the test line */
|
||||
dotest_testeval = eval(dotest_testline);
|
||||
|
||||
/* ignore white space or comment lines */
|
||||
if (isnull(dotest_testeval)) {
|
||||
continue;
|
||||
}
|
||||
/* ignore white space or comment lines */
|
||||
if (isnull(dotest_testeval)) {
|
||||
continue;
|
||||
}
|
||||
|
||||
/* look for test line parse errors */
|
||||
if (iserror(dotest_testeval)) {
|
||||
printf("**** evaluation error: ");
|
||||
++dotest_failcnt;
|
||||
/* look for test line parse errors */
|
||||
if (iserror(dotest_testeval)) {
|
||||
printf("**** evaluation error: ");
|
||||
++dotest_failcnt;
|
||||
|
||||
/* look for test line dotest_failcnt */
|
||||
} else if (dotest_testeval != 1) {
|
||||
printf("**** did not return 1: ");
|
||||
++dotest_failcnt;
|
||||
}
|
||||
/* look for test line dotest_failcnt */
|
||||
} else if (dotest_testeval != 1) {
|
||||
printf("**** did not return 1: ");
|
||||
++dotest_failcnt;
|
||||
}
|
||||
|
||||
/* show the test line we just performed */
|
||||
printf("%d-%d: %s", dotest_code, dotest_linenum, dotest_testline);
|
||||
/* show the test line we just performed */
|
||||
printf("%d-%d: %s", dotest_code, dotest_linenum, dotest_testline);
|
||||
|
||||
/* error accounting */
|
||||
dotest_tmperrcnt = errcount() - dotest_errcnt;
|
||||
if (dotest_tmperrcnt > 0) {
|
||||
/* error accounting */
|
||||
dotest_tmperrcnt = errcount() - dotest_errcnt;
|
||||
if (dotest_tmperrcnt > 0) {
|
||||
|
||||
/* report any other errors */
|
||||
if (dotest_tmperrcnt > 1) {
|
||||
printf("%d-%d: NOTE: %d error conditions(s): %s\n",
|
||||
dotest_code, dotest_linenum, dotest_tmperrcnt);
|
||||
}
|
||||
/* report any other errors */
|
||||
if (dotest_tmperrcnt > 1) {
|
||||
printf("%d-%d: NOTE: %d error conditions(s): %s\n",
|
||||
dotest_code, dotest_linenum, dotest_tmperrcnt);
|
||||
}
|
||||
|
||||
/* report the calc error string */
|
||||
printf("%d-%d: NOTE: last error string: %s\n",
|
||||
dotest_code, dotest_linenum, strerror());
|
||||
/* report the calc error string */
|
||||
printf("%d-%d: NOTE: last error string: %s\n",
|
||||
dotest_code, dotest_linenum, strerror());
|
||||
|
||||
/* new error count level */
|
||||
dotest_errcnt = errcount();
|
||||
if (dotest_maxcond >= 0 &&
|
||||
dotest_old_errcount-dotest_errcnt > dotest_maxcond) {
|
||||
printf("%d-%d: total error conditions: %d > %d\n",
|
||||
dotest_code, dotest_linenum,
|
||||
dotest_maxcond, dotest_old_errcount-dotest_errcnt);
|
||||
}
|
||||
}
|
||||
/* new error count level */
|
||||
dotest_errcnt = errcount();
|
||||
if (dotest_maxcond >= 0 &&
|
||||
dotest_old_errcount-dotest_errcnt > dotest_maxcond) {
|
||||
printf("%d-%d: total error conditions: %d > %d\n",
|
||||
dotest_code, dotest_linenum,
|
||||
dotest_maxcond, dotest_old_errcount-dotest_errcnt);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* test the close of the line file
|
||||
*/
|
||||
printf("%d-: detected %d error condition(s), many of which may be OK\n",
|
||||
dotest_code, dotest_old_errcount-dotest_errcnt);
|
||||
dotest_code, dotest_old_errcount-dotest_errcnt);
|
||||
printf("%d-: closing line file: %d\n", dotest_code, dotest_file);
|
||||
fclose(dotest_f_file);
|
||||
|
||||
@@ -183,11 +183,11 @@ define dotest(dotest_file, dotest_code = 0, dotest_maxcond = -1)
|
||||
* test line file accounting
|
||||
*/
|
||||
if (dotest_failcnt > 0) {
|
||||
printf("**** %d-: %d test failure(s) in %d line(s)\n",
|
||||
dotest_code, dotest_failcnt, dotest_linenum);
|
||||
printf("**** %d-: %d test failure(s) in %d line(s)\n",
|
||||
dotest_code, dotest_failcnt, dotest_linenum);
|
||||
} else {
|
||||
printf("%d-: no failure(s) in %d line(s)\n",
|
||||
dotest_code, dotest_linenum);
|
||||
printf("%d-: no failure(s) in %d line(s)\n",
|
||||
dotest_code, dotest_linenum);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
178
cal/ellip.cal
178
cal/ellip.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,16 +17,16 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:33
|
||||
* File existed as early as: before 1990
|
||||
* 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/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Attempt to factor numbers using elliptic functions:
|
||||
*
|
||||
* y^2 = x^3 + a*x + b (mod ellip_N).
|
||||
* y^2 = x^3 + a*x + b (mod ellip_N).
|
||||
*
|
||||
* Many points (x,y) (mod ellip_N) are found that solve the above equation,
|
||||
* starting from a trivial solution and 'multiplying' that point together
|
||||
@@ -47,13 +47,13 @@
|
||||
* Theory and Cryptography" by Neal Koblitz for a good explanation.
|
||||
*
|
||||
* efactor(iN, ia, B, force)
|
||||
* iN is the number to be factored.
|
||||
* ia is the initial value of a in the equation, and each successive
|
||||
* value of a is an independent attempt at factoring (default 1).
|
||||
* B is the limit of the primes that make up the high power that the
|
||||
* point is raised to for each factoring attempt (default 100).
|
||||
* force is a flag to attempt to factor numbers even if they are
|
||||
* thought to already be prime (default false).
|
||||
* iN is the number to be factored.
|
||||
* ia is the initial value of a in the equation, and each successive
|
||||
* value of a is an independent attempt at factoring (default 1).
|
||||
* B is the limit of the primes that make up the high power that the
|
||||
* point is raised to for each factoring attempt (default 100).
|
||||
* force is a flag to attempt to factor numbers even if they are
|
||||
* thought to already be prime (default false).
|
||||
*
|
||||
* Making B larger makes the power the point being raised to contain more
|
||||
* prime factors, thus increasing the chance that the order of the point
|
||||
@@ -77,114 +77,114 @@
|
||||
* of the powers so far.
|
||||
*
|
||||
* If a factor is found, it is returned and is also saved in the global
|
||||
* variable f. The number being factored is also saved in the global
|
||||
* variable f. The number being factored is also saved in the global
|
||||
* variable ellip_N.
|
||||
*/
|
||||
|
||||
|
||||
obj point {x, y};
|
||||
global ellip_N; /* number to factor */
|
||||
global ellip_a; /* first coefficient */
|
||||
global ellip_b; /* second coefficient */
|
||||
global ellip_f; /* found factor */
|
||||
global ellip_N; /* number to factor */
|
||||
global ellip_a; /* first coefficient */
|
||||
global ellip_b; /* second coefficient */
|
||||
global ellip_f; /* found factor */
|
||||
|
||||
|
||||
define efactor(iN, ia, B, force)
|
||||
{
|
||||
local C, x, p;
|
||||
local C, x, p;
|
||||
|
||||
if (!force && ptest(iN, 50))
|
||||
return 1;
|
||||
if (isnull(B))
|
||||
B = 100;
|
||||
if (isnull(ia))
|
||||
ia = 1;
|
||||
obj point x;
|
||||
ellip_a = ia;
|
||||
ellip_b = -ia;
|
||||
ellip_N = iN;
|
||||
C = isqrt(ellip_N);
|
||||
C = 2 * C + 2 * isqrt(C) + 1;
|
||||
ellip_f = 0;
|
||||
while (ellip_f == 0) {
|
||||
print "A =", ellip_a;
|
||||
x.x = 1;
|
||||
x.y = 1;
|
||||
print 2, x;
|
||||
x = x ^ (2 ^ (highbit(C) + 1));
|
||||
for (p = 3; ((p < B) && (ellip_f == 0)); p += 2) {
|
||||
if (!ptest(p, 1))
|
||||
continue;
|
||||
print p, x;
|
||||
x = x ^ (p ^ ((highbit(C) // highbit(p)) + 1));
|
||||
}
|
||||
ellip_a++;
|
||||
ellip_b--;
|
||||
}
|
||||
return ellip_f;
|
||||
if (!force && ptest(iN, 50))
|
||||
return 1;
|
||||
if (isnull(B))
|
||||
B = 100;
|
||||
if (isnull(ia))
|
||||
ia = 1;
|
||||
obj point x;
|
||||
ellip_a = ia;
|
||||
ellip_b = -ia;
|
||||
ellip_N = iN;
|
||||
C = isqrt(ellip_N);
|
||||
C = 2 * C + 2 * isqrt(C) + 1;
|
||||
ellip_f = 0;
|
||||
while (ellip_f == 0) {
|
||||
print "A =", ellip_a;
|
||||
x.x = 1;
|
||||
x.y = 1;
|
||||
print 2, x;
|
||||
x = x ^ (2 ^ (highbit(C) + 1));
|
||||
for (p = 3; ((p < B) && (ellip_f == 0)); p += 2) {
|
||||
if (!ptest(p, 1))
|
||||
continue;
|
||||
print p, x;
|
||||
x = x ^ (p ^ ((highbit(C) // highbit(p)) + 1));
|
||||
}
|
||||
ellip_a++;
|
||||
ellip_b--;
|
||||
}
|
||||
return ellip_f;
|
||||
}
|
||||
|
||||
|
||||
define point_print(p)
|
||||
{
|
||||
print "(" : p.x : "," : p.y : ")" :;
|
||||
print "(" : p.x : "," : p.y : ")" :;
|
||||
}
|
||||
|
||||
|
||||
define point_mul(p1, p2)
|
||||
{
|
||||
local r, m;
|
||||
local r, m;
|
||||
|
||||
if (p2 == 1)
|
||||
return p1;
|
||||
if (p1 == p2)
|
||||
return point_square(`p1);
|
||||
obj point r;
|
||||
m = (minv(p2.x - p1.x, ellip_N) * (p2.y - p1.y)) % ellip_N;
|
||||
if (m == 0) {
|
||||
if (ellip_f == 0)
|
||||
ellip_f = gcd(p2.x - p1.x, ellip_N);
|
||||
r.x = 1;
|
||||
r.y = 1;
|
||||
return r;
|
||||
}
|
||||
r.x = (m^2 - p1.x - p2.x) % ellip_N;
|
||||
r.y = ((m * (p1.x - r.x)) - p1.y) % ellip_N;
|
||||
return r;
|
||||
if (p2 == 1)
|
||||
return p1;
|
||||
if (p1 == p2)
|
||||
return point_square(`p1);
|
||||
obj point r;
|
||||
m = (minv(p2.x - p1.x, ellip_N) * (p2.y - p1.y)) % ellip_N;
|
||||
if (m == 0) {
|
||||
if (ellip_f == 0)
|
||||
ellip_f = gcd(p2.x - p1.x, ellip_N);
|
||||
r.x = 1;
|
||||
r.y = 1;
|
||||
return r;
|
||||
}
|
||||
r.x = (m^2 - p1.x - p2.x) % ellip_N;
|
||||
r.y = ((m * (p1.x - r.x)) - p1.y) % ellip_N;
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
define point_square(p)
|
||||
{
|
||||
local r, m;
|
||||
local r, m;
|
||||
|
||||
obj point r;
|
||||
m = ((3 * p.x^2 + ellip_a) * minv(p.y << 1, ellip_N)) % ellip_N;
|
||||
if (m == 0) {
|
||||
if (ellip_f == 0)
|
||||
ellip_f = gcd(p.y << 1, ellip_N);
|
||||
r.x = 1;
|
||||
r.y = 1;
|
||||
return r;
|
||||
}
|
||||
r.x = (m^2 - p.x - p.x) % ellip_N;
|
||||
r.y = ((m * (p.x - r.x)) - p.y) % ellip_N;
|
||||
return r;
|
||||
obj point r;
|
||||
m = ((3 * p.x^2 + ellip_a) * minv(p.y << 1, ellip_N)) % ellip_N;
|
||||
if (m == 0) {
|
||||
if (ellip_f == 0)
|
||||
ellip_f = gcd(p.y << 1, ellip_N);
|
||||
r.x = 1;
|
||||
r.y = 1;
|
||||
return r;
|
||||
}
|
||||
r.x = (m^2 - p.x - p.x) % ellip_N;
|
||||
r.y = ((m * (p.x - r.x)) - p.y) % ellip_N;
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
define point_pow(p, pow)
|
||||
{
|
||||
local bit, r, t;
|
||||
local bit, r, t;
|
||||
|
||||
r = 1;
|
||||
if (isodd(pow))
|
||||
r = p;
|
||||
t = p;
|
||||
for (bit = 2; ((bit <= pow) && (ellip_f == 0)); bit <<= 1) {
|
||||
t = point_square(`t);
|
||||
if (bit & pow)
|
||||
r = point_mul(`t, `r);
|
||||
}
|
||||
return r;
|
||||
r = 1;
|
||||
if (isodd(pow))
|
||||
r = p;
|
||||
t = p;
|
||||
for (bit = 2; ((bit <= pow) && (ellip_f == 0)); bit <<= 1) {
|
||||
t = point_square(`t);
|
||||
if (bit & pow)
|
||||
r = point_mul(`t, `r);
|
||||
}
|
||||
return r;
|
||||
}
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
@@ -56,7 +56,7 @@ define __CZ__factor_factorial(n,start){
|
||||
if(start){
|
||||
if(!isint(start) && start < 0 && start > n)
|
||||
return newerror("__CZ__factor_factorial(n,start): value of "
|
||||
"parameter 'start' out of range");
|
||||
"parameter 'start' out of range");
|
||||
if(start == n && isprime(n)){
|
||||
prime_list = mat[1 , 2];
|
||||
prime_list[0,0] = n;
|
||||
@@ -64,7 +64,7 @@ define __CZ__factor_factorial(n,start){
|
||||
}
|
||||
else if(!isprime(start) && nextprime(start) >n)
|
||||
return newerror("__CZ__factor_factorial(n,start): value of parameter "
|
||||
"'start' out of range");
|
||||
"'start' out of range");
|
||||
else{
|
||||
if(!isprime(start)) prime = nextprime(start);
|
||||
else prime = start;
|
||||
@@ -168,34 +168,34 @@ define __CZ__add_factored_factorials(matrix_2n,matrix_n){
|
||||
|
||||
|
||||
timings
|
||||
this comb comb-this rel. k/n
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
n=2^25 k=2^17 319.127944 529.025062 - 0.68
|
||||
*/
|
||||
|
||||
define benchmark_binomial(s,limit){
|
||||
@@ -207,7 +207,7 @@ define benchmark_binomial(s,limit){
|
||||
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;
|
||||
print "n=2^"limit,"k=2^"k," ",T1," ",T2,T1<T2?"-":"+"," "k/limit;
|
||||
if(A!=B){
|
||||
print "false";
|
||||
break;
|
||||
@@ -225,11 +225,11 @@ define __CZ__multiply_factored_factorial(matrix,stop){
|
||||
|
||||
if(!ismat(matrix))
|
||||
return newerror("__CZ__multiply_factored_factorial(matrix): "
|
||||
"argument matrix not a matrix ");
|
||||
"argument matrix not a matrix ");
|
||||
if(!matrix[0,0])
|
||||
return
|
||||
newerror("__CZ__multiply_factored_factorial(matrix): "
|
||||
"matrix[0,0] is null/0");
|
||||
"matrix[0,0] is null/0");
|
||||
|
||||
if(!isnull(stop))
|
||||
pix = stop;
|
||||
@@ -328,7 +328,7 @@ define binomial(n,k){
|
||||
do {
|
||||
prime_list[K ,0] = prime;
|
||||
diff = __CZ__prime_divisors(n,prime)-
|
||||
( __CZ__prime_divisors(n-k,prime)+__CZ__prime_divisors(k,prime));
|
||||
( __CZ__prime_divisors(n-k,prime)+__CZ__prime_divisors(k,prime));
|
||||
if(diff != 0)
|
||||
prime_list[K++,1] = diff;
|
||||
prime = nextprime(prime);
|
||||
@@ -376,7 +376,7 @@ define bigcatalan(n){
|
||||
|
||||
/*
|
||||
df(-111) = -1/3472059605858239446587523014902616804783337112829102414124928
|
||||
7753332469144201839599609375
|
||||
7753332469144201839599609375
|
||||
|
||||
df(-3+1i) = 0.12532538977287649201-0.0502372106177184607i
|
||||
df(2n + 1) = (2*n)!/(n!*2^n)
|
||||
@@ -427,7 +427,7 @@ define doublefactorial(n){
|
||||
*/
|
||||
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);
|
||||
cos(pi()* n)-1/4)* gamma(n/2+1);
|
||||
epsilon(eps);
|
||||
return ret;
|
||||
}
|
||||
|
||||
338
cal/fnv_tool.cal
338
cal/fnv_tool.cal
@@ -3,10 +3,10 @@
|
||||
*
|
||||
* This file provides the following functions:
|
||||
*
|
||||
* find_fnv_prime(bits)
|
||||
* deprecated_fnv0(bits, fnv_prime, string)
|
||||
* fnv_offset_basis(bits, fnv_prime)
|
||||
* fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
|
||||
* find_fnv_prime(bits)
|
||||
* deprecated_fnv0(bits, fnv_prime, string)
|
||||
* fnv_offset_basis(bits, fnv_prime)
|
||||
* fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
|
||||
*
|
||||
* See the individual function for details on args and return value.
|
||||
*
|
||||
@@ -22,8 +22,8 @@
|
||||
*
|
||||
* For more information on the FNV hash see:
|
||||
*
|
||||
* https://en.wikipedia.org/wiki/Fowler-Noll-Vo_hash_function
|
||||
* http://www.isthe.com/chongo/tech/comp/fnv/index.html
|
||||
* https://en.wikipedia.org/wiki/Fowler-Noll-Vo_hash_function
|
||||
* http://www.isthe.com/chongo/tech/comp/fnv/index.html
|
||||
*
|
||||
* IMPORTANT NOTE:
|
||||
*
|
||||
@@ -36,40 +36,40 @@
|
||||
*
|
||||
* Let integer n > 0 be the number if bits in the FNV hash. Then:
|
||||
*
|
||||
* t = floor((5+n)/12)
|
||||
* t = floor((5+n)/12)
|
||||
*
|
||||
* The FNV prime, for the given n bits is the smallest prime of the form:
|
||||
*
|
||||
* p = 256^t + 2^8 + b
|
||||
* p = 256^t + 2^8 + b
|
||||
*
|
||||
* such that:
|
||||
*
|
||||
* 0 < b < 2^8
|
||||
* The number of one-bits in b must be 4 or 5
|
||||
* p mod (2^40 - 2^24 - 1) > (2^24 + 2^8 + 2^7)
|
||||
* 0 < b < 2^8
|
||||
* The number of one-bits in b must be 4 or 5
|
||||
* p mod (2^40 - 2^24 - 1) > (2^24 + 2^8 + 2^7)
|
||||
*
|
||||
* If you force n to not be a power of 2, for example:
|
||||
*
|
||||
* n = 44
|
||||
* n = 44
|
||||
*
|
||||
* you will find that the FNV prime for 44 bits is:
|
||||
*
|
||||
* p44 = 4294967597
|
||||
* = 0x10000012d
|
||||
* = 0b100000000000000000000000100101101
|
||||
* = 2^32 + 301 = 2^32 + 2^8 + 2^5 + 2^3 + 2^2 + 2^0
|
||||
* p44 = 4294967597
|
||||
* = 0x10000012d
|
||||
* = 0b100000000000000000000000100101101
|
||||
* = 2^32 + 301 = 2^32 + 2^8 + 2^5 + 2^3 + 2^2 + 2^0
|
||||
*
|
||||
* However a hash size of 44 bits is not a true FNV hash, it is only a "FNV-style" hash.
|
||||
*
|
||||
* NOTE: We disallow n <= 31 because there are no FNV primes that small.
|
||||
*
|
||||
* NOTE: For n that is a power of 2 and n > 1024, you will find that
|
||||
* that FNV primes become so rare that that one may not find a suitable
|
||||
* FNV prime. For n = powers of 2 >= 2048 and <= 1048576,
|
||||
* there is NO FNV primes.
|
||||
* that FNV primes become so rare that that one may not find a suitable
|
||||
* FNV prime. For n = powers of 2 >= 2048 and <= 1048576,
|
||||
* there is NO FNV primes.
|
||||
*
|
||||
* As for as hashing goes, large values of n, even if an
|
||||
* FNV hash may be found, are unlikely to be truly useful. :-)
|
||||
* As for as hashing goes, large values of n, even if an
|
||||
* FNV hash may be found, are unlikely to be truly useful. :-)
|
||||
*/
|
||||
/*
|
||||
* Copyright (c) 2023 by Landon Curt Noll. All Rights Reserved.
|
||||
@@ -105,86 +105,86 @@
|
||||
* for a value and provide commends on the value of bits.
|
||||
*
|
||||
* given:
|
||||
* bits number of bits in the hash, null() ==> prompt for value
|
||||
* bits number of bits in the hash, null() ==> prompt for value
|
||||
*
|
||||
* returns:
|
||||
* 0 ==> no FNV prime found
|
||||
* >0 ==> FNV prime
|
||||
* 0 ==> no FNV prime found
|
||||
* >0 ==> FNV prime
|
||||
*/
|
||||
define find_fnv_prime(bits)
|
||||
{
|
||||
local b; /* lower octet of the potential FNV prime: [1,255] */
|
||||
local p; /* value to test as an FNV prime */
|
||||
local t; /* power of 256 part of the FNV prime */
|
||||
local one_bits; /* number of 1 bits in b */
|
||||
local p_minus_b; /* potential FNV prime less b */
|
||||
local interactive; /* true ==> interactive mode and print commentary */
|
||||
local b; /* lower octet of the potential FNV prime: [1,255] */
|
||||
local p; /* value to test as an FNV prime */
|
||||
local t; /* power of 256 part of the FNV prime */
|
||||
local one_bits; /* number of 1 bits in b */
|
||||
local p_minus_b; /* potential FNV prime less b */
|
||||
local interactive; /* true ==> interactive mode and print commentary */
|
||||
|
||||
/*
|
||||
* case: no arg, prompt for bits and print commentary
|
||||
*/
|
||||
interactive = 0; /* assume non-interactive mode */
|
||||
interactive = 0; /* assume non-interactive mode */
|
||||
if (isnull(bits)) {
|
||||
|
||||
/*
|
||||
* must be attached to an interactive terminal
|
||||
*/
|
||||
if (!isatty(files(0))) {
|
||||
print "# FATAL: stdin is not a tty: not attached to an interactive terminal";
|
||||
return 0;
|
||||
}
|
||||
interactive = 1; /* set interactive mode */
|
||||
/*
|
||||
* must be attached to an interactive terminal
|
||||
*/
|
||||
if (!isatty(files(0))) {
|
||||
print "# FATAL: stdin is not a tty: not attached to an interactive terminal";
|
||||
return 0;
|
||||
}
|
||||
interactive = 1; /* set interactive mode */
|
||||
|
||||
/*
|
||||
* prompt for the number of bits
|
||||
*/
|
||||
do {
|
||||
local strscanf_ret; /* return from strscanf_ret */
|
||||
local input; /* value read after prompt */
|
||||
/*
|
||||
* prompt for the number of bits
|
||||
*/
|
||||
do {
|
||||
local strscanf_ret; /* return from strscanf_ret */
|
||||
local input; /* value read after prompt */
|
||||
|
||||
/*
|
||||
* prompt and obtain the input
|
||||
*/
|
||||
input = prompt("Enter hash size in bits: ");
|
||||
strscanf_ret = strscanf(input, "%i", bits);
|
||||
print "input =", input;
|
||||
print "bits =", bits;
|
||||
if (!isint(bits) || bits <= 0) {
|
||||
print;
|
||||
print "# NOTE: must enter a integer > 0, try again";
|
||||
print;
|
||||
}
|
||||
} while (!isint(bits) || bits <= 0);
|
||||
/*
|
||||
* prompt and obtain the input
|
||||
*/
|
||||
input = prompt("Enter hash size in bits: ");
|
||||
strscanf_ret = strscanf(input, "%i", bits);
|
||||
print "input =", input;
|
||||
print "bits =", bits;
|
||||
if (!isint(bits) || bits <= 0) {
|
||||
print;
|
||||
print "# NOTE: must enter a integer > 0, try again";
|
||||
print;
|
||||
}
|
||||
} while (!isint(bits) || bits <= 0);
|
||||
}
|
||||
|
||||
/*
|
||||
* firewall - bits must be non-negative integer
|
||||
*/
|
||||
if (!isint(bits) || bits < 0) {
|
||||
if (interactive) {
|
||||
print "# FATAL: bits must be non-negative integer";
|
||||
}
|
||||
return 0;
|
||||
if (interactive) {
|
||||
print "# FATAL: bits must be non-negative integer";
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* provide commentary on the choice of bits if we are interactive
|
||||
*/
|
||||
if (interactive) {
|
||||
if (popcnt(bits) == 1) {
|
||||
if (bits > 1024) {
|
||||
print "# WARNING: FNV primes for bit size powers of 2 > 1024 are extremely rare.";
|
||||
print "# WARNING: There are no FNV primes for bit size powers of 2 >= 2048 and <= 1048576.";
|
||||
}
|
||||
print "n =", bits;
|
||||
} else {
|
||||
if (bits < 32) {
|
||||
print "# WARNING: bits < 32 is not recommended because there isn't enough bits to be worth hashing";
|
||||
}
|
||||
print "# WARNING: because bits is not a power of 2, we can only form an \"FNV-style hash\": not a true FNV hash.";
|
||||
print "# WARNING: A \"FNV-style hash\" may not have the desired hash properties of a true FNV hash.";
|
||||
print "n =", bits;
|
||||
}
|
||||
if (popcnt(bits) == 1) {
|
||||
if (bits > 1024) {
|
||||
print "# WARNING: FNV primes for bit size powers of 2 > 1024 are extremely rare.";
|
||||
print "# WARNING: There are no FNV primes for bit size powers of 2 >= 2048 and <= 1048576.";
|
||||
}
|
||||
print "n =", bits;
|
||||
} else {
|
||||
if (bits < 32) {
|
||||
print "# WARNING: bits < 32 is not recommended because there isn't enough bits to be worth hashing";
|
||||
}
|
||||
print "# WARNING: because bits is not a power of 2, we can only form an \"FNV-style hash\": not a true FNV hash.";
|
||||
print "# WARNING: A \"FNV-style hash\" may not have the desired hash properties of a true FNV hash.";
|
||||
print "n =", bits;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -198,28 +198,28 @@ define find_fnv_prime(bits)
|
||||
*/
|
||||
for (b=1; b < 256; ++b) {
|
||||
|
||||
/*
|
||||
* reject b unless the of one-bits in bottom octet of p is 4 or 5
|
||||
*/
|
||||
one_bits = popcnt(b);
|
||||
if (one_bits != 4 && one_bits != 5) {
|
||||
continue;
|
||||
}
|
||||
/*
|
||||
* reject b unless the of one-bits in bottom octet of p is 4 or 5
|
||||
*/
|
||||
one_bits = popcnt(b);
|
||||
if (one_bits != 4 && one_bits != 5) {
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* reject p if p mod (2^40 - 2^24 - 1) <= (2^24 + 2^8 + 2^7)
|
||||
*/
|
||||
p = p_minus_b + b;
|
||||
if ((p % (2^40 - 2^24 - 1)) <= (2^24 + 2^8 + 2^7)) {
|
||||
continue;
|
||||
}
|
||||
/*
|
||||
* reject p if p mod (2^40 - 2^24 - 1) <= (2^24 + 2^8 + 2^7)
|
||||
*/
|
||||
p = p_minus_b + b;
|
||||
if ((p % (2^40 - 2^24 - 1)) <= (2^24 + 2^8 + 2^7)) {
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* accept potential p value that is prime
|
||||
*/
|
||||
if (ptest(p) == 1) {
|
||||
return p;
|
||||
}
|
||||
/*
|
||||
* accept potential p value that is prime
|
||||
*/
|
||||
if (ptest(p) == 1) {
|
||||
return p;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -227,29 +227,29 @@ define find_fnv_prime(bits)
|
||||
*/
|
||||
if (b >= 256) {
|
||||
|
||||
/*
|
||||
* examine results if interactive
|
||||
*/
|
||||
if (interactive) {
|
||||
print "# FATAL: There is no a suitable FNV prime for bits =", bits;
|
||||
quit "find_fnv_prime: FATAL: FNV prime search failed";
|
||||
}
|
||||
/*
|
||||
* examine results if interactive
|
||||
*/
|
||||
if (interactive) {
|
||||
print "# FATAL: There is no a suitable FNV prime for bits =", bits;
|
||||
quit "find_fnv_prime: FATAL: FNV prime search failed";
|
||||
}
|
||||
|
||||
/*
|
||||
* return 0 to indicate no FNV prime found
|
||||
*/
|
||||
return 0;
|
||||
/*
|
||||
* return 0 to indicate no FNV prime found
|
||||
*/
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* provide FNV commentary if interactive
|
||||
*/
|
||||
if (interactive) {
|
||||
print "t =", t;
|
||||
print "b =", b;
|
||||
print "# NOTE: p = 256^":t, "+ 2^8 +", b;
|
||||
print;
|
||||
print "p =", p;
|
||||
print "t =", t;
|
||||
print "b =", b;
|
||||
print "# NOTE: p = 256^":t, "+ 2^8 +", b;
|
||||
print;
|
||||
print "p =", p;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -266,44 +266,44 @@ define find_fnv_prime(bits)
|
||||
* for a hash of size bits.
|
||||
*
|
||||
* given:
|
||||
* bits number of bits in FNV hash
|
||||
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
* string string to hash
|
||||
* bits number of bits in FNV hash
|
||||
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
* string string to hash
|
||||
*
|
||||
* returns:
|
||||
* FNV-0 hash, for size bytes, of string
|
||||
* FNV-0 hash, for size bytes, of string
|
||||
*
|
||||
* NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
*/
|
||||
define deprecated_fnv0(bits, fnv_prime, string)
|
||||
{
|
||||
local hash; /* FNV hash value */
|
||||
local len; /* length of string */
|
||||
local base; /* base of FNV hash: 2^bits */
|
||||
local hash; /* FNV hash value */
|
||||
local len; /* length of string */
|
||||
local base; /* base of FNV hash: 2^bits */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(bits) || bits <= 0) {
|
||||
quit "deprecated_fnv0: FATAL: bits arg must be an integer > 0";
|
||||
quit "deprecated_fnv0: FATAL: bits arg must be an integer > 0";
|
||||
}
|
||||
if (!isstr(string)) {
|
||||
quit "deprecated_fnv0: FATAL: string arg must be a string";
|
||||
quit "deprecated_fnv0: FATAL: string arg must be a string";
|
||||
}
|
||||
|
||||
/*
|
||||
* fnv_prime == null() means to try and generate the FNV prime
|
||||
*/
|
||||
if (isnull(fnv_prime)) {
|
||||
/* try to generate an FNV prime */
|
||||
fnv_prime = find_fnv_prime(bits);
|
||||
if (fnv_prime == 0) {
|
||||
quit "deprecated_fnv0: FATAL: no FNV prime exists for the given hash size in bits";
|
||||
}
|
||||
/* try to generate an FNV prime */
|
||||
fnv_prime = find_fnv_prime(bits);
|
||||
if (fnv_prime == 0) {
|
||||
quit "deprecated_fnv0: FATAL: no FNV prime exists for the given hash size in bits";
|
||||
}
|
||||
}
|
||||
if (!isint(fnv_prime) || fnv_prime <= 0) {
|
||||
quit "deprecated_fnv0: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
|
||||
quit "deprecated_fnv0: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -313,7 +313,7 @@ define deprecated_fnv0(bits, fnv_prime, string)
|
||||
base = 2^bits;
|
||||
hash = 0;
|
||||
for (i=0; i < len; ++i) {
|
||||
hash = xor((hash * fnv_prime) % base, ord(string[i]));
|
||||
hash = xor((hash * fnv_prime) % base, ord(string[i]));
|
||||
}
|
||||
return hash;
|
||||
}
|
||||
@@ -323,18 +323,18 @@ define deprecated_fnv0(bits, fnv_prime, string)
|
||||
* fnv_offset_basis - generate and FNV offset basis
|
||||
*
|
||||
* given:
|
||||
* bits number of bits in FNV hash
|
||||
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
* bits number of bits in FNV hash
|
||||
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
*
|
||||
* returns:
|
||||
* FNV offset basis for a hash size of bits and an FNV prime of fnv_prime
|
||||
* FNV offset basis for a hash size of bits and an FNV prime of fnv_prime
|
||||
*
|
||||
* NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
*/
|
||||
define
|
||||
fnv_offset_basis(bits, fnv_prime)
|
||||
{
|
||||
local fnv0_hash = 0; /* FNV-0 hash value */
|
||||
local fnv0_hash = 0; /* FNV-0 hash value */
|
||||
|
||||
/* string to generate a FNV offset basis - do not change this value */
|
||||
static chongo_was_here = "chongo <Landon Curt Noll> /\\../\\";
|
||||
@@ -343,21 +343,21 @@ fnv_offset_basis(bits, fnv_prime)
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(bits) || bits <= 0) {
|
||||
quit "fnv_offset_basis: FATAL: bits arg must be an integer > 0";
|
||||
quit "fnv_offset_basis: FATAL: bits arg must be an integer > 0";
|
||||
}
|
||||
|
||||
/*
|
||||
* fnv_prime == null() means to try and generate the FNV prime
|
||||
*/
|
||||
if (isnull(fnv_prime)) {
|
||||
/* try to generate an FNV prime */
|
||||
fnv_prime = find_fnv_prime(bits);
|
||||
if (fnv_prime == 0) {
|
||||
quit "fnv_offset_basis: FATAL: no FNV prime exists for the given hash size in bits";
|
||||
}
|
||||
/* try to generate an FNV prime */
|
||||
fnv_prime = find_fnv_prime(bits);
|
||||
if (fnv_prime == 0) {
|
||||
quit "fnv_offset_basis: FATAL: no FNV prime exists for the given hash size in bits";
|
||||
}
|
||||
}
|
||||
if (!isint(fnv_prime) || fnv_prime <= 0) {
|
||||
quit "fnv_offset_basis: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
|
||||
quit "fnv_offset_basis: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -374,10 +374,10 @@ fnv_offset_basis(bits, fnv_prime)
|
||||
* These functions, if given non-standard values, will produce bogus results.
|
||||
* To produce a true FNV-1a hash:
|
||||
*
|
||||
* bits must be a power of 2
|
||||
* 32 <= bits
|
||||
* fnv_prime == find_fnv_prime(bits) OR fnv_prime == null()
|
||||
* prev_hash == previous FNV hash OR prev_hash == null()
|
||||
* bits must be a power of 2
|
||||
* 32 <= bits
|
||||
* fnv_prime == find_fnv_prime(bits) OR fnv_prime == null()
|
||||
* prev_hash == previous FNV hash OR prev_hash == null()
|
||||
*
|
||||
* If fnv_prime == null(), this function will try to compute the FNV prime
|
||||
* for a hash of size bits.
|
||||
@@ -388,64 +388,64 @@ fnv_offset_basis(bits, fnv_prime)
|
||||
* One may chain "FNV-style" hashes by replacing the offset_basis with
|
||||
* the hash state of the previous hash. For the first hash:
|
||||
*
|
||||
* fnv_prime = find_fnv_prime(bits)
|
||||
* hash_val = fnv_style_hash(bits, fnv_prime, null(), string_a);
|
||||
* fnv_prime = find_fnv_prime(bits)
|
||||
* hash_val = fnv_style_hash(bits, fnv_prime, null(), string_a);
|
||||
*
|
||||
* then:
|
||||
*
|
||||
* hash_val = fnv_style_hash(bits, fnv_prime, hash_val, string_b);
|
||||
* hash_val = fnv_style_hash(bits, fnv_prime, hash_val, string_b);
|
||||
*
|
||||
* This will produce the same as the string_a concatenated with string_b:
|
||||
*
|
||||
* hash_val = fnv_style_hash(bits, null(), null(), string_a + string_b);
|
||||
* hash_val = fnv_style_hash(bits, null(), null(), string_a + string_b);
|
||||
*
|
||||
* NOTE: Because string_a and string_b are strings, the expression:
|
||||
*
|
||||
* string_a + string_b
|
||||
* string_a + string_b
|
||||
*
|
||||
* is string_a concatenated with string_b.
|
||||
* is string_a concatenated with string_b.
|
||||
*
|
||||
* given:
|
||||
* bits number of bits in FNV hash
|
||||
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
* prev_hash previous hash value, null() ==> generate FNV offset basis
|
||||
* string string to hash
|
||||
* bits number of bits in FNV hash
|
||||
* fnv_prime FNV prime, null() ==> generate suitable FNV prime if possible
|
||||
* prev_hash previous hash value, null() ==> generate FNV offset basis
|
||||
* string string to hash
|
||||
*
|
||||
* returns:
|
||||
* "FNV-style" hash of bits
|
||||
* "FNV-style" hash of bits
|
||||
*
|
||||
* NOTE: This function does NOT attempt to determine that fnv_prime is prime.
|
||||
*/
|
||||
define
|
||||
fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
|
||||
{
|
||||
local hash = 0; /* FNV hash value */
|
||||
local len; /* length of string */
|
||||
local base; /* base of FNV hash: 2^bits */
|
||||
local hash = 0; /* FNV hash value */
|
||||
local len; /* length of string */
|
||||
local base; /* base of FNV hash: 2^bits */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(bits) || bits <= 0) {
|
||||
quit "fnv1a_style_hash: FATAL: bits arg must be an integer > 0";
|
||||
quit "fnv1a_style_hash: FATAL: bits arg must be an integer > 0";
|
||||
}
|
||||
if (!isstr(string)) {
|
||||
quit "fnv1a_style_hash: FATAL: string arg must be a string";
|
||||
quit "fnv1a_style_hash: FATAL: string arg must be a string";
|
||||
}
|
||||
|
||||
/*
|
||||
* fnv_prime == null() means to try and generate the FNV prime
|
||||
*/
|
||||
if (isnull(fnv_prime)) {
|
||||
/* try to generate an FNV prime */
|
||||
fnv_prime = find_fnv_prime(bits);
|
||||
if (fnv_prime == 0) {
|
||||
quit "fnv1a_style_hash: FATAL: no FNV prime exists for the given hash size in bits";
|
||||
}
|
||||
/* try to generate an FNV prime */
|
||||
fnv_prime = find_fnv_prime(bits);
|
||||
if (fnv_prime == 0) {
|
||||
quit "fnv1a_style_hash: FATAL: no FNV prime exists for the given hash size in bits";
|
||||
}
|
||||
}
|
||||
if (!isint(fnv_prime) || fnv_prime <= 0) {
|
||||
quit "fnv1a_style_hash: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
|
||||
quit "fnv1a_style_hash: FATAL: fnv_prime arg must be an integer > 0 and should be prime";
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -453,11 +453,11 @@ fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
|
||||
*/
|
||||
if (isnull(prev_hash)) {
|
||||
|
||||
/* generate the FNV offset basis for a hash of size bits */
|
||||
prev_hash = fnv_offset_basis(bits, fnv_prime);
|
||||
/* generate the FNV offset basis for a hash of size bits */
|
||||
prev_hash = fnv_offset_basis(bits, fnv_prime);
|
||||
}
|
||||
if (!isint(prev_hash) || prev_hash < 0) {
|
||||
quit "fnv1a_style_hash: FATAL: prev_hash arg must be an integer => 0";
|
||||
quit "fnv1a_style_hash: FATAL: prev_hash arg must be an integer => 0";
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -467,7 +467,7 @@ fnv1a_style_hash(bits, fnv_prime, prev_hash, string)
|
||||
base = 2^bits;
|
||||
hash = prev_hash;
|
||||
for (i=0; i < len; ++i) {
|
||||
hash = xor((hash * fnv_prime) % base, ord(string[i]));
|
||||
hash = xor((hash * fnv_prime) % base, ord(string[i]));
|
||||
}
|
||||
return hash;
|
||||
}
|
||||
|
||||
68
cal/gvec.cal
68
cal/gvec.cal
@@ -17,37 +17,37 @@
|
||||
define gvec(function, vector)
|
||||
{
|
||||
local xlen,y,foo;
|
||||
local precx = 1e-50; /* default for now */
|
||||
local precx = 1e-50; /* default for now */
|
||||
local argc = param(0)-1;
|
||||
local old_tilde; /* previous config("tilde") */
|
||||
local old_tilde; /* previous config("tilde") */
|
||||
|
||||
/*
|
||||
* parse args
|
||||
*/
|
||||
local plist = mat[argc];
|
||||
if (config("resource_debug") & 8) {
|
||||
print "plist=", plist;
|
||||
print "argc=", argc;
|
||||
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 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;
|
||||
print "plist=", plist;
|
||||
}
|
||||
local argm = argc-1;
|
||||
if (config("resource_debug") & 8) {
|
||||
print "argm=", argm;
|
||||
print "argm=", argm;
|
||||
}
|
||||
if (slist[0] != slist[argm]) {
|
||||
quit "lengths don't match";
|
||||
quit "lengths don't match";
|
||||
}
|
||||
xlen = size(vector);
|
||||
y = mat[xlen];
|
||||
@@ -67,32 +67,32 @@ define gvec(function, vector)
|
||||
*/
|
||||
if (isdefined(function)) {
|
||||
|
||||
/* yep, it's a function, either builtin or user-defined */
|
||||
for (local j=0; j<xlen; j++) {
|
||||
/* 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);
|
||||
}
|
||||
/* 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);
|
||||
}
|
||||
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 */
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/11/13 13:25:43
|
||||
* File existed as early as: 1996
|
||||
* Under source code control: 1996/11/13 13:25:43
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
|
||||
176
cal/hms.cal
176
cal/hms.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2010/09/01 17:14:55
|
||||
* File existed as early as: 2010
|
||||
* 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/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -28,14 +28,14 @@ obj hms {hour, min, sec};
|
||||
|
||||
define hms(hour, min, sec)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* default missing args to 0 */
|
||||
if (isnull(sec)) {
|
||||
sec = 0;
|
||||
sec = 0;
|
||||
}
|
||||
if (isnull(min)) {
|
||||
min = 0;
|
||||
min = 0;
|
||||
}
|
||||
|
||||
/* load object */
|
||||
@@ -51,30 +51,30 @@ define hms(hour, min, sec)
|
||||
|
||||
define hms_add(a, b)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* initialize 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 2nd arg is not hms, add scalar hours */
|
||||
ans.hour += b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -85,19 +85,19 @@ define hms_add(a, b)
|
||||
|
||||
define hms_neg(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
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;
|
||||
/* 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;
|
||||
/* 2nd arg is not hms, negate scalar hours */
|
||||
ans.hour = -a;
|
||||
ans.min = 0;
|
||||
ans.sec = 0;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -108,30 +108,30 @@ define hms_neg(a)
|
||||
|
||||
define hms_sub(a, b)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* initialize 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 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;
|
||||
/* 2nd arg is not hms, subtract scalar hours */
|
||||
ans.hour -= b;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -142,23 +142,23 @@ define hms_sub(a, b)
|
||||
|
||||
define hms_mul(a, b)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
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;
|
||||
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;
|
||||
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;
|
||||
ans.hour = b.hour * a;
|
||||
ans.min = b.min * a;
|
||||
ans.sec = b.sec * a;
|
||||
}
|
||||
|
||||
/* return normalized result */
|
||||
@@ -169,11 +169,11 @@ define hms_mul(a, b)
|
||||
|
||||
define hms_print(a)
|
||||
{
|
||||
local obj hms ans; /* temp object for hms type testing */
|
||||
local obj hms ans; /* temp object for hms type testing */
|
||||
|
||||
/* firewall - arg must be a hms object */
|
||||
if (! istype(a, ans)) {
|
||||
quit "hms_print called with non hms object";
|
||||
quit "hms_print called with non hms object";
|
||||
}
|
||||
|
||||
/* print in hms form */
|
||||
@@ -183,12 +183,12 @@ define hms_print(a)
|
||||
|
||||
define hms_abs(a)
|
||||
{
|
||||
local obj hms ans; /* temp object for hms type testing */
|
||||
local hour; /* return scalar value */
|
||||
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);
|
||||
return abs(a);
|
||||
}
|
||||
|
||||
/* compute hours */
|
||||
@@ -201,12 +201,12 @@ define hms_abs(a)
|
||||
|
||||
define hms_norm(a)
|
||||
{
|
||||
local obj hms ans; /* temp object for hms type testing */
|
||||
local hour; /* hours */
|
||||
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";
|
||||
quit "hms_norm called with non hms object";
|
||||
}
|
||||
|
||||
/* square hours (norm is the square of absolute value */
|
||||
@@ -219,18 +219,18 @@ define hms_norm(a)
|
||||
|
||||
define hms_test(a)
|
||||
{
|
||||
local obj hms ans; /* temp value */
|
||||
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";
|
||||
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;
|
||||
/* false */
|
||||
return 0;
|
||||
}
|
||||
/* true */
|
||||
return 1;
|
||||
@@ -239,11 +239,11 @@ define hms_test(a)
|
||||
|
||||
define hms_int(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
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";
|
||||
quit "hms_int called with non hms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
@@ -259,11 +259,11 @@ define hms_int(a)
|
||||
|
||||
define hms_frac(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
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";
|
||||
quit "hms_frac called with non hms object";
|
||||
}
|
||||
|
||||
/* normalize the argument */
|
||||
@@ -281,7 +281,7 @@ define hms_frac(a)
|
||||
|
||||
define hms_rel(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = hms_abs(a);
|
||||
@@ -294,7 +294,7 @@ define hms_rel(a,b)
|
||||
|
||||
define hms_cmp(a,b)
|
||||
{
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
local abs_a, abs_b; /* scalars of the arguments */
|
||||
|
||||
/* compute scalars of the arguments */
|
||||
abs_a = hms_abs(a);
|
||||
@@ -307,16 +307,16 @@ define hms_cmp(a,b)
|
||||
|
||||
define hms_inc(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* increment a hms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
++ans.sec;
|
||||
ans = a;
|
||||
++ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* increment a scalar */
|
||||
@@ -326,16 +326,16 @@ define hms_inc(a)
|
||||
|
||||
define hms_dec(a)
|
||||
{
|
||||
local obj hms ans; /* return value */
|
||||
local obj hms ans; /* return value */
|
||||
|
||||
/* decrement a hms object */
|
||||
if (istype(a, ans)) {
|
||||
ans = a;
|
||||
--ans.sec;
|
||||
ans = a;
|
||||
--ans.sec;
|
||||
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
/* return normalized result */
|
||||
ans = fixhms(ans);
|
||||
return ans;
|
||||
}
|
||||
|
||||
/* decrement a scalar */
|
||||
@@ -345,11 +345,11 @@ define hms_dec(a)
|
||||
|
||||
define fixhms(a)
|
||||
{
|
||||
local obj hms ans; /* temp value */
|
||||
local obj hms ans; /* temp value */
|
||||
|
||||
/* firewall */
|
||||
if (! istype(a, ans)) {
|
||||
quit "attempt to fix a non hms object";
|
||||
quit "attempt to fix a non hms object";
|
||||
}
|
||||
|
||||
/* use builtin h2hms function */
|
||||
|
||||
@@ -26,9 +26,9 @@ 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;
|
||||
if (strncmp(x, "cinf", 4) == 0
|
||||
|| strncmp(x, "pinf", 4) == 0 || strncmp(x, "ninf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -36,8 +36,8 @@ define isinfinite(x)
|
||||
define iscinf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "cinf", 4) == 0)
|
||||
return 1;
|
||||
if (strncmp(x, "cinf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -45,8 +45,8 @@ define iscinf(x)
|
||||
define ispinf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "pinf", 4) == 0)
|
||||
return 1;
|
||||
if (strncmp(x, "pinf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -54,8 +54,8 @@ define ispinf(x)
|
||||
define isninf(x)
|
||||
{
|
||||
if (isstr(x)) {
|
||||
if (strncmp(x, "ninf", 4) == 0)
|
||||
return 1;
|
||||
if (strncmp(x, "ninf", 4) == 0)
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -27,9 +27,9 @@
|
||||
|
||||
/*
|
||||
* NOTE: Because leading HALF values are trimmed from integer, a file
|
||||
* that begins with lots of 0 bits (in the case of big Endian)
|
||||
* or that ends with lots of 0 bits (in the case of little Endian)
|
||||
* will be changed when the subsequent integer is written back.
|
||||
* that begins with lots of 0 bits (in the case of big Endian)
|
||||
* or that ends with lots of 0 bits (in the case of little Endian)
|
||||
* will be changed when the subsequent integer is written back.
|
||||
*/
|
||||
|
||||
|
||||
@@ -37,16 +37,16 @@
|
||||
* file2be - convert a file into an big Endian integer
|
||||
*
|
||||
* given:
|
||||
* filename filename to read
|
||||
* filename filename to read
|
||||
*
|
||||
* returns:
|
||||
* integer read from its contents on big Endian order
|
||||
* integer read from its contents on big Endian order
|
||||
*/
|
||||
define file2be(filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local i;
|
||||
|
||||
/*
|
||||
@@ -62,8 +62,8 @@ define file2be(filename)
|
||||
*/
|
||||
ret = 0;
|
||||
while (! isnull(c = fgetc(fd))) {
|
||||
ret <<= 8;
|
||||
ret += ord(c);
|
||||
ret <<= 8;
|
||||
ret += ord(c);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -78,17 +78,17 @@ define file2be(filename)
|
||||
* file2le - convert a file into an little Endian integer
|
||||
*
|
||||
* given:
|
||||
* filename filename to read
|
||||
* filename filename to read
|
||||
*
|
||||
* returns:
|
||||
* integer read from its contents on little Endian order
|
||||
* integer read from its contents on little Endian order
|
||||
*/
|
||||
define file2le(filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local shft; /* bit shift for the c value */
|
||||
local fd; /* open file */
|
||||
local ret; /* integer to return */
|
||||
local c; /* character read from the file */
|
||||
local shft; /* bit shift for the c value */
|
||||
local i;
|
||||
|
||||
/*
|
||||
@@ -105,8 +105,8 @@ define file2le(filename)
|
||||
ret = 0;
|
||||
shft = 0;
|
||||
while (! isnull(c = fgetc(fd))) {
|
||||
ret |= (ord(c) << shft);
|
||||
shft += 8;
|
||||
ret |= (ord(c) << shft);
|
||||
shft += 8;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -121,25 +121,25 @@ define file2le(filename)
|
||||
* be2file - convert a big Endian integer into a file
|
||||
*
|
||||
* given:
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
*
|
||||
* returns:
|
||||
* The number of octets written to the file.
|
||||
* The number of octets written to the file.
|
||||
*
|
||||
* NOTE: The absolute value of the integer is written to the file.
|
||||
*/
|
||||
define be2file(v, filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local octlen; /* length of v in octets */
|
||||
local fd; /* open file */
|
||||
local octlen; /* length of v in octets */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(v)) {
|
||||
quit "be2file: 1st arg not an integer";
|
||||
quit "be2file: 1st arg not an integer";
|
||||
}
|
||||
v = abs(v);
|
||||
|
||||
@@ -156,7 +156,7 @@ define be2file(v, filename)
|
||||
*/
|
||||
octlen = int((highbit(v)+8) / 8);
|
||||
for (i=octlen-1; i >= 0; --i) {
|
||||
fputc(fd, char(v >> (i*8)));
|
||||
fputc(fd, char(v >> (i*8)));
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -171,24 +171,24 @@ define be2file(v, filename)
|
||||
* le2file - convert a little Endian integer into a file
|
||||
*
|
||||
* given:
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
* v integer to write to the file
|
||||
* filename filename to write
|
||||
*
|
||||
* returns:
|
||||
* The number of octets written to the file.
|
||||
* The number of octets written to the file.
|
||||
*
|
||||
* NOTE: The absolute value of the integer is written to the file.
|
||||
*/
|
||||
define le2file(v, filename)
|
||||
{
|
||||
local fd; /* open file */
|
||||
local cnt; /* octets written */
|
||||
local fd; /* open file */
|
||||
local cnt; /* octets written */
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(v)) {
|
||||
quit "be2file: 1st arg not an integer";
|
||||
quit "be2file: 1st arg not an integer";
|
||||
}
|
||||
v = abs(v);
|
||||
|
||||
@@ -205,9 +205,9 @@ define le2file(v, filename)
|
||||
*/
|
||||
cnt = 0;
|
||||
while (v > 0) {
|
||||
fputc(fd, char(v));
|
||||
v >>= 8;
|
||||
++cnt;
|
||||
fputc(fd, char(v));
|
||||
v >>= 8;
|
||||
++cnt;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
788
cal/intnum.cal
788
cal/intnum.cal
@@ -43,7 +43,7 @@ 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;
|
||||
return 1;
|
||||
__CZ__tanhsinh_order = order;
|
||||
__CZ__tanhsinh_prec = eps;
|
||||
__CZ__tanhsinh_x = list();
|
||||
@@ -68,34 +68,34 @@ define quadtscomputenodes(order, expo, eps)
|
||||
*/
|
||||
/* 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);
|
||||
/*
|
||||
* 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;
|
||||
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;
|
||||
*/
|
||||
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) */
|
||||
@@ -119,100 +119,100 @@ define quadtscore(a, b, n)
|
||||
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;
|
||||
order = n;
|
||||
m = ilog(order / 3, 2) + 1;
|
||||
} else
|
||||
order = 3 * 2 ^ (m - 1);
|
||||
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
|
||||
* 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");
|
||||
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);
|
||||
}
|
||||
}
|
||||
ret = sum;
|
||||
/*
|
||||
* 1
|
||||
* t = - - + b + 1
|
||||
* x
|
||||
*/
|
||||
else if (isninf(a) && !iscinf(b)) {
|
||||
for (k = 0; k < sizel; k++) {
|
||||
x1 = __CZ__tanhsinh_x[k];
|
||||
x2 = -__CZ__tanhsinh_x[k];
|
||||
w1 = __CZ__tanhsinh_w[k];
|
||||
|
||||
x = bround((b + 1) - (2 / (x1 + 1)), places);
|
||||
xm = bround((b + 1) - (2 / (x2 + 1)), places);
|
||||
w = bround(w1 * (1 / 2 * (2 / (x1 + 1)) ^ 2), places);
|
||||
w2 = bround(w1 * (1 / 2 * (2 / (x2 + 1)) ^ 2), places);
|
||||
sum += bround(w * f(x), places);
|
||||
sum += bround(w2 * f(xm), places);
|
||||
}
|
||||
}
|
||||
/*
|
||||
* 1
|
||||
* t = - + a - 1
|
||||
* x
|
||||
*/
|
||||
else if (!iscinf(a) && ispinf(b)) {
|
||||
for (k = 0; k < sizel; k++) {
|
||||
x1 = __CZ__tanhsinh_x[k];
|
||||
x2 = -__CZ__tanhsinh_x[k];
|
||||
w1 = __CZ__tanhsinh_w[k];
|
||||
x = bround((a - 1) + (2 / (x1 + 1)), places);
|
||||
xm = bround((a - 1) + (2 / (x2 + 1)), places);
|
||||
w = bround(w1 * (((1 / 2) * (2 / (x1 + 1)) ^ 2)), places);
|
||||
w2 = bround(w1 * (((1 / 2) * (2 / (x2 + 1)) ^ 2)), places);
|
||||
sum += bround(w * f(x), places);
|
||||
sum += bround(w2 * f(xm), places);
|
||||
}
|
||||
} else if (isninf(a) || isninf(b)) {
|
||||
/*TODO: swap(a,b) and negate(w)? Lookup! */
|
||||
return newerror("quadtscore: reverse limits?");
|
||||
} else {
|
||||
return
|
||||
newerror("quadtscore: complex infinity not yet implemented");
|
||||
}
|
||||
ret = sum;
|
||||
} else {
|
||||
/* 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;
|
||||
/* 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;
|
||||
@@ -225,97 +225,97 @@ 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");
|
||||
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);
|
||||
/* 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 ((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]);
|
||||
results[0] = quadtscore(a, points[0]);
|
||||
} else {
|
||||
results[0] = 0;
|
||||
}
|
||||
if (sp == 1) {
|
||||
if (sp == 1) {
|
||||
if (b != points[0]) {
|
||||
results[1] = quadtscore(points[0], b);
|
||||
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]);
|
||||
}
|
||||
} 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);
|
||||
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;
|
||||
}
|
||||
} 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
|
||||
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
|
||||
* high school.
|
||||
* 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;
|
||||
* 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 */
|
||||
/* 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) */
|
||||
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];
|
||||
sum += results[k];
|
||||
}
|
||||
return sum;
|
||||
}
|
||||
@@ -330,7 +330,7 @@ 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;
|
||||
return;
|
||||
|
||||
__CZ__gl_x = mat[N];
|
||||
__CZ__gl_w = mat[N];
|
||||
@@ -344,28 +344,28 @@ define quadglcomputenodes(N)
|
||||
* 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);
|
||||
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];
|
||||
__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;
|
||||
}
|
||||
@@ -386,64 +386,64 @@ define quadglcore(a, b, n)
|
||||
eps = epsilon(epsilon() * 1e-2);
|
||||
places = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (!isnull(n))
|
||||
order = n;
|
||||
order = n;
|
||||
else {
|
||||
m = int (4 + max(0, ln(places / 30.0) / ln(2))) + 2;
|
||||
order = 3 * 2 ^ (m - 1);
|
||||
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];
|
||||
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(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;
|
||||
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;
|
||||
/* 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;
|
||||
@@ -452,97 +452,97 @@ define quadglcore(a, b, n)
|
||||
define quadgl(a, b, points)
|
||||
{
|
||||
local k sp results epsbits nsect interval length segment slope C x1 y1 x2
|
||||
y2;
|
||||
y2;
|
||||
local sum D1 D2 D3 D4;
|
||||
if (param(0) < 2)
|
||||
return newerror("quadgl: not enough arguments");
|
||||
return newerror("quadgl: not enough arguments");
|
||||
epsbits = highbit(1 + int (1 / epsilon())) +1;
|
||||
if (isnull(points)) {
|
||||
/* return as given */
|
||||
return quadglcore(a, b);
|
||||
/* 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];
|
||||
/* 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]);
|
||||
results[0] = quadglcore(a, points[0]);
|
||||
} else {
|
||||
results[0] = 0;
|
||||
}
|
||||
if (sp == 1) {
|
||||
if (b != points[0]) {
|
||||
results[1] = quadglcore(points[0], b);
|
||||
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]);
|
||||
}
|
||||
} 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);
|
||||
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;
|
||||
}
|
||||
} 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;
|
||||
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 */
|
||||
/* 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) */
|
||||
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];
|
||||
sum += results[k];
|
||||
}
|
||||
return sum;
|
||||
}
|
||||
@@ -550,49 +550,49 @@ define quadgl(a, b, points)
|
||||
define quad(a, b, points = -1, method = "tanhsinh")
|
||||
{
|
||||
if (isnull(a) || isnull(b) || param(0) < 2)
|
||||
return newerror("quad: both limits must be given");
|
||||
return newerror("quad: both limits must be given");
|
||||
if (isstr(a)) {
|
||||
if (strncmp(a, "cinf", 1) == 0)
|
||||
return
|
||||
newerror(strcat
|
||||
("quad: complex infinity not yet supported, use",
|
||||
" 'pinf' or 'ninf' respectively"));
|
||||
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 (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 (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 (!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);
|
||||
}
|
||||
if (!isstr(points)) {
|
||||
if (points == -1) {
|
||||
return quadgl(a, b);
|
||||
} else {
|
||||
return quadgl(a, b, points);
|
||||
}
|
||||
} else {
|
||||
return quadgl(a, b);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -602,33 +602,33 @@ define makerange(start, end, steps)
|
||||
local segment;
|
||||
steps = int (steps);
|
||||
if (steps < 1) {
|
||||
return newerror("makerange: number of steps must be > 0");
|
||||
return newerror("makerange: number of steps must be > 0");
|
||||
}
|
||||
if (!isnum(start) || !isnum(end)) {
|
||||
return newerror("makerange: only numbers are supported yet");
|
||||
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;
|
||||
}
|
||||
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);
|
||||
}
|
||||
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);
|
||||
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;
|
||||
}
|
||||
for (k = re(start), l = 0; k <= (re(end)); k += segment, l++) {
|
||||
x1 = slope * (k) + C;
|
||||
ret[l] = k + x1 * 1i;
|
||||
}
|
||||
|
||||
}
|
||||
return ret;
|
||||
@@ -638,23 +638,23 @@ 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");
|
||||
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");
|
||||
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");
|
||||
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;
|
||||
a = centerx + radius * cos(twopi * k / points);
|
||||
b = centery + radius * sin(twopi * k / points);
|
||||
ret[k] = a + b * 1i;
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
@@ -663,32 +663,32 @@ 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");
|
||||
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");
|
||||
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");
|
||||
return newerror("makecircle: a is not a real > 0");
|
||||
}
|
||||
if (!isreal(b) || b <= 0) {
|
||||
return newerror("makecircle: b is not a real > 0");
|
||||
return newerror("makecircle: b is not a real > 0");
|
||||
}
|
||||
if (!isreal(angle)) {
|
||||
return newerror("makecircle: angle is not a real");
|
||||
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;
|
||||
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;
|
||||
}
|
||||
@@ -698,13 +698,13 @@ 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);
|
||||
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;
|
||||
}
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
@@ -109,10 +109,10 @@ define lambertw_series_print(){
|
||||
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.14758879113205794065490184399030194122136720202792-
|
||||
0.00000000000000000000000000000000000000000000000000i
|
||||
; lambertw(-exp(-1)+.001)-lambertw_series(-exp(-1)+.001,epsilon()*1e-10,1)
|
||||
0.00000000000000000000000000000000000000000000000000-
|
||||
0.00000000000000000000000000000000000000000000000000-
|
||||
0.00000000000000000000000000000000000000000000000000i
|
||||
*/
|
||||
define lambertw_series(z,eps,branch,terms){
|
||||
@@ -210,34 +210,34 @@ define lambertw(z,branch){
|
||||
sufficient precision itself (M below was calculated by Mathematica and also
|
||||
with the series above with epsilon(1e-200)):
|
||||
; epsilon(1e-50)
|
||||
0.00000000000000000001
|
||||
0.00000000000000000001
|
||||
; display(50)
|
||||
20
|
||||
20
|
||||
; M=-0.9999999999999999999999997668356018402875796636464119050387
|
||||
; lambertw(-exp(-1)+1e-50,0)-M
|
||||
-0.00000000000000000000000002678416515423276355643684
|
||||
-0.00000000000000000000000002678416515423276355643684
|
||||
; epsilon(1e-60)
|
||||
0.0000000000000000000000000000000000000000000000000
|
||||
0.0000000000000000000000000000000000000000000000000
|
||||
; A=-exp(-1)+1e-50
|
||||
; epsilon(1e-50)
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw(A,0)-M
|
||||
-0.00000000000000000000000000000000000231185460220585
|
||||
-0.00000000000000000000000000000000000231185460220585
|
||||
; lambertw_series(A,epsilon(),0)-M
|
||||
-0.00000000000000000000000000000000000132145133161626
|
||||
-0.00000000000000000000000000000000000132145133161626
|
||||
; epsilon(1e-100)
|
||||
0.00000000000000000000000000000000000000000000000001
|
||||
0.00000000000000000000000000000000000000000000000001
|
||||
; A=-exp(-1)+1e-50
|
||||
; epsilon(1e-65)
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw_series(A,epsilon(),0)-M
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
|
||||
-0.00000000000000000000000000000000000000002959444084
|
||||
-0.00000000000000000000000000000000000000002959444084
|
||||
; epsilon(1e-74)
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
0.00000000000000000000000000000000000000000000000000
|
||||
; lambertw_series(-exp(-1)+1e-50,epsilon(),0)-M
|
||||
-0.00000000000000000000000000000000000000000000000006
|
||||
-0.00000000000000000000000000000000000000000000000006
|
||||
*/
|
||||
closeness = abs(z-branchpoint);
|
||||
if( closeness< 1){
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,23 +17,23 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2005/12/12 06:41:50
|
||||
* File existed as early as: 2005
|
||||
* 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/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* linear - perform a simple two point 2D linear interpolation
|
||||
*
|
||||
* given:
|
||||
* x0, y0 first known point on the line
|
||||
* x1, y1 second known point on the line
|
||||
* x a given point to interpolate on
|
||||
* x0, y0 first known point on the line
|
||||
* x1, y1 second known point on the line
|
||||
* x a given point to interpolate on
|
||||
*
|
||||
* returns:
|
||||
* y such that (x,y) is on the line defined by (x0,y0) and (x1,y1)
|
||||
* y such that (x,y) is on the line defined by (x0,y0) and (x1,y1)
|
||||
*
|
||||
* NOTE: The line cannot be vertical. So x0 != y0.
|
||||
*/
|
||||
@@ -41,10 +41,10 @@ define linear(x0, y0, x1, y1, x)
|
||||
{
|
||||
/* firewall */
|
||||
if (!isnum(x0) || ! isnum(y0) || !isnum(x1) || ! isnum(y1) || !isnum(x)) {
|
||||
quit "non-numeric argument passed to linear";
|
||||
quit "non-numeric argument passed to linear";
|
||||
}
|
||||
if (x0 == x1) {
|
||||
quit "linear given a line with an infinite slope";
|
||||
quit "linear given a line with an infinite slope";
|
||||
}
|
||||
|
||||
/* return y = y0 + (delta_Y/delta_X) * (x - x0) */
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
|
||||
1918
cal/lucas.cal
1918
cal/lucas.cal
File diff suppressed because it is too large
Load Diff
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/01/11 05:41:43
|
||||
* File existed as early as: 1991
|
||||
* Under source code control: 1991/01/11 05:41:43
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -31,260 +31,260 @@
|
||||
*
|
||||
* These values were taken from:
|
||||
*
|
||||
* "Prime numbers and Computer Methods for Factorization", by Hans Riesel,
|
||||
* Birkhauser, 1985, pp 384-387.
|
||||
* "Prime numbers and Computer Methods for Factorization", by Hans Riesel,
|
||||
* Birkhauser, 1985, pp 384-387.
|
||||
*
|
||||
* This routine assumes that the file "lucas.cal" has been loaded.
|
||||
*
|
||||
* NOTE: There are several errors in Riesel's table that have been corrected
|
||||
* in this file:
|
||||
* in this file:
|
||||
*
|
||||
* 193*2^87-1 is prime
|
||||
* 193*2^97-1 is NOT prime
|
||||
* 199*2^211-1 is prime
|
||||
* 199*2^221-1 is NOT prime
|
||||
* 193*2^87-1 is prime
|
||||
* 193*2^97-1 is NOT prime
|
||||
* 199*2^211-1 is prime
|
||||
* 199*2^221-1 is NOT prime
|
||||
*/
|
||||
|
||||
|
||||
static prime_cnt = 1145; /* number of primes in the list */
|
||||
static prime_cnt = 1145; /* number of primes in the list */
|
||||
|
||||
/* h = prime parameters */
|
||||
static mat h_p[prime_cnt] = {
|
||||
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* element 0 */
|
||||
1, 1, 1, 1, 3, 3, 3, 3, 3, 3,
|
||||
3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
|
||||
3, 3, 3, 3, 3, 3, 3, 3, 3, 5,
|
||||
5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
|
||||
5, 5, 5, 5, 5, 5, 7, 7, 7, 7,
|
||||
7, 7, 7, 7, 9, 9, 9, 9, 9, 9,
|
||||
9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
|
||||
9, 9, 9, 11, 11, 11, 11, 11, 11, 11,
|
||||
11, 11, 11, 13, 13, 13, 13, 13, 13, 15,
|
||||
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, /* 100 */
|
||||
15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
|
||||
15, 15, 17, 17, 17, 17, 17, 17, 17, 17,
|
||||
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
|
||||
17, 17, 19, 19, 19, 19, 19, 19, 19, 19,
|
||||
19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
|
||||
19, 19, 21, 21, 21, 21, 21, 21, 21, 21,
|
||||
21, 21, 21, 21, 21, 21, 21, 21, 23, 23,
|
||||
23, 23, 23, 23, 23, 23, 23, 25, 25, 25,
|
||||
25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
|
||||
25, 25, 25, 27, 27, 27, 27, 27, 27, 27, /* 200 */
|
||||
27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
|
||||
27, 27, 27, 27, 27, 27, 27, 29, 29, 29,
|
||||
29, 29, 31, 31, 31, 31, 31, 31, 31, 31,
|
||||
31, 31, 31, 31, 31, 31, 31, 31, 31, 31,
|
||||
33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
|
||||
33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
|
||||
33, 33, 33, 33, 35, 35, 35, 35, 35, 35,
|
||||
35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
|
||||
35, 37, 39, 39, 39, 39, 39, 39, 39, 39,
|
||||
39, 41, 41, 41, 41, 41, 41, 41, 41, 41, /* 300 */
|
||||
41, 41, 41, 41, 43, 43, 43, 43, 43, 45,
|
||||
45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
|
||||
45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
|
||||
45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
|
||||
45, 45, 45, 45, 45, 47, 47, 47, 47, 49,
|
||||
49, 49, 49, 49, 49, 49, 49, 49, 49, 49,
|
||||
49, 49, 49, 49, 49, 49, 51, 51, 51, 51,
|
||||
51, 51, 51, 51, 51, 51, 51, 51, 51, 51,
|
||||
51, 53, 53, 53, 53, 53, 53, 53, 53, 53,
|
||||
53, 55, 55, 55, 55, 55, 55, 55, 55, 55, /* 400 */
|
||||
55, 55, 55, 55, 55, 55, 55, 55, 55, 55,
|
||||
57, 57, 57, 57, 57, 57, 57, 57, 57, 57,
|
||||
57, 57, 57, 57, 57, 57, 57, 57, 59, 59,
|
||||
59, 59, 59, 59, 61, 61, 61, 61, 61, 61,
|
||||
61, 61, 61, 61, 61, 61, 61, 61, 61, 61,
|
||||
61, 63, 63, 63, 63, 63, 63, 63, 63, 63,
|
||||
63, 63, 63, 63, 63, 63, 63, 63, 63, 63,
|
||||
63, 63, 63, 63, 65, 65, 65, 65, 65, 65,
|
||||
65, 65, 65, 65, 65, 65, 65, 65, 65, 65,
|
||||
65, 65, 67, 67, 67, 67, 67, 67, 67, 67, /* 500 */
|
||||
69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
|
||||
69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
|
||||
69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
|
||||
69, 69, 71, 71, 71, 73, 73, 73, 73, 73,
|
||||
73, 75, 75, 75, 75, 75, 75, 75, 75, 75,
|
||||
75, 75, 75, 75, 75, 75, 75, 75, 75, 75,
|
||||
75, 75, 75, 75, 75, 75, 75, 77, 77, 77,
|
||||
77, 77, 77, 77, 77, 77, 77, 77, 77, 79,
|
||||
79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
|
||||
81, 81, 81, 81, 81, 81, 81, 81, 81, 81, /* 600 */
|
||||
81, 81, 81, 83, 83, 83, 83, 83, 83, 83,
|
||||
83, 83, 83, 83, 83, 83, 83, 83, 83, 83,
|
||||
83, 83, 83, 83, 83, 85, 85, 85, 85, 85,
|
||||
85, 85, 85, 85, 87, 87, 87, 87, 87, 87,
|
||||
87, 87, 87, 87, 87, 87, 87, 87, 87, 87,
|
||||
87, 87, 87, 87, 87, 87, 89, 89, 89, 89,
|
||||
89, 89, 89, 89, 89, 91, 91, 91, 91, 91,
|
||||
91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
|
||||
91, 91, 91, 91, 91, 91, 91, 93, 93, 93,
|
||||
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, /* 700 */
|
||||
93, 93, 93, 93, 93, 95, 95, 95, 95, 95,
|
||||
95, 95, 95, 95, 95, 97, 97, 97, 97, 97,
|
||||
99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
|
||||
99, 99, 99, 99, 99, 99, 101, 101, 101, 101,
|
||||
103, 103, 103, 103, 103, 103, 103, 103, 103, 103,
|
||||
103, 103, 103, 105, 105, 105, 105, 105, 105, 105,
|
||||
105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
|
||||
105, 105, 107, 107, 107, 107, 107, 107, 107, 107,
|
||||
107, 107, 107, 107, 107, 107, 109, 109, 109, 109,
|
||||
109, 113, 113, 113, 113, 113, 113, 113, 113, 113, /* 800 */
|
||||
113, 115, 115, 115, 115, 115, 115, 115, 115, 115,
|
||||
115, 115, 115, 115, 115, 115, 115, 119, 119, 119,
|
||||
119, 119, 119, 119, 119, 121, 121, 121, 121, 121,
|
||||
121, 121, 121, 121, 121, 121, 121, 125, 125, 125,
|
||||
125, 125, 125, 127, 127, 131, 131, 131, 131, 131,
|
||||
131, 131, 131, 131, 131, 133, 133, 133, 133, 133,
|
||||
133, 133, 133, 133, 133, 133, 133, 133, 137, 137,
|
||||
137, 137, 139, 139, 139, 139, 139, 139, 139, 139,
|
||||
139, 139, 139, 139, 139, 139, 139, 139, 139, 139,
|
||||
139, 139, 139, 139, 139, 139, 139, 139, 139, 143, /* 900 */
|
||||
143, 143, 143, 143, 143, 143, 143, 143, 143, 143,
|
||||
143, 143, 143, 143, 143, 143, 143, 143, 143, 143,
|
||||
143, 143, 143, 145, 145, 145, 145, 145, 145, 145,
|
||||
145, 145, 145, 145, 149, 149, 149, 149, 149, 149,
|
||||
149, 151, 151, 151, 155, 155, 155, 155, 155, 155,
|
||||
155, 155, 155, 155, 155, 155, 157, 157, 157, 157,
|
||||
157, 157, 157, 157, 157, 161, 161, 161, 161, 161,
|
||||
161, 161, 161, 161, 161, 161, 161, 161, 161, 161,
|
||||
163, 163, 163, 163, 167, 167, 167, 167, 167, 167,
|
||||
167, 167, 167, 167, 167, 167, 169, 169, 169, 169, /* 1000 */
|
||||
169, 169, 169, 169, 169, 169, 169, 169, 173, 173,
|
||||
173, 173, 173, 173, 173, 173, 173, 173, 173, 173,
|
||||
173, 173, 173, 173, 175, 175, 175, 175, 175, 175,
|
||||
175, 175, 175, 175, 175, 175, 175, 175, 175, 175,
|
||||
179, 179, 179, 181, 181, 181, 181, 181, 181, 181,
|
||||
181, 181, 181, 181, 181, 181, 181, 181, 181, 181,
|
||||
181, 181, 181, 181, 181, 181, 181, 181, 185, 185,
|
||||
185, 185, 185, 185, 185, 185, 185, 185, 187, 187,
|
||||
187, 187, 187, 191, 193, 193, 193, 193, 193, 193,
|
||||
193, 197, 197, 197, 197, 197, 197, 197, 197, 197, /* 1100 */
|
||||
197, 197, 197, 197, 197, 197, 197, 197, 197, 199,
|
||||
199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
|
||||
199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
|
||||
199, 199, 199, 199, 199
|
||||
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* element 0 */
|
||||
1, 1, 1, 1, 3, 3, 3, 3, 3, 3,
|
||||
3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
|
||||
3, 3, 3, 3, 3, 3, 3, 3, 3, 5,
|
||||
5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
|
||||
5, 5, 5, 5, 5, 5, 7, 7, 7, 7,
|
||||
7, 7, 7, 7, 9, 9, 9, 9, 9, 9,
|
||||
9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
|
||||
9, 9, 9, 11, 11, 11, 11, 11, 11, 11,
|
||||
11, 11, 11, 13, 13, 13, 13, 13, 13, 15,
|
||||
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, /* 100 */
|
||||
15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
|
||||
15, 15, 17, 17, 17, 17, 17, 17, 17, 17,
|
||||
17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
|
||||
17, 17, 19, 19, 19, 19, 19, 19, 19, 19,
|
||||
19, 19, 19, 19, 19, 19, 19, 19, 19, 19,
|
||||
19, 19, 21, 21, 21, 21, 21, 21, 21, 21,
|
||||
21, 21, 21, 21, 21, 21, 21, 21, 23, 23,
|
||||
23, 23, 23, 23, 23, 23, 23, 25, 25, 25,
|
||||
25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
|
||||
25, 25, 25, 27, 27, 27, 27, 27, 27, 27, /* 200 */
|
||||
27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
|
||||
27, 27, 27, 27, 27, 27, 27, 29, 29, 29,
|
||||
29, 29, 31, 31, 31, 31, 31, 31, 31, 31,
|
||||
31, 31, 31, 31, 31, 31, 31, 31, 31, 31,
|
||||
33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
|
||||
33, 33, 33, 33, 33, 33, 33, 33, 33, 33,
|
||||
33, 33, 33, 33, 35, 35, 35, 35, 35, 35,
|
||||
35, 35, 35, 35, 35, 35, 35, 35, 35, 35,
|
||||
35, 37, 39, 39, 39, 39, 39, 39, 39, 39,
|
||||
39, 41, 41, 41, 41, 41, 41, 41, 41, 41, /* 300 */
|
||||
41, 41, 41, 41, 43, 43, 43, 43, 43, 45,
|
||||
45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
|
||||
45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
|
||||
45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
|
||||
45, 45, 45, 45, 45, 47, 47, 47, 47, 49,
|
||||
49, 49, 49, 49, 49, 49, 49, 49, 49, 49,
|
||||
49, 49, 49, 49, 49, 49, 51, 51, 51, 51,
|
||||
51, 51, 51, 51, 51, 51, 51, 51, 51, 51,
|
||||
51, 53, 53, 53, 53, 53, 53, 53, 53, 53,
|
||||
53, 55, 55, 55, 55, 55, 55, 55, 55, 55, /* 400 */
|
||||
55, 55, 55, 55, 55, 55, 55, 55, 55, 55,
|
||||
57, 57, 57, 57, 57, 57, 57, 57, 57, 57,
|
||||
57, 57, 57, 57, 57, 57, 57, 57, 59, 59,
|
||||
59, 59, 59, 59, 61, 61, 61, 61, 61, 61,
|
||||
61, 61, 61, 61, 61, 61, 61, 61, 61, 61,
|
||||
61, 63, 63, 63, 63, 63, 63, 63, 63, 63,
|
||||
63, 63, 63, 63, 63, 63, 63, 63, 63, 63,
|
||||
63, 63, 63, 63, 65, 65, 65, 65, 65, 65,
|
||||
65, 65, 65, 65, 65, 65, 65, 65, 65, 65,
|
||||
65, 65, 67, 67, 67, 67, 67, 67, 67, 67, /* 500 */
|
||||
69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
|
||||
69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
|
||||
69, 69, 69, 69, 69, 69, 69, 69, 69, 69,
|
||||
69, 69, 71, 71, 71, 73, 73, 73, 73, 73,
|
||||
73, 75, 75, 75, 75, 75, 75, 75, 75, 75,
|
||||
75, 75, 75, 75, 75, 75, 75, 75, 75, 75,
|
||||
75, 75, 75, 75, 75, 75, 75, 77, 77, 77,
|
||||
77, 77, 77, 77, 77, 77, 77, 77, 77, 79,
|
||||
79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
|
||||
81, 81, 81, 81, 81, 81, 81, 81, 81, 81, /* 600 */
|
||||
81, 81, 81, 83, 83, 83, 83, 83, 83, 83,
|
||||
83, 83, 83, 83, 83, 83, 83, 83, 83, 83,
|
||||
83, 83, 83, 83, 83, 85, 85, 85, 85, 85,
|
||||
85, 85, 85, 85, 87, 87, 87, 87, 87, 87,
|
||||
87, 87, 87, 87, 87, 87, 87, 87, 87, 87,
|
||||
87, 87, 87, 87, 87, 87, 89, 89, 89, 89,
|
||||
89, 89, 89, 89, 89, 91, 91, 91, 91, 91,
|
||||
91, 91, 91, 91, 91, 91, 91, 91, 91, 91,
|
||||
91, 91, 91, 91, 91, 91, 91, 93, 93, 93,
|
||||
93, 93, 93, 93, 93, 93, 93, 93, 93, 93, /* 700 */
|
||||
93, 93, 93, 93, 93, 95, 95, 95, 95, 95,
|
||||
95, 95, 95, 95, 95, 97, 97, 97, 97, 97,
|
||||
99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
|
||||
99, 99, 99, 99, 99, 99, 101, 101, 101, 101,
|
||||
103, 103, 103, 103, 103, 103, 103, 103, 103, 103,
|
||||
103, 103, 103, 105, 105, 105, 105, 105, 105, 105,
|
||||
105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
|
||||
105, 105, 107, 107, 107, 107, 107, 107, 107, 107,
|
||||
107, 107, 107, 107, 107, 107, 109, 109, 109, 109,
|
||||
109, 113, 113, 113, 113, 113, 113, 113, 113, 113, /* 800 */
|
||||
113, 115, 115, 115, 115, 115, 115, 115, 115, 115,
|
||||
115, 115, 115, 115, 115, 115, 115, 119, 119, 119,
|
||||
119, 119, 119, 119, 119, 121, 121, 121, 121, 121,
|
||||
121, 121, 121, 121, 121, 121, 121, 125, 125, 125,
|
||||
125, 125, 125, 127, 127, 131, 131, 131, 131, 131,
|
||||
131, 131, 131, 131, 131, 133, 133, 133, 133, 133,
|
||||
133, 133, 133, 133, 133, 133, 133, 133, 137, 137,
|
||||
137, 137, 139, 139, 139, 139, 139, 139, 139, 139,
|
||||
139, 139, 139, 139, 139, 139, 139, 139, 139, 139,
|
||||
139, 139, 139, 139, 139, 139, 139, 139, 139, 143, /* 900 */
|
||||
143, 143, 143, 143, 143, 143, 143, 143, 143, 143,
|
||||
143, 143, 143, 143, 143, 143, 143, 143, 143, 143,
|
||||
143, 143, 143, 145, 145, 145, 145, 145, 145, 145,
|
||||
145, 145, 145, 145, 149, 149, 149, 149, 149, 149,
|
||||
149, 151, 151, 151, 155, 155, 155, 155, 155, 155,
|
||||
155, 155, 155, 155, 155, 155, 157, 157, 157, 157,
|
||||
157, 157, 157, 157, 157, 161, 161, 161, 161, 161,
|
||||
161, 161, 161, 161, 161, 161, 161, 161, 161, 161,
|
||||
163, 163, 163, 163, 167, 167, 167, 167, 167, 167,
|
||||
167, 167, 167, 167, 167, 167, 169, 169, 169, 169, /* 1000 */
|
||||
169, 169, 169, 169, 169, 169, 169, 169, 173, 173,
|
||||
173, 173, 173, 173, 173, 173, 173, 173, 173, 173,
|
||||
173, 173, 173, 173, 175, 175, 175, 175, 175, 175,
|
||||
175, 175, 175, 175, 175, 175, 175, 175, 175, 175,
|
||||
179, 179, 179, 181, 181, 181, 181, 181, 181, 181,
|
||||
181, 181, 181, 181, 181, 181, 181, 181, 181, 181,
|
||||
181, 181, 181, 181, 181, 181, 181, 181, 185, 185,
|
||||
185, 185, 185, 185, 185, 185, 185, 185, 187, 187,
|
||||
187, 187, 187, 191, 193, 193, 193, 193, 193, 193,
|
||||
193, 197, 197, 197, 197, 197, 197, 197, 197, 197, /* 1100 */
|
||||
197, 197, 197, 197, 197, 197, 197, 197, 197, 199,
|
||||
199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
|
||||
199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
|
||||
199, 199, 199, 199, 199
|
||||
};
|
||||
|
||||
|
||||
/* n (exponent) prime parameters */
|
||||
static mat n_p[prime_cnt] = {
|
||||
2, 3, 5, 7, 13, 17, 19, 31, 61, 89, /* element 0 */
|
||||
107, 127, 521, 607, 1, 2, 3, 4, 6, 7,
|
||||
11, 18, 34, 38, 43, 55, 64, 76, 94, 103,
|
||||
143, 206, 216, 306, 324, 391, 458, 470, 827, 2,
|
||||
4, 8, 10, 12, 14, 18, 32, 48, 54, 72,
|
||||
148, 184, 248, 270, 274, 420, 1, 5, 9, 17,
|
||||
21, 29, 45, 177, 1, 3, 7, 13, 15, 21,
|
||||
43, 63, 99, 109, 159, 211, 309, 343, 415, 469,
|
||||
781, 871, 939, 2, 26, 50, 54, 126, 134, 246,
|
||||
354, 362, 950, 3, 7, 23, 287, 291, 795, 1,
|
||||
2, 4, 5, 10, 14, 17, 31, 41, 73, 80, /* 100 */
|
||||
82, 116, 125, 145, 157, 172, 202, 224, 266, 289,
|
||||
293, 463, 2, 4, 6, 16, 20, 36, 54, 60,
|
||||
96, 124, 150, 252, 356, 460, 612, 654, 664, 698,
|
||||
702, 972, 1, 3, 5, 21, 41, 49, 89, 133,
|
||||
141, 165, 189, 293, 305, 395, 651, 665, 771, 801,
|
||||
923, 953, 1, 2, 3, 7, 10, 13, 18, 27,
|
||||
37, 51, 74, 157, 271, 458, 530, 891, 4, 6,
|
||||
12, 46, 72, 244, 264, 544, 888, 3, 9, 11,
|
||||
17, 23, 35, 39, 75, 105, 107, 155, 215, 335,
|
||||
635, 651, 687, 1, 2, 4, 5, 8, 10, 14, /* 200 */
|
||||
28, 37, 38, 70, 121, 122, 160, 170, 253, 329,
|
||||
362, 454, 485, 500, 574, 892, 962, 4, 16, 76,
|
||||
148, 184, 1, 5, 7, 11, 13, 23, 33, 35,
|
||||
37, 47, 115, 205, 235, 271, 409, 739, 837, 887,
|
||||
2, 3, 6, 8, 10, 22, 35, 42, 43, 46,
|
||||
56, 91, 102, 106, 142, 190, 208, 266, 330, 360,
|
||||
382, 462, 503, 815, 2, 6, 10, 20, 44, 114,
|
||||
146, 156, 174, 260, 306, 380, 654, 686, 702, 814,
|
||||
906, 1, 3, 24, 105, 153, 188, 605, 795, 813,
|
||||
839, 2, 10, 14, 18, 50, 114, 122, 294, 362, /* 300 */
|
||||
554, 582, 638, 758, 7, 31, 67, 251, 767, 1,
|
||||
2, 3, 4, 5, 6, 8, 9, 14, 15, 16,
|
||||
22, 28, 29, 36, 37, 54, 59, 85, 93, 117,
|
||||
119, 161, 189, 193, 256, 308, 322, 327, 411, 466,
|
||||
577, 591, 902, 928, 946, 4, 14, 70, 78, 1,
|
||||
5, 7, 9, 13, 15, 29, 33, 39, 55, 81,
|
||||
95, 205, 279, 581, 807, 813, 1, 9, 10, 19,
|
||||
22, 57, 69, 97, 141, 169, 171, 195, 238, 735,
|
||||
885, 2, 6, 8, 42, 50, 62, 362, 488, 642,
|
||||
846, 1, 3, 5, 7, 15, 33, 41, 57, 69, /* 400 */
|
||||
75, 77, 131, 133, 153, 247, 305, 351, 409, 471,
|
||||
1, 2, 4, 5, 8, 10, 20, 22, 25, 26,
|
||||
32, 44, 62, 77, 158, 317, 500, 713, 12, 16,
|
||||
72, 160, 256, 916, 3, 5, 9, 13, 17, 19,
|
||||
25, 39, 63, 67, 75, 119, 147, 225, 419, 715,
|
||||
895, 2, 3, 8, 11, 14, 16, 28, 32, 39,
|
||||
66, 68, 91, 98, 116, 126, 164, 191, 298, 323,
|
||||
443, 714, 758, 759, 4, 6, 12, 22, 28, 52,
|
||||
78, 94, 124, 162, 174, 192, 204, 304, 376, 808,
|
||||
930, 972, 5, 9, 21, 45, 65, 77, 273, 677, /* 500 */
|
||||
1, 4, 5, 7, 9, 11, 13, 17, 19, 23,
|
||||
29, 37, 49, 61, 79, 99, 121, 133, 141, 164,
|
||||
173, 181, 185, 193, 233, 299, 313, 351, 377, 540,
|
||||
569, 909, 2, 14, 410, 7, 11, 19, 71, 79,
|
||||
131, 1, 3, 5, 6, 18, 19, 20, 22, 28,
|
||||
29, 39, 43, 49, 75, 85, 92, 111, 126, 136,
|
||||
159, 162, 237, 349, 381, 767, 969, 2, 4, 14,
|
||||
26, 58, 60, 64, 100, 122, 212, 566, 638, 1,
|
||||
3, 7, 15, 43, 57, 61, 75, 145, 217, 247,
|
||||
3, 5, 11, 17, 21, 27, 81, 101, 107, 327, /* 600 */
|
||||
383, 387, 941, 2, 4, 8, 10, 14, 18, 22,
|
||||
24, 26, 28, 36, 42, 58, 64, 78, 158, 198,
|
||||
206, 424, 550, 676, 904, 5, 11, 71, 113, 115,
|
||||
355, 473, 563, 883, 1, 2, 8, 9, 10, 12,
|
||||
22, 29, 32, 50, 57, 69, 81, 122, 138, 200,
|
||||
296, 514, 656, 682, 778, 881, 4, 8, 12, 24,
|
||||
48, 52, 64, 84, 96, 1, 3, 9, 13, 15,
|
||||
17, 19, 23, 47, 57, 67, 73, 77, 81, 83,
|
||||
191, 301, 321, 435, 867, 869, 917, 3, 4, 7,
|
||||
10, 15, 18, 19, 24, 27, 39, 60, 84, 111, /* 700 */
|
||||
171, 192, 222, 639, 954, 2, 6, 26, 32, 66,
|
||||
128, 170, 288, 320, 470, 1, 9, 45, 177, 585,
|
||||
1, 4, 5, 7, 8, 11, 19, 25, 28, 35,
|
||||
65, 79, 212, 271, 361, 461, 10, 18, 54, 70,
|
||||
3, 7, 11, 19, 63, 75, 95, 127, 155, 163,
|
||||
171, 283, 563, 2, 3, 5, 6, 8, 9, 25,
|
||||
32, 65, 113, 119, 155, 177, 299, 335, 426, 462,
|
||||
617, 896, 10, 12, 18, 24, 28, 40, 90, 132,
|
||||
214, 238, 322, 532, 858, 940, 9, 149, 177, 419,
|
||||
617, 8, 14, 74, 80, 274, 334, 590, 608, 614, /* 800 */
|
||||
650, 1, 3, 11, 13, 19, 21, 31, 49, 59,
|
||||
69, 73, 115, 129, 397, 623, 769, 12, 16, 52,
|
||||
160, 192, 216, 376, 436, 1, 3, 21, 27, 37,
|
||||
43, 91, 117, 141, 163, 373, 421, 2, 4, 44,
|
||||
182, 496, 904, 25, 113, 2, 14, 34, 38, 42,
|
||||
78, 90, 178, 778, 974, 3, 11, 15, 19, 31,
|
||||
59, 75, 103, 163, 235, 375, 615, 767, 2, 18,
|
||||
38, 62, 1, 5, 7, 9, 15, 19, 21, 35,
|
||||
37, 39, 41, 49, 69, 111, 115, 141, 159, 181,
|
||||
201, 217, 487, 567, 677, 765, 811, 841, 917, 2, /* 900 */
|
||||
4, 6, 8, 12, 18, 26, 32, 34, 36, 42,
|
||||
60, 78, 82, 84, 88, 154, 174, 208, 256, 366,
|
||||
448, 478, 746, 5, 13, 15, 31, 77, 151, 181,
|
||||
245, 445, 447, 883, 4, 16, 48, 60, 240, 256,
|
||||
304, 5, 221, 641, 2, 8, 14, 16, 44, 46,
|
||||
82, 172, 196, 254, 556, 806, 1, 5, 33, 121,
|
||||
125, 305, 445, 473, 513, 2, 6, 18, 22, 34,
|
||||
54, 98, 122, 146, 222, 306, 422, 654, 682, 862,
|
||||
3, 31, 63, 303, 4, 6, 8, 10, 16, 32,
|
||||
38, 42, 52, 456, 576, 668, 1, 5, 11, 17, /* 1000 */
|
||||
67, 137, 157, 203, 209, 227, 263, 917, 2, 4,
|
||||
6, 16, 32, 50, 76, 80, 96, 104, 162, 212,
|
||||
230, 260, 480, 612, 1, 3, 9, 21, 23, 41,
|
||||
47, 57, 69, 83, 193, 249, 291, 421, 433, 997,
|
||||
8, 68, 108, 3, 5, 7, 9, 11, 17, 23,
|
||||
31, 35, 43, 47, 83, 85, 99, 101, 195, 267,
|
||||
281, 363, 391, 519, 623, 653, 673, 701, 2, 6,
|
||||
10, 18, 26, 40, 46, 78, 230, 542, 1, 17,
|
||||
21, 53, 253, 226, 3, 15, 27, 63, 87, 135,
|
||||
543, 2, 16, 20, 22, 40, 82, 112, 178, 230, /* 1100 */
|
||||
302, 304, 328, 374, 442, 472, 500, 580, 694, 1,
|
||||
5, 7, 15, 19, 23, 25, 27, 43, 65, 99,
|
||||
125, 141, 165, 201, 211, 331, 369, 389, 445, 461,
|
||||
463, 467, 513, 583, 835
|
||||
2, 3, 5, 7, 13, 17, 19, 31, 61, 89, /* element 0 */
|
||||
107, 127, 521, 607, 1, 2, 3, 4, 6, 7,
|
||||
11, 18, 34, 38, 43, 55, 64, 76, 94, 103,
|
||||
143, 206, 216, 306, 324, 391, 458, 470, 827, 2,
|
||||
4, 8, 10, 12, 14, 18, 32, 48, 54, 72,
|
||||
148, 184, 248, 270, 274, 420, 1, 5, 9, 17,
|
||||
21, 29, 45, 177, 1, 3, 7, 13, 15, 21,
|
||||
43, 63, 99, 109, 159, 211, 309, 343, 415, 469,
|
||||
781, 871, 939, 2, 26, 50, 54, 126, 134, 246,
|
||||
354, 362, 950, 3, 7, 23, 287, 291, 795, 1,
|
||||
2, 4, 5, 10, 14, 17, 31, 41, 73, 80, /* 100 */
|
||||
82, 116, 125, 145, 157, 172, 202, 224, 266, 289,
|
||||
293, 463, 2, 4, 6, 16, 20, 36, 54, 60,
|
||||
96, 124, 150, 252, 356, 460, 612, 654, 664, 698,
|
||||
702, 972, 1, 3, 5, 21, 41, 49, 89, 133,
|
||||
141, 165, 189, 293, 305, 395, 651, 665, 771, 801,
|
||||
923, 953, 1, 2, 3, 7, 10, 13, 18, 27,
|
||||
37, 51, 74, 157, 271, 458, 530, 891, 4, 6,
|
||||
12, 46, 72, 244, 264, 544, 888, 3, 9, 11,
|
||||
17, 23, 35, 39, 75, 105, 107, 155, 215, 335,
|
||||
635, 651, 687, 1, 2, 4, 5, 8, 10, 14, /* 200 */
|
||||
28, 37, 38, 70, 121, 122, 160, 170, 253, 329,
|
||||
362, 454, 485, 500, 574, 892, 962, 4, 16, 76,
|
||||
148, 184, 1, 5, 7, 11, 13, 23, 33, 35,
|
||||
37, 47, 115, 205, 235, 271, 409, 739, 837, 887,
|
||||
2, 3, 6, 8, 10, 22, 35, 42, 43, 46,
|
||||
56, 91, 102, 106, 142, 190, 208, 266, 330, 360,
|
||||
382, 462, 503, 815, 2, 6, 10, 20, 44, 114,
|
||||
146, 156, 174, 260, 306, 380, 654, 686, 702, 814,
|
||||
906, 1, 3, 24, 105, 153, 188, 605, 795, 813,
|
||||
839, 2, 10, 14, 18, 50, 114, 122, 294, 362, /* 300 */
|
||||
554, 582, 638, 758, 7, 31, 67, 251, 767, 1,
|
||||
2, 3, 4, 5, 6, 8, 9, 14, 15, 16,
|
||||
22, 28, 29, 36, 37, 54, 59, 85, 93, 117,
|
||||
119, 161, 189, 193, 256, 308, 322, 327, 411, 466,
|
||||
577, 591, 902, 928, 946, 4, 14, 70, 78, 1,
|
||||
5, 7, 9, 13, 15, 29, 33, 39, 55, 81,
|
||||
95, 205, 279, 581, 807, 813, 1, 9, 10, 19,
|
||||
22, 57, 69, 97, 141, 169, 171, 195, 238, 735,
|
||||
885, 2, 6, 8, 42, 50, 62, 362, 488, 642,
|
||||
846, 1, 3, 5, 7, 15, 33, 41, 57, 69, /* 400 */
|
||||
75, 77, 131, 133, 153, 247, 305, 351, 409, 471,
|
||||
1, 2, 4, 5, 8, 10, 20, 22, 25, 26,
|
||||
32, 44, 62, 77, 158, 317, 500, 713, 12, 16,
|
||||
72, 160, 256, 916, 3, 5, 9, 13, 17, 19,
|
||||
25, 39, 63, 67, 75, 119, 147, 225, 419, 715,
|
||||
895, 2, 3, 8, 11, 14, 16, 28, 32, 39,
|
||||
66, 68, 91, 98, 116, 126, 164, 191, 298, 323,
|
||||
443, 714, 758, 759, 4, 6, 12, 22, 28, 52,
|
||||
78, 94, 124, 162, 174, 192, 204, 304, 376, 808,
|
||||
930, 972, 5, 9, 21, 45, 65, 77, 273, 677, /* 500 */
|
||||
1, 4, 5, 7, 9, 11, 13, 17, 19, 23,
|
||||
29, 37, 49, 61, 79, 99, 121, 133, 141, 164,
|
||||
173, 181, 185, 193, 233, 299, 313, 351, 377, 540,
|
||||
569, 909, 2, 14, 410, 7, 11, 19, 71, 79,
|
||||
131, 1, 3, 5, 6, 18, 19, 20, 22, 28,
|
||||
29, 39, 43, 49, 75, 85, 92, 111, 126, 136,
|
||||
159, 162, 237, 349, 381, 767, 969, 2, 4, 14,
|
||||
26, 58, 60, 64, 100, 122, 212, 566, 638, 1,
|
||||
3, 7, 15, 43, 57, 61, 75, 145, 217, 247,
|
||||
3, 5, 11, 17, 21, 27, 81, 101, 107, 327, /* 600 */
|
||||
383, 387, 941, 2, 4, 8, 10, 14, 18, 22,
|
||||
24, 26, 28, 36, 42, 58, 64, 78, 158, 198,
|
||||
206, 424, 550, 676, 904, 5, 11, 71, 113, 115,
|
||||
355, 473, 563, 883, 1, 2, 8, 9, 10, 12,
|
||||
22, 29, 32, 50, 57, 69, 81, 122, 138, 200,
|
||||
296, 514, 656, 682, 778, 881, 4, 8, 12, 24,
|
||||
48, 52, 64, 84, 96, 1, 3, 9, 13, 15,
|
||||
17, 19, 23, 47, 57, 67, 73, 77, 81, 83,
|
||||
191, 301, 321, 435, 867, 869, 917, 3, 4, 7,
|
||||
10, 15, 18, 19, 24, 27, 39, 60, 84, 111, /* 700 */
|
||||
171, 192, 222, 639, 954, 2, 6, 26, 32, 66,
|
||||
128, 170, 288, 320, 470, 1, 9, 45, 177, 585,
|
||||
1, 4, 5, 7, 8, 11, 19, 25, 28, 35,
|
||||
65, 79, 212, 271, 361, 461, 10, 18, 54, 70,
|
||||
3, 7, 11, 19, 63, 75, 95, 127, 155, 163,
|
||||
171, 283, 563, 2, 3, 5, 6, 8, 9, 25,
|
||||
32, 65, 113, 119, 155, 177, 299, 335, 426, 462,
|
||||
617, 896, 10, 12, 18, 24, 28, 40, 90, 132,
|
||||
214, 238, 322, 532, 858, 940, 9, 149, 177, 419,
|
||||
617, 8, 14, 74, 80, 274, 334, 590, 608, 614, /* 800 */
|
||||
650, 1, 3, 11, 13, 19, 21, 31, 49, 59,
|
||||
69, 73, 115, 129, 397, 623, 769, 12, 16, 52,
|
||||
160, 192, 216, 376, 436, 1, 3, 21, 27, 37,
|
||||
43, 91, 117, 141, 163, 373, 421, 2, 4, 44,
|
||||
182, 496, 904, 25, 113, 2, 14, 34, 38, 42,
|
||||
78, 90, 178, 778, 974, 3, 11, 15, 19, 31,
|
||||
59, 75, 103, 163, 235, 375, 615, 767, 2, 18,
|
||||
38, 62, 1, 5, 7, 9, 15, 19, 21, 35,
|
||||
37, 39, 41, 49, 69, 111, 115, 141, 159, 181,
|
||||
201, 217, 487, 567, 677, 765, 811, 841, 917, 2, /* 900 */
|
||||
4, 6, 8, 12, 18, 26, 32, 34, 36, 42,
|
||||
60, 78, 82, 84, 88, 154, 174, 208, 256, 366,
|
||||
448, 478, 746, 5, 13, 15, 31, 77, 151, 181,
|
||||
245, 445, 447, 883, 4, 16, 48, 60, 240, 256,
|
||||
304, 5, 221, 641, 2, 8, 14, 16, 44, 46,
|
||||
82, 172, 196, 254, 556, 806, 1, 5, 33, 121,
|
||||
125, 305, 445, 473, 513, 2, 6, 18, 22, 34,
|
||||
54, 98, 122, 146, 222, 306, 422, 654, 682, 862,
|
||||
3, 31, 63, 303, 4, 6, 8, 10, 16, 32,
|
||||
38, 42, 52, 456, 576, 668, 1, 5, 11, 17, /* 1000 */
|
||||
67, 137, 157, 203, 209, 227, 263, 917, 2, 4,
|
||||
6, 16, 32, 50, 76, 80, 96, 104, 162, 212,
|
||||
230, 260, 480, 612, 1, 3, 9, 21, 23, 41,
|
||||
47, 57, 69, 83, 193, 249, 291, 421, 433, 997,
|
||||
8, 68, 108, 3, 5, 7, 9, 11, 17, 23,
|
||||
31, 35, 43, 47, 83, 85, 99, 101, 195, 267,
|
||||
281, 363, 391, 519, 623, 653, 673, 701, 2, 6,
|
||||
10, 18, 26, 40, 46, 78, 230, 542, 1, 17,
|
||||
21, 53, 253, 226, 3, 15, 27, 63, 87, 135,
|
||||
543, 2, 16, 20, 22, 40, 82, 112, 178, 230, /* 1100 */
|
||||
302, 304, 328, 374, 442, 472, 500, 580, 694, 1,
|
||||
5, 7, 15, 19, 23, 25, 27, 43, 65, 99,
|
||||
125, 141, 165, 201, 211, 331, 369, 389, 445, 461,
|
||||
463, 467, 513, 583, 835
|
||||
};
|
||||
|
||||
|
||||
@@ -299,82 +299,82 @@ read -once "lucas.cal";
|
||||
* when n_p is below a given limit.
|
||||
*
|
||||
* input:
|
||||
* high_n skip tests on n_p[i] > high_n
|
||||
* [quiet] if given and != 0, then do not print individual test results
|
||||
* high_n skip tests on n_p[i] > high_n
|
||||
* [quiet] if given and != 0, then do not print individual test results
|
||||
*
|
||||
* returns:
|
||||
* 1 all is OK
|
||||
* 0 something went wrong
|
||||
* 1 all is OK
|
||||
* 0 something went wrong
|
||||
*/
|
||||
define
|
||||
lucas_chk(high_n, quiet)
|
||||
{
|
||||
local i; /* index */
|
||||
local result; /* 0 => non-prime, 1 => prime, -1 => bad test */
|
||||
local error; /* number of errors and bad tests found */
|
||||
local i; /* index */
|
||||
local result; /* 0 => non-prime, 1 => prime, -1 => bad test */
|
||||
local error; /* number of errors and bad tests found */
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(high_n)) {
|
||||
ldebug("test_lucas", "high_n is non-int");
|
||||
quit "FATAL: bad args: high_n must be an integer";
|
||||
}
|
||||
if (param(0) == 1) {
|
||||
quiet = 0;
|
||||
}
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(high_n)) {
|
||||
ldebug("test_lucas", "high_n is non-int");
|
||||
quit "FATAL: bad args: high_n must be an integer";
|
||||
}
|
||||
if (param(0) == 1) {
|
||||
quiet = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* scan thru the above prime table
|
||||
*/
|
||||
error = 0;
|
||||
for (i=0; i < prime_cnt; ++i) {
|
||||
/*
|
||||
* scan thru the above prime table
|
||||
*/
|
||||
error = 0;
|
||||
for (i=0; i < prime_cnt; ++i) {
|
||||
|
||||
/* skip primes where h>=2^n */
|
||||
if (highbit(h_p[i]) >= n_p[i]) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "h>=2^n skip:", h_p[i]:"*2^":n_p[i]:"-1";
|
||||
}
|
||||
continue;
|
||||
}
|
||||
/* skip primes where h>=2^n */
|
||||
if (highbit(h_p[i]) >= n_p[i]) {
|
||||
if (config("resource_debug") & 8) {
|
||||
print "h>=2^n skip:", h_p[i]:"*2^":n_p[i]:"-1";
|
||||
}
|
||||
continue;
|
||||
}
|
||||
|
||||
/* test the prime if it is small enough */
|
||||
if (n_p[i] <= high_n) {
|
||||
/* test the prime if it is small enough */
|
||||
if (n_p[i] <= high_n) {
|
||||
|
||||
/* test the table value */
|
||||
result = lucas(h_p[i], n_p[i]);
|
||||
/* test the table value */
|
||||
result = lucas(h_p[i], n_p[i]);
|
||||
|
||||
/* report the test */
|
||||
if (result == 0) {
|
||||
print "ERROR, bad primality test of",\
|
||||
h_p[i]:"*2^":n_p[i]:"-1";
|
||||
++error;
|
||||
} else if (result == 1) {
|
||||
if (quiet == 0) {
|
||||
print h_p[i]:"*2^":n_p[i]:"-1 is prime";
|
||||
}
|
||||
} else if (result == -1) {
|
||||
print "ERROR, failed to compute v(1) for",\
|
||||
h_p[i]:"*2^":n_p[i]:"-1";
|
||||
++error;
|
||||
} else {
|
||||
print "ERROR, bogus return value:", result;
|
||||
++error;
|
||||
}
|
||||
}
|
||||
}
|
||||
/* report the test */
|
||||
if (result == 0) {
|
||||
print "ERROR, bad primality test of",\
|
||||
h_p[i]:"*2^":n_p[i]:"-1";
|
||||
++error;
|
||||
} else if (result == 1) {
|
||||
if (quiet == 0) {
|
||||
print h_p[i]:"*2^":n_p[i]:"-1 is prime";
|
||||
}
|
||||
} else if (result == -1) {
|
||||
print "ERROR, failed to compute v(1) for",\
|
||||
h_p[i]:"*2^":n_p[i]:"-1";
|
||||
++error;
|
||||
} else {
|
||||
print "ERROR, bogus return value:", result;
|
||||
++error;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* return the full status */
|
||||
if (error == 0) {
|
||||
if (quiet == 0) {
|
||||
print "lucas_chk(":high_n:") passed";
|
||||
}
|
||||
return 1;
|
||||
} else if (error == 1) {
|
||||
print "lucas_chk(":high_n:") failed", error, "test";
|
||||
return 0;
|
||||
} else {
|
||||
print "lucas_chk(":high_n:") failed", error, "tests";
|
||||
return 0;
|
||||
}
|
||||
/* return the full status */
|
||||
if (error == 0) {
|
||||
if (quiet == 0) {
|
||||
print "lucas_chk(":high_n:") passed";
|
||||
}
|
||||
return 1;
|
||||
} else if (error == 1) {
|
||||
print "lucas_chk(":high_n:") failed", error, "test";
|
||||
return 0;
|
||||
} else {
|
||||
print "lucas_chk(":high_n:") failed", error, "tests";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,10 +19,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:36
|
||||
* File existed as early as: 1991
|
||||
* Under source code control: 1991/05/22 21:56:36
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -32,26 +32,26 @@
|
||||
|
||||
define mersenne(p)
|
||||
{
|
||||
local u, i, p_mask;
|
||||
local u, i, p_mask;
|
||||
|
||||
/* firewall */
|
||||
if (! isint(p))
|
||||
quit "p is not an integer";
|
||||
/* firewall */
|
||||
if (! isint(p))
|
||||
quit "p is not an integer";
|
||||
|
||||
/* two is a special case */
|
||||
if (p == 2)
|
||||
return 1;
|
||||
/* two is a special case */
|
||||
if (p == 2)
|
||||
return 1;
|
||||
|
||||
/* if p is not prime, then 2^p-1 is not prime */
|
||||
if (! ptest(p,1))
|
||||
return 0;
|
||||
/* if p is not prime, then 2^p-1 is not prime */
|
||||
if (! ptest(p,1))
|
||||
return 0;
|
||||
|
||||
/* lltest: u(i+1) = u(i)^2 - 2 mod 2^p-1 */
|
||||
u = 4;
|
||||
for (i = 2; i < p; ++i) {
|
||||
u = hnrmod(u^2 - 2, 1, p, -1);
|
||||
}
|
||||
/* lltest: u(i+1) = u(i)^2 - 2 mod 2^p-1 */
|
||||
u = 4;
|
||||
for (i = 2; i < p; ++i) {
|
||||
u = hnrmod(u^2 - 2, 1, p, -1);
|
||||
}
|
||||
|
||||
/* 2^p-1 is prime iff u(p) = 0 mod 2^p-1 */
|
||||
return (u == 0);
|
||||
/* 2^p-1 is prime iff u(p) = 0 mod 2^p-1 */
|
||||
return (u == 0);
|
||||
}
|
||||
|
||||
412
cal/mfactor.cal
412
cal/mfactor.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/07/06 06:09:40
|
||||
* File existed as early as: 1996
|
||||
* Under source code control: 1996/07/06 06:09:40
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -29,12 +29,12 @@
|
||||
*
|
||||
* We will assume that mfactor is called with p_elim == 17.
|
||||
*
|
||||
* n = (the Mersenne exponent we are testing)
|
||||
* Q = 4*2*3*5*7*11*13*17 (4 * pfact(of some reasonable integer))
|
||||
* n = (the Mersenne exponent we are testing)
|
||||
* Q = 4*2*3*5*7*11*13*17 (4 * pfact(of some reasonable integer))
|
||||
*
|
||||
* We first determine all values of h mod Q such that:
|
||||
*
|
||||
* gcd(h*n+1, Q) == 1 and h*n+1 == +/-1 mod 8
|
||||
* gcd(h*n+1, Q) == 1 and h*n+1 == +/-1 mod 8
|
||||
*
|
||||
* There will be 2*1*2*4*6*10*12*16 such values of h.
|
||||
*
|
||||
@@ -45,59 +45,59 @@
|
||||
*
|
||||
* We need only test factors of the form:
|
||||
*
|
||||
* (Q*g*n + hx) + 1
|
||||
* (Q*g*n + hx) + 1
|
||||
*
|
||||
* where:
|
||||
*
|
||||
* g is an integer >= 0
|
||||
* hx is computed from hset[] difference value described above
|
||||
* g is an integer >= 0
|
||||
* hx is computed from hset[] difference value described above
|
||||
*
|
||||
* Note that (Q*g*n + hx) is always even and that hx is a multiple
|
||||
* of n. Thus the typical factor form:
|
||||
*
|
||||
* 2*k*n + 1
|
||||
* 2*k*n + 1
|
||||
*
|
||||
* implies that:
|
||||
*
|
||||
* k = (Q*g + hx/n)/2
|
||||
* k = (Q*g + hx/n)/2
|
||||
*
|
||||
* This allows us to quickly eliminate factor values that are divisible
|
||||
* by 2, 3, 5, 7, 11, 13 or 17. (well <= p value found below)
|
||||
* by 2, 3, 5, 7, 11, 13 or 17. (well <= p value found below)
|
||||
*
|
||||
* The following loop shows how test_factor is advanced to higher test
|
||||
* values using hset[]. Here, hcount is the number of elements in hset[].
|
||||
* values using hset[]. Here, hcount is the number of elements in hset[].
|
||||
* It can be shown that hset[0] == 0. We add hset[hcount] to the hset[]
|
||||
* array for looping control convenience.
|
||||
*
|
||||
* (* increase test_factor thru other possible test values *)
|
||||
* test_factor = 0;
|
||||
* hindx = 0;
|
||||
* do {
|
||||
* while (++hindx <= hcount) {
|
||||
* test_factor += hset[hindx];
|
||||
* }
|
||||
* hindx = 0;
|
||||
* } while (test_factor < some_limit);
|
||||
* (* increase test_factor thru other possible test values *)
|
||||
* test_factor = 0;
|
||||
* hindx = 0;
|
||||
* do {
|
||||
* while (++hindx <= hcount) {
|
||||
* test_factor += hset[hindx];
|
||||
* }
|
||||
* hindx = 0;
|
||||
* } while (test_factor < some_limit);
|
||||
*
|
||||
* The test, mfactor(67, 1, 10000) took on an 200 MHz r4k (user CPU seconds):
|
||||
*
|
||||
* 210.83 (prior to use of hset[])
|
||||
* 78.35 (hset[] for p_elim = 7)
|
||||
* 73.87 (hset[] for p_elim = 11)
|
||||
* 73.92 (hset[] for p_elim = 13)
|
||||
* 234.16 (hset[] for p_elim = 17)
|
||||
* p_elim == 19 requires over 190 Megs of memory
|
||||
* 210.83 (prior to use of hset[])
|
||||
* 78.35 (hset[] for p_elim = 7)
|
||||
* 73.87 (hset[] for p_elim = 11)
|
||||
* 73.92 (hset[] for p_elim = 13)
|
||||
* 234.16 (hset[] for p_elim = 17)
|
||||
* p_elim == 19 requires over 190 Megs of memory
|
||||
*
|
||||
* Over a long period of time, the call to load_hset() becomes insignificant.
|
||||
* If we look at the user CPU seconds from the first 10000 cycle to the
|
||||
* end of the test we find:
|
||||
*
|
||||
* 205.00 (prior to use of hset[])
|
||||
* 75.89 (hset[] for p_elim = 7)
|
||||
* 73.74 (hset[] for p_elim = 11)
|
||||
* 70.61 (hset[] for p_elim = 13)
|
||||
* 57.78 (hset[] for p_elim = 17)
|
||||
* p_elim == 19 rejected because of memory size
|
||||
* 205.00 (prior to use of hset[])
|
||||
* 75.89 (hset[] for p_elim = 7)
|
||||
* 73.74 (hset[] for p_elim = 11)
|
||||
* 70.61 (hset[] for p_elim = 13)
|
||||
* 57.78 (hset[] for p_elim = 17)
|
||||
* p_elim == 19 rejected because of memory size
|
||||
*
|
||||
* The p_elim == 17 overhead takes ~3 minutes on an 200 MHz r4k CPU and
|
||||
* requires about ~13 Megs of memory. The p_elim == 13 overhead
|
||||
@@ -108,8 +108,8 @@
|
||||
* for p_elim == 13.
|
||||
*
|
||||
* NOTE: The values above are prior to optimizations where hset[] was
|
||||
* multiplied by n plus other optimizations. Thus, the CPU
|
||||
* times you may get will not likely match the above values.
|
||||
* multiplied by n plus other optimizations. Thus, the CPU
|
||||
* times you may get will not likely match the above values.
|
||||
*/
|
||||
|
||||
|
||||
@@ -118,198 +118,198 @@
|
||||
*
|
||||
* Mersenne numbers are numbers of the form:
|
||||
*
|
||||
* 2^n-1 for integer n > 0
|
||||
* 2^n-1 for integer n > 0
|
||||
*
|
||||
* We know that factors of a Mersenne number are of the form:
|
||||
*
|
||||
* 2*k*n+1 and +/- 1 mod 8
|
||||
* 2*k*n+1 and +/- 1 mod 8
|
||||
*
|
||||
* We make use of the hset[] difference array to eliminate factor
|
||||
* candidates that would otherwise be divisible by 2, 3, 5, 7 ... p_elim.
|
||||
*
|
||||
* given:
|
||||
* n attempt to factor M(n) = 2^n-1
|
||||
* start_k the value k in 2*k*n+1 to start the search (def: 1)
|
||||
* rept_loop loop cycle reporting (def: 10000)
|
||||
* p_elim largest prime to eliminate from test factors (def: 17)
|
||||
* n attempt to factor M(n) = 2^n-1
|
||||
* start_k the value k in 2*k*n+1 to start the search (def: 1)
|
||||
* rept_loop loop cycle reporting (def: 10000)
|
||||
* p_elim largest prime to eliminate from test factors (def: 17)
|
||||
*
|
||||
* returns:
|
||||
* factor of (2^n)-1
|
||||
* factor of (2^n)-1
|
||||
*
|
||||
* NOTE: The p_elim argument is optional and defaults to 17. A p_elim value
|
||||
* of 17 is faster than 13 for even medium length runs. However 13
|
||||
* uses less memory and has a shorter startup time.
|
||||
* of 17 is faster than 13 for even medium length runs. However 13
|
||||
* uses less memory and has a shorter startup time.
|
||||
*/
|
||||
define mfactor(n, start_k, rept_loop, p_elim)
|
||||
{
|
||||
local Q; /* 4*pfact(p_elim), hset[] cycle size */
|
||||
local hcount; /* elements in the hset[] difference array */
|
||||
local loop; /* report loop count */
|
||||
local q; /* test factor of 2^n-1 */
|
||||
local g; /* g as in test candidate form: (Q*g*hset[i])*n + 1 */
|
||||
local hindx; /* hset[] index */
|
||||
local i;
|
||||
local tmp;
|
||||
local tmp2;
|
||||
local Q; /* 4*pfact(p_elim), hset[] cycle size */
|
||||
local hcount; /* elements in the hset[] difference array */
|
||||
local loop; /* report loop count */
|
||||
local q; /* test factor of 2^n-1 */
|
||||
local g; /* g as in test candidate form: (Q*g*hset[i])*n + 1 */
|
||||
local hindx; /* hset[] index */
|
||||
local i;
|
||||
local tmp;
|
||||
local tmp2;
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(n) || n <= 0) {
|
||||
quit "n must be an integer > 0";
|
||||
}
|
||||
if (!isint(start_k)) {
|
||||
start_k = 1;
|
||||
} else if (!isint(start_k) || start_k <= 0) {
|
||||
quit "start_k must be an integer > 0";
|
||||
}
|
||||
if (!isint(rept_loop)) {
|
||||
rept_loop = 10000;
|
||||
}
|
||||
if (rept_loop < 1) {
|
||||
quit "rept_loop must be an integer > 0";
|
||||
}
|
||||
if (!isint(p_elim)) {
|
||||
p_elim = 17;
|
||||
}
|
||||
if (p_elim < 3) {
|
||||
quit "p_elim must be an integer > 2 (try 13 or 17)";
|
||||
}
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(n) || n <= 0) {
|
||||
quit "n must be an integer > 0";
|
||||
}
|
||||
if (!isint(start_k)) {
|
||||
start_k = 1;
|
||||
} else if (!isint(start_k) || start_k <= 0) {
|
||||
quit "start_k must be an integer > 0";
|
||||
}
|
||||
if (!isint(rept_loop)) {
|
||||
rept_loop = 10000;
|
||||
}
|
||||
if (rept_loop < 1) {
|
||||
quit "rept_loop must be an integer > 0";
|
||||
}
|
||||
if (!isint(p_elim)) {
|
||||
p_elim = 17;
|
||||
}
|
||||
if (p_elim < 3) {
|
||||
quit "p_elim must be an integer > 2 (try 13 or 17)";
|
||||
}
|
||||
|
||||
/*
|
||||
* declare our global values
|
||||
*/
|
||||
Q = 4*pfact(p_elim);
|
||||
hcount = 2;
|
||||
/* allocate the h difference array */
|
||||
for (i=2; i <= p_elim; i = nextcand(i)) {
|
||||
hcount *= (i-1);
|
||||
}
|
||||
local mat hset[hcount+1];
|
||||
/*
|
||||
* declare our global values
|
||||
*/
|
||||
Q = 4*pfact(p_elim);
|
||||
hcount = 2;
|
||||
/* allocate the h difference array */
|
||||
for (i=2; i <= p_elim; i = nextcand(i)) {
|
||||
hcount *= (i-1);
|
||||
}
|
||||
local mat hset[hcount+1];
|
||||
|
||||
/*
|
||||
* load the hset[] difference array
|
||||
*/
|
||||
{
|
||||
local x; /* h*n+1 mod 8 */
|
||||
local h; /* potential h value */
|
||||
local last_h; /* previous valid h value */
|
||||
/*
|
||||
* load the hset[] difference array
|
||||
*/
|
||||
{
|
||||
local x; /* h*n+1 mod 8 */
|
||||
local h; /* potential h value */
|
||||
local last_h; /* previous valid h value */
|
||||
|
||||
last_h = 0;
|
||||
for (i=0,h=0; h < Q; ++h) {
|
||||
if (gcd(h*n+1,Q) == 1) {
|
||||
x = (h*n+1) % 8;
|
||||
if (x == 1 || x == 7) {
|
||||
hset[i++] = (h-last_h) * n;
|
||||
last_h = h;
|
||||
}
|
||||
}
|
||||
}
|
||||
hset[hcount] = Q*n - last_h*n;
|
||||
}
|
||||
last_h = 0;
|
||||
for (i=0,h=0; h < Q; ++h) {
|
||||
if (gcd(h*n+1,Q) == 1) {
|
||||
x = (h*n+1) % 8;
|
||||
if (x == 1 || x == 7) {
|
||||
hset[i++] = (h-last_h) * n;
|
||||
last_h = h;
|
||||
}
|
||||
}
|
||||
}
|
||||
hset[hcount] = Q*n - last_h*n;
|
||||
}
|
||||
|
||||
/*
|
||||
* setup
|
||||
*
|
||||
* determine the next g and hset[] index (hindx) values such that:
|
||||
*
|
||||
* 2*start_k <= (Q*g + hset[hindx])
|
||||
*
|
||||
* and (Q*g + hset[hindx]) is a minimum and where:
|
||||
*
|
||||
* Q = (4 * pfact(of some reasonable integer))
|
||||
* g = (some integer) (hset[] cycle number)
|
||||
*
|
||||
* We also compute 'q', the next test candidate.
|
||||
*/
|
||||
g = (2*start_k) // Q;
|
||||
tmp = 2*start_k - Q*g;
|
||||
for (tmp2=0, hindx=0;
|
||||
hindx < hcount && (tmp2 += hset[hindx]/n) < tmp;
|
||||
++hindx) {
|
||||
}
|
||||
if (hindx == hcount) {
|
||||
/* we are beyond the end of a hset[] cycle, start at the next */
|
||||
++g;
|
||||
hindx = 0;
|
||||
tmp2 = hset[0]/n;
|
||||
}
|
||||
q = (Q*g + tmp2)*n + 1;
|
||||
/*
|
||||
* setup
|
||||
*
|
||||
* determine the next g and hset[] index (hindx) values such that:
|
||||
*
|
||||
* 2*start_k <= (Q*g + hset[hindx])
|
||||
*
|
||||
* and (Q*g + hset[hindx]) is a minimum and where:
|
||||
*
|
||||
* Q = (4 * pfact(of some reasonable integer))
|
||||
* g = (some integer) (hset[] cycle number)
|
||||
*
|
||||
* We also compute 'q', the next test candidate.
|
||||
*/
|
||||
g = (2*start_k) // Q;
|
||||
tmp = 2*start_k - Q*g;
|
||||
for (tmp2=0, hindx=0;
|
||||
hindx < hcount && (tmp2 += hset[hindx]/n) < tmp;
|
||||
++hindx) {
|
||||
}
|
||||
if (hindx == hcount) {
|
||||
/* we are beyond the end of a hset[] cycle, start at the next */
|
||||
++g;
|
||||
hindx = 0;
|
||||
tmp2 = hset[0]/n;
|
||||
}
|
||||
q = (Q*g + tmp2)*n + 1;
|
||||
|
||||
/*
|
||||
* look for a factor
|
||||
*
|
||||
* We ignore factors that themselves are divisible by a prime <=
|
||||
* some small prime p.
|
||||
*
|
||||
* This process is guaranteed to find the smallest factor
|
||||
* of 2^n-1. A smallest factor of 2^n-1 must be prime, otherwise
|
||||
* the divisors of that factor would also be factors of 2^n-1.
|
||||
* Thus we know that if a test factor itself is not prime, it
|
||||
* cannot be the smallest factor of 2^n-1.
|
||||
*
|
||||
* Eliminating all non-prime test factors would take too long.
|
||||
* However we can eliminate 80.81% of the test factors
|
||||
* by not using test factors that are divisible by a prime <= 17.
|
||||
*/
|
||||
if (pmod(2,n,q) == 1) {
|
||||
return q;
|
||||
} else {
|
||||
/* report this loop */
|
||||
printf("at 2*%d*%d+1, CPU: %f\n",
|
||||
(q-1)/(2*n), n, usertime());
|
||||
fflush(files(1));
|
||||
loop = 0;
|
||||
}
|
||||
do {
|
||||
/*
|
||||
* determine if we need to report
|
||||
*
|
||||
* NOTE: (q-1)/(2*n) is the k value from 2*k*n + 1.
|
||||
*/
|
||||
if (rept_loop <= ++loop) {
|
||||
/* report this loop */
|
||||
printf("at 2*%d*%d+1, CPU: %f\n",
|
||||
(q-1)/(2*n), n, usertime());
|
||||
fflush(files(1));
|
||||
loop = 0;
|
||||
}
|
||||
/*
|
||||
* look for a factor
|
||||
*
|
||||
* We ignore factors that themselves are divisible by a prime <=
|
||||
* some small prime p.
|
||||
*
|
||||
* This process is guaranteed to find the smallest factor
|
||||
* of 2^n-1. A smallest factor of 2^n-1 must be prime, otherwise
|
||||
* the divisors of that factor would also be factors of 2^n-1.
|
||||
* Thus we know that if a test factor itself is not prime, it
|
||||
* cannot be the smallest factor of 2^n-1.
|
||||
*
|
||||
* Eliminating all non-prime test factors would take too long.
|
||||
* However we can eliminate 80.81% of the test factors
|
||||
* by not using test factors that are divisible by a prime <= 17.
|
||||
*/
|
||||
if (pmod(2,n,q) == 1) {
|
||||
return q;
|
||||
} else {
|
||||
/* report this loop */
|
||||
printf("at 2*%d*%d+1, CPU: %f\n",
|
||||
(q-1)/(2*n), n, usertime());
|
||||
fflush(files(1));
|
||||
loop = 0;
|
||||
}
|
||||
do {
|
||||
/*
|
||||
* determine if we need to report
|
||||
*
|
||||
* NOTE: (q-1)/(2*n) is the k value from 2*k*n + 1.
|
||||
*/
|
||||
if (rept_loop <= ++loop) {
|
||||
/* report this loop */
|
||||
printf("at 2*%d*%d+1, CPU: %f\n",
|
||||
(q-1)/(2*n), n, usertime());
|
||||
fflush(files(1));
|
||||
loop = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* skip if divisible by a prime <= 449
|
||||
*
|
||||
* The value 281 was determined by timing loops
|
||||
* which found that 281 was at or near the
|
||||
* minimum time to factor 2^(2^127-1)-1.
|
||||
*
|
||||
* The addition of the do { ... } while (factor(q, 449)>1);
|
||||
* loop reduced the factoring loop time (36504 k values with
|
||||
* the hset[] initialization time removed) from 25.69 sec to
|
||||
* 15.62 sec of CPU time on a 200MHz r4k.
|
||||
*/
|
||||
do {
|
||||
/*
|
||||
* determine the next factor candidate
|
||||
*/
|
||||
q += hset[++hindx];
|
||||
if (hindx >= hcount) {
|
||||
hindx = 0;
|
||||
/*
|
||||
* if we cared about g,
|
||||
* then we wound ++g here too
|
||||
*/
|
||||
}
|
||||
} while (factor(q, 449) > 1);
|
||||
} while (pmod(2,n,q) != 1);
|
||||
/*
|
||||
* skip if divisible by a prime <= 449
|
||||
*
|
||||
* The value 281 was determined by timing loops
|
||||
* which found that 281 was at or near the
|
||||
* minimum time to factor 2^(2^127-1)-1.
|
||||
*
|
||||
* The addition of the do { ... } while (factor(q, 449)>1);
|
||||
* loop reduced the factoring loop time (36504 k values with
|
||||
* the hset[] initialization time removed) from 25.69 sec to
|
||||
* 15.62 sec of CPU time on a 200MHz r4k.
|
||||
*/
|
||||
do {
|
||||
/*
|
||||
* determine the next factor candidate
|
||||
*/
|
||||
q += hset[++hindx];
|
||||
if (hindx >= hcount) {
|
||||
hindx = 0;
|
||||
/*
|
||||
* if we cared about g,
|
||||
* then we wound ++g here too
|
||||
*/
|
||||
}
|
||||
} while (factor(q, 449) > 1);
|
||||
} while (pmod(2,n,q) != 1);
|
||||
|
||||
/*
|
||||
* return the factor found
|
||||
*
|
||||
* q is a factor of (2^n)-1
|
||||
*/
|
||||
return q;
|
||||
/*
|
||||
* return the factor found
|
||||
*
|
||||
* q is a factor of (2^n)-1
|
||||
*/
|
||||
return q;
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
print "mfactor(n [, start_k=1 [, rept_loop=10000 [, p_elim=17]]])"
|
||||
print "mfactor(n [, start_k=1 [, rept_loop=10000 [, p_elim=17]]])"
|
||||
}
|
||||
|
||||
198
cal/mod.cal
198
cal/mod.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,192 +17,192 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj mod {a}; /* definition of the object */
|
||||
obj mod {a}; /* definition of the object */
|
||||
|
||||
global mod_value = 100; /* modulus value (value of N) */
|
||||
global mod_value = 100; /* modulus value (value of N) */
|
||||
|
||||
|
||||
define lmod(a)
|
||||
{
|
||||
local obj mod x;
|
||||
local obj mod x;
|
||||
|
||||
if (!isreal(a) || !isint(a))
|
||||
quit "Bad argument for lmod function";
|
||||
x.a = a % mod_value;
|
||||
return x;
|
||||
if (!isreal(a) || !isint(a))
|
||||
quit "Bad argument for lmod function";
|
||||
x.a = a % mod_value;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_print(a)
|
||||
{
|
||||
if (digits(mod_value) <= 20)
|
||||
print a.a, "(mod", mod_value : ")" :;
|
||||
else
|
||||
print a.a, "(mod N)" :;
|
||||
if (digits(mod_value) <= 20)
|
||||
print a.a, "(mod", mod_value : ")" :;
|
||||
else
|
||||
print a.a, "(mod N)" :;
|
||||
}
|
||||
|
||||
|
||||
define mod_one()
|
||||
{
|
||||
return lmod(1);
|
||||
return lmod(1);
|
||||
}
|
||||
|
||||
|
||||
define mod_cmp(a, b)
|
||||
{
|
||||
if (isnum(a))
|
||||
return (a % mod_value) != b.a;
|
||||
if (isnum(b))
|
||||
return (b % mod_value) != a.a;
|
||||
return a.a != b.a;
|
||||
if (isnum(a))
|
||||
return (a % mod_value) != b.a;
|
||||
if (isnum(b))
|
||||
return (b % mod_value) != a.a;
|
||||
return a.a != b.a;
|
||||
}
|
||||
|
||||
|
||||
define mod_rel(a, b)
|
||||
{
|
||||
if (isnum(a))
|
||||
a = lmod(a);
|
||||
if (isnum(b))
|
||||
b = lmod(b);
|
||||
if (a.a < b.a)
|
||||
return -1;
|
||||
return a.a != b.a;
|
||||
if (isnum(a))
|
||||
a = lmod(a);
|
||||
if (isnum(b))
|
||||
b = lmod(b);
|
||||
if (a.a < b.a)
|
||||
return -1;
|
||||
return a.a != b.a;
|
||||
}
|
||||
|
||||
|
||||
define mod_add(a, b)
|
||||
{
|
||||
local obj mod x;
|
||||
local obj mod x;
|
||||
|
||||
if (isnum(b)) {
|
||||
if (!isint(b))
|
||||
quit "Adding non-integer";
|
||||
x.a = (a.a + b) % mod_value;
|
||||
return x;
|
||||
}
|
||||
if (isnum(a)) {
|
||||
if (!isint(a))
|
||||
quit "Adding non-integer";
|
||||
x.a = (a + b.a) % mod_value;
|
||||
return x;
|
||||
}
|
||||
x.a = (a.a + b.a) % mod_value;
|
||||
return x;
|
||||
if (isnum(b)) {
|
||||
if (!isint(b))
|
||||
quit "Adding non-integer";
|
||||
x.a = (a.a + b) % mod_value;
|
||||
return x;
|
||||
}
|
||||
if (isnum(a)) {
|
||||
if (!isint(a))
|
||||
quit "Adding non-integer";
|
||||
x.a = (a + b.a) % mod_value;
|
||||
return x;
|
||||
}
|
||||
x.a = (a.a + b.a) % mod_value;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_sub(a, b)
|
||||
{
|
||||
return a + (-b);
|
||||
return a + (-b);
|
||||
}
|
||||
|
||||
|
||||
define mod_neg(a)
|
||||
{
|
||||
local obj mod x;
|
||||
local obj mod x;
|
||||
|
||||
x.a = mod_value - a.a;
|
||||
return x;
|
||||
x.a = mod_value - a.a;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_mul(a, b)
|
||||
{
|
||||
local obj mod x;
|
||||
local obj mod x;
|
||||
|
||||
if (isnum(b)) {
|
||||
if (!isint(b))
|
||||
quit "Multiplying by non-integer";
|
||||
x.a = (a.a * b) % mod_value;
|
||||
return x;
|
||||
}
|
||||
if (isnum(a)) {
|
||||
if (!isint(a))
|
||||
quit "Multiplying by non-integer";
|
||||
x.a = (a * b.a) % mod_value;
|
||||
return x;
|
||||
}
|
||||
x.a = (a.a * b.a) % mod_value;
|
||||
return x;
|
||||
if (isnum(b)) {
|
||||
if (!isint(b))
|
||||
quit "Multiplying by non-integer";
|
||||
x.a = (a.a * b) % mod_value;
|
||||
return x;
|
||||
}
|
||||
if (isnum(a)) {
|
||||
if (!isint(a))
|
||||
quit "Multiplying by non-integer";
|
||||
x.a = (a * b.a) % mod_value;
|
||||
return x;
|
||||
}
|
||||
x.a = (a.a * b.a) % mod_value;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_square(a)
|
||||
{
|
||||
local obj mod x;
|
||||
local obj mod x;
|
||||
|
||||
x.a = a.a^2 % mod_value;
|
||||
return x;
|
||||
x.a = a.a^2 % mod_value;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_inc(a)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
x = a;
|
||||
if (++x.a == mod_value)
|
||||
x.a = 0;
|
||||
return x;
|
||||
x = a;
|
||||
if (++x.a == mod_value)
|
||||
x.a = 0;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_dec(a)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
x = a;
|
||||
if (--x.a < 0)
|
||||
x.a = mod_value - 1;
|
||||
return x;
|
||||
x = a;
|
||||
if (--x.a < 0)
|
||||
x.a = mod_value - 1;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_inv(a)
|
||||
{
|
||||
local obj mod x;
|
||||
local obj mod x;
|
||||
|
||||
x.a = minv(a.a, mod_value);
|
||||
return x;
|
||||
x.a = minv(a.a, mod_value);
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define mod_div(a, b)
|
||||
{
|
||||
local c;
|
||||
local obj mod x;
|
||||
local obj mod y;
|
||||
if (isnum(a))
|
||||
a = lmod(a);
|
||||
if (isnum(b))
|
||||
b = lmod(b);
|
||||
c = gcd(a.a, b.a);
|
||||
x.a = a.a / c;
|
||||
y.a = b.a / c;
|
||||
return x * inverse(y);
|
||||
local c;
|
||||
local obj mod x;
|
||||
local obj mod y;
|
||||
if (isnum(a))
|
||||
a = lmod(a);
|
||||
if (isnum(b))
|
||||
b = lmod(b);
|
||||
c = gcd(a.a, b.a);
|
||||
x.a = a.a / c;
|
||||
y.a = b.a / c;
|
||||
return x * inverse(y);
|
||||
}
|
||||
|
||||
|
||||
define mod_pow(a, b)
|
||||
{
|
||||
local x, y, z;
|
||||
local x, y, z;
|
||||
|
||||
obj mod x;
|
||||
y = a;
|
||||
z = b;
|
||||
if (b < 0) {
|
||||
y = inverse(a);
|
||||
z = -b;
|
||||
}
|
||||
x.a = pmod(y.a, z, mod_value);
|
||||
return x;
|
||||
obj mod x;
|
||||
y = a;
|
||||
z = b;
|
||||
if (b < 0) {
|
||||
y = inverse(a);
|
||||
z = -b;
|
||||
}
|
||||
x.a = pmod(y.a, z, mod_value);
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/09/07 23:53:51
|
||||
* File existed as early as: 1997
|
||||
* Under source code control: 1997/09/07 23:53:51
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -40,14 +40,14 @@
|
||||
*
|
||||
* In an assignment of a set-valued lvalue to an lvalue, as in
|
||||
*
|
||||
* A = set(1,2,3);
|
||||
* B = A;
|
||||
* A = set(1,2,3);
|
||||
* B = A;
|
||||
*
|
||||
* the sets share the same data string, so a change to either has the effect
|
||||
* of changing both. A set equal to A but with a different string can be
|
||||
* created by
|
||||
*
|
||||
* B = A | set()
|
||||
* B = A | set()
|
||||
*
|
||||
* The functions empty() and full() return the empty set and the set of all
|
||||
* integers in [0,B] respectively.
|
||||
@@ -57,58 +57,58 @@
|
||||
* test(A) returns 0 or 1 according as A is or is not the empty set
|
||||
*
|
||||
* isin(A, n) for set A and integer n returns 1 if n is in A, 0 if
|
||||
* 0 <= n <= B and n is not in A, the null value if n < 0 or n > B.
|
||||
* 0 <= n <= B and n is not in A, the null value if n < 0 or n > B.
|
||||
*
|
||||
* addmember(A, n) adds n as a member of A, provided n is in [0, B];
|
||||
* this is also achieved by A |= n.
|
||||
* this is also achieved by A |= n.
|
||||
*
|
||||
* rmmember(A, n) removes n from A if it is a member; this is also achieved
|
||||
* by A \= n.
|
||||
* by A \= n.
|
||||
*
|
||||
* The following unary and binary operations are defined for sets A, B.
|
||||
* For binary operations with one argument a set and the other an
|
||||
* integer n, the integer taken to represent set(n).
|
||||
* For binary operations with one argument a set and the other an
|
||||
* integer n, the integer taken to represent set(n).
|
||||
*
|
||||
* A | B = union of A and B, integers in at least one of A and B
|
||||
* A & B = intersection of A and B, integers in both A and B
|
||||
* A ~ B = symmetric difference (boolean sum) of A and Bi, integers
|
||||
* in exactly one of A and B
|
||||
* A \ B = set difference, integers in A but not in B
|
||||
* A | B = union of A and B, integers in at least one of A and B
|
||||
* A & B = intersection of A and B, integers in both A and B
|
||||
* A ~ B = symmetric difference (boolean sum) of A and Bi, integers
|
||||
* in exactly one of A and B
|
||||
* A \ B = set difference, integers in A but not in B
|
||||
*
|
||||
* ~A = complement of A, integers not in A
|
||||
* #A = number of integers in A
|
||||
* !A = 1 or 0 according as A is empty or not empty
|
||||
* +A = sum of the members of A
|
||||
* ~A = complement of A, integers not in A
|
||||
* #A = number of integers in A
|
||||
* !A = 1 or 0 according as A is empty or not empty
|
||||
* +A = sum of the members of A
|
||||
*
|
||||
* min(A) = least member of A, -1 for empty set
|
||||
* max(A) = greatest member of A, -1 for empty set
|
||||
* sum(A) = sum of the members of A
|
||||
* min(A) = least member of A, -1 for empty set
|
||||
* max(A) = greatest member of A, -1 for empty set
|
||||
* sum(A) = sum of the members of A
|
||||
*
|
||||
* In the following a and b denote arbitrary members of A and B:
|
||||
*
|
||||
* A + B = set of sums a + b
|
||||
* A - B = set of differences a - b
|
||||
* A * B = set of products a * b
|
||||
* A ^ n = set of powers a ^ n
|
||||
* A % m = set of integers congruent to a mod m
|
||||
* A + B = set of sums a + b
|
||||
* A - B = set of differences a - b
|
||||
* A * B = set of products a * b
|
||||
* A ^ n = set of powers a ^ n
|
||||
* A % m = set of integers congruent to a mod m
|
||||
*
|
||||
* A == B returns 1 or not according as A and B are equal or not
|
||||
* A != B = !(A == B)
|
||||
* A <= B returns 1 if A is a subset of B, i.e. every member of A is
|
||||
* a member of B
|
||||
* A < B = ((A <= B) && (A != B))
|
||||
* A >= B = (B <= A)
|
||||
* A > B = (B < A)
|
||||
* A == B returns 1 or not according as A and B are equal or not
|
||||
* A != B = !(A == B)
|
||||
* A <= B returns 1 if A is a subset of B, i.e. every member of A is
|
||||
* a member of B
|
||||
* A < B = ((A <= B) && (A != B))
|
||||
* A >= B = (B <= A)
|
||||
* A > B = (B < A)
|
||||
*
|
||||
* Expressions may be formed from the above "arithmetic" operations in
|
||||
* the usual way, with parentheses for variations from the usual precedence
|
||||
* rules. For example
|
||||
*
|
||||
* A + 3 * A ^ 2 + (A - B) ^ 3
|
||||
* A + 3 * A ^ 2 + (A - B) ^ 3
|
||||
*
|
||||
* returns the set of integers expressible as
|
||||
*
|
||||
* a_1 + 3 * a_2 ^ 2 + (a_3 - b) ^3
|
||||
* a_1 + 3 * a_2 ^ 2 + (a_3 - b) ^3
|
||||
*
|
||||
* where a_1, a_2, a_3 are in A, and b is in B.
|
||||
*
|
||||
@@ -119,28 +119,28 @@
|
||||
* isinterval(A) returns 1 if A is a non-empty interval, 0 otherwise.
|
||||
*
|
||||
* randset(n, a, b) returns a random set of n integers between a and b
|
||||
* inclusive; a defaults to 0, b to N-1. An error occurs if
|
||||
* n is too large.
|
||||
* inclusive; a defaults to 0, b to N-1. An error occurs if
|
||||
* n is too large.
|
||||
*
|
||||
* polyvals(L, A) for L = list(c_0, c_1, c_2, ...) returns the set of
|
||||
* values of
|
||||
*
|
||||
* c_0 + c_1 * a + c_2 * a^2 + ...
|
||||
* c_0 + c_1 * a + c_2 * a^2 + ...
|
||||
*
|
||||
* for a in the set A.
|
||||
*
|
||||
* polyvals2(L, A, B) returns the set of values of poly(L, i, j) for i in
|
||||
* A and j in B. Here L is a list whose members are integers or
|
||||
* lists of integers, the latter representing polynomials in the
|
||||
* second variable. For example, with L = list(0, list(0, 1), 1),
|
||||
* polyvals2(L, A, B) will return the values of i^2 + i * j for
|
||||
* i in A, j in B.
|
||||
* A and j in B. Here L is a list whose members are integers or
|
||||
* lists of integers, the latter representing polynomials in the
|
||||
* second variable. For example, with L = list(0, list(0, 1), 1),
|
||||
* polyvals2(L, A, B) will return the values of i^2 + i * j for
|
||||
* i in A, j in B.
|
||||
*
|
||||
*/
|
||||
|
||||
|
||||
static N; /* Number of integers in [0,B], = B + 1 */
|
||||
static M; /* Maximum string size required, = N // 8 */
|
||||
static N; /* Number of integers in [0,B], = B + 1 */
|
||||
static M; /* Maximum string size required, = N // 8 */
|
||||
|
||||
obj set {s};
|
||||
|
||||
@@ -148,17 +148,17 @@ define isset(a) = istype(a, obj set);
|
||||
|
||||
define setbound(n)
|
||||
{
|
||||
local v;
|
||||
local v;
|
||||
|
||||
v = N - 1;
|
||||
if (isnull(n))
|
||||
return v;
|
||||
if (!isint(n) || n < 0)
|
||||
quit "Bad argument for setbound";
|
||||
N = n + 1;
|
||||
M = quo(N, 8, 1); /* M // 8 rounded up */
|
||||
if (v >= 0)
|
||||
return v;
|
||||
v = N - 1;
|
||||
if (isnull(n))
|
||||
return v;
|
||||
if (!isint(n) || n < 0)
|
||||
quit "Bad argument for setbound";
|
||||
N = n + 1;
|
||||
M = quo(N, 8, 1); /* M // 8 rounded up */
|
||||
if (v >= 0)
|
||||
return v;
|
||||
}
|
||||
|
||||
setbound(100);
|
||||
@@ -167,90 +167,90 @@ define empty() = obj set = {""};
|
||||
|
||||
define full()
|
||||
{
|
||||
local v;
|
||||
local v;
|
||||
|
||||
obj set v;
|
||||
v.s = M * char(-1);
|
||||
if (!ismult(N, 8)) v.s[M-1] = 255 >> (8 - N & 7);
|
||||
return v;
|
||||
obj set v;
|
||||
v.s = M * char(-1);
|
||||
if (!ismult(N, 8)) v.s[M-1] = 255 >> (8 - N & 7);
|
||||
return v;
|
||||
}
|
||||
|
||||
define isin(a, b)
|
||||
{
|
||||
if (!isset(a) || !isint(b))
|
||||
quit "Bad argument for isin";
|
||||
return bit(a.s, b);
|
||||
if (!isset(a) || !isint(b))
|
||||
quit "Bad argument for isin";
|
||||
return bit(a.s, b);
|
||||
}
|
||||
|
||||
define addmember(a, n)
|
||||
{
|
||||
if (!isset(a) || !isint(n))
|
||||
quit "Bad argument for addmember";
|
||||
if (n < N && n >= 0)
|
||||
setbit(a.s, n);
|
||||
if (!isset(a) || !isint(n))
|
||||
quit "Bad argument for addmember";
|
||||
if (n < N && n >= 0)
|
||||
setbit(a.s, n);
|
||||
}
|
||||
|
||||
define rmmember(a, n)
|
||||
{
|
||||
if (n < N && n >= 0)
|
||||
setbit(a.s, n, 0);
|
||||
if (n < N && n >= 0)
|
||||
setbit(a.s, n, 0);
|
||||
}
|
||||
|
||||
define set()
|
||||
{
|
||||
local i, v, s;
|
||||
local i, v, s;
|
||||
|
||||
s = M * char(0);
|
||||
for (i = 1; i <= param(0); i++) {
|
||||
v = param(i);
|
||||
if (!isint(v))
|
||||
quit "Non-integral argument for set";
|
||||
if (v >= 0 && v < N)
|
||||
setbit(s, v);
|
||||
}
|
||||
return mkset(s);
|
||||
s = M * char(0);
|
||||
for (i = 1; i <= param(0); i++) {
|
||||
v = param(i);
|
||||
if (!isint(v))
|
||||
quit "Non-integral argument for set";
|
||||
if (v >= 0 && v < N)
|
||||
setbit(s, v);
|
||||
}
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
|
||||
define mkset(s)
|
||||
{
|
||||
local h, m;
|
||||
local h, m;
|
||||
|
||||
if (!isstr(s))
|
||||
quit "Non-string argument for mkset";
|
||||
h = highbit(s);
|
||||
if (h >= N)
|
||||
quit "Too-long string for mkset";
|
||||
m = quo(h + 1, 8, 1);
|
||||
return obj set = {head(s, m)};
|
||||
if (!isstr(s))
|
||||
quit "Non-string argument for mkset";
|
||||
h = highbit(s);
|
||||
if (h >= N)
|
||||
quit "Too-long string for mkset";
|
||||
m = quo(h + 1, 8, 1);
|
||||
return obj set = {head(s, m)};
|
||||
}
|
||||
|
||||
|
||||
define primes(a,b)
|
||||
{
|
||||
local i, s, m;
|
||||
local i, s, m;
|
||||
|
||||
if (isnull(b)) {
|
||||
if (isnull(a)) {
|
||||
a = 0;
|
||||
b = N - 1;
|
||||
}
|
||||
else b = 0;
|
||||
}
|
||||
if (isnull(b)) {
|
||||
if (isnull(a)) {
|
||||
a = 0;
|
||||
b = N - 1;
|
||||
}
|
||||
else b = 0;
|
||||
}
|
||||
|
||||
if (!isint(a) || !isint(b))
|
||||
quit "Non-integer argument for primes";
|
||||
if (a > b)
|
||||
swap(a,b);
|
||||
if (b < 0 || a >= N)
|
||||
return empty();
|
||||
a = max(a, 0);
|
||||
b = min(b, N-1);
|
||||
s = M * char(0);
|
||||
for (i = a; i <= b; i++)
|
||||
if (isprime(i))
|
||||
setbit(s, i);
|
||||
return mkset(s);
|
||||
if (!isint(a) || !isint(b))
|
||||
quit "Non-integer argument for primes";
|
||||
if (a > b)
|
||||
swap(a,b);
|
||||
if (b < 0 || a >= N)
|
||||
return empty();
|
||||
a = max(a, 0);
|
||||
b = min(b, N-1);
|
||||
s = M * char(0);
|
||||
for (i = a; i <= b; i++)
|
||||
if (isprime(i))
|
||||
setbit(s, i);
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define set_max(a) = highbit(a.s);
|
||||
@@ -261,56 +261,56 @@ define set_not(a) = !a.s;
|
||||
|
||||
define set_cmp(a,b)
|
||||
{
|
||||
if (isset(a) && isset(b))
|
||||
return a.s != b.s;
|
||||
return 1;
|
||||
if (isset(a) && isset(b))
|
||||
return a.s != b.s;
|
||||
return 1;
|
||||
}
|
||||
|
||||
define set_rel(a,b)
|
||||
{
|
||||
local c;
|
||||
local c;
|
||||
|
||||
if (a == b)
|
||||
return 0;
|
||||
if (isset(a)) {
|
||||
if (isset(b)) {
|
||||
c = a & b;
|
||||
if (c == a)
|
||||
return -1;
|
||||
if (c == b)
|
||||
return 1;
|
||||
return;
|
||||
}
|
||||
if (!isint(b))
|
||||
return set_rel(a, set(b));
|
||||
}
|
||||
if (isint(a))
|
||||
return set_rel(set(a), b);
|
||||
if (a == b)
|
||||
return 0;
|
||||
if (isset(a)) {
|
||||
if (isset(b)) {
|
||||
c = a & b;
|
||||
if (c == a)
|
||||
return -1;
|
||||
if (c == b)
|
||||
return 1;
|
||||
return;
|
||||
}
|
||||
if (!isint(b))
|
||||
return set_rel(a, set(b));
|
||||
}
|
||||
if (isint(a))
|
||||
return set_rel(set(a), b);
|
||||
}
|
||||
|
||||
|
||||
define set_or(a, b)
|
||||
{
|
||||
if (isset(a)) {
|
||||
if (isset(b))
|
||||
return obj set = {a.s | b.s};
|
||||
if (isint(b))
|
||||
return a | set(b);
|
||||
}
|
||||
if (isint(a))
|
||||
return set(a) | b;
|
||||
return newerror("Bad argument for set_or");
|
||||
if (isset(a)) {
|
||||
if (isset(b))
|
||||
return obj set = {a.s | b.s};
|
||||
if (isint(b))
|
||||
return a | set(b);
|
||||
}
|
||||
if (isint(a))
|
||||
return set(a) | b;
|
||||
return newerror("Bad argument for set_or");
|
||||
}
|
||||
|
||||
define set_and(a, b)
|
||||
{
|
||||
if (isint(a))
|
||||
return set(a) & b;
|
||||
if (isint(b))
|
||||
return a & set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_and");
|
||||
return mkset(a.s & b.s);
|
||||
if (isint(a))
|
||||
return set(a) & b;
|
||||
if (isint(b))
|
||||
return a & set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_and");
|
||||
return mkset(a.s & b.s);
|
||||
}
|
||||
|
||||
|
||||
@@ -318,295 +318,295 @@ define set_comp(a) = full() \ a;
|
||||
|
||||
define set_setminus(a,b)
|
||||
{
|
||||
if (isint(a))
|
||||
return set(a) \ b;
|
||||
if (isint(b))
|
||||
return a \ set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_setminus");
|
||||
return mkset(a.s \ b.s);
|
||||
if (isint(a))
|
||||
return set(a) \ b;
|
||||
if (isint(b))
|
||||
return a \ set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_setminus");
|
||||
return mkset(a.s \ b.s);
|
||||
}
|
||||
|
||||
|
||||
define set_xor(a,b)
|
||||
{
|
||||
if (isint(a))
|
||||
return set(a) ~ b;
|
||||
if (isint(b))
|
||||
return a ~ set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_xor");
|
||||
return mkset(a.s ~ b.s);
|
||||
if (isint(a))
|
||||
return set(a) ~ b;
|
||||
if (isint(b))
|
||||
return a ~ set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_xor");
|
||||
return mkset(a.s ~ b.s);
|
||||
}
|
||||
|
||||
define set_content(a) = #a.s;
|
||||
|
||||
define set_add(a, b)
|
||||
{
|
||||
local s, i, j, m, n;
|
||||
local s, i, j, m, n;
|
||||
|
||||
if (isint(a))
|
||||
return set(a) + b;
|
||||
if (isint(b))
|
||||
return a + set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_add");
|
||||
if (!a || !b)
|
||||
return empty();
|
||||
m = highbit(a.s);
|
||||
n = highbit(b.s);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (isin(a, i))
|
||||
for (j = 0; j <= n && i + j < N; j++)
|
||||
if (isin(b, j))
|
||||
setbit(s, i + j);
|
||||
return mkset(s);
|
||||
if (isint(a))
|
||||
return set(a) + b;
|
||||
if (isint(b))
|
||||
return a + set(b);
|
||||
if (!isset(a) || !isset(b))
|
||||
return newerror("Bad argument for set_add");
|
||||
if (!a || !b)
|
||||
return empty();
|
||||
m = highbit(a.s);
|
||||
n = highbit(b.s);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (isin(a, i))
|
||||
for (j = 0; j <= n && i + j < N; j++)
|
||||
if (isin(b, j))
|
||||
setbit(s, i + j);
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define set_sub(a,b)
|
||||
{
|
||||
local s, i, j, m, n;
|
||||
local s, i, j, m, n;
|
||||
|
||||
if (isint(b))
|
||||
return a - set(b);
|
||||
if (isint(a))
|
||||
return set(a) - b;
|
||||
if (isset(a) && isset(b)) {
|
||||
if (!a || !b)
|
||||
return empty();
|
||||
m = highbit(a.s);
|
||||
n = highbit(b.s);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (isin(a, i))
|
||||
for (j = 0; j <= n && j <= i; j++)
|
||||
if (isin(b, j))
|
||||
setbit(s, i - j);
|
||||
return mkset(s);
|
||||
}
|
||||
return newerror("Bad argument for set_sub");
|
||||
if (isint(b))
|
||||
return a - set(b);
|
||||
if (isint(a))
|
||||
return set(a) - b;
|
||||
if (isset(a) && isset(b)) {
|
||||
if (!a || !b)
|
||||
return empty();
|
||||
m = highbit(a.s);
|
||||
n = highbit(b.s);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (isin(a, i))
|
||||
for (j = 0; j <= n && j <= i; j++)
|
||||
if (isin(b, j))
|
||||
setbit(s, i - j);
|
||||
return mkset(s);
|
||||
}
|
||||
return newerror("Bad argument for set_sub");
|
||||
}
|
||||
|
||||
define set_mul(a, b)
|
||||
{
|
||||
local s, i, j, m, n;
|
||||
local s, i, j, m, n;
|
||||
|
||||
if (isset(a)) {
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
if (isset(b)) {
|
||||
if (!a || !b)
|
||||
return empty();
|
||||
n = highbit(b.s);
|
||||
for (i = 0; i <= m; ++i)
|
||||
if (isin(a, i))
|
||||
for (j = 1; j <= n && i * j < N; ++j)
|
||||
if (isin(b, j))
|
||||
setbit(s, i * j);
|
||||
return mkset(s);
|
||||
}
|
||||
if (isint(b)) {
|
||||
if (b == 0) {
|
||||
if (a)
|
||||
return set(0);
|
||||
return empty();
|
||||
}
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m && b * i < N; ++i)
|
||||
if (isin(a, i))
|
||||
setbit(s, b * i);
|
||||
return mkset(s);
|
||||
}
|
||||
}
|
||||
if (isint(a))
|
||||
return b * a;
|
||||
return newerror("Bad argument for set_mul");
|
||||
if (isset(a)) {
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
if (isset(b)) {
|
||||
if (!a || !b)
|
||||
return empty();
|
||||
n = highbit(b.s);
|
||||
for (i = 0; i <= m; ++i)
|
||||
if (isin(a, i))
|
||||
for (j = 1; j <= n && i * j < N; ++j)
|
||||
if (isin(b, j))
|
||||
setbit(s, i * j);
|
||||
return mkset(s);
|
||||
}
|
||||
if (isint(b)) {
|
||||
if (b == 0) {
|
||||
if (a)
|
||||
return set(0);
|
||||
return empty();
|
||||
}
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m && b * i < N; ++i)
|
||||
if (isin(a, i))
|
||||
setbit(s, b * i);
|
||||
return mkset(s);
|
||||
}
|
||||
}
|
||||
if (isint(a))
|
||||
return b * a;
|
||||
return newerror("Bad argument for set_mul");
|
||||
}
|
||||
|
||||
define set_square(a)
|
||||
{
|
||||
local s, i, m;
|
||||
local s, i, m;
|
||||
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m && i^2 < N; ++i)
|
||||
if (bit(a.s, i))
|
||||
setbit(s, i^2);
|
||||
return mkset(s);
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m && i^2 < N; ++i)
|
||||
if (bit(a.s, i))
|
||||
setbit(s, i^2);
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define set_pow(a, n)
|
||||
{
|
||||
local s, i, m;
|
||||
local s, i, m;
|
||||
|
||||
if (!isint(n) || n < 0)
|
||||
quit "Bad exponent for set_power";
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m && i^n < N; ++i)
|
||||
if (bit(a.s, i))
|
||||
setbit(s, i^n);
|
||||
return mkset(s);
|
||||
if (!isint(n) || n < 0)
|
||||
quit "Bad exponent for set_power";
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m && i^n < N; ++i)
|
||||
if (bit(a.s, i))
|
||||
setbit(s, i^n);
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define set_sum(a)
|
||||
{
|
||||
local v, m, i;
|
||||
local v, m, i;
|
||||
|
||||
v = 0;
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m; ++i)
|
||||
if (bit(a.s, i))
|
||||
v += i;
|
||||
return v;
|
||||
v = 0;
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m; ++i)
|
||||
if (bit(a.s, i))
|
||||
v += i;
|
||||
return v;
|
||||
}
|
||||
|
||||
define set_plus(a) = set_sum(a);
|
||||
|
||||
define interval(a, b)
|
||||
{
|
||||
local i, j, s;
|
||||
static tail = "\0\1\3\7\17\37\77\177\377";
|
||||
local i, j, s;
|
||||
static tail = "\0\1\3\7\17\37\77\177\377";
|
||||
|
||||
if (!isint(a) || !isint(b))
|
||||
quit "Non-integer argument for interval";
|
||||
if (a > b)
|
||||
swap(a, b);
|
||||
if (b < 0 || a >= N)
|
||||
return empty();
|
||||
a = max(a, 0);
|
||||
b = min(b, N-1);
|
||||
i = quo(a, 8, 0);
|
||||
j = quo(b, 8, 0);
|
||||
s = M * char(0);
|
||||
if (i == j) {
|
||||
s[i] = tail[b + 1 - 8 * i] \ tail[a - 8 * i];
|
||||
return mkset(s);
|
||||
}
|
||||
s[i] = ~tail[a - 8 * i];
|
||||
while (++i < j)
|
||||
s[i] = -1;
|
||||
s[j] = tail[b + 1 - 8 * j];
|
||||
return mkset(s);
|
||||
if (!isint(a) || !isint(b))
|
||||
quit "Non-integer argument for interval";
|
||||
if (a > b)
|
||||
swap(a, b);
|
||||
if (b < 0 || a >= N)
|
||||
return empty();
|
||||
a = max(a, 0);
|
||||
b = min(b, N-1);
|
||||
i = quo(a, 8, 0);
|
||||
j = quo(b, 8, 0);
|
||||
s = M * char(0);
|
||||
if (i == j) {
|
||||
s[i] = tail[b + 1 - 8 * i] \ tail[a - 8 * i];
|
||||
return mkset(s);
|
||||
}
|
||||
s[i] = ~tail[a - 8 * i];
|
||||
while (++i < j)
|
||||
s[i] = -1;
|
||||
s[j] = tail[b + 1 - 8 * j];
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define isinterval(a)
|
||||
{
|
||||
local i, max, s;
|
||||
local i, max, s;
|
||||
|
||||
if (!isset(a))
|
||||
quit "Non-set argument for isinterval";
|
||||
if (!isset(a))
|
||||
quit "Non-set argument for isinterval";
|
||||
|
||||
s = a.s;
|
||||
if (!s)
|
||||
return 0;
|
||||
for (i = lowbit(s) + 1, max = highbit(s); i < max; i++)
|
||||
if (!bit(s, i))
|
||||
return 0;
|
||||
return 1;
|
||||
s = a.s;
|
||||
if (!s)
|
||||
return 0;
|
||||
for (i = lowbit(s) + 1, max = highbit(s); i < max; i++)
|
||||
if (!bit(s, i))
|
||||
return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
define set_mod(a, b)
|
||||
{
|
||||
local s, m, i, j;
|
||||
local s, m, i, j;
|
||||
|
||||
if (isset(a) && isint(b)) {
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (bit(a.s, i))
|
||||
for (j = 0; j < N; j++)
|
||||
if (meq(i, j, b))
|
||||
setbit(s, j);
|
||||
return mkset(s);
|
||||
}
|
||||
return newerror("Bad argument for set_mod");
|
||||
if (isset(a) && isint(b)) {
|
||||
s = M * char(0);
|
||||
m = highbit(a.s);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (bit(a.s, i))
|
||||
for (j = 0; j < N; j++)
|
||||
if (meq(i, j, b))
|
||||
setbit(s, j);
|
||||
return mkset(s);
|
||||
}
|
||||
return newerror("Bad argument for set_mod");
|
||||
}
|
||||
|
||||
define randset(n, a, b)
|
||||
{
|
||||
local m, s, i;
|
||||
local m, s, i;
|
||||
|
||||
if (isnull(a))
|
||||
a = 0;
|
||||
if (isnull(b))
|
||||
b = N - 1;
|
||||
if (!isint(n) || !isint(a) || !isint(b) || n < 0 || a < 0 || b < 0)
|
||||
quit "Bad argument for randset";
|
||||
if (a > b)
|
||||
swap(a, b);
|
||||
m = b - a + 1;
|
||||
if (n > m)
|
||||
return newerror("Too many numbers specified for randset");
|
||||
if (2 * n > m)
|
||||
return interval(a,b) \ randset(m - n, a, b);
|
||||
++b;
|
||||
s = M * char(0);
|
||||
while (n-- > 0) {
|
||||
do
|
||||
i = rand(a, b);
|
||||
while
|
||||
(bit(s, i));
|
||||
setbit(s, i);
|
||||
}
|
||||
return mkset(s);
|
||||
if (isnull(a))
|
||||
a = 0;
|
||||
if (isnull(b))
|
||||
b = N - 1;
|
||||
if (!isint(n) || !isint(a) || !isint(b) || n < 0 || a < 0 || b < 0)
|
||||
quit "Bad argument for randset";
|
||||
if (a > b)
|
||||
swap(a, b);
|
||||
m = b - a + 1;
|
||||
if (n > m)
|
||||
return newerror("Too many numbers specified for randset");
|
||||
if (2 * n > m)
|
||||
return interval(a,b) \ randset(m - n, a, b);
|
||||
++b;
|
||||
s = M * char(0);
|
||||
while (n-- > 0) {
|
||||
do
|
||||
i = rand(a, b);
|
||||
while
|
||||
(bit(s, i));
|
||||
setbit(s, i);
|
||||
}
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define polyvals(L, A)
|
||||
{
|
||||
local s, m, v, i;
|
||||
local s, m, v, i;
|
||||
|
||||
if (!islist(L))
|
||||
quit "Non-list first argument for polyvals";
|
||||
if (!isset(A))
|
||||
quit "Non-set second argument for polyvals";
|
||||
m = highbit(A.s);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (bit(A.s, i)) {
|
||||
v = poly(L,i);
|
||||
if (v >> 0 && v < N)
|
||||
setbit(s, v);
|
||||
}
|
||||
return mkset(s);
|
||||
if (!islist(L))
|
||||
quit "Non-list first argument for polyvals";
|
||||
if (!isset(A))
|
||||
quit "Non-set second argument for polyvals";
|
||||
m = highbit(A.s);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (bit(A.s, i)) {
|
||||
v = poly(L,i);
|
||||
if (v >> 0 && v < N)
|
||||
setbit(s, v);
|
||||
}
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define polyvals2(L, A, B)
|
||||
{
|
||||
local s1, s2, s, m, n, i, j, v;
|
||||
local s1, s2, s, m, n, i, j, v;
|
||||
|
||||
s1 = A.s;
|
||||
s2 = B.s;
|
||||
m = highbit(s1);
|
||||
n = highbit(s2);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (bit(s1, i))
|
||||
for (j = 0; j <= n; j++)
|
||||
if (bit(s2, j)) {
|
||||
v = poly(L, i, j);
|
||||
if (v >= 0 && v < N)
|
||||
setbit(s, v);
|
||||
}
|
||||
return mkset(s);
|
||||
s1 = A.s;
|
||||
s2 = B.s;
|
||||
m = highbit(s1);
|
||||
n = highbit(s2);
|
||||
s = M * char(0);
|
||||
for (i = 0; i <= m; i++)
|
||||
if (bit(s1, i))
|
||||
for (j = 0; j <= n; j++)
|
||||
if (bit(s2, j)) {
|
||||
v = poly(L, i, j);
|
||||
if (v >= 0 && v < N)
|
||||
setbit(s, v);
|
||||
}
|
||||
return mkset(s);
|
||||
}
|
||||
|
||||
define set_print(a)
|
||||
{
|
||||
local i, s, m;
|
||||
local i, s, m;
|
||||
|
||||
s = a.s;
|
||||
i = lowbit(s);
|
||||
print "set(":;
|
||||
if (i >= 0) {
|
||||
print i:;
|
||||
m = highbit(s);
|
||||
while (++i <= m)
|
||||
if (bit(s, i))
|
||||
print ",":i:;
|
||||
}
|
||||
print ")",;
|
||||
s = a.s;
|
||||
i = lowbit(s);
|
||||
print "set(":;
|
||||
if (i >= 0) {
|
||||
print i:;
|
||||
m = highbit(s);
|
||||
while (++i <= m)
|
||||
if (bit(s, i))
|
||||
print ",":i:;
|
||||
}
|
||||
print ")",;
|
||||
}
|
||||
|
||||
local N, M; /* End scope of static variables N, M */
|
||||
local N, M; /* End scope of static variables N, M */
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2021/11/06 14:35:37
|
||||
* File existed as early as: 2021
|
||||
* Under source code control: 2021/11/06 14:35:37
|
||||
* File existed as early as: 2021
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -30,23 +30,23 @@
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val value to find a digit of
|
||||
* place digit place
|
||||
* val value to find a digit of
|
||||
* place digit place
|
||||
*
|
||||
* returns:
|
||||
* value (>= 0 and < 10) that is the place-th digit of val
|
||||
* or 0 if place is not a digit of val
|
||||
* value (>= 0 and < 10) that is the place-th digit of val
|
||||
* or 0 if place is not a digit of val
|
||||
*/
|
||||
define digitof(val, place)
|
||||
{
|
||||
local d; /* length of val in digits */
|
||||
local d; /* length of val in digits */
|
||||
|
||||
/* determine length */
|
||||
d = digits(val);
|
||||
|
||||
/* firewall - return 0 if digit place doesn't exist */
|
||||
if (place < 1 || place > d) {
|
||||
return 0;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* return the place-th digit of val as a single digit */
|
||||
@@ -60,18 +60,18 @@ define digitof(val, place)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* d digits of a value
|
||||
* place digit place
|
||||
* d digits of a value
|
||||
* place digit place
|
||||
*
|
||||
* returns:
|
||||
* given palindrome val, the other digit paired with place
|
||||
* or 0 if place is not a digit of val
|
||||
* given palindrome val, the other digit paired with place
|
||||
* or 0 if place is not a digit of val
|
||||
*/
|
||||
define copalplace(d, place)
|
||||
{
|
||||
/* firewall - return 0 if digit place doesn't exist */
|
||||
if (d < 1 || place < 1 || place > d) {
|
||||
return 0;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* return digit coplace */
|
||||
@@ -85,18 +85,18 @@ define copalplace(d, place)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* NOTE: When the value has an odd number of digits, the upper half
|
||||
* includes the middle digit.
|
||||
* includes the middle digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* val a value
|
||||
*
|
||||
* returns:
|
||||
* the upper half digits of a value
|
||||
* the upper half digits of a value
|
||||
*/
|
||||
define upperhalf(val)
|
||||
{
|
||||
local d; /* length of val in digits */
|
||||
local halfd; /* length of upper hand of val */
|
||||
local d; /* length of val in digits */
|
||||
local halfd; /* length of upper hand of val */
|
||||
|
||||
/* determine length */
|
||||
d = digits(val);
|
||||
@@ -113,16 +113,16 @@ define upperhalf(val)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* val a value
|
||||
*
|
||||
* returns:
|
||||
* val as a palindrome with lower half being reverse digits of val
|
||||
* val as a palindrome with lower half being reverse digits of val
|
||||
*/
|
||||
define mkpal(val)
|
||||
{
|
||||
local d; /* length of val in digits */
|
||||
local i; /* counter */
|
||||
local ret; /* palindrome being formed */
|
||||
local d; /* length of val in digits */
|
||||
local i; /* counter */
|
||||
local ret; /* palindrome being formed */
|
||||
|
||||
/* determine length */
|
||||
d = digits(val);
|
||||
@@ -130,7 +130,7 @@ define mkpal(val)
|
||||
/* insert digits in reverse order at the bottom */
|
||||
ret = val;
|
||||
for (i=0; i < d; ++i) {
|
||||
ret = ret*10 + digit(val, i);
|
||||
ret = ret*10 + digit(val, i);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
@@ -142,18 +142,18 @@ define mkpal(val)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* digit the digit to put into the middle of the palindrome
|
||||
* val a value
|
||||
* digit the digit to put into the middle of the palindrome
|
||||
*
|
||||
* returns:
|
||||
* val as a palindrome with lower half being reverse digits of val
|
||||
* and digit as a middle digit
|
||||
* val as a palindrome with lower half being reverse digits of val
|
||||
* and digit as a middle digit
|
||||
*/
|
||||
define mkpalmiddigit(val, digit)
|
||||
{
|
||||
local d; /* length of val in digits */
|
||||
local i; /* counter */
|
||||
local ret; /* palindrome being formed */
|
||||
local d; /* length of val in digits */
|
||||
local i; /* counter */
|
||||
local ret; /* palindrome being formed */
|
||||
|
||||
/* determine length */
|
||||
d = digits(val);
|
||||
@@ -161,7 +161,7 @@ define mkpalmiddigit(val, digit)
|
||||
/* insert digits in reverse order at the bottom */
|
||||
ret = val*10 + digit;
|
||||
for (i=0; i < d; ++i) {
|
||||
ret = ret*10 + digit(val, i);
|
||||
ret = ret*10 + digit(val, i);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
@@ -173,31 +173,31 @@ define mkpalmiddigit(val, digit)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* val a value
|
||||
*
|
||||
* returns:
|
||||
* 1 ==> val is a palindrome
|
||||
* 0 ==> val is NOT a palindrome
|
||||
* 1 ==> val is a palindrome
|
||||
* 0 ==> val is NOT a palindrome
|
||||
*/
|
||||
define ispal(val)
|
||||
{
|
||||
local half; /* upper half of digits of val */
|
||||
local digit; /* middle digit */
|
||||
local half; /* upper half of digits of val */
|
||||
local digit; /* middle digit */
|
||||
|
||||
/* case: val has an even number of digits */
|
||||
if (iseven(digits(val))) {
|
||||
|
||||
/* test palindrome-ness */
|
||||
return (val == mkpal(upperhalf(val)));
|
||||
/* test palindrome-ness */
|
||||
return (val == mkpal(upperhalf(val)));
|
||||
|
||||
/* case: val can an odd number of digits */
|
||||
} else {
|
||||
|
||||
/* test palindrome-ness */
|
||||
half = upperhalf(val);
|
||||
digit = half % 10;
|
||||
half //= 10;
|
||||
return (val == mkpalmiddigit(half, digit));
|
||||
/* test palindrome-ness */
|
||||
half = upperhalf(val);
|
||||
digit = half % 10;
|
||||
half //= 10;
|
||||
return (val == mkpalmiddigit(half, digit));
|
||||
}
|
||||
}
|
||||
|
||||
@@ -208,21 +208,21 @@ define ispal(val)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* pal a palindrome
|
||||
* pal a palindrome
|
||||
*
|
||||
* returns:
|
||||
* next palindrome > pal
|
||||
* next palindrome > pal
|
||||
*/
|
||||
define palnextpal(pal)
|
||||
{
|
||||
local paldigits; /* digits in pal */
|
||||
local half; /* upper half of newval */
|
||||
local newhalf; /* half+1 */
|
||||
local newpal; /* new palindrome */
|
||||
local paldigits; /* digits in pal */
|
||||
local half; /* upper half of newval */
|
||||
local newhalf; /* half+1 */
|
||||
local newpal; /* new palindrome */
|
||||
|
||||
/* case: negative palindrome */
|
||||
if (pal < 0) {
|
||||
return -(palprevpal(-pal));
|
||||
return -(palprevpal(-pal));
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -244,19 +244,19 @@ define palnextpal(pal)
|
||||
*/
|
||||
paldigits = digits(pal);
|
||||
if (digits(newhalf) == digits(half)) {
|
||||
/* no change in half digits: process as normal */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpal(newhalf);
|
||||
} else {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
}
|
||||
/* no change in half digits: process as normal */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpal(newhalf);
|
||||
} else {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
}
|
||||
} else {
|
||||
/* change in half digits: process as opposite */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
} else {
|
||||
newpal = mkpal(newhalf);
|
||||
}
|
||||
/* change in half digits: process as opposite */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
} else {
|
||||
newpal = mkpal(newhalf);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -272,22 +272,22 @@ define palnextpal(pal)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* val a value
|
||||
*
|
||||
* returns:
|
||||
* next palindrome > val
|
||||
* next palindrome > val
|
||||
*/
|
||||
define nextpal(val)
|
||||
{
|
||||
local newval; /* val+1 */
|
||||
local newvaldigits; /* digits in newval */
|
||||
local half; /* upper half of newval */
|
||||
local pal; /* palindrome test value */
|
||||
local newpal; /* new palindrome */
|
||||
local newval; /* val+1 */
|
||||
local newvaldigits; /* digits in newval */
|
||||
local half; /* upper half of newval */
|
||||
local pal; /* palindrome test value */
|
||||
local newpal; /* new palindrome */
|
||||
|
||||
/* case: negative value */
|
||||
if (val < 0) {
|
||||
return -(prevpal(-val));
|
||||
return -(prevpal(-val));
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -298,7 +298,7 @@ define nextpal(val)
|
||||
|
||||
/* case: single digit palindrome */
|
||||
if (newvaldigits < 2) {
|
||||
return newval;
|
||||
return newval;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -314,16 +314,16 @@ define nextpal(val)
|
||||
* half may not or may include the middle digit.
|
||||
*/
|
||||
if (iseven(newvaldigits)) {
|
||||
pal = mkpal(half);
|
||||
pal = mkpal(half);
|
||||
} else {
|
||||
pal = mkpalmiddigit(half // 10, half % 10);
|
||||
pal = mkpalmiddigit(half // 10, half % 10);
|
||||
}
|
||||
|
||||
/*
|
||||
* case: we found a larger palindrome, we are done
|
||||
*/
|
||||
if (pal > val) {
|
||||
return pal;
|
||||
return pal;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -344,33 +344,33 @@ define nextpal(val)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* pal a palindrome
|
||||
* pal a palindrome
|
||||
*
|
||||
* returns:
|
||||
* previous palindrome < pal
|
||||
* previous palindrome < pal
|
||||
*/
|
||||
define palprevpal(pal)
|
||||
{
|
||||
local paldigits; /* digits in pal */
|
||||
local half; /* upper half of newval */
|
||||
local newhalf; /* half+1 */
|
||||
local newpal; /* new palindrome */
|
||||
local paldigits; /* digits in pal */
|
||||
local half; /* upper half of newval */
|
||||
local newhalf; /* half+1 */
|
||||
local newpal; /* new palindrome */
|
||||
|
||||
/* case: negative value */
|
||||
if (pal < 0) {
|
||||
return -(palnextpal(-pal));
|
||||
return -(palnextpal(-pal));
|
||||
}
|
||||
|
||||
/* case: single digit palindrome */
|
||||
if (pal < 10) {
|
||||
newpal = pal-1;
|
||||
return newpal;
|
||||
newpal = pal-1;
|
||||
return newpal;
|
||||
}
|
||||
|
||||
/* case: 10 or 11 */
|
||||
if (pal < 12) {
|
||||
newpal = 9;
|
||||
return newpal;
|
||||
newpal = 9;
|
||||
return newpal;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -392,19 +392,19 @@ define palprevpal(pal)
|
||||
*/
|
||||
paldigits = digits(pal);
|
||||
if (digits(newhalf) == digits(half)) {
|
||||
/* no change in half digits: process as normal */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpal(newhalf);
|
||||
} else {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
}
|
||||
/* no change in half digits: process as normal */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpal(newhalf);
|
||||
} else {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
}
|
||||
} else {
|
||||
/* change in half digits: process as opposite */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
} else {
|
||||
newpal = mkpal(newhalf);
|
||||
}
|
||||
/* change in half digits: process as opposite */
|
||||
if (iseven(paldigits)) {
|
||||
newpal = mkpalmiddigit(newhalf // 10, newhalf % 10);
|
||||
} else {
|
||||
newpal = mkpal(newhalf);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -420,22 +420,22 @@ define palprevpal(pal)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* val a value
|
||||
*
|
||||
* returns:
|
||||
* previous palindrome < val
|
||||
* previous palindrome < val
|
||||
*/
|
||||
define prevpal(val)
|
||||
{
|
||||
local newval; /* val-1 */
|
||||
local newvaldigits; /* digits in newval */
|
||||
local half; /* upper half of newval */
|
||||
local pal; /* palindrome test value */
|
||||
local newpal; /* new palindrome */
|
||||
local newval; /* val-1 */
|
||||
local newvaldigits; /* digits in newval */
|
||||
local half; /* upper half of newval */
|
||||
local pal; /* palindrome test value */
|
||||
local newpal; /* new palindrome */
|
||||
|
||||
/* case: negative value */
|
||||
if (val < 0) {
|
||||
return -(nextpal(-val));
|
||||
return -(nextpal(-val));
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -446,7 +446,7 @@ define prevpal(val)
|
||||
|
||||
/* case: single digit palindrome */
|
||||
if (newvaldigits < 2) {
|
||||
return newval;
|
||||
return newval;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -462,16 +462,16 @@ define prevpal(val)
|
||||
* half may not or may include the middle digit.
|
||||
*/
|
||||
if (iseven(newvaldigits)) {
|
||||
pal = mkpal(half);
|
||||
pal = mkpal(half);
|
||||
} else {
|
||||
pal = mkpalmiddigit(half // 10, half % 10);
|
||||
pal = mkpalmiddigit(half // 10, half % 10);
|
||||
}
|
||||
|
||||
/*
|
||||
* case: we found a smaller palindrome, we are done
|
||||
*/
|
||||
if (pal < val) {
|
||||
return pal;
|
||||
return pal;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -492,15 +492,15 @@ define prevpal(val)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* val a value
|
||||
*
|
||||
* returns:
|
||||
* next palindrome (highly probable) prime > val
|
||||
* next palindrome (highly probable) prime > val
|
||||
*/
|
||||
define nextprimepal(val)
|
||||
{
|
||||
local pal; /* palindrome test value */
|
||||
local dpal; /* digits in pal */
|
||||
local pal; /* palindrome test value */
|
||||
local dpal; /* digits in pal */
|
||||
|
||||
/*
|
||||
* pre-start under the next palindrome
|
||||
@@ -512,45 +512,45 @@ define nextprimepal(val)
|
||||
*/
|
||||
do {
|
||||
|
||||
/* case: negative values and tiny values */
|
||||
if (pal < 2) {
|
||||
return 2;
|
||||
}
|
||||
/* case: negative values and tiny values */
|
||||
if (pal < 2) {
|
||||
return 2;
|
||||
}
|
||||
|
||||
/*
|
||||
* compute the next palindrome
|
||||
*/
|
||||
pal = palnextpal(pal);
|
||||
dpal = digits(pal);
|
||||
/*
|
||||
* compute the next palindrome
|
||||
*/
|
||||
pal = palnextpal(pal);
|
||||
dpal = digits(pal);
|
||||
|
||||
/* case: 11 is the only prime palindrome with even digit count */
|
||||
if (pal == 11) {
|
||||
return 11;
|
||||
}
|
||||
/* case: 11 is the only prime palindrome with even digit count */
|
||||
if (pal == 11) {
|
||||
return 11;
|
||||
}
|
||||
|
||||
/* case: even number of digits and not 11 */
|
||||
if (iseven(dpal)) {
|
||||
/* case: even number of digits and not 11 */
|
||||
if (iseven(dpal)) {
|
||||
|
||||
/*
|
||||
* Except for 11 (which is handled above already), there are
|
||||
* no prime palindrome with even digits. So we need to
|
||||
* increase the digit count and work with that larger palindrome.
|
||||
*/
|
||||
pal = nextpal(10^dpal);
|
||||
}
|
||||
/*
|
||||
* Except for 11 (which is handled above already), there are
|
||||
* no prime palindrome with even digits. So we need to
|
||||
* increase the digit count and work with that larger palindrome.
|
||||
*/
|
||||
pal = nextpal(10^dpal);
|
||||
}
|
||||
|
||||
/* case: palindrome is even or ends in 5 */
|
||||
if (iseven(pal % 10) || (pal%10 == 10/2)) {
|
||||
/* case: palindrome is even or ends in 5 */
|
||||
if (iseven(pal % 10) || (pal%10 == 10/2)) {
|
||||
|
||||
/*
|
||||
* we need to increase the bottom and top digits
|
||||
* so that we have a chance to be prime
|
||||
*/
|
||||
pal += (1 + 10^(dpal-1));
|
||||
}
|
||||
if (config("resource_debug") & 0x8) {
|
||||
print "DEBUG: nextprimepal:", pal;
|
||||
}
|
||||
/*
|
||||
* we need to increase the bottom and top digits
|
||||
* so that we have a chance to be prime
|
||||
*/
|
||||
pal += (1 + 10^(dpal-1));
|
||||
}
|
||||
if (config("resource_debug") & 0x8) {
|
||||
print "DEBUG: nextprimepal:", pal;
|
||||
}
|
||||
} while (ptest(pal) == 0 && pal > 0);
|
||||
|
||||
/* return palindrome that his (highly probable) prime or 0 */
|
||||
@@ -564,15 +564,15 @@ define nextprimepal(val)
|
||||
* NOTE: We assume base 10 digits and place 1 is the units digit.
|
||||
*
|
||||
* given:
|
||||
* val a value
|
||||
* val a value
|
||||
*
|
||||
* returns:
|
||||
* prev palindrome (highly probable) prime < val or 0
|
||||
* prev palindrome (highly probable) prime < val or 0
|
||||
*/
|
||||
define prevprimepal(val)
|
||||
{
|
||||
local pal; /* palindrome test value */
|
||||
local dpal; /* digits in pal */
|
||||
local pal; /* palindrome test value */
|
||||
local dpal; /* digits in pal */
|
||||
|
||||
/*
|
||||
* pre-start over the previous palindrome
|
||||
@@ -584,56 +584,56 @@ define prevprimepal(val)
|
||||
*/
|
||||
do {
|
||||
|
||||
/*
|
||||
* case: single digit values are always palindromes
|
||||
*/
|
||||
if (val < 10) {
|
||||
/*
|
||||
* The prevcand() call will return 0 if there is no previous prime
|
||||
* such as the case when val < 2.
|
||||
*/
|
||||
return prevcand(pal);
|
||||
}
|
||||
/*
|
||||
* case: single digit values are always palindromes
|
||||
*/
|
||||
if (val < 10) {
|
||||
/*
|
||||
* The prevcand() call will return 0 if there is no previous prime
|
||||
* such as the case when val < 2.
|
||||
*/
|
||||
return prevcand(pal);
|
||||
}
|
||||
|
||||
/*
|
||||
* compute the previous palindrome
|
||||
*/
|
||||
pal = palprevpal(pal);
|
||||
dpal = digits(pal);
|
||||
/*
|
||||
* compute the previous palindrome
|
||||
*/
|
||||
pal = palprevpal(pal);
|
||||
dpal = digits(pal);
|
||||
|
||||
/* case: 11 is the only prime palindrome with even digit count */
|
||||
if (pal == 11) {
|
||||
return 11;
|
||||
}
|
||||
/* case: 11 is the only prime palindrome with even digit count */
|
||||
if (pal == 11) {
|
||||
return 11;
|
||||
}
|
||||
|
||||
/* case: 2 digit palindrome and not 11 */
|
||||
if (dpal == 2) {
|
||||
return 7;
|
||||
}
|
||||
/* case: 2 digit palindrome and not 11 */
|
||||
if (dpal == 2) {
|
||||
return 7;
|
||||
}
|
||||
|
||||
/* case: even number of digits */
|
||||
if (iseven(dpal)) {
|
||||
/* case: even number of digits */
|
||||
if (iseven(dpal)) {
|
||||
|
||||
/*
|
||||
* Except for 11 (which is handled above already), there are
|
||||
* no prime palindrome with even digits. So we need to
|
||||
* decrease the digit count and work with that smaller palindrome.
|
||||
*/
|
||||
pal = prevpal(10^(dpal-1));
|
||||
}
|
||||
/*
|
||||
* Except for 11 (which is handled above already), there are
|
||||
* no prime palindrome with even digits. So we need to
|
||||
* decrease the digit count and work with that smaller palindrome.
|
||||
*/
|
||||
pal = prevpal(10^(dpal-1));
|
||||
}
|
||||
|
||||
/* case: palindrome is even or ends in 5 */
|
||||
if (iseven(pal % 10) || (pal%10 == 10/2)) {
|
||||
/* case: palindrome is even or ends in 5 */
|
||||
if (iseven(pal % 10) || (pal%10 == 10/2)) {
|
||||
|
||||
/*
|
||||
* we need to decrease the bottom and top digits
|
||||
* so that we have a chance to be prime
|
||||
*/
|
||||
pal -= (1 + 10^(dpal-1));
|
||||
}
|
||||
if (config("resource_debug") & 0x8) {
|
||||
print "DEBUG: prevprimepal:", pal;
|
||||
}
|
||||
/*
|
||||
* we need to decrease the bottom and top digits
|
||||
* so that we have a chance to be prime
|
||||
*/
|
||||
pal -= (1 + 10^(dpal-1));
|
||||
}
|
||||
if (config("resource_debug") & 0x8) {
|
||||
print "DEBUG: prevprimepal:", pal;
|
||||
}
|
||||
} while (ptest(pal) == 0 && pal > 0);
|
||||
|
||||
/* return palindrome that his (highly probable) prime or 0 */
|
||||
|
||||
98
cal/pell.cal
98
cal/pell.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:50:34
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -31,60 +31,60 @@
|
||||
|
||||
define pell(D)
|
||||
{
|
||||
local X, Y;
|
||||
local X, Y;
|
||||
|
||||
X = pellx(D);
|
||||
if (isnull(X)) {
|
||||
print "D=":D:" is square";
|
||||
return;
|
||||
}
|
||||
Y = isqrt((X^2 - 1) / D);
|
||||
print X : "^2 - " : D : "*" : Y : "^2 = " : X^2 - D*Y^2;
|
||||
X = pellx(D);
|
||||
if (isnull(X)) {
|
||||
print "D=":D:" is square";
|
||||
return;
|
||||
}
|
||||
Y = isqrt((X^2 - 1) / D);
|
||||
print X : "^2 - " : D : "*" : Y : "^2 = " : X^2 - D*Y^2;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Function to solve Pell's equation
|
||||
* Returns the solution X to:
|
||||
* X^2 - D * Y^2 = 1
|
||||
* X^2 - D * Y^2 = 1
|
||||
*/
|
||||
define pellx(D)
|
||||
{
|
||||
local R, Rp, U, Up, V, Vp, A, T, Q1, Q2, n;
|
||||
local mat ans[2,2];
|
||||
local mat tmp[2,2];
|
||||
local R, Rp, U, Up, V, Vp, A, T, Q1, Q2, n;
|
||||
local mat ans[2,2];
|
||||
local mat tmp[2,2];
|
||||
|
||||
R = isqrt(D);
|
||||
Vp = D - R^2;
|
||||
if (Vp == 0)
|
||||
return;
|
||||
Rp = R + R;
|
||||
U = Rp;
|
||||
Up = U;
|
||||
V = 1;
|
||||
A = 0;
|
||||
n = 0;
|
||||
ans[0,0] = 1;
|
||||
ans[1,1] = 1;
|
||||
tmp[0,1] = 1;
|
||||
tmp[1,0] = 1;
|
||||
do {
|
||||
T = V;
|
||||
V = A * (Up - U) + Vp;
|
||||
Vp = T;
|
||||
A = U // V;
|
||||
Up = U;
|
||||
U = Rp - U % V;
|
||||
tmp[0,0] = A;
|
||||
ans *= tmp;
|
||||
n++;
|
||||
} while (A != Rp);
|
||||
Q2 = ans[[1]];
|
||||
Q1 = isqrt(Q2^2 * D + 1);
|
||||
if (isodd(n)) {
|
||||
T = Q1^2 + D * Q2^2;
|
||||
Q2 = Q1 * Q2 * 2;
|
||||
Q1 = T;
|
||||
}
|
||||
return Q1;
|
||||
R = isqrt(D);
|
||||
Vp = D - R^2;
|
||||
if (Vp == 0)
|
||||
return;
|
||||
Rp = R + R;
|
||||
U = Rp;
|
||||
Up = U;
|
||||
V = 1;
|
||||
A = 0;
|
||||
n = 0;
|
||||
ans[0,0] = 1;
|
||||
ans[1,1] = 1;
|
||||
tmp[0,1] = 1;
|
||||
tmp[1,0] = 1;
|
||||
do {
|
||||
T = V;
|
||||
V = A * (Up - U) + Vp;
|
||||
Vp = T;
|
||||
A = U // V;
|
||||
Up = U;
|
||||
U = Rp - U % V;
|
||||
tmp[0,0] = A;
|
||||
ans *= tmp;
|
||||
n++;
|
||||
} while (A != Rp);
|
||||
Q2 = ans[[1]];
|
||||
Q1 = isqrt(Q2^2 * D + 1);
|
||||
if (isodd(n)) {
|
||||
T = Q1^2 + D * Q2^2;
|
||||
Q2 = Q1 * Q2 * 2;
|
||||
Q1 = T;
|
||||
}
|
||||
return Q1;
|
||||
}
|
||||
|
||||
178
cal/pi.cal
178
cal/pi.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -31,43 +31,43 @@
|
||||
|
||||
define qpi(epsilon)
|
||||
{
|
||||
local niter, yn, ym, tm, an, am, t, tn, sqrt2, epsilon2, count, digits;
|
||||
local bits, bits2;
|
||||
local niter, yn, ym, tm, an, am, t, tn, sqrt2, epsilon2, count, digits;
|
||||
local bits, bits2;
|
||||
|
||||
if (isnull(epsilon))
|
||||
epsilon = epsilon();
|
||||
digits = digits(1/epsilon);
|
||||
if (digits <= 8) { niter = 1; epsilon = 1e-8; }
|
||||
else if (digits <= 40) { niter = 2; epsilon = 1e-40; }
|
||||
else if (digits <= 170) { niter = 3; epsilon = 1e-170; }
|
||||
else if (digits <= 693) { niter = 4; epsilon = 1e-693; }
|
||||
else {
|
||||
niter = 4;
|
||||
t = 693;
|
||||
while (t < digits) {
|
||||
++niter;
|
||||
t *= 4;
|
||||
}
|
||||
}
|
||||
epsilon2 = epsilon/(digits/10 + 1);
|
||||
digits = digits(1/epsilon2);
|
||||
sqrt2 = sqrt(2, epsilon2);
|
||||
bits = abs(ilog2(epsilon)) + 1;
|
||||
bits2 = abs(ilog2(epsilon2)) + 1;
|
||||
yn = sqrt2 - 1;
|
||||
an = 6 - 4 * sqrt2;
|
||||
tn = 2;
|
||||
for (count = 0; count < niter; ++count) {
|
||||
ym = yn;
|
||||
am = an;
|
||||
tn *= 4;
|
||||
t = sqrt(sqrt(1-ym^4, epsilon2), epsilon2);
|
||||
yn = (1-t)/(1+t);
|
||||
an = (1+yn)^4*am-tn*yn*(1+yn+yn^2);
|
||||
yn = bround(yn, bits2);
|
||||
an = bround(an, bits2);
|
||||
}
|
||||
return (bround(1/an, bits));
|
||||
if (isnull(epsilon))
|
||||
epsilon = epsilon();
|
||||
digits = digits(1/epsilon);
|
||||
if (digits <= 8) { niter = 1; epsilon = 1e-8; }
|
||||
else if (digits <= 40) { niter = 2; epsilon = 1e-40; }
|
||||
else if (digits <= 170) { niter = 3; epsilon = 1e-170; }
|
||||
else if (digits <= 693) { niter = 4; epsilon = 1e-693; }
|
||||
else {
|
||||
niter = 4;
|
||||
t = 693;
|
||||
while (t < digits) {
|
||||
++niter;
|
||||
t *= 4;
|
||||
}
|
||||
}
|
||||
epsilon2 = epsilon/(digits/10 + 1);
|
||||
digits = digits(1/epsilon2);
|
||||
sqrt2 = sqrt(2, epsilon2);
|
||||
bits = abs(ilog2(epsilon)) + 1;
|
||||
bits2 = abs(ilog2(epsilon2)) + 1;
|
||||
yn = sqrt2 - 1;
|
||||
an = 6 - 4 * sqrt2;
|
||||
tn = 2;
|
||||
for (count = 0; count < niter; ++count) {
|
||||
ym = yn;
|
||||
am = an;
|
||||
tn *= 4;
|
||||
t = sqrt(sqrt(1-ym^4, epsilon2), epsilon2);
|
||||
yn = (1-t)/(1+t);
|
||||
an = (1+yn)^4*am-tn*yn*(1+yn+yn^2);
|
||||
yn = bround(yn, bits2);
|
||||
an = bround(an, bits2);
|
||||
}
|
||||
return (bround(1/an, bits));
|
||||
}
|
||||
|
||||
|
||||
@@ -86,58 +86,58 @@ define qpi(epsilon)
|
||||
|
||||
define piforever()
|
||||
{
|
||||
local k = 2;
|
||||
local a = 4;
|
||||
local b = 1;
|
||||
local a1 = 12;
|
||||
local b1 = 4;
|
||||
local a2, b2, p, q, d, d1;
|
||||
local stdout = files(1);
|
||||
local first = 1, row = -1, col = 0;
|
||||
local k = 2;
|
||||
local a = 4;
|
||||
local b = 1;
|
||||
local a1 = 12;
|
||||
local b1 = 4;
|
||||
local a2, b2, p, q, d, d1;
|
||||
local stdout = files(1);
|
||||
local first = 1, row = -1, col = 0;
|
||||
|
||||
while (1) {
|
||||
/*
|
||||
* Next approximation
|
||||
*/
|
||||
p = k * k;
|
||||
q = k + ++k;
|
||||
while (1) {
|
||||
/*
|
||||
* Next approximation
|
||||
*/
|
||||
p = k * k;
|
||||
q = k + ++k;
|
||||
|
||||
a2 = a;
|
||||
b2 = b;
|
||||
a2 = a;
|
||||
b2 = b;
|
||||
|
||||
a = a1;
|
||||
a1 = p * a2 + q * a1;
|
||||
b = b1;
|
||||
b1 = p * b2 + q * b1;
|
||||
a = a1;
|
||||
a1 = p * a2 + q * a1;
|
||||
b = b1;
|
||||
b1 = p * b2 + q * b1;
|
||||
|
||||
/*
|
||||
* Print common digits
|
||||
*/
|
||||
d = a // b;
|
||||
d1 = a1 // b1;
|
||||
/*
|
||||
* Print common digits
|
||||
*/
|
||||
d = a // b;
|
||||
d1 = a1 // b1;
|
||||
|
||||
while (d == d1) {
|
||||
if (first) {
|
||||
printf("%d.", d);
|
||||
first = 0;
|
||||
} else {
|
||||
if (!(col % 50)) {
|
||||
printf("\n");
|
||||
col = 0;
|
||||
if (!(++row % 20)) {
|
||||
printf("\n");
|
||||
row = 0;
|
||||
}
|
||||
}
|
||||
printf("%d", d);
|
||||
if (!(++col % 10))
|
||||
printf(" ");
|
||||
}
|
||||
a = 10 * (a % b);
|
||||
a1 = 10 * (a1 % b1);
|
||||
d = a // b;
|
||||
d1 = a1 // b1;
|
||||
}
|
||||
fflush(stdout);
|
||||
}
|
||||
while (d == d1) {
|
||||
if (first) {
|
||||
printf("%d.", d);
|
||||
first = 0;
|
||||
} else {
|
||||
if (!(col % 50)) {
|
||||
printf("\n");
|
||||
col = 0;
|
||||
if (!(++row % 20)) {
|
||||
printf("\n");
|
||||
row = 0;
|
||||
}
|
||||
}
|
||||
printf("%d", d);
|
||||
if (!(++col % 10))
|
||||
printf(" ");
|
||||
}
|
||||
a = 10 * (a % b);
|
||||
a1 = 10 * (a1 % b1);
|
||||
d = a // b;
|
||||
d1 = a1 // b1;
|
||||
}
|
||||
fflush(stdout);
|
||||
}
|
||||
}
|
||||
|
||||
66
cal/pix.cal
66
cal/pix.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,51 +17,51 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/07/09 03:14:14
|
||||
* File existed as early as: 1996
|
||||
* Under source code control: 1996/07/09 03:14:14
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Here is an iterative method of finding the number of primes less than
|
||||
* or equal to a given number. This method is from "Computer Recreations"
|
||||
* or equal to a given number. This method is from "Computer Recreations"
|
||||
* June 1996 issue of Scientific American.
|
||||
*
|
||||
* NOTE: For reasonable values of x, the builtin function pix(x) is
|
||||
* much faster. This code is provided because the method
|
||||
* is interesting.
|
||||
* much faster. This code is provided because the method
|
||||
* is interesting.
|
||||
*/
|
||||
|
||||
|
||||
define pi_of_x(x)
|
||||
{
|
||||
local An; /* A(n) */
|
||||
local An1; /* A(n-1) */
|
||||
local An2; /* A(n-2) */
|
||||
local An3; /* A(n-3) */
|
||||
local primes; /* number of primes found */
|
||||
local n; /* loop counter */
|
||||
local An; /* A(n) */
|
||||
local An1; /* A(n-1) */
|
||||
local An2; /* A(n-2) */
|
||||
local An3; /* A(n-3) */
|
||||
local primes; /* number of primes found */
|
||||
local n; /* loop counter */
|
||||
|
||||
/*
|
||||
* setup
|
||||
*/
|
||||
An1 = 2;
|
||||
An2 = 0;
|
||||
An3 = 3;
|
||||
primes = 1;
|
||||
/*
|
||||
* setup
|
||||
*/
|
||||
An1 = 2;
|
||||
An2 = 0;
|
||||
An3 = 3;
|
||||
primes = 1;
|
||||
|
||||
/*
|
||||
* main A(n+1)=A(n-1)+A(n-2) sequence loop
|
||||
*/
|
||||
for (n = 3; n < x; ++n) {
|
||||
An = An2 + An3;
|
||||
An3 = An2;
|
||||
An2 = An1;
|
||||
An1 = An;
|
||||
if (An % n == 0)
|
||||
++primes;
|
||||
}
|
||||
return primes;
|
||||
/*
|
||||
* main A(n+1)=A(n-1)+A(n-2) sequence loop
|
||||
*/
|
||||
for (n = 3; n < x; ++n) {
|
||||
An = An2 + An3;
|
||||
An3 = An2;
|
||||
An2 = An1;
|
||||
An1 = An;
|
||||
if (An % n == 0)
|
||||
++primes;
|
||||
}
|
||||
return primes;
|
||||
}
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,32 +17,32 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
* Under source code control: 1991/05/22 21:56:37
|
||||
* File existed as early as: 1991
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
define pfactor(N, B, ai, af)
|
||||
{
|
||||
local a, k, i, d;
|
||||
local a, k, i, d;
|
||||
|
||||
if (isnull(B))
|
||||
B = 1000;
|
||||
if (isnull(ai))
|
||||
ai = 2;
|
||||
if (isnull(af))
|
||||
af = ai + 20;
|
||||
k = lcmfact(B);
|
||||
d = lfactor(N, B);
|
||||
if (d > 1)
|
||||
return d;
|
||||
for (a = ai; a <= af; a++) {
|
||||
i = pmod(a, k, N);
|
||||
d = gcd(i - 1, N);
|
||||
if ((d > 1) && (d != N))
|
||||
return d;
|
||||
}
|
||||
return 1;
|
||||
if (isnull(B))
|
||||
B = 1000;
|
||||
if (isnull(ai))
|
||||
ai = 2;
|
||||
if (isnull(af))
|
||||
af = ai + 20;
|
||||
k = lcmfact(B);
|
||||
d = lfactor(N, B);
|
||||
if (d > 1)
|
||||
return d;
|
||||
for (a = ai; a <= af; a++) {
|
||||
i = pmod(a, k, N);
|
||||
d = gcd(i - 1, N);
|
||||
if ((d > 1) && (d != N))
|
||||
return d;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1050
cal/poly.cal
1050
cal/poly.cal
File diff suppressed because it is too large
Load Diff
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/12/18 04:43:25
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/12/18 04:43:25
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -32,7 +32,7 @@
|
||||
* entering "end", "exit" or "quit"; "end" returns to the level from
|
||||
* which adder() is called, e.g. with:
|
||||
*
|
||||
* for (;;) adder()
|
||||
* for (;;) adder()
|
||||
*
|
||||
* entering "end" would start a new edition with sum = 0; "quit" and
|
||||
* "exit" return to the top level.
|
||||
@@ -43,25 +43,25 @@
|
||||
* thus the string may include variables, assignments, functions, etc.
|
||||
* as in:
|
||||
*
|
||||
* 2 + 3
|
||||
* x = 2 + 3, x^3
|
||||
* x^2
|
||||
* local x = 2; while (x < 100) x *= 2; x % 100
|
||||
* x
|
||||
* exp(2, 1e-5)
|
||||
* sum
|
||||
* print sum^2;
|
||||
* 3; print sum^2;
|
||||
* 2 + 3
|
||||
* x = 2 + 3, x^3
|
||||
* x^2
|
||||
* local x = 2; while (x < 100) x *= 2; x % 100
|
||||
* x
|
||||
* exp(2, 1e-5)
|
||||
* sum
|
||||
* print sum^2;
|
||||
* 3; print sum^2;
|
||||
*
|
||||
* (Here the second line creates x as a global variable; the local
|
||||
* variable x in the fourth line has no effect on the global x. In
|
||||
* variable x in the fourth line has no effect on the global x. In
|
||||
* the last three lines, sum is the sum of numbers already entered, so
|
||||
* the third last line doubles the value of sum. The value returned
|
||||
* by "print sum^2;" is the null value, so the second last line adds
|
||||
* nothing to sum. The last line returns the value 3, i.e. the last
|
||||
* non-null value found for the expressions separated by semicolons,
|
||||
* so sum will be increased by 3 after the "print sum^2;" command
|
||||
* is executed. XXX The terminating semicolon is essential in the
|
||||
* is executed. XXX The terminating semicolon is essential in the
|
||||
* last two lines. A command like eval("print 7;") is acceptable to
|
||||
* calc but eval("print 7") causes an exit from calc. XXX)
|
||||
*
|
||||
@@ -72,44 +72,44 @@
|
||||
*
|
||||
* Calling showvalues(str) assumes str defines a function of x as in:
|
||||
*
|
||||
* "sin(x)", "x^2 + 3*x", "exp(x, 1e-5)".
|
||||
* "sin(x)", "x^2 + 3*x", "exp(x, 1e-5)".
|
||||
*
|
||||
* Values of the function so defined are returned for values of x
|
||||
* entered in response to the ? prompt. Operation is terminated by
|
||||
* entered in response to the ? prompt. Operation is terminated by
|
||||
* entering "end", "exit" or "quit".
|
||||
*/
|
||||
|
||||
|
||||
define adder() {
|
||||
global sum = 0;
|
||||
local s, t;
|
||||
for (;;) {
|
||||
s = prompt("? ");
|
||||
if (s == "end")
|
||||
break;
|
||||
t = eval(s);
|
||||
if (!isnum(t)) {
|
||||
print "Please enter a number";
|
||||
continue;
|
||||
}
|
||||
sum += t;
|
||||
print "\t":sum;
|
||||
}
|
||||
global sum = 0;
|
||||
local s, t;
|
||||
for (;;) {
|
||||
s = prompt("? ");
|
||||
if (s == "end")
|
||||
break;
|
||||
t = eval(s);
|
||||
if (!isnum(t)) {
|
||||
print "Please enter a number";
|
||||
continue;
|
||||
}
|
||||
sum += t;
|
||||
print "\t":sum;
|
||||
}
|
||||
}
|
||||
|
||||
global prompt_x;
|
||||
|
||||
define showvalues(str) {
|
||||
local s;
|
||||
for (;;) {
|
||||
s = prompt("? ");
|
||||
if (s == "end")
|
||||
break;
|
||||
prompt_x = eval(s);
|
||||
if (!isnum(prompt_x)) {
|
||||
print "Please enter a number";
|
||||
continue;
|
||||
}
|
||||
print "\t":eval(str);
|
||||
}
|
||||
local s;
|
||||
for (;;) {
|
||||
s = prompt("? ");
|
||||
if (s == "end")
|
||||
break;
|
||||
prompt_x = eval(s);
|
||||
if (!isnum(prompt_x)) {
|
||||
print "Please enter a number";
|
||||
continue;
|
||||
}
|
||||
print "\t":eval(str);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -31,40 +31,40 @@
|
||||
|
||||
define psqrt(u, p)
|
||||
{
|
||||
local p1, q, n, y, r, v, w, t, k;
|
||||
local p1, q, n, y, r, v, w, t, k;
|
||||
|
||||
p1 = p - 1;
|
||||
r = lowbit(p1);
|
||||
q = p >> r;
|
||||
t = 1 << (r - 1);
|
||||
for (n = 2; ; n++) {
|
||||
if (ptest(n, 1) == 0)
|
||||
continue;
|
||||
y = pmod(n, q, p);
|
||||
k = pmod(y, t, p);
|
||||
if (k == 1)
|
||||
continue;
|
||||
if (k != p1)
|
||||
return;
|
||||
break;
|
||||
}
|
||||
t = pmod(u, (q - 1) / 2, p);
|
||||
v = (t * u) % p;
|
||||
w = (t^2 * u) % p;
|
||||
while (w != 1) {
|
||||
k = 0;
|
||||
t = w;
|
||||
do {
|
||||
k++;
|
||||
t = t^2 % p;
|
||||
} while (t != 1);
|
||||
if (k == r)
|
||||
return;
|
||||
t = pmod(y, 1 << (r - k - 1), p);
|
||||
y = t^2 % p;
|
||||
v = (v * t) % p;
|
||||
w = (w * y) % p;
|
||||
r = k;
|
||||
}
|
||||
return min(v, p - v);
|
||||
p1 = p - 1;
|
||||
r = lowbit(p1);
|
||||
q = p >> r;
|
||||
t = 1 << (r - 1);
|
||||
for (n = 2; ; n++) {
|
||||
if (ptest(n, 1) == 0)
|
||||
continue;
|
||||
y = pmod(n, q, p);
|
||||
k = pmod(y, t, p);
|
||||
if (k == 1)
|
||||
continue;
|
||||
if (k != p1)
|
||||
return;
|
||||
break;
|
||||
}
|
||||
t = pmod(u, (q - 1) / 2, p);
|
||||
v = (t * u) % p;
|
||||
w = (t^2 * u) % p;
|
||||
while (w != 1) {
|
||||
k = 0;
|
||||
t = w;
|
||||
do {
|
||||
k++;
|
||||
t = t^2 % p;
|
||||
} while (t != 1);
|
||||
if (k == r)
|
||||
return;
|
||||
t = pmod(y, 1 << (r - k - 1), p);
|
||||
y = t^2 % p;
|
||||
v = (v * t) % p;
|
||||
w = (w * y) % p;
|
||||
r = k;
|
||||
}
|
||||
return min(v, p - v);
|
||||
}
|
||||
|
||||
@@ -12,7 +12,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -20,21 +20,21 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1999/10/13 04:10:33
|
||||
* File existed as early as: 1999
|
||||
* Under source code control: 1999/10/13 04:10:33
|
||||
* File existed as early as: 1999
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* usage:
|
||||
* qtime(utc_hr_offset)
|
||||
* qtime(utc_hr_offset)
|
||||
*
|
||||
* utc_hr_offset Offset from UTC in hours.
|
||||
* utc_hr_offset Offset from UTC in hours.
|
||||
*
|
||||
* See:
|
||||
* http://www.magnetic-ink.dk/download/qtime.html
|
||||
* http://www.magnetic-ink.dk/download/qtime.html
|
||||
*
|
||||
* for examples of qtime() written on other languages.
|
||||
*/
|
||||
@@ -45,42 +45,42 @@
|
||||
*/
|
||||
define qtime(utc_hr_offset)
|
||||
{
|
||||
static mat hr[12] = {
|
||||
"twelve", "one", "two", "three", "four", "five",
|
||||
"six", "seven", "eight", "nine", "ten", "eleven"
|
||||
};
|
||||
static mat mn[7] = {
|
||||
"", "five ", "ten ", "a quarter ", "twenty ", "twenty-five ", "half "
|
||||
};
|
||||
static mat ny[5] = {
|
||||
"nearly ", "almost ", "", "just after ", "after "
|
||||
};
|
||||
static mat up[3] = {
|
||||
"to ", "", "past "
|
||||
};
|
||||
local adj_mins = (((time() + utc_hr_offset*3600) % 86400) + 30)//60+27;
|
||||
local hours = (adj_mins // 60) % 12;
|
||||
local minutes = adj_mins % 60;
|
||||
local almost = minutes % 5;
|
||||
local divisions = (minutes // 5) - 5;
|
||||
local to_past_idx = divisions > 0 ? 1 : 0;
|
||||
static mat hr[12] = {
|
||||
"twelve", "one", "two", "three", "four", "five",
|
||||
"six", "seven", "eight", "nine", "ten", "eleven"
|
||||
};
|
||||
static mat mn[7] = {
|
||||
"", "five ", "ten ", "a quarter ", "twenty ", "twenty-five ", "half "
|
||||
};
|
||||
static mat ny[5] = {
|
||||
"nearly ", "almost ", "", "just after ", "after "
|
||||
};
|
||||
static mat up[3] = {
|
||||
"to ", "", "past "
|
||||
};
|
||||
local adj_mins = (((time() + utc_hr_offset*3600) % 86400) + 30)//60+27;
|
||||
local hours = (adj_mins // 60) % 12;
|
||||
local minutes = adj_mins % 60;
|
||||
local almost = minutes % 5;
|
||||
local divisions = (minutes // 5) - 5;
|
||||
local to_past_idx = divisions > 0 ? 1 : 0;
|
||||
|
||||
if (divisions < 0) {
|
||||
divisions = -divisions;
|
||||
to_past_idx = -1;
|
||||
}
|
||||
++to_past_idx;
|
||||
if (divisions < 0) {
|
||||
divisions = -divisions;
|
||||
to_past_idx = -1;
|
||||
}
|
||||
++to_past_idx;
|
||||
|
||||
/*
|
||||
* Print the English sentence
|
||||
*
|
||||
* We avoid forward and back quotes just to show that the char()
|
||||
* builtin function can be used in conjunction with a printf.
|
||||
*/
|
||||
printf("It%cs %s%s%s%s",
|
||||
char(0x27), ny[almost], mn[divisions],
|
||||
up[to_past_idx], hr[hours]);
|
||||
if (divisions == 0)
|
||||
printf(" o%cclock", char(0x27));
|
||||
print ".";
|
||||
/*
|
||||
* Print the English sentence
|
||||
*
|
||||
* We avoid forward and back quotes just to show that the char()
|
||||
* builtin function can be used in conjunction with a printf.
|
||||
*/
|
||||
printf("It%cs %s%s%s%s",
|
||||
char(0x27), ny[almost], mn[divisions],
|
||||
up[to_past_idx], hr[hours]);
|
||||
if (divisions == 0)
|
||||
printf(" o%cclock", char(0x27));
|
||||
print ".";
|
||||
}
|
||||
|
||||
206
cal/quat.cal
206
cal/quat.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,205 +17,205 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:50:35
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* Routines to handle quaternions of the form:
|
||||
* a + bi + cj + dk
|
||||
* a + bi + cj + dk
|
||||
*
|
||||
* Note: In this module, quaternians are manipulated in the form:
|
||||
* s + v
|
||||
* s + v
|
||||
* Where s is a scalar and v is a vector of size 3.
|
||||
*/
|
||||
|
||||
|
||||
obj quat {s, v}; /* definition of the quaternion object */
|
||||
obj quat {s, v}; /* definition of the quaternion object */
|
||||
|
||||
|
||||
define quat(a,b,c,d)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
x.s = isnull(a) ? 0 : a;
|
||||
mat x.v[3];
|
||||
x.v[0] = isnull(b) ? 0 : b;
|
||||
x.v[1] = isnull(c) ? 0 : c;
|
||||
x.v[2] = isnull(d) ? 0 : d;
|
||||
return x;
|
||||
x.s = isnull(a) ? 0 : a;
|
||||
mat x.v[3];
|
||||
x.v[0] = isnull(b) ? 0 : b;
|
||||
x.v[1] = isnull(c) ? 0 : c;
|
||||
x.v[2] = isnull(d) ? 0 : d;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
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] : ")" :;
|
||||
}
|
||||
|
||||
|
||||
define quat_norm(a)
|
||||
{
|
||||
return a.s^2 + dp(a.v, a.v);
|
||||
return a.s^2 + dp(a.v, a.v);
|
||||
}
|
||||
|
||||
|
||||
define quat_abs(a, e)
|
||||
{
|
||||
return sqrt(a.s^2 + dp(a.v, a.v), e);
|
||||
return sqrt(a.s^2 + dp(a.v, a.v), e);
|
||||
}
|
||||
|
||||
|
||||
define quat_conj(a)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
x.s = a.s;
|
||||
x.v = -a.v;
|
||||
return x;
|
||||
x.s = a.s;
|
||||
x.v = -a.v;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define quat_add(a, b)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s + b;
|
||||
x.v = a.v;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.s = a + b.s;
|
||||
x.v = b.v;
|
||||
return x;
|
||||
}
|
||||
x.s = a.s + b.s;
|
||||
x.v = a.v + b.v;
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s + b;
|
||||
x.v = a.v;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.s = a + b.s;
|
||||
x.v = b.v;
|
||||
return x;
|
||||
}
|
||||
x.s = a.s + b.s;
|
||||
x.v = a.v + b.v;
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
}
|
||||
|
||||
|
||||
define quat_sub(a, b)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s - b;
|
||||
x.v = a.v;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.s = a - b.s;
|
||||
x.v = -b.v;
|
||||
return x;
|
||||
}
|
||||
x.s = a.s - b.s;
|
||||
x.v = a.v - b.v;
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s - b;
|
||||
x.v = a.v;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.s = a - b.s;
|
||||
x.v = -b.v;
|
||||
return x;
|
||||
}
|
||||
x.s = a.s - b.s;
|
||||
x.v = a.v - b.v;
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
}
|
||||
|
||||
|
||||
define quat_inc(a)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
x = a;
|
||||
x.s++;
|
||||
return x;
|
||||
x = a;
|
||||
x.s++;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define quat_dec(a)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
x = a;
|
||||
x.s--;
|
||||
return x;
|
||||
x = a;
|
||||
x.s--;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define quat_neg(a)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
x.s = -a.s;
|
||||
x.v = -a.v;
|
||||
return x;
|
||||
x.s = -a.s;
|
||||
x.v = -a.v;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define quat_mul(a, b)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s * b;
|
||||
x.v = a.v * b;
|
||||
} else if (!istype(a, x)) {
|
||||
x.s = b.s * a;
|
||||
x.v = b.v * a;
|
||||
} else {
|
||||
x.s = a.s * b.s - dp(a.v, b.v);
|
||||
x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v);
|
||||
}
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s * b;
|
||||
x.v = a.v * b;
|
||||
} else if (!istype(a, x)) {
|
||||
x.s = b.s * a;
|
||||
x.v = b.v * a;
|
||||
} else {
|
||||
x.s = a.s * b.s - dp(a.v, b.v);
|
||||
x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v);
|
||||
}
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
}
|
||||
|
||||
|
||||
define quat_div(a, b)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s / b;
|
||||
x.v = a.v / b;
|
||||
return x;
|
||||
}
|
||||
return a * quat_inv(b);
|
||||
if (!istype(b, x)) {
|
||||
x.s = a.s / b;
|
||||
x.v = a.v / b;
|
||||
return x;
|
||||
}
|
||||
return a * quat_inv(b);
|
||||
}
|
||||
|
||||
|
||||
define quat_inv(a)
|
||||
{
|
||||
local x, q2;
|
||||
local x, q2;
|
||||
|
||||
obj quat x;
|
||||
q2 = a.s^2 + dp(a.v, a.v);
|
||||
x.s = a.s / q2;
|
||||
x.v = a.v / (-q2);
|
||||
return x;
|
||||
obj quat x;
|
||||
q2 = a.s^2 + dp(a.v, a.v);
|
||||
x.s = a.s / q2;
|
||||
x.v = a.v / (-q2);
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define quat_scale(a, b)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
x.s = scale(a.s, b);
|
||||
x.v = scale(a.v, b);
|
||||
return x;
|
||||
x.s = scale(a.s, b);
|
||||
x.v = scale(a.v, b);
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define quat_shift(a, b)
|
||||
{
|
||||
local obj quat x;
|
||||
local obj quat x;
|
||||
|
||||
x.s = a.s << b;
|
||||
x.v = a.v << b;
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
x.s = a.s << b;
|
||||
x.v = a.v << b;
|
||||
if (x.v)
|
||||
return x;
|
||||
return x.s;
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -32,30 +32,30 @@
|
||||
|
||||
define randbitrun(run_cnt)
|
||||
{
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 18; /* max run we will keep track of */
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 18; /* max run we will keep track of */
|
||||
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
|
||||
/*
|
||||
* parse args
|
||||
*/
|
||||
if (param(0) == 0) {
|
||||
run_cnt = 65536;
|
||||
run_cnt = 65536;
|
||||
}
|
||||
|
||||
/*
|
||||
* run setup
|
||||
*/
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = randbit(1); /* our first number */
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = randbit(1); /* our first number */
|
||||
run = 1;
|
||||
|
||||
/*
|
||||
@@ -63,10 +63,10 @@ define randbitrun(run_cnt)
|
||||
*
|
||||
* A bit run length of 'r' occurs with a probability of:
|
||||
*
|
||||
* 1/2^n;
|
||||
* 1/2^n;
|
||||
*/
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
prob[i] = 1.0/(1<<i);
|
||||
prob[i] = 1.0/(1<<i);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -74,31 +74,31 @@ define randbitrun(run_cnt)
|
||||
*/
|
||||
for (i=0; i < run_cnt; ++i) {
|
||||
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = randbit(1);
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = randbit(1);
|
||||
|
||||
/* look for a run break */
|
||||
if (current != last) {
|
||||
/* look for a run break */
|
||||
if (current != last) {
|
||||
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
|
||||
/* start a new run */
|
||||
current = randbit(1);
|
||||
run = 1;
|
||||
/* start a new run */
|
||||
current = randbit(1);
|
||||
run = 1;
|
||||
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
}
|
||||
/* determine the number of runs found */
|
||||
tally_sum = matsum(tally) + long_run_cnt;
|
||||
@@ -109,9 +109,9 @@ define randbitrun(run_cnt)
|
||||
printf("rand runbit test used %d values to produce %d runs\n",
|
||||
run_cnt, tally_sum);
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
}
|
||||
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
|
||||
printf("max length=%d\n", max_run);
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1994/03/14 23:11:21
|
||||
* File existed as early as: 1994
|
||||
* Under source code control: 1994/03/14 23:11:21
|
||||
* File existed as early as: 1994
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -32,37 +32,37 @@ read -once "lucas.cal"
|
||||
* randmprime - find a random prime of the form h*2^n-1 of a given size
|
||||
*
|
||||
* given:
|
||||
* bits minimum bits in prime to return
|
||||
* seed random seed for srandom()
|
||||
* [dbg] if given, enable debugging
|
||||
* bits minimum bits in prime to return
|
||||
* seed random seed for srandom()
|
||||
* [dbg] if given, enable debugging
|
||||
*
|
||||
* returns:
|
||||
* a prime of the form h*2^n-1
|
||||
* a prime of the form h*2^n-1
|
||||
*/
|
||||
define
|
||||
randmprime(bits, seed, dbg)
|
||||
{
|
||||
local n; /* n as in h*2^n-1 */
|
||||
local h; /* h as in h*2^n-1 */
|
||||
local plush; /* value added to h since the beginning */
|
||||
local init; /* initial CPU time */
|
||||
local start; /* CPU time before last test */
|
||||
local stop; /* CPU time after last test */
|
||||
local tmp; /* just a tmp place holder value */
|
||||
local ret; /* h*2^n-1 that is prime */
|
||||
local n; /* n as in h*2^n-1 */
|
||||
local h; /* h as in h*2^n-1 */
|
||||
local plush; /* value added to h since the beginning */
|
||||
local init; /* initial CPU time */
|
||||
local start; /* CPU time before last test */
|
||||
local stop; /* CPU time after last test */
|
||||
local tmp; /* just a tmp place holder value */
|
||||
local ret; /* h*2^n-1 that is prime */
|
||||
|
||||
/* firewall */
|
||||
if (param(0) < 2 || param(0) > 3) {
|
||||
quit "bad usage: rndprime(dig, seed [,dbg])";
|
||||
quit "bad usage: rndprime(dig, seed [,dbg])";
|
||||
}
|
||||
if (!isint(bits) || bits < 0 || !isint(seed) || seed < 0) {
|
||||
quit "args must be non-negative integers";
|
||||
quit "args must be non-negative integers";
|
||||
}
|
||||
if (bits < 1) {
|
||||
bits = 1;
|
||||
bits = 1;
|
||||
}
|
||||
if (param(0) == 2 || dbg < 0) {
|
||||
dbg = 0;
|
||||
dbg = 0;
|
||||
}
|
||||
|
||||
/* seed generator */
|
||||
@@ -76,57 +76,57 @@ randmprime(bits, seed, dbg)
|
||||
++n;
|
||||
}
|
||||
if (dbg >= 1) {
|
||||
print "DEBUG3: initial h =", h;
|
||||
print "DEBUG3: initial n =", n;
|
||||
print "DEBUG3: initial h =", h;
|
||||
print "DEBUG3: initial n =", n;
|
||||
}
|
||||
|
||||
/*
|
||||
* loop until we find a prime
|
||||
*/
|
||||
if (dbg >= 1) {
|
||||
start = usertime();
|
||||
init = usertime();
|
||||
plush = 0;
|
||||
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
|
||||
start = usertime();
|
||||
init = usertime();
|
||||
plush = 0;
|
||||
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
|
||||
}
|
||||
while (lucas(h,n) == 0) {
|
||||
|
||||
/* bump h, and n if needed */
|
||||
if (dbg >= 2) {
|
||||
stop = usertime();
|
||||
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
|
||||
}
|
||||
if (dbg >= 1) {
|
||||
print "DEBUG1: composite: (h+" : plush : ")*2^" : n : "-1";
|
||||
plush += 2;
|
||||
}
|
||||
h += 2;
|
||||
while (highbit(h) >= n) {
|
||||
++n;
|
||||
}
|
||||
if (dbg >= 1) {
|
||||
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
|
||||
start = stop;
|
||||
}
|
||||
/* bump h, and n if needed */
|
||||
if (dbg >= 2) {
|
||||
stop = usertime();
|
||||
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
|
||||
}
|
||||
if (dbg >= 1) {
|
||||
print "DEBUG1: composite: (h+" : plush : ")*2^" : n : "-1";
|
||||
plush += 2;
|
||||
}
|
||||
h += 2;
|
||||
while (highbit(h) >= n) {
|
||||
++n;
|
||||
}
|
||||
if (dbg >= 1) {
|
||||
print "DEBUG1: testing (h+" : plush : ")*2^" : n : "-1";
|
||||
start = stop;
|
||||
}
|
||||
}
|
||||
|
||||
/* found a prime */
|
||||
if (dbg >= 2) {
|
||||
stop = usertime();
|
||||
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
|
||||
print "DEBUG3: " : h : "*2^" : n : "-1 is prime";
|
||||
stop = usertime();
|
||||
print "DEBUG2: last test:", stop-start, " total time:", stop-init;
|
||||
print "DEBUG3: " : h : "*2^" : n : "-1 is prime";
|
||||
}
|
||||
if (dbg >= 1) {
|
||||
print "DEBUG1: prime: (h+" : plush : ")*2^" : n : "-1";
|
||||
print "DEBUG1: prime: (h+" : plush : ")*2^" : n : "-1";
|
||||
}
|
||||
ret = h*2^n-1;
|
||||
if (dbg >= 3) {
|
||||
print "DEBUG3: highbit(h):", highbit(h);
|
||||
print "DEBUG3: digits(h):", digits(h);
|
||||
print "DEBUG3: highbit(n):", highbit(n);
|
||||
print "DEBUG3: digits(2^n):", int(n*ln(10)/ln(2)+1);
|
||||
print "DEBUG3: highbit(h*2^n-1):", highbit(ret);
|
||||
print "DEBUG3: digits(h*2^n)-1:", digits(ret);
|
||||
print "DEBUG3: highbit(h):", highbit(h);
|
||||
print "DEBUG3: digits(h):", digits(h);
|
||||
print "DEBUG3: highbit(n):", highbit(n);
|
||||
print "DEBUG3: digits(2^n):", int(n*ln(10)/ln(2)+1);
|
||||
print "DEBUG3: highbit(h*2^n-1):", highbit(ret);
|
||||
print "DEBUG3: digits(h*2^n)-1:", digits(ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/02/13 03:43:11
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -32,30 +32,30 @@
|
||||
|
||||
define randombitrun(run_cnt)
|
||||
{
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 18; /* max run we will keep track of */
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 18; /* max run we will keep track of */
|
||||
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
|
||||
/*
|
||||
* parse args
|
||||
*/
|
||||
if (param(0) == 0) {
|
||||
run_cnt = 65536;
|
||||
run_cnt = 65536;
|
||||
}
|
||||
|
||||
/*
|
||||
* run setup
|
||||
*/
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = randombit(1); /* our first number */
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = randombit(1); /* our first number */
|
||||
run = 1;
|
||||
|
||||
/*
|
||||
@@ -63,10 +63,10 @@ define randombitrun(run_cnt)
|
||||
*
|
||||
* A bit run length of 'r' occurs with a probability of:
|
||||
*
|
||||
* 1/2^n;
|
||||
* 1/2^n;
|
||||
*/
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
prob[i] = 1.0/(1<<i);
|
||||
prob[i] = 1.0/(1<<i);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -74,31 +74,31 @@ define randombitrun(run_cnt)
|
||||
*/
|
||||
for (i=0; i < run_cnt; ++i) {
|
||||
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = randombit(1);
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = randombit(1);
|
||||
|
||||
/* look for a run break */
|
||||
if (current != last) {
|
||||
/* look for a run break */
|
||||
if (current != last) {
|
||||
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
|
||||
/* start a new run */
|
||||
current = randombit(1);
|
||||
run = 1;
|
||||
/* start a new run */
|
||||
current = randombit(1);
|
||||
run = 1;
|
||||
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
}
|
||||
/* determine the number of runs found */
|
||||
tally_sum = matsum(tally) + long_run_cnt;
|
||||
@@ -109,9 +109,9 @@ define randombitrun(run_cnt)
|
||||
printf("random runbit test used %d values to produce %d runs\n",
|
||||
run_cnt, tally_sum);
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
}
|
||||
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
|
||||
printf("max length=%d\n", max_run);
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1997/02/19 03:35:59
|
||||
* File existed as early as: 1997
|
||||
* Under source code control: 1997/02/19 03:35:59
|
||||
* File existed as early as: 1997
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -41,30 +41,30 @@
|
||||
|
||||
define randomrun(run_cnt)
|
||||
{
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 9; /* max run we will keep track of */
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 9; /* max run we will keep track of */
|
||||
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
|
||||
/*
|
||||
* parse args
|
||||
*/
|
||||
if (param(0) == 0) {
|
||||
run_cnt = 65536;
|
||||
run_cnt = 65536;
|
||||
}
|
||||
|
||||
/*
|
||||
* run setup
|
||||
*/
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = random(); /* our first number */
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = random(); /* our first number */
|
||||
run = 1;
|
||||
|
||||
/*
|
||||
@@ -72,10 +72,10 @@ define randomrun(run_cnt)
|
||||
*
|
||||
* A run length of 'r' occurs with a probability of:
|
||||
*
|
||||
* 1/r! - 1/(r+1)!
|
||||
* 1/r! - 1/(r+1)!
|
||||
*/
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
prob[i] = 1.0/fact(i) - 1.0/fact(i+1);
|
||||
prob[i] = 1.0/fact(i) - 1.0/fact(i+1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -83,31 +83,31 @@ define randomrun(run_cnt)
|
||||
*/
|
||||
for (i=0; i < run_cnt; ++i) {
|
||||
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = random();
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = random();
|
||||
|
||||
/* look for a run break */
|
||||
if (current < last) {
|
||||
/* look for a run break */
|
||||
if (current < last) {
|
||||
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
|
||||
/* start a new run */
|
||||
current = random();
|
||||
run = 1;
|
||||
/* start a new run */
|
||||
current = random();
|
||||
run = 1;
|
||||
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
}
|
||||
/* determine the number of runs found */
|
||||
tally_sum = matsum(tally) + long_run_cnt;
|
||||
@@ -118,9 +118,9 @@ define randomrun(run_cnt)
|
||||
printf("random run test used %d values to produce %d runs\n",
|
||||
run_cnt, tally_sum);
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
}
|
||||
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
|
||||
printf("max length=%d\n", max_run);
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/02/12 20:00:06
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/02/12 20:00:06
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -40,30 +40,30 @@
|
||||
|
||||
define randrun(run_cnt)
|
||||
{
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 9; /* max run we will keep track of */
|
||||
local i; /* index */
|
||||
local max_run; /* longest run */
|
||||
local long_run_cnt; /* number of runs longer than MAX_RUN */
|
||||
local run; /* current run length */
|
||||
local tally_sum; /* sum of all tally values */
|
||||
local last; /* last random number */
|
||||
local current; /* current random number */
|
||||
local MAX_RUN = 9; /* max run we will keep track of */
|
||||
local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */
|
||||
|
||||
/*
|
||||
* parse args
|
||||
*/
|
||||
if (param(0) == 0) {
|
||||
run_cnt = 65536;
|
||||
run_cnt = 65536;
|
||||
}
|
||||
|
||||
/*
|
||||
* run setup
|
||||
*/
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = rand(); /* our first number */
|
||||
max_run = 0; /* no runs yet */
|
||||
long_run_cnt = 0; /* no long runs set */
|
||||
current = rand(); /* our first number */
|
||||
run = 1;
|
||||
|
||||
/*
|
||||
@@ -71,10 +71,10 @@ define randrun(run_cnt)
|
||||
*
|
||||
* A run length of 'r' occurs with a probability of:
|
||||
*
|
||||
* 1/r! - 1/(r+1)!
|
||||
* 1/r! - 1/(r+1)!
|
||||
*/
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
prob[i] = 1.0/fact(i) - 1.0/fact(i+1);
|
||||
prob[i] = 1.0/fact(i) - 1.0/fact(i+1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -82,31 +82,31 @@ define randrun(run_cnt)
|
||||
*/
|
||||
for (i=0; i < run_cnt; ++i) {
|
||||
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = rand();
|
||||
/* get our current number */
|
||||
last = current;
|
||||
current = rand();
|
||||
|
||||
/* look for a run break */
|
||||
if (current < last) {
|
||||
/* look for a run break */
|
||||
if (current < last) {
|
||||
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
/* record the stats */
|
||||
if (run > max_run) {
|
||||
max_run = run;
|
||||
}
|
||||
if (run > MAX_RUN) {
|
||||
++long_run_cnt;
|
||||
} else {
|
||||
++tally[run];
|
||||
}
|
||||
|
||||
/* start a new run */
|
||||
current = rand();
|
||||
run = 1;
|
||||
/* start a new run */
|
||||
current = rand();
|
||||
run = 1;
|
||||
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
/* note the continuing run */
|
||||
} else {
|
||||
++run;
|
||||
}
|
||||
}
|
||||
/* determine the number of runs found */
|
||||
tally_sum = matsum(tally) + long_run_cnt;
|
||||
@@ -117,9 +117,9 @@ define randrun(run_cnt)
|
||||
printf("rand run test used %d values to produce %d runs\n",
|
||||
run_cnt, tally_sum);
|
||||
for (i=1; i <= MAX_RUN; ++i) {
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n",
|
||||
i, prob[i], round(tally_sum*prob[i]), tally[i],
|
||||
(tally[i] - round(tally_sum*prob[i]))/tally_sum);
|
||||
}
|
||||
printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt);
|
||||
printf("max length=%d\n", max_run);
|
||||
|
||||
15753
cal/regress.cal
15753
cal/regress.cal
File diff suppressed because it is too large
Load Diff
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2003/01/05 00:00:01
|
||||
* File existed as early as: 2003
|
||||
* Under source code control: 2003/01/05 00:00:01
|
||||
* File existed as early as: 2003
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -29,18 +29,18 @@
|
||||
* repeat - return the value of a repeated set of digits
|
||||
*
|
||||
* usage:
|
||||
* repeat(digit_set, repeat_count)
|
||||
* repeat(digit_set, repeat_count)
|
||||
*/
|
||||
define repeat(digit_set, repeat_count)
|
||||
{
|
||||
local digit_count; /* digits in the digit_set */
|
||||
local digit_count; /* digits in the digit_set */
|
||||
|
||||
/* firewall */
|
||||
if (!isint(digit_set) || digit_set <= 0) {
|
||||
quit "digit set must be an integer > 0";
|
||||
quit "digit set must be an integer > 0";
|
||||
}
|
||||
if (!isint(repeat_count) || repeat_count <= 0) {
|
||||
quit "repeat count must be an integer > 0";
|
||||
quit "repeat count must be an integer > 0";
|
||||
}
|
||||
|
||||
/* return repeated set of digits */
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
* This file is not covered under version 2.1 of the GNU LGPL.
|
||||
* This file is covered under "The unlicense":
|
||||
*
|
||||
* https://unlicense.org
|
||||
* https://unlicense.org
|
||||
*
|
||||
* In particular:
|
||||
*
|
||||
@@ -35,8 +35,8 @@
|
||||
*
|
||||
* For more information, please refer to <http://unlicense.org/>
|
||||
*
|
||||
* Under source code control: 2006/03/08 05:54:09
|
||||
* File existed as early as: 2006
|
||||
* Under source code control: 2006/03/08 05:54:09
|
||||
* File existed as early as: 2006
|
||||
*/
|
||||
|
||||
up = CUU ="\e[A";
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,18 +17,18 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1996/01/01 08:21:00
|
||||
* File existed as early as: 1996
|
||||
* Under source code control: 1996/01/01 08:21:00
|
||||
* File existed as early as: 1996
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
* The period of Blum generators with modulus 'n=p*q' (where p and
|
||||
* q are primes 3 mod 4) is:
|
||||
*
|
||||
* lambda(n) = lcm(factors of p-1 & q-1)
|
||||
* lambda(n) = lcm(factors of p-1 & q-1)
|
||||
*
|
||||
* One can construct a generator with a maximal period when
|
||||
* 'p' and 'q' have the fewest possible factors in common.
|
||||
@@ -38,118 +38,118 @@
|
||||
* such primes.
|
||||
*
|
||||
* given:
|
||||
* seed1 - a large random value (at least 10^20 and perhaps < 10^314)
|
||||
* seed2 - a large random value (at least 10^20 and perhaps < 10^314)
|
||||
* size - min Blum modulus as a power of 2 (at least 32, perhaps >= 512)
|
||||
* trials - number of ptest() trials (default 25)
|
||||
* seed1 - a large random value (at least 10^20 and perhaps < 10^314)
|
||||
* seed2 - a large random value (at least 10^20 and perhaps < 10^314)
|
||||
* size - min Blum modulus as a power of 2 (at least 32, perhaps >= 512)
|
||||
* trials - number of ptest() trials (default 25)
|
||||
*
|
||||
* returns:
|
||||
* the previous random state
|
||||
* the previous random state
|
||||
*
|
||||
* NOTE: The [10^20, 10^314) range comes from the fact that the 13th internal
|
||||
* modulus is ~10^315. We want the lower bound seed to be reasonably big.
|
||||
* modulus is ~10^315. We want the lower bound seed to be reasonably big.
|
||||
*/
|
||||
|
||||
|
||||
define seedrandom(seed1, seed2, size, trials)
|
||||
{
|
||||
local p; /* first Blum prime */
|
||||
local fp; /* prime co-factor of p-1 */
|
||||
local sp; /* min bit size of p */
|
||||
local q; /* second Blum prime */
|
||||
local fq; /* prime co-factor of q-1 */
|
||||
local sq; /* min bit size of q */
|
||||
local n; /* Blum modulus */
|
||||
local binsize; /* smallest power of 2 > n=p*q */
|
||||
local r; /* initial quadratic residue */
|
||||
local random_state; /* the initial rand state */
|
||||
local random_junk; /* rand state that is not needed */
|
||||
local old_state; /* old random state to return */
|
||||
local p; /* first Blum prime */
|
||||
local fp; /* prime co-factor of p-1 */
|
||||
local sp; /* min bit size of p */
|
||||
local q; /* second Blum prime */
|
||||
local fq; /* prime co-factor of q-1 */
|
||||
local sq; /* min bit size of q */
|
||||
local n; /* Blum modulus */
|
||||
local binsize; /* smallest power of 2 > n=p*q */
|
||||
local r; /* initial quadratic residue */
|
||||
local random_state; /* the initial rand state */
|
||||
local random_junk; /* rand state that is not needed */
|
||||
local old_state; /* old random state to return */
|
||||
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(seed1)) {
|
||||
quit "1st arg (seed1) is not an int";
|
||||
}
|
||||
if (!isint(seed2)) {
|
||||
quit "2nd arg (seed2) is not an int";
|
||||
}
|
||||
if (!isint(size)) {
|
||||
quit "3rd arg (size) is not an int";
|
||||
}
|
||||
if (!isint(trials)) {
|
||||
trials = 25;
|
||||
}
|
||||
if (digits(seed1) <= 20) {
|
||||
quit "1st arg (seed1) must be > 10^20 and perhaps < 10^314";
|
||||
}
|
||||
if (digits(seed2) <= 20) {
|
||||
quit "2nd arg (seed2) must be > 10^20 and perhaps < 10^314";
|
||||
}
|
||||
if (size < 32) {
|
||||
quit "3rd arg (size) needs to be >= 32 (perhaps >= 512)";
|
||||
}
|
||||
if (trials < 1) {
|
||||
quit "4th arg (trials) must be > 0";
|
||||
}
|
||||
/*
|
||||
* firewall
|
||||
*/
|
||||
if (!isint(seed1)) {
|
||||
quit "1st arg (seed1) is not an int";
|
||||
}
|
||||
if (!isint(seed2)) {
|
||||
quit "2nd arg (seed2) is not an int";
|
||||
}
|
||||
if (!isint(size)) {
|
||||
quit "3rd arg (size) is not an int";
|
||||
}
|
||||
if (!isint(trials)) {
|
||||
trials = 25;
|
||||
}
|
||||
if (digits(seed1) <= 20) {
|
||||
quit "1st arg (seed1) must be > 10^20 and perhaps < 10^314";
|
||||
}
|
||||
if (digits(seed2) <= 20) {
|
||||
quit "2nd arg (seed2) must be > 10^20 and perhaps < 10^314";
|
||||
}
|
||||
if (size < 32) {
|
||||
quit "3rd arg (size) needs to be >= 32 (perhaps >= 512)";
|
||||
}
|
||||
if (trials < 1) {
|
||||
quit "4th arg (trials) must be > 0";
|
||||
}
|
||||
|
||||
/*
|
||||
* determine the search parameters
|
||||
*/
|
||||
++size; /* convert power of 2 to bit length */
|
||||
sp = int((size/2)-(size*0.03)+1);
|
||||
sq = size - sp;
|
||||
/*
|
||||
* determine the search parameters
|
||||
*/
|
||||
++size; /* convert power of 2 to bit length */
|
||||
sp = int((size/2)-(size*0.03)+1);
|
||||
sq = size - sp;
|
||||
|
||||
/*
|
||||
* find the first Blum prime
|
||||
*/
|
||||
random_state = srandom(seed1, 13);
|
||||
do {
|
||||
do {
|
||||
fp = nextcand(2^sp+randombit(sp), 1, 1, 3, 4);
|
||||
p = 2*fp+1;
|
||||
} while (ptest(p,1,0) == 0);
|
||||
} while(ptest(p, trials) == 0 || ptest(fp, trials) == 0);
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 1st Blum prime */ p=", p;
|
||||
}
|
||||
/*
|
||||
* find the first Blum prime
|
||||
*/
|
||||
random_state = srandom(seed1, 13);
|
||||
do {
|
||||
do {
|
||||
fp = nextcand(2^sp+randombit(sp), 1, 1, 3, 4);
|
||||
p = 2*fp+1;
|
||||
} while (ptest(p,1,0) == 0);
|
||||
} while(ptest(p, trials) == 0 || ptest(fp, trials) == 0);
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 1st Blum prime */ p=", p;
|
||||
}
|
||||
|
||||
/*
|
||||
* find the 2nd Blum prime
|
||||
*/
|
||||
random_junk = srandom(seed2, 13);
|
||||
do {
|
||||
do {
|
||||
fq = nextcand(2^sq+randombit(sq), 1, 1, 3, 4);
|
||||
q = 2*fq+1;
|
||||
} while (ptest(q,1,0) == 0);
|
||||
} while(ptest(q, trials) == 0 || ptest(fq, trials) == 0);
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 2nd Blum prime */ q=", q;
|
||||
}
|
||||
/*
|
||||
* find the 2nd Blum prime
|
||||
*/
|
||||
random_junk = srandom(seed2, 13);
|
||||
do {
|
||||
do {
|
||||
fq = nextcand(2^sq+randombit(sq), 1, 1, 3, 4);
|
||||
q = 2*fq+1;
|
||||
} while (ptest(q,1,0) == 0);
|
||||
} while(ptest(q, trials) == 0 || ptest(fq, trials) == 0);
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* 2nd Blum prime */ q=", q;
|
||||
}
|
||||
|
||||
/*
|
||||
* seed the Blum generator
|
||||
*/
|
||||
n = p*q; /* the Blum modulus */
|
||||
binsize = highbit(n)+1; /* smallest power of 2 > p*q */
|
||||
r = pmod(rand(1<<ceil(binsize*4/5), 1<<(binsize-2)), 2, n);
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* seed quadratic residue */ r=", r;
|
||||
print "/* newn", binsize, "bit quadratic residue*/ newn=", n;
|
||||
}
|
||||
old_state = srandom(r, n);
|
||||
/*
|
||||
* seed the Blum generator
|
||||
*/
|
||||
n = p*q; /* the Blum modulus */
|
||||
binsize = highbit(n)+1; /* smallest power of 2 > p*q */
|
||||
r = pmod(rand(1<<ceil(binsize*4/5), 1<<(binsize-2)), 2, n);
|
||||
if (config("resource_debug") & 8) {
|
||||
print "/* seed quadratic residue */ r=", r;
|
||||
print "/* newn", binsize, "bit quadratic residue*/ newn=", n;
|
||||
}
|
||||
old_state = srandom(r, n);
|
||||
|
||||
/*
|
||||
* restore other states that we altered
|
||||
*/
|
||||
random_junk = srandom(random_state);
|
||||
/*
|
||||
* restore other states that we altered
|
||||
*/
|
||||
random_junk = srandom(random_state);
|
||||
|
||||
/*
|
||||
* return the previous random state
|
||||
*/
|
||||
return old_state;
|
||||
/*
|
||||
* return the previous random state
|
||||
*/
|
||||
return old_state;
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
##
|
||||
## 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
|
||||
## 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
|
||||
@@ -17,11 +17,11 @@
|
||||
## received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
## 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
##
|
||||
## Under source code control: 2006/05/20 14:10:11
|
||||
## File existed as early as: 2006
|
||||
## Under source code control: 2006/05/20 14:10:11
|
||||
## File existed as early as: 2006
|
||||
##
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
## chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
## Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
|
||||
|
||||
strcpy("", "") == ""
|
||||
@@ -49,7 +49,7 @@ strncpy("ab", "xyz", 3) == "xy"
|
||||
strcmp("", "") == 0
|
||||
strcmp("", "a") == -1
|
||||
strcmp("\n", "\n") == 0
|
||||
strcmp("\0", "") == 1 ## '\0' treated like other characters
|
||||
strcmp("\0", "") == 1 ## '\0' treated like other characters
|
||||
strcmp("ab", "") == 1
|
||||
strcmp("ab", "a") == 1
|
||||
strcmp("ab", "ab") == 0
|
||||
@@ -123,15 +123,15 @@ substr("abcd",5,1) == ""
|
||||
substr("a\0c\0",2,2) == "\0c" ## '\0' treated like other characters
|
||||
substr("a\0c\0",2,3) == "\0c\0"
|
||||
|
||||
#"" == 0 ## # operator counts number of bits
|
||||
#"" == 0 ## # operator counts number of bits
|
||||
#"\0" == 0
|
||||
# "a" == 3
|
||||
# "ab" == 6 ## white space ignored
|
||||
# "ab" == 6 ## white space ignored
|
||||
# "abc" == 10
|
||||
# 27 == 4
|
||||
# 0b1010111011 == 7
|
||||
|
||||
7 # 9 == 2 ## 7 # 9 = abs(7 - 9)
|
||||
7 # 9 == 2 ## 7 # 9 = abs(7 - 9)
|
||||
3/4 # 2/3 == 1/12
|
||||
|
||||
a = 5, a #= 2, a == 3
|
||||
@@ -181,9 +181,9 @@ protect(set8700_A[2]) == 1024
|
||||
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
|
||||
|
||||
## Testing simple assignment of matrix
|
||||
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
|
||||
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
|
||||
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## copying matrix to list
|
||||
set8700_B = list(5,6,7), protect(set8700_B) == 1024
|
||||
@@ -192,18 +192,18 @@ protect(set8700_B[2]) == 0
|
||||
protect(set8700_A,0), protect(set8700_A) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## copying matrix to matrix
|
||||
set8700_B = mat[3], protect(set8700_B) == 1024
|
||||
protect(set8700_B[2]) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Testing list protection
|
||||
set8700_A = list(1, 2, list(3,4)), 1
|
||||
@@ -212,18 +212,18 @@ protect(set8700_A[2]) == 1024
|
||||
protect(set8700_A[2][0], 512), protect(set8700_A[2][0]) == 1536
|
||||
|
||||
## Simple assignment of list
|
||||
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
|
||||
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
set8700_B = set8700_A, protect(set8700_B) == 1024 ## protect(set8700_A) copied
|
||||
protect(set8700_B[2]) == 1024 ## protect(set8700_A[2]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Copying list to list
|
||||
set8700_B = list(5,6,7), protect(set8700_B) == 1024
|
||||
protect(set8700_B[2]) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
protect(set8700_B) == 1024 ## protect(set8700_A) not copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Copying list to matrix
|
||||
set8700_B = mat[3], protect(set8700_B) == 1024
|
||||
@@ -231,8 +231,8 @@ protect(set8700_B[2]) == 0
|
||||
copy(set8700_A,set8700_B), set8700_B[0] == 1 && set8700_B[1] == 2
|
||||
set8700_B[2] == list(3,4)
|
||||
protect(set8700_B) == 1024
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
protect(set8700_B[0]) == 1024 ## protect(set8700_A[0]) copied
|
||||
protect(set8700_B[2][0]) == 1536 ## protect(set8700_A[2][0]) copied
|
||||
|
||||
## Protecting one element of a list
|
||||
set8700_A = list(1,4,3,2), protect(set8700_A[1]) == 0
|
||||
@@ -241,16 +241,16 @@ protect(set8700_A[1], 1024), protect(set8700_A[1]) == 1024
|
||||
## Testing sort
|
||||
set8700_A = sort(set8700_A), set8700_A == list(1,2,3,4)
|
||||
protect(set8700_A[1]) == 0
|
||||
protect(set8700_A[3]) == 1024 ## status of 4
|
||||
protect(set8700_A[3]) == 1024 ## status of 4
|
||||
|
||||
## Testings reverse
|
||||
set8700_A = reverse(set8700_A), set8700_A == list(4,3,2,1)
|
||||
protect(set8700_A[0]) == 1024 ## status of 4
|
||||
protect(set8700_A[0]) == 1024 ## status of 4
|
||||
|
||||
## Testing swap
|
||||
swap(set8700_A[0], set8700_A[1]), set8700_A == list(3,4,2,1)
|
||||
protect(set8700_A[0]) == 0 ## status moved
|
||||
protect(set8700_A[1]) == 1024 ## 4 retains protection
|
||||
protect(set8700_A[0]) == 0 ## status moved
|
||||
protect(set8700_A[1]) == 1024 ## 4 retains protection
|
||||
|
||||
## Testing list with protected list argument
|
||||
protect(set8700_A, 0), protect(set8700_A) == 0
|
||||
@@ -258,23 +258,23 @@ protect(set8700_A, 512), protect(set8700_A) == 512
|
||||
protect(set8700_A[1]) == 1024
|
||||
set8700_L = list(1,set8700_A,3), protect(set8700_L) == 0
|
||||
protect(set8700_L[0]) == 0
|
||||
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
|
||||
## Testing list with "initialization"
|
||||
set8700_L = list(1,2,3), protect(set8700_L) == 0
|
||||
protect(set8700_L[0]) | protect(set8700_L[1]) | protect(set8700_L[2]) == 0 ## All zero
|
||||
protect(set8700_L[0]) | protect(set8700_L[1]) | protect(set8700_L[2]) == 0 ## All zero
|
||||
set8700_L = {1,set8700_A}, set8700_L[1] == set8700_A
|
||||
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
set8700_L[1] = 2, protect(set8700_L[1]) == 512 ## Not changed
|
||||
protect(set8700_L[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_L[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
set8700_L[1] = 2, protect(set8700_L[1]) == 512 ## Not changed
|
||||
|
||||
## Testing matrix with "initialization"
|
||||
set8700_M = mat[3] = {1,set8700_A}, protect(set8700_M) == 0
|
||||
protect(set8700_M[0]) == 0
|
||||
protect(set8700_M[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_M[1]) == 512 ## protect(set8700_A) copied
|
||||
protect(set8700_M[2]) == 0
|
||||
protect(set8700_M[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
protect(set8700_M[1][1]) == 1024 ## protect(set8700_A[1]) copied
|
||||
|
||||
## Testing push, pop, append, remove
|
||||
set8700_A = list(1,2), protect(set8700_A,0,1), protect(set8700_A[0]) == 0
|
||||
@@ -319,12 +319,12 @@ set8700_x == 7
|
||||
set8700_x-- == error(10388)
|
||||
|
||||
protect(set8700_A,0), protect(set8700_A,16), 1
|
||||
set8700_A = "abcdef", protect(set8700_A) == 16 ## No copy to set8700_A
|
||||
set8700_A = "abcdef", protect(set8700_A) == 16 ## No copy to set8700_A
|
||||
protect(set8700_B,0), set8700_B = "xyz", protect(set8700_B) == 0
|
||||
copy(set8700_B, set8700_A) == error(10226)
|
||||
set8700_A == "abcdef" ## set8700_A not changed
|
||||
set8700_A == "abcdef" ## set8700_A not changed
|
||||
protect(set8700_A,0), copy(set8700_B,set8700_A), set8700_A == "xyzdef"
|
||||
protect(set8700_B,128), protect(set8700_B) == 128 ## No copy from set8700_B
|
||||
protect(set8700_B,128), protect(set8700_B) == 128 ## No copy from set8700_B
|
||||
copy(set8700_B,set8700_A,,,3) == error(10225)
|
||||
set8700_A == "xyzdef"
|
||||
protect(set8700_B,0), copy(set8700_B,set8700_A,,,3), set8700_A == "xyzxyz"
|
||||
@@ -354,7 +354,7 @@ set8700_x = 7, protect(set8700_x,0), protect(set8700_x, 512), 1
|
||||
set8700_A = {set8700_x,,set8700_x}, protect(set8700_A[0]) == 1536
|
||||
protect(set8700_A[1]) == 0
|
||||
protect(set8700_A[2]) == 512
|
||||
protect(set8700_A,16), protect(set8700_A) == 16 ## No copy to
|
||||
protect(set8700_A,16), protect(set8700_A) == 16 ## No copy to
|
||||
set8700_A == (mat[3] = {7,0,7})
|
||||
set8700_A = {1,2,3}, errno() == 10390;
|
||||
set8700_A == (mat[3] = {7,0,7})
|
||||
@@ -368,7 +368,7 @@ set8700_A = list(2,3,5), modify(set8700_A, 7) == error(10406)
|
||||
protect(set8700_A,2), modify(set8700_A, "set8700_f") == error(10407)
|
||||
protect(set8700_A,0), modify(set8700_A, "h") == error(10408)
|
||||
set8700_B = 42, protect(set8700_B,0), modify(set8700_B, "set8700_f") == error(10409)
|
||||
set8700_A == list(2,3,5) ## set8700_A not affected by failures
|
||||
set8700_A == list(2,3,5) ## set8700_A not affected by failures
|
||||
protect(set8700_A,0,1), modify(set8700_A, "set8700_f") == null()
|
||||
set8700_A == list(4,9,25)
|
||||
modify(set8700_A,"set8700_g") == null()
|
||||
@@ -389,7 +389,7 @@ set8700_L = {{1,2,3},{'a','b','c'}}, set8700_L[0] == (mat[3] = {1,0,3})
|
||||
set8700_L[1] == (mat[3] = {'a','b',0})
|
||||
set8700_M = mat[2], protect(set8700_M,0), set8700_M = {1,2,3,4}, set8700_M == (mat[2] = {1,2})
|
||||
set8700_x = 5, set8700_M = {set8700_x++, set8700_x++, set8700_x++, set8700_x++, set8700_x++}, set8700_M == (mat[2] = {5,6})
|
||||
set8700_x == 10 ## All initialization terms evaluated
|
||||
set8700_x == 10 ## All initialization terms evaluated
|
||||
set8700_S = " ", set8700_S = {'a','b','c','d'}, set8700_S == "abc"
|
||||
|
||||
set8700_P = obj set8700_point = {1,2,3,4}, set8700_P.set8700_x == 1 && set8700_P.set8700_y == 2 && set8700_P.set8700_z == 3
|
||||
|
||||
@@ -28,7 +28,7 @@ define smallfactors(x0)
|
||||
local d q x flist tuple w;
|
||||
|
||||
if (x >= (2 ^ 32) - 1)
|
||||
return newerror("smallfactors: number must be < 2^32 -1");
|
||||
return newerror("smallfactors: number must be < 2^32 -1");
|
||||
|
||||
tuple = mat[2];
|
||||
flist = list();
|
||||
@@ -37,19 +37,19 @@ define smallfactors(x0)
|
||||
q = 0;
|
||||
tuple[0] = d;
|
||||
if (x < 2)
|
||||
return 0;
|
||||
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];
|
||||
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;
|
||||
}
|
||||
@@ -58,7 +58,7 @@ define printsmallfactors(flist)
|
||||
{
|
||||
local k;
|
||||
for (k = 0; k < size(flist); k++) {
|
||||
print flist[k][0]:"^":flist[k][1];
|
||||
print flist[k][0]:"^":flist[k][1];
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -32,35 +32,35 @@
|
||||
|
||||
define solve(low, high, epsilon)
|
||||
{
|
||||
local flow, fhigh, fmid, mid, places;
|
||||
local flow, fhigh, fmid, mid, places;
|
||||
|
||||
if (isnull(epsilon))
|
||||
epsilon = epsilon();
|
||||
if (epsilon <= 0)
|
||||
quit "Non-positive epsilon value";
|
||||
places = highbit(1 + int(1/epsilon)) + 1;
|
||||
flow = f(low);
|
||||
if (abs(flow) < epsilon)
|
||||
return low;
|
||||
fhigh = f(high);
|
||||
if (abs(fhigh) < epsilon)
|
||||
return high;
|
||||
if (sgn(flow) == sgn(fhigh))
|
||||
quit "Non-opposite signs";
|
||||
while (1) {
|
||||
mid = bround(high - fhigh * (high - low) / (fhigh - flow),
|
||||
places);
|
||||
if ((mid == low) || (mid == high))
|
||||
places++;
|
||||
fmid = f(mid);
|
||||
if (abs(fmid) < epsilon)
|
||||
return mid;
|
||||
if (sgn(fmid) == sgn(flow)) {
|
||||
low = mid;
|
||||
flow = fmid;
|
||||
} else {
|
||||
high = mid;
|
||||
fhigh = fmid;
|
||||
}
|
||||
}
|
||||
if (isnull(epsilon))
|
||||
epsilon = epsilon();
|
||||
if (epsilon <= 0)
|
||||
quit "Non-positive epsilon value";
|
||||
places = highbit(1 + int(1/epsilon)) + 1;
|
||||
flow = f(low);
|
||||
if (abs(flow) < epsilon)
|
||||
return low;
|
||||
fhigh = f(high);
|
||||
if (abs(fhigh) < epsilon)
|
||||
return high;
|
||||
if (sgn(flow) == sgn(fhigh))
|
||||
quit "Non-opposite signs";
|
||||
while (1) {
|
||||
mid = bround(high - fhigh * (high - low) / (fhigh - flow),
|
||||
places);
|
||||
if ((mid == low) || (mid == high))
|
||||
places++;
|
||||
fmid = f(mid);
|
||||
if (abs(fmid) < epsilon)
|
||||
return mid;
|
||||
if (sgn(fmid) == sgn(flow)) {
|
||||
low = mid;
|
||||
flow = fmid;
|
||||
} else {
|
||||
high = mid;
|
||||
fhigh = fmid;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2006/06/07 14:10:11
|
||||
* File existed as early as: 2006
|
||||
* Under source code control: 2006/06/07 14:10:11
|
||||
* File existed as early as: 2006
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -39,43 +39,43 @@ if (! iserror(E_SPLITBITS_3)) E_SPLITBITS_3 = newerror("2nd argument must be an
|
||||
*/
|
||||
define splitbits(x, b)
|
||||
{
|
||||
local ret; /* list to return */
|
||||
local mask; /* 2^b-1 */
|
||||
local x_is_reg = 0; /* true if x < 0 */
|
||||
local ret; /* list to return */
|
||||
local mask; /* 2^b-1 */
|
||||
local x_is_reg = 0; /* true if x < 0 */
|
||||
|
||||
/* firewall */
|
||||
if (! isint(x)) {
|
||||
return error(E_SPLITBITS_1);
|
||||
return error(E_SPLITBITS_1);
|
||||
}
|
||||
if (! isint(b)) {
|
||||
return error(E_SPLITBITS_2);
|
||||
return error(E_SPLITBITS_2);
|
||||
}
|
||||
if (b <= 0) {
|
||||
return error(E_SPLITBITS_3);
|
||||
return error(E_SPLITBITS_3);
|
||||
}
|
||||
|
||||
/* special case: x == 0 */
|
||||
if (x == 0) {
|
||||
return list(0);
|
||||
return list(0);
|
||||
}
|
||||
|
||||
/* setup for splitting x */
|
||||
ret = list();
|
||||
mask = 2^b-1;
|
||||
if (x < 0) {
|
||||
x_is_reg = 1;
|
||||
x = abs(x);
|
||||
x_is_reg = 1;
|
||||
x = abs(x);
|
||||
}
|
||||
|
||||
/* split x */
|
||||
while (x > 0) {
|
||||
printf("%d %x\n", size(ret), x);
|
||||
if (x_is_reg) {
|
||||
append(ret, xor(x & mask, mask));
|
||||
} else {
|
||||
append(ret, x & mask);
|
||||
}
|
||||
x >>= b;
|
||||
printf("%d %x\n", size(ret), x);
|
||||
if (x_is_reg) {
|
||||
append(ret, xor(x & mask, mask));
|
||||
} else {
|
||||
append(ret, x & mask);
|
||||
}
|
||||
x >>= b;
|
||||
}
|
||||
|
||||
/* return list */
|
||||
|
||||
@@ -17,8 +17,8 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
* Under source code control: 2013/08/11 01:31:28
|
||||
* File existed as early as: 2013
|
||||
*/
|
||||
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:50:37
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -32,30 +32,30 @@
|
||||
|
||||
define ss(p)
|
||||
{
|
||||
local a, b, i, p4;
|
||||
local a, b, i, p4;
|
||||
|
||||
if (p == 2) {
|
||||
print "1^2 + 1^2 = 2";
|
||||
return;
|
||||
}
|
||||
if ((p % 4) != 1) {
|
||||
print p, "is not of the form 4N+1";
|
||||
return;
|
||||
}
|
||||
if (!ptest(p, min(p-2, 10))) {
|
||||
print p, "is not a prime";
|
||||
return;
|
||||
}
|
||||
p4 = (p - 1) / 4;
|
||||
i = 2;
|
||||
do {
|
||||
a = pmod(i++, p4, p);
|
||||
} while ((a^2 % p) == 1);
|
||||
b = p;
|
||||
while (b^2 > p) {
|
||||
i = b % a;
|
||||
b = a;
|
||||
a = i;
|
||||
}
|
||||
print a : "^2 +" , b : "^2 =" , a^2 + b^2;
|
||||
if (p == 2) {
|
||||
print "1^2 + 1^2 = 2";
|
||||
return;
|
||||
}
|
||||
if ((p % 4) != 1) {
|
||||
print p, "is not of the form 4N+1";
|
||||
return;
|
||||
}
|
||||
if (!ptest(p, min(p-2, 10))) {
|
||||
print p, "is not a prime";
|
||||
return;
|
||||
}
|
||||
p4 = (p - 1) / 4;
|
||||
i = 2;
|
||||
do {
|
||||
a = pmod(i++, p4, p);
|
||||
} while ((a^2 % p) == 1);
|
||||
b = p;
|
||||
while (b^2 > p) {
|
||||
i = b % a;
|
||||
b = a;
|
||||
a = i;
|
||||
}
|
||||
print a : "^2 +" , b : "^2 =" , a^2 + b^2;
|
||||
}
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,10 +17,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 2006/06/22 17:29
|
||||
* File existed as early as: 2006
|
||||
* Under source code control: 2006/06/22 17:29
|
||||
* File existed as early as: 2006
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
||||
298
cal/surd.cal
298
cal/surd.cal
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,266 +17,266 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1990/02/15 01:50:38
|
||||
* File existed as early as: before 1990
|
||||
* Under source code control: 1990/02/15 01:50:38
|
||||
* File existed as early as: before 1990
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
obj surd {a, b}; /* definition of the surd object */
|
||||
obj surd {a, b}; /* definition of the surd object */
|
||||
|
||||
global surd_type = -1; /* type of surd (value of D) */
|
||||
static obj surd surd__; /* example surd for testing against */
|
||||
global surd_type = -1; /* type of surd (value of D) */
|
||||
static obj surd surd__; /* example surd for testing against */
|
||||
|
||||
|
||||
define surd(a,b)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
obj surd x;
|
||||
x.a = a;
|
||||
x.b = b;
|
||||
return x;
|
||||
obj surd x;
|
||||
x.a = a;
|
||||
x.b = b;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define surd_print(a)
|
||||
{
|
||||
print "surd(" : a.a : ", " : a.b : ")" :;
|
||||
print "surd(" : a.a : ", " : a.b : ")" :;
|
||||
}
|
||||
|
||||
|
||||
define surd_conj(a)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
obj surd x;
|
||||
x.a = a.a;
|
||||
x.b = -a.b;
|
||||
return x;
|
||||
obj surd x;
|
||||
x.a = a.a;
|
||||
x.b = -a.b;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define surd_norm(a)
|
||||
{
|
||||
return a.a^2 + abs(surd_type) * a.b^2;
|
||||
return a.a^2 + abs(surd_type) * a.b^2;
|
||||
}
|
||||
|
||||
|
||||
define surd_value(a, xepsilon)
|
||||
{
|
||||
local epsilon;
|
||||
local epsilon;
|
||||
|
||||
epsilon = xepsilon;
|
||||
if (isnull(epsilon))
|
||||
epsilon = epsilon();
|
||||
return a.a + a.b * sqrt(surd_type, epsilon);
|
||||
epsilon = xepsilon;
|
||||
if (isnull(epsilon))
|
||||
epsilon = epsilon();
|
||||
return a.a + a.b * sqrt(surd_type, epsilon);
|
||||
}
|
||||
|
||||
define surd_add(a, b)
|
||||
{
|
||||
local obj surd x;
|
||||
local obj surd x;
|
||||
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a + b;
|
||||
x.b = a.b;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.a = a + b.a;
|
||||
x.b = b.b;
|
||||
return x;
|
||||
}
|
||||
x.a = a.a + b.a;
|
||||
x.b = a.b + b.b;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a + b;
|
||||
x.b = a.b;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.a = a + b.a;
|
||||
x.b = b.b;
|
||||
return x;
|
||||
}
|
||||
x.a = a.a + b.a;
|
||||
x.b = a.b + b.b;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
}
|
||||
|
||||
|
||||
define surd_sub(a, b)
|
||||
{
|
||||
local obj surd x;
|
||||
local obj surd x;
|
||||
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a - b;
|
||||
x.b = a.b;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.a = a - b.a;
|
||||
x.b = -b.b;
|
||||
return x;
|
||||
}
|
||||
x.a = a.a - b.a;
|
||||
x.b = a.b - b.b;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a - b;
|
||||
x.b = a.b;
|
||||
return x;
|
||||
}
|
||||
if (!istype(a, x)) {
|
||||
x.a = a - b.a;
|
||||
x.b = -b.b;
|
||||
return x;
|
||||
}
|
||||
x.a = a.a - b.a;
|
||||
x.b = a.b - b.b;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
}
|
||||
|
||||
|
||||
define surd_inc(a)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
x = a;
|
||||
x.a++;
|
||||
return x;
|
||||
x = a;
|
||||
x.a++;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define surd_dec(a)
|
||||
{
|
||||
local x;
|
||||
local x;
|
||||
|
||||
x = a;
|
||||
x.a--;
|
||||
return x;
|
||||
x = a;
|
||||
x.a--;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define surd_neg(a)
|
||||
{
|
||||
local obj surd x;
|
||||
local obj surd x;
|
||||
|
||||
x.a = -a.a;
|
||||
x.b = -a.b;
|
||||
return x;
|
||||
x.a = -a.a;
|
||||
x.b = -a.b;
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define surd_mul(a, b)
|
||||
{
|
||||
local obj surd x;
|
||||
local obj surd x;
|
||||
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a * b;
|
||||
x.b = a.b * b;
|
||||
} else if (!istype(a, x)) {
|
||||
x.a = b.a * a;
|
||||
x.b = b.b * a;
|
||||
} else {
|
||||
x.a = a.a * b.a + surd_type * a.b * b.b;
|
||||
x.b = a.a * b.b + a.b * b.a;
|
||||
}
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a * b;
|
||||
x.b = a.b * b;
|
||||
} else if (!istype(a, x)) {
|
||||
x.a = b.a * a;
|
||||
x.b = b.b * a;
|
||||
} else {
|
||||
x.a = a.a * b.a + surd_type * a.b * b.b;
|
||||
x.b = a.a * b.b + a.b * b.a;
|
||||
}
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
}
|
||||
|
||||
|
||||
define surd_square(a)
|
||||
{
|
||||
local obj surd x;
|
||||
local obj surd x;
|
||||
|
||||
x.a = a.a^2 + a.b^2 * surd_type;
|
||||
x.b = a.a * a.b * 2;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
x.a = a.a^2 + a.b^2 * surd_type;
|
||||
x.b = a.a * a.b * 2;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
}
|
||||
|
||||
|
||||
define surd_scale(a, b)
|
||||
{
|
||||
local obj surd x;
|
||||
local obj surd x;
|
||||
|
||||
x.a = scale(a.a, b);
|
||||
x.b = scale(a.b, b);
|
||||
return x;
|
||||
x.a = scale(a.a, b);
|
||||
x.b = scale(a.b, b);
|
||||
return x;
|
||||
}
|
||||
|
||||
|
||||
define surd_shift(a, b)
|
||||
{
|
||||
local obj surd x;
|
||||
local obj surd x;
|
||||
|
||||
x.a = a.a << b;
|
||||
x.b = a.b << b;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
x.a = a.a << b;
|
||||
x.b = a.b << b;
|
||||
if (x.b)
|
||||
return x;
|
||||
return x.a;
|
||||
}
|
||||
|
||||
|
||||
define surd_div(a, b)
|
||||
{
|
||||
local x, y;
|
||||
local x, y;
|
||||
|
||||
if ((a == 0) && b)
|
||||
return 0;
|
||||
obj surd x;
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a / b;
|
||||
x.b = a.b / b;
|
||||
return x;
|
||||
}
|
||||
y = b;
|
||||
y.b = -b.b;
|
||||
return (a * y) / (b.a^2 - surd_type * b.b^2);
|
||||
if ((a == 0) && b)
|
||||
return 0;
|
||||
obj surd x;
|
||||
if (!istype(b, x)) {
|
||||
x.a = a.a / b;
|
||||
x.b = a.b / b;
|
||||
return x;
|
||||
}
|
||||
y = b;
|
||||
y.b = -b.b;
|
||||
return (a * y) / (b.a^2 - surd_type * b.b^2);
|
||||
}
|
||||
|
||||
|
||||
define surd_inv(a)
|
||||
{
|
||||
return 1 / a;
|
||||
return 1 / a;
|
||||
}
|
||||
|
||||
|
||||
define surd_sgn(a)
|
||||
{
|
||||
if (surd_type < 0)
|
||||
quit "Taking sign of complex surd";
|
||||
if (a.a == 0)
|
||||
return sgn(a.b);
|
||||
if (a.b == 0)
|
||||
return sgn(a.a);
|
||||
if ((a.a > 0) && (a.b > 0))
|
||||
return 1;
|
||||
if ((a.a < 0) && (a.b < 0))
|
||||
return -1;
|
||||
return sgn(a.a^2 - a.b^2 * surd_type) * sgn(a.a);
|
||||
if (surd_type < 0)
|
||||
quit "Taking sign of complex surd";
|
||||
if (a.a == 0)
|
||||
return sgn(a.b);
|
||||
if (a.b == 0)
|
||||
return sgn(a.a);
|
||||
if ((a.a > 0) && (a.b > 0))
|
||||
return 1;
|
||||
if ((a.a < 0) && (a.b < 0))
|
||||
return -1;
|
||||
return sgn(a.a^2 - a.b^2 * surd_type) * sgn(a.a);
|
||||
}
|
||||
|
||||
|
||||
define surd_cmp(a, b)
|
||||
{
|
||||
if (!istype(a, surd__))
|
||||
return ((b.b != 0) || (a != b.a));
|
||||
if (!istype(b, surd__))
|
||||
return ((a.b != 0) || (b != a.a));
|
||||
return ((a.a != b.a) || (a.b != b.b));
|
||||
if (!istype(a, surd__))
|
||||
return ((b.b != 0) || (a != b.a));
|
||||
if (!istype(b, surd__))
|
||||
return ((a.b != 0) || (b != a.a));
|
||||
return ((a.a != b.a) || (a.b != b.b));
|
||||
}
|
||||
|
||||
|
||||
define surd_rel(a, b)
|
||||
{
|
||||
local x, y;
|
||||
local x, y;
|
||||
|
||||
if (surd_type < 0)
|
||||
quit "Relative comparison of complex surds";
|
||||
if (!istype(a, surd__)) {
|
||||
x = a - b.a;
|
||||
y = -b.b;
|
||||
} else if (!istype(b, surd__)) {
|
||||
x = a.a - b;
|
||||
y = a.b;
|
||||
} else {
|
||||
x = a.a - b.a;
|
||||
y = a.b - b.b;
|
||||
}
|
||||
if (y == 0)
|
||||
return sgn(x);
|
||||
if (x == 0)
|
||||
return sgn(y);
|
||||
if ((x < 0) && (y < 0))
|
||||
return -1;
|
||||
if ((x > 0) && (y > 0))
|
||||
return 1;
|
||||
return sgn(x^2 - y^2 * surd_type) * sgn(x);
|
||||
if (surd_type < 0)
|
||||
quit "Relative comparison of complex surds";
|
||||
if (!istype(a, surd__)) {
|
||||
x = a - b.a;
|
||||
y = -b.b;
|
||||
} else if (!istype(b, surd__)) {
|
||||
x = a.a - b;
|
||||
y = a.b;
|
||||
} else {
|
||||
x = a.a - b.a;
|
||||
y = a.b - b.b;
|
||||
}
|
||||
if (y == 0)
|
||||
return sgn(x);
|
||||
if (x == 0)
|
||||
return sgn(y);
|
||||
if ((x < 0) && (y < 0))
|
||||
return -1;
|
||||
if ((x > 0) && (y > 0))
|
||||
return 1;
|
||||
return sgn(x^2 - y^2 * surd_type) * sgn(x);
|
||||
}
|
||||
|
||||
if (config("resource_debug") & 3) {
|
||||
|
||||
@@ -9,7 +9,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -17,11 +17,11 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/07/09 06:12:13
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/07/09 06:12:13
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* chongo <was here> /\oo/\ http://www.isthe.com/chongo/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
@@ -33,12 +33,12 @@ obj matrix {m}
|
||||
*/
|
||||
define matrix_inc(a)
|
||||
{
|
||||
local i;
|
||||
local i;
|
||||
|
||||
/* increment each matrix member */
|
||||
for (i= 0; i < size(a.m); i++)
|
||||
++a.m[[i]];
|
||||
return a;
|
||||
/* increment each matrix member */
|
||||
for (i= 0; i < size(a.m); i++)
|
||||
++a.m[[i]];
|
||||
return a;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -46,12 +46,12 @@ define matrix_inc(a)
|
||||
*/
|
||||
define matrix_dec(a)
|
||||
{
|
||||
local i;
|
||||
local i;
|
||||
|
||||
/* decrement each matrix member */
|
||||
for (i= 0; i < size(a.m); i++)
|
||||
--a.m[[i]];
|
||||
return a;
|
||||
/* decrement each matrix member */
|
||||
for (i= 0; i < size(a.m); i++)
|
||||
--a.m[[i]];
|
||||
return a;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -59,24 +59,24 @@ define matrix_dec(a)
|
||||
*/
|
||||
define mkmat()
|
||||
{
|
||||
local s, M, i, v;
|
||||
local s, M, i, v;
|
||||
|
||||
/* firewall */
|
||||
s = param(0);
|
||||
if (s == 0)
|
||||
quit "Need at least one argument";
|
||||
/* firewall */
|
||||
s = param(0);
|
||||
if (s == 0)
|
||||
quit "Need at least one argument";
|
||||
|
||||
/* create the matrix */
|
||||
mat M[s];
|
||||
/* create the matrix */
|
||||
mat M[s];
|
||||
|
||||
/* load the matrix with the args */
|
||||
for (i = 0; i < s; i++)
|
||||
M[i] = param(i + 1);
|
||||
/* load the matrix with the args */
|
||||
for (i = 0; i < s; i++)
|
||||
M[i] = param(i + 1);
|
||||
|
||||
/* create the object with the matrix */
|
||||
obj matrix v;
|
||||
v.m = M;
|
||||
return v;
|
||||
/* create the object with the matrix */
|
||||
obj matrix v;
|
||||
v.m = M;
|
||||
return v;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -84,29 +84,29 @@ define mkmat()
|
||||
*/
|
||||
define ckmat()
|
||||
{
|
||||
local s, a, i;
|
||||
local s, a, i;
|
||||
|
||||
/* firewall */
|
||||
s = param(0);
|
||||
if (s < 2)
|
||||
quit "Need at least two arguments";
|
||||
/* firewall */
|
||||
s = param(0);
|
||||
if (s < 2)
|
||||
quit "Need at least two arguments";
|
||||
|
||||
/* get the object to test */
|
||||
a = param(1);
|
||||
/* get the object to test */
|
||||
a = param(1);
|
||||
|
||||
/* verify the matrix in the object is the right size */
|
||||
if (size(a.m) != s-1) {
|
||||
return 0;
|
||||
}
|
||||
/* verify the matrix in the object is the right size */
|
||||
if (size(a.m) != s-1) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* check each matrix element with the args passed */
|
||||
for (i = 2; i <= s; i++) {
|
||||
if (a.m[i-2] != param(i)) {
|
||||
/* args do not match */
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
/* check each matrix element with the args passed */
|
||||
for (i = 2; i <= s; i++) {
|
||||
if (a.m[i-2] != param(i)) {
|
||||
/* args do not match */
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* args match the matrix in the object */
|
||||
return 1;
|
||||
/* args match the matrix in the object */
|
||||
return 1;
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,10 +19,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/11/01 22:52:25
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/11/01 22:52:25
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
/*
|
||||
@@ -40,25 +40,25 @@
|
||||
defaultverbose = 1;
|
||||
|
||||
define mknonnegreal() {
|
||||
switch(rand(8)) {
|
||||
case 0: return rand(20);
|
||||
case 1: return rand(20,1000);
|
||||
case 2: return rand(1,10000)/rand(1,100);
|
||||
case 3: return scale(mkposreal(), rand(1,100));
|
||||
case 4: return scale(mkposreal(), -rand(1,100));
|
||||
case 5: return rand(1, 1000) + scale(mkfrac(),-rand(1,100));
|
||||
case 6: return mkposreal()^2;
|
||||
case 7: return mkposreal() * (1+scale(mkfrac(),-rand(1,100)));
|
||||
}
|
||||
switch(rand(8)) {
|
||||
case 0: return rand(20);
|
||||
case 1: return rand(20,1000);
|
||||
case 2: return rand(1,10000)/rand(1,100);
|
||||
case 3: return scale(mkposreal(), rand(1,100));
|
||||
case 4: return scale(mkposreal(), -rand(1,100));
|
||||
case 5: return rand(1, 1000) + scale(mkfrac(),-rand(1,100));
|
||||
case 6: return mkposreal()^2;
|
||||
case 7: return mkposreal() * (1+scale(mkfrac(),-rand(1,100)));
|
||||
}
|
||||
}
|
||||
|
||||
define mkposreal() {
|
||||
local x;
|
||||
local x;
|
||||
|
||||
x = mknonnegreal();
|
||||
while (x == 0)
|
||||
x = mknonnegreal();
|
||||
return x;
|
||||
x = mknonnegreal();
|
||||
while (x == 0)
|
||||
x = mknonnegreal();
|
||||
return x;
|
||||
}
|
||||
|
||||
define mkreal_2700() = rand(2) ? mknonnegreal() : -mknonnegreal();
|
||||
@@ -67,15 +67,15 @@ define mknonzeroreal() = rand(2) ? mkposreal() : -mkposreal();
|
||||
|
||||
/* Number > 0 and < 1, almost uniformly distributed */
|
||||
define mkposfrac() {
|
||||
local x,y;
|
||||
local x,y;
|
||||
|
||||
x = rand(1,1000);
|
||||
do
|
||||
y = rand(1,1000);
|
||||
while (y == x);
|
||||
if (x > y)
|
||||
swap(x,y);
|
||||
return x/y;
|
||||
x = rand(1,1000);
|
||||
do
|
||||
y = rand(1,1000);
|
||||
while (y == x);
|
||||
if (x > y)
|
||||
swap(x,y);
|
||||
return x/y;
|
||||
}
|
||||
|
||||
/* Nonzero > -1 and < 1 */
|
||||
@@ -86,13 +86,13 @@ define mksquarereal() = mknonnegreal()^2;
|
||||
/*
|
||||
* We might be able to do better than the following. For non-square
|
||||
* positive integer less than 1e6, could use:
|
||||
* x = rand(1, 1000);
|
||||
* return rand(x^2 + 1, (x + 1)^2);
|
||||
* x = rand(1, 1000);
|
||||
* return rand(x^2 + 1, (x + 1)^2);
|
||||
* Maybe could do:
|
||||
* do
|
||||
* x = mkreal_2700();
|
||||
* while
|
||||
* (issq(x));
|
||||
* do
|
||||
* x = mkreal_2700();
|
||||
* while
|
||||
* (issq(x));
|
||||
* This would of course not be satisfactory for testing issq().
|
||||
*/
|
||||
|
||||
@@ -102,127 +102,127 @@ define mkcomplex_2700() = mkreal_2700() + 1i * mkreal_2700();
|
||||
|
||||
define testcsqrt(str, n, verbose)
|
||||
{
|
||||
local x, y, z, m, i, p, v;
|
||||
local x, y, z, m, i, p, v;
|
||||
|
||||
if (isnull(verbose))
|
||||
verbose = defaultverbose;
|
||||
if (verbose > 0) {
|
||||
print str:":",:;
|
||||
}
|
||||
m = 0;
|
||||
for (i = 1; i <= n; i++) {
|
||||
if (verbose > 1) print i,:;
|
||||
x = rand(3) ? mkreal_2700(): mkcomplex_2700();
|
||||
y = scale(mknonzeroreal(), -100);
|
||||
if (verbose > 2)
|
||||
printf("%d: x = %d, y = %d\n", i, x, y);
|
||||
if (isnull(verbose))
|
||||
verbose = defaultverbose;
|
||||
if (verbose > 0) {
|
||||
print str:":",:;
|
||||
}
|
||||
m = 0;
|
||||
for (i = 1; i <= n; i++) {
|
||||
if (verbose > 1) print i,:;
|
||||
x = rand(3) ? mkreal_2700(): mkcomplex_2700();
|
||||
y = scale(mknonzeroreal(), -100);
|
||||
if (verbose > 2)
|
||||
printf("%d: x = %d, y = %d\n", i, x, y);
|
||||
|
||||
for (z = 0; z < 128; z++) {
|
||||
v = sqrt(x,y,z);
|
||||
p = checksqrt(x,y,z,v);
|
||||
if (p) {
|
||||
if (verbose > 0)
|
||||
printf(
|
||||
"*** Type %d failure for x = %r, "
|
||||
"y = %r, z = %d\n",
|
||||
p, x, y, z);
|
||||
m++;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (verbose > 0) {
|
||||
if (m) {
|
||||
printf("*** %d error(s)\n", m);
|
||||
} else {
|
||||
printf("no errors\n");
|
||||
}
|
||||
}
|
||||
return m;
|
||||
for (z = 0; z < 128; z++) {
|
||||
v = sqrt(x,y,z);
|
||||
p = checksqrt(x,y,z,v);
|
||||
if (p) {
|
||||
if (verbose > 0)
|
||||
printf(
|
||||
"*** Type %d failure for x = %r, "
|
||||
"y = %r, z = %d\n",
|
||||
p, x, y, z);
|
||||
m++;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (verbose > 0) {
|
||||
if (m) {
|
||||
printf("*** %d error(s)\n", m);
|
||||
} else {
|
||||
printf("no errors\n");
|
||||
}
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
|
||||
define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */
|
||||
define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */
|
||||
{
|
||||
local A, B, X, Y, t1, t2, eps, u, n, f, s;
|
||||
local A, B, X, Y, t1, t2, eps, u, n, f, s;
|
||||
|
||||
A = re(x);
|
||||
B = im(x);
|
||||
X = re(v);
|
||||
Y = im(v);
|
||||
A = re(x);
|
||||
B = im(x);
|
||||
X = re(v);
|
||||
Y = im(v);
|
||||
|
||||
/* checking signs of X and Y */
|
||||
/* checking signs of X and Y */
|
||||
|
||||
if (B == 0 && A <= 0) /* t1 = sgn(re(tvsqrt)) */
|
||||
t1 = 0;
|
||||
else
|
||||
t1 = (z & 64) ? -1 : 1;
|
||||
if (B == 0 && A <= 0) /* t1 = sgn(re(tvsqrt)) */
|
||||
t1 = 0;
|
||||
else
|
||||
t1 = (z & 64) ? -1 : 1;
|
||||
|
||||
t2 = B ? sgn(B) : (A < 0); /* t2 = sgn(im(tvsqrt)) */
|
||||
if (z & 64)
|
||||
t2 = -t2;
|
||||
t2 = B ? sgn(B) : (A < 0); /* t2 = sgn(im(tvsqrt)) */
|
||||
if (z & 64)
|
||||
t2 = -t2;
|
||||
|
||||
if (t1 == 0 && X != 0)
|
||||
return 1;
|
||||
if (t1 == 0 && X != 0)
|
||||
return 1;
|
||||
|
||||
if (t2 == 0 && Y != 0) {
|
||||
printf("x = %d, Y = %d, t2 = %d\n", x, Y, t2);
|
||||
return 2;
|
||||
}
|
||||
if (t2 == 0 && Y != 0) {
|
||||
printf("x = %d, Y = %d, t2 = %d\n", x, Y, t2);
|
||||
return 2;
|
||||
}
|
||||
|
||||
if (X && sgn(X) != t1)
|
||||
return 3;
|
||||
if (X && sgn(X) != t1)
|
||||
return 3;
|
||||
|
||||
if (Y && sgn(Y) != t2)
|
||||
return 4;
|
||||
if (Y && sgn(Y) != t2)
|
||||
return 4;
|
||||
|
||||
if (z & 32 && iscomsq(x))
|
||||
return 5 * (x != v^2);
|
||||
if (z & 32 && iscomsq(x))
|
||||
return 5 * (x != v^2);
|
||||
|
||||
eps = (z & 16) ? abs(y)/2 : abs(y);
|
||||
u = sgn(y);
|
||||
eps = (z & 16) ? abs(y)/2 : abs(y);
|
||||
u = sgn(y);
|
||||
|
||||
/* Checking X */
|
||||
/* Checking X */
|
||||
|
||||
n = X/y;
|
||||
if (!isint(n))
|
||||
return 6;
|
||||
n = X/y;
|
||||
if (!isint(n))
|
||||
return 6;
|
||||
|
||||
if (t1) {
|
||||
f = checkavrem(A, B, abs(X), eps);
|
||||
if (t1) {
|
||||
f = checkavrem(A, B, abs(X), eps);
|
||||
|
||||
if (z & 16 && f < 0)
|
||||
return 7;
|
||||
if (!(z & 16) && f <= 0)
|
||||
return 8;
|
||||
if (z & 16 && f < 0)
|
||||
return 7;
|
||||
if (!(z & 16) && f <= 0)
|
||||
return 8;
|
||||
|
||||
if (!(z & 16) || f == 0) {
|
||||
s = X ? t1 * sgn(A - X^2 + B^2/4/X^2) : t1;
|
||||
if (s && !checkrounding(s,n,t1,u,z))
|
||||
return 9;
|
||||
}
|
||||
}
|
||||
if (!(z & 16) || f == 0) {
|
||||
s = X ? t1 * sgn(A - X^2 + B^2/4/X^2) : t1;
|
||||
if (s && !checkrounding(s,n,t1,u,z))
|
||||
return 9;
|
||||
}
|
||||
}
|
||||
|
||||
/* Checking Y */
|
||||
/* Checking Y */
|
||||
|
||||
n = Y/y;
|
||||
if (!isint(n))
|
||||
return 10;
|
||||
n = Y/y;
|
||||
if (!isint(n))
|
||||
return 10;
|
||||
|
||||
if (t2) {
|
||||
f = checkavrem(-A, B, abs(Y), eps);
|
||||
if (t2) {
|
||||
f = checkavrem(-A, B, abs(Y), eps);
|
||||
|
||||
if (z & 16 && f < 0)
|
||||
return 11;
|
||||
if (!(z & 16) && f <= 0)
|
||||
return 12;
|
||||
if (z & 16 && f < 0)
|
||||
return 11;
|
||||
if (!(z & 16) && f <= 0)
|
||||
return 12;
|
||||
|
||||
if (!(z & 16) || f == 0) {
|
||||
s = Y ? t2 * sgn(-A - Y^2 + B^2/4/Y^2) : t2;
|
||||
if (s && !checkrounding(s,n,t2,u,z))
|
||||
return 13;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
if (!(z & 16) || f == 0) {
|
||||
s = Y ? t2 * sgn(-A - Y^2 + B^2/4/Y^2) : t2;
|
||||
if (s && !checkrounding(s,n,t2,u,z))
|
||||
return 13;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -233,61 +233,61 @@ define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */
|
||||
|
||||
define checkavrem(A, B, X, eps)
|
||||
{
|
||||
local f;
|
||||
local f;
|
||||
|
||||
f = sgn(A - (X + eps)^2 + B^2/4/(X + eps)^2);
|
||||
if (f > 0)
|
||||
return -1; /* X < tv - eps */
|
||||
if (f == 0)
|
||||
return 0; /* X = tv - eps */
|
||||
f = sgn(A - (X + eps)^2 + B^2/4/(X + eps)^2);
|
||||
if (f > 0)
|
||||
return -1; /* X < tv - eps */
|
||||
if (f == 0)
|
||||
return 0; /* X = tv - eps */
|
||||
|
||||
if (X > eps) {
|
||||
f = sgn(A - (X - eps)^2 + B^2/4/(X - eps)^2);
|
||||
if (X > eps) {
|
||||
f = sgn(A - (X - eps)^2 + B^2/4/(X - eps)^2);
|
||||
|
||||
if (f < 0)
|
||||
return -1; /* X > tv + eps */
|
||||
if (f == 0)
|
||||
return 0; /* X = tv + eps */
|
||||
}
|
||||
return 1; /* tv - eps < X < tv + eps */
|
||||
if (f < 0)
|
||||
return -1; /* X > tv + eps */
|
||||
if (f == 0)
|
||||
return 0; /* X = tv + eps */
|
||||
}
|
||||
return 1; /* tv - eps < X < tv + eps */
|
||||
}
|
||||
|
||||
|
||||
define checkrounding(s,n,t,u,z)
|
||||
{
|
||||
local w;
|
||||
local w;
|
||||
|
||||
switch (z & 15) {
|
||||
case 0: w = (s == u); break;
|
||||
case 1: w = (s == -u); break;
|
||||
case 2: w = (s == t); break;
|
||||
case 3: w = (s == -t); break;
|
||||
case 4: w = (s > 0); break;
|
||||
case 5: w = (s < 0); break;
|
||||
case 6: w = (s == u/t); break;
|
||||
case 7: w = (s == -u/t); break;
|
||||
case 8: w = iseven(n); break;
|
||||
case 9: w = isodd(n); break;
|
||||
case 10: w = (u/t > 0) ? iseven(n) : isodd(n); break;
|
||||
case 11: w = (u/t > 0) ? isodd(n) : iseven(n); break;
|
||||
case 12: w = (u > 0) ? iseven(n) : isodd(n); break;
|
||||
case 13: w = (u > 0) ? isodd(n) : iseven(n); break;
|
||||
case 14: w = (t > 0) ? iseven(n) : isodd(n); break;
|
||||
case 15: w = (t > 0) ? isodd(n) : iseven(n); break;
|
||||
}
|
||||
return w;
|
||||
switch (z & 15) {
|
||||
case 0: w = (s == u); break;
|
||||
case 1: w = (s == -u); break;
|
||||
case 2: w = (s == t); break;
|
||||
case 3: w = (s == -t); break;
|
||||
case 4: w = (s > 0); break;
|
||||
case 5: w = (s < 0); break;
|
||||
case 6: w = (s == u/t); break;
|
||||
case 7: w = (s == -u/t); break;
|
||||
case 8: w = iseven(n); break;
|
||||
case 9: w = isodd(n); break;
|
||||
case 10: w = (u/t > 0) ? iseven(n) : isodd(n); break;
|
||||
case 11: w = (u/t > 0) ? isodd(n) : iseven(n); break;
|
||||
case 12: w = (u > 0) ? iseven(n) : isodd(n); break;
|
||||
case 13: w = (u > 0) ? isodd(n) : iseven(n); break;
|
||||
case 14: w = (t > 0) ? iseven(n) : isodd(n); break;
|
||||
case 15: w = (t > 0) ? isodd(n) : iseven(n); break;
|
||||
}
|
||||
return w;
|
||||
}
|
||||
|
||||
define iscomsq(x)
|
||||
{
|
||||
local c;
|
||||
local c;
|
||||
|
||||
if (isreal(x))
|
||||
return issq(abs(x));
|
||||
c = norm(x);
|
||||
if (!issq(c))
|
||||
return 0;
|
||||
return issq((re(x) + sqrt(c,1,32))/2);
|
||||
if (isreal(x))
|
||||
return issq(abs(x));
|
||||
c = norm(x);
|
||||
if (!issq(c))
|
||||
return 0;
|
||||
return issq((re(x) + sqrt(c,1,32))/2);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -295,33 +295,33 @@ define iscomsq(x)
|
||||
*/
|
||||
define test2700(verbose, tnum)
|
||||
{
|
||||
local n; /* test parameter */
|
||||
local ep; /* test parameter */
|
||||
local i;
|
||||
local n; /* test parameter */
|
||||
local ep; /* test parameter */
|
||||
local i;
|
||||
|
||||
/* set test parameters */
|
||||
n = 32; /* internal test loop count */
|
||||
if (isnull(verbose)) {
|
||||
verbose = defaultverbose;
|
||||
}
|
||||
if (isnull(tnum)) {
|
||||
tnum = 1; /* initial test number */
|
||||
}
|
||||
/* set test parameters */
|
||||
n = 32; /* internal test loop count */
|
||||
if (isnull(verbose)) {
|
||||
verbose = defaultverbose;
|
||||
}
|
||||
if (isnull(tnum)) {
|
||||
tnum = 1; /* initial test number */
|
||||
}
|
||||
|
||||
/*
|
||||
* test a lot of stuff
|
||||
*/
|
||||
srand(2700e2700);
|
||||
for (i=0; i < n; ++i) {
|
||||
err += testcsqrt(strcat(str(tnum++),": complex sqrt",str(i)),
|
||||
1, verbose);
|
||||
}
|
||||
if (verbose > 1) {
|
||||
if (err) {
|
||||
print "***", err, "error(s) found in testall";
|
||||
} else {
|
||||
print "no errors in testall";
|
||||
}
|
||||
}
|
||||
return tnum;
|
||||
/*
|
||||
* test a lot of stuff
|
||||
*/
|
||||
srand(2700e2700);
|
||||
for (i=0; i < n; ++i) {
|
||||
err += testcsqrt(strcat(str(tnum++),": complex sqrt",str(i)),
|
||||
1, verbose);
|
||||
}
|
||||
if (verbose > 1) {
|
||||
if (err) {
|
||||
print "***", err, "error(s) found in testall";
|
||||
} else {
|
||||
print "no errors in testall";
|
||||
}
|
||||
}
|
||||
return tnum;
|
||||
}
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,10 +19,10 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/11/28 11:56:57
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/11/28 11:56:57
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
*
|
||||
* 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
|
||||
* 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
|
||||
@@ -19,82 +19,82 @@
|
||||
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
||||
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
*
|
||||
* Under source code control: 1995/12/02 04:27:41
|
||||
* File existed as early as: 1995
|
||||
* Under source code control: 1995/12/02 04:27:41
|
||||
* File existed as early as: 1995
|
||||
*
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
||||
*/
|
||||
|
||||
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
defaultverbose = 1; /* default verbose value */
|
||||
|
||||
define testi(str, n, N, verbose)
|
||||
{
|
||||
local A, t, i, j, d1, d2;
|
||||
local m;
|
||||
local A, t, i, j, d1, d2;
|
||||
local m;
|
||||
|
||||
if (isnull(verbose)) verbose = defaultverbose;
|
||||
if (verbose > 0) {
|
||||
print str:":",:;
|
||||
}
|
||||
if (isnull(N))
|
||||
N = 1e6;
|
||||
mat A[n,n];
|
||||
for (i = 0; i < n; i++)
|
||||
for (j = 0; j < n; j++)
|
||||
A[i,j] = rand(-N, N);
|
||||
t = runtime();
|
||||
d1 = det(A);
|
||||
t = runtime() - t;
|
||||
d2 = det(A^2);
|
||||
if (d2 != d1^2) {
|
||||
if (verbose > 0) {
|
||||
printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1);
|
||||
}
|
||||
return 1; /* error */
|
||||
} else {
|
||||
if (verbose > 0) {
|
||||
printf("no errors\n");
|
||||
}
|
||||
if (verbose > 1) {
|
||||
printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t);
|
||||
}
|
||||
}
|
||||
return 0; /* ok */
|
||||
if (isnull(verbose)) verbose = defaultverbose;
|
||||
if (verbose > 0) {
|
||||
print str:":",:;
|
||||
}
|
||||
if (isnull(N))
|
||||
N = 1e6;
|
||||
mat A[n,n];
|
||||
for (i = 0; i < n; i++)
|
||||
for (j = 0; j < n; j++)
|
||||
A[i,j] = rand(-N, N);
|
||||
t = runtime();
|
||||
d1 = det(A);
|
||||
t = runtime() - t;
|
||||
d2 = det(A^2);
|
||||
if (d2 != d1^2) {
|
||||
if (verbose > 0) {
|
||||
printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1);
|
||||
}
|
||||
return 1; /* error */
|
||||
} else {
|
||||
if (verbose > 0) {
|
||||
printf("no errors\n");
|
||||
}
|
||||
if (verbose > 1) {
|
||||
printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t);
|
||||
}
|
||||
}
|
||||
return 0; /* ok */
|
||||
}
|
||||
|
||||
define testr(str, n, N, verbose)
|
||||
{
|
||||
local A, t, i, j, d1, d2;
|
||||
local A, t, i, j, d1, d2;
|
||||
|
||||
if (isnull(verbose)) verbose = defaultverbose;
|
||||
if (verbose > 0) {
|
||||
print str:":",:;
|
||||
}
|
||||
if (isnull(N))
|
||||
N = 1e6;
|
||||
mat A[n,n];
|
||||
for (i = 0; i < n; i++)
|
||||
for (j = 0; j < n; j++)
|
||||
A[i,j] = rand(-(N^2), N^2)/rand(1, N);
|
||||
t = usertime();
|
||||
d1 = det(A);
|
||||
t = usertime() - t;
|
||||
d2 = det(A^2);
|
||||
if (d2 != d1^2) {
|
||||
if (verbose > 0) {
|
||||
printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1);
|
||||
}
|
||||
return 1; /* error */
|
||||
} else {
|
||||
if (verbose > 0) {
|
||||
printf("no errors\n");
|
||||
}
|
||||
if (verbose > 1) {
|
||||
printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t);
|
||||
}
|
||||
}
|
||||
return 0; /* ok */
|
||||
if (isnull(verbose)) verbose = defaultverbose;
|
||||
if (verbose > 0) {
|
||||
print str:":",:;
|
||||
}
|
||||
if (isnull(N))
|
||||
N = 1e6;
|
||||
mat A[n,n];
|
||||
for (i = 0; i < n; i++)
|
||||
for (j = 0; j < n; j++)
|
||||
A[i,j] = rand(-(N^2), N^2)/rand(1, N);
|
||||
t = usertime();
|
||||
d1 = det(A);
|
||||
t = usertime() - t;
|
||||
d2 = det(A^2);
|
||||
if (d2 != d1^2) {
|
||||
if (verbose > 0) {
|
||||
printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1);
|
||||
}
|
||||
return 1; /* error */
|
||||
} else {
|
||||
if (verbose > 0) {
|
||||
printf("no errors\n");
|
||||
}
|
||||
if (verbose > 1) {
|
||||
printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t);
|
||||
}
|
||||
}
|
||||
return 0; /* ok */
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -102,39 +102,39 @@ define testr(str, n, N, verbose)
|
||||
*/
|
||||
define test3300(verbose, tnum)
|
||||
{
|
||||
local N; /* test parameter */
|
||||
local i;
|
||||
local N; /* test parameter */
|
||||
local i;
|
||||
|
||||
/*
|
||||
* set test parameters
|
||||
*/
|
||||
if (isnull(verbose)) {
|
||||
verbose = defaultverbose;
|
||||
}
|
||||
N = 1e6;
|
||||
srand(3300e3300);
|
||||
/*
|
||||
* set test parameters
|
||||
*/
|
||||
if (isnull(verbose)) {
|
||||
verbose = defaultverbose;
|
||||
}
|
||||
N = 1e6;
|
||||
srand(3300e3300);
|
||||
|
||||
/*
|
||||
* test a lot of stuff
|
||||
*/
|
||||
for (i=0; i < 19; ++i) {
|
||||
err += testi(strcat(str(tnum++), ": testi(", str(i), ")"), \
|
||||
i, N, verbose);
|
||||
}
|
||||
for (i=0; i < 9; ++i) {
|
||||
err += testr(strcat(str(tnum++), ": testr(", str(i), ")"), \
|
||||
i, N, verbose);
|
||||
}
|
||||
/*
|
||||
* test a lot of stuff
|
||||
*/
|
||||
for (i=0; i < 19; ++i) {
|
||||
err += testi(strcat(str(tnum++), ": testi(", str(i), ")"), \
|
||||
i, N, verbose);
|
||||
}
|
||||
for (i=0; i < 9; ++i) {
|
||||
err += testr(strcat(str(tnum++), ": testr(", str(i), ")"), \
|
||||
i, N, verbose);
|
||||
}
|
||||
|
||||
/*
|
||||
* test results
|
||||
*/
|
||||
if (verbose > 1) {
|
||||
if (err) {
|
||||
print "***", err, "error(s) found in testall";
|
||||
} else {
|
||||
print "no errors in testall";
|
||||
}
|
||||
}
|
||||
return tnum;
|
||||
/*
|
||||
* test results
|
||||
*/
|
||||
if (verbose > 1) {
|
||||
if (err) {
|
||||
print "***", err, "error(s) found in testall";
|
||||
} else {
|
||||
print "no errors in testall";
|
||||
}
|
||||
}
|
||||
return tnum;
|
||||
}
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user