bcalc_ext.bc

# bcalc_ext.bc -- bash bc wrapper extensions
# jun/2022  by mountaineerbr

# 8 888888888o       ,o888888o.              8 8888888888   `8.`8888.      ,8' 
# 8 8888    `88.    8888     `88.            8 8888          `8.`8888.    ,8'  
# 8 8888     `88 ,8 8888       `8.           8 8888           `8.`8888.  ,8'   
# 8 8888     ,88 88 8888                     8 8888            `8.`8888.,8'    
# 8 8888.   ,88' 88 8888                     8 888888888888     `8.`88888'     
# 8 8888888888   88 8888                     8 8888             .88.`8888.     
# 8 8888    `88. 88 8888                     8 8888            .8'`8.`8888.    
# 8 8888      88 `8 8888       .8'           8 8888           .8'  `8.`8888.   
# 8 8888    ,88'    8888     ,88'            8 8888          .8'    `8.`8888.  
# 8 888888888P       `8888888P'              8 888888888888 .8'      `8.`8888. 
#                                                    
# 8888888 8888888888 8 8888888888   b.             8 
#       8 8888       8 8888         888o.          8 
#       8 8888       8 8888         Y88888o.       8 
#       8 8888       8 8888         .`Y888888o.    8 
#       8 8888       8 888888888888 8o. `Y888888o. 8 
#       8 8888       8 8888         8`Y8o. `Y88888o8 
#       8 8888       8 8888         8   `Y8o. `Y8888 
#       8 8888       8 8888         8      `Y8o. `Y8 
#       8 8888       8 8888         8         `Y8o.` 
#       8 8888       8 888888888888 8            `Yo 
#                                                                           
#    d888888o.    8 8888     ,o888888o.     b.             8    d888888o.   
#  .`8888:' `88.  8 8888  . 8888     `88.   888o.          8  .`8888:' `88. 
#  8.`8888.   Y8  8 8888 ,8 8888       `8b  Y88888o.       8  8.`8888.   Y8 
#  `8.`8888.      8 8888 88 8888        `8b .`Y888888o.    8  `8.`8888.     
#   `8.`8888.     8 8888 88 8888         88 8o. `Y888888o. 8   `8.`8888.    
#    `8.`8888.    8 8888 88 8888         88 8`Y8o. `Y88888o8    `8.`8888.   
#     `8.`8888.   8 8888 88 8888        ,8P 8   `Y8o. `Y8888     `8.`8888.  
# 8b   `8.`8888.  8 8888 `8 8888       ,8P  8      `Y8o. `Y8 8b   `8.`8888. 
# `8b.  ;8.`8888  8 8888  ` 8888     ,88'   8         `Y8o.` `8b.  ;8.`8888 
#  `Y8888P ,88P'  8 8888     `8888888P'     8            `Yo  `Y8888P ,88P' 

### MaxScale - Get the maximum scale from your GNU BC
### BC is currently only 32bit in all cases. 
### The package manager recognizes that it might have to install 32bit libraries for a 64 bit environment, but continue to be 32 bits libraries.
### That is why your maximum scale is always 2147483647 (though is safer to use 2147483647, because by reason of the minus or the decimal symbol in case of negative or decimal operations by reason of the minus and decimal symbol) 1111111111111111111111111111110 bits (check https://github.com/abueesp/mathstuffinc/blob/master/bitscalc.py). 
### If you try to add just 1 bit more, you will get a fatal error 'Out of memory for malloc'.
### Which explain that more memory can't be allocated, even if there is not an overflow because you are running a >32 bits computer.
### If you want to use bc in bash (such as $(echo "scale=2147483646;1/6" | bc) | tee -a division) you will get 'bash: xrealloc: cannot allocate 18446744071562067968 bytes;' (2^31 digits represent A LOT of bytes for a normal 32/64 bits computer memory!) and 'Out of memory malloc' in case you want to assign the value to a variable or simply copy and paste outside bc. However, you can still operate with such a large number inside bc without problems while you don't exceed 2^31 digits. Isn't that awesome?"
#scale=2147483646


/*************************************

   bc program:	scientific_constants.bc
   author:	Steffen Brinkmann
   e-mail:	subcom@users.sourceforge.net
   comments:	- published uner the GPL
		- contains particle masses, basic constants, such as
		  speed of light in the vacuum and the gravitational
		  constant.
		- scale is set to 100

From: http://x-bc.sourceforge.net/scientific_constants_bc.html
*************************************/

scale=100

/* -- I -- particle masses: */

mp       = 1.6726231*10^(-27)   /* proton rest mass in kg */
mn       = 1.6749286*10^(-27)   /* neutron rest mass in kg */
me       = 9.1093897*10^(-31)   /* electron rest mass in kg */

mpev     = 938.28*10^6          /* proton rest mass in eV */
mnev     = 939.57*10^6          /* neutron rest mass in eV */
meev     = .511*10^6            /* electron rest mass in eV */

/* -- II -- general constants: */
c        = 299792458            /* speed of light in the vacuum in m/s */
h        = 6.6260755*10^(-34)   /* Planck constant in Js */
hbar     = 1.05457266*10^(-34)  /* Planck constant divided by 2*pi in Js */
kb       = 1.380658*10^(-23)    /* boltzmann constant in J/K */
ec       = 1.60217733*10^(-19)  /* elementary charge in C */
na       = 6.0221367*10^23      /* avogadro number in 1/mol */
epsilon0 = 8.854187817*10^(-12) /* dielectric constant in C^2/Jm */
mu0      = 12.566370614         /* permeability of vacuum in T^2*m^3/J */
alpha    = .00729735307         /* fine structure constant */
mub      = 9.2740154*10^(-24)   /* Bohr magneton J/T */
mun      = 5.0507866*10^(-27)   /* nuclear magneton J/T */
ge       = 2.002319304386       /* free electron g factor */
gammae   = 1.7608592*10^11      /* free electron gyromagnetic ratio in T/s */
mue      = -9.2847701*10^(-24)  /* electron magnetic moment */
gammap   = 2.67515255*10^8      /* proton gyromagnetic ratio in water in T/s */
mup      = 1.41060761*10^(-26)  /* proton magnetic moment in J/T */
amu      = 1.66057*10^(-27)     /* atomic mass unit in kg */
a0       = 5.29177*10^(-11)     /* Bohr radius in m */
re       = 2.81792*10^(-15)     /* electron radius in m */
vmol     = 22.41383             /* molar volume in l/mol */
gh       = 5.585                /* proton g factor (lande factor) */
grav     = 6.673*10^(-11)       /* gravitational constant m^3/kg*s^2 */
g        = 9.80665              /* acceleration due to gravity on surface of earth in m/s^2 */
lambdac  = 2.42631*10^(-12)     /* compton wavelength of the electron m */
#!/usr/bin/bc

# bc integer functions I've found useful
# while systems programming in the unix environment.

# License: LGPLv2
# Author:
#    http://www.pixelbeat.org/
# Notes:
#    I only use bc when python is not available.
#    Personally I have this file in ~/bin/bc so
#    that I can just invoke bc as normal and have these
#    extra functions available.
# Changes:
#    V0.1, 11 Apr 2007, Initial release


define min(x,y) {
    if (x<y) return x
    return y
}

define max(x,y) {
    if (x>y) return x
    return y
}

define abs(x) {
    if (x<0) return -x
    return x
}

/* take integer part */
define int(x) {
    auto old_scale   /* variables global by default */
    old_scale=scale  /* scale is global */
    scale=0; ret=x/1
    scale=old_scale
    return ret
}

/* round to nearest integer */
define round(x) {
    if (x<0) x-=.5 else x+=.5
    return int(x)
}

/* smallest integer >= arg */
define ceil(x) {
    auto intx
    intx=int(x)
    if (intx<x) intx+=1
    return intx
}

/* largest integer <= arg */
define floor(x) {
    return -ceil(-x)
}

/* round x to previous multiple of y */
define round_down(x,y) {
    return y*floor(x/y)
}

/* round x to next multiple of y */
define round_up(x,y) {
    return y*ceil(x/y)
}

/* round x to nearest multiple of y */
define round_to(x,y) {
    return y*round(x/y)
}

/* Greatest Common Divisor or Highest Common Factor of x and y */
/* Note when people say Lowest Common Denominator they usually mean this */
define gcd(x,y) {
     if (y==0) return x
     return gcd(y,x%y) /* anything that divides into x and y also divides into the remainder of x/y */
}

/* Lowest Common Multiple of x and y */
/* Lowest Common Denominator of fractions is LCM of the denominators */
define lcm(x,y) {
    return (x*y/gcd(x,y))
}
/********************************

  bc program:	extensions.bc
  author:	Steffen Brinkmann   
  e-mail:	s.z.s@web.de
  comments:	- published under the GPL
		- contains functions of trigonometry, exponential functions,
		  functions of number theory and some mathematical constants
		  so far.
From: http://x-bc.sourceforge.net/extensions_bc.html
*********************************/
/*
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program 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 Library General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 */
/***********************************************
--I--	constants
1.-	pi			:	defined as 4*atan(1)
2.-	e			:	defined as e(1)

--II--	trigonometry:
1.-	sin(x)			:	returns sine of x
2.-	cos(x)  		:	returns cosine of x
3.-	atan(x) 		:	returns arc tangent of x
4.-	tan(x)  		:	returns tangent of x
5.-	asin(x) 		:	returns arc sine of x
6.-	acos(x) 		:	returns arc cosine of x
7.-	cot(x)			:	returns cotangent of x
8.-	acot(x)			:	returns arc cotangent of x
9.-	sec(x)			:	returns secans of x	
10.-	cosec(x),csc(x)		:	returns cosecans of x
11.-	asec(x)			:	returns arc secans of x
12.-	acosec(x),ascs(x)	:	returns arc cosecans of x
13.-	sinh(x)			:	returns hyperbolical sine of x
14.-	cosh(x)			:	returns hyperbolical cosine of x
15.-	tanh(x)			:	returns hyperbolical tangent of x
16.-	coth(x)			:	returns hyperbolical cotangent of x
17.-	asinh(x)		:	returns arc hyperbolical sine of x
18.-	acosh(x)		:	returns arc hyperbolical cosine of x
19.-	atanh(x)		:	returns arc hyperbolical tangent of x
20.-	acoth(x)		:	returns arc hyperbolical cotangent of x
21.-	sech(x)			:	returns secans hyperbolicus of x
22.-	cosech(x),csch(x)	:	returns cosecans hyperbolicus of x
23.-	asech(x)		:	returns arc secans hyperbolicus of x
24.-	acosech(x),acsch(x)	:	returns arc cosecans hyperbolicus of x
	

--II--	exponential functions:
1.-	ln(x)			:	returns natural logarithm of x
2.-	log(x)			:	returns logarithm (base 10) of x
3.-	lb(x),ld(x)		:	returns logarithm (base 2) of x
4.-	pow(x,y)		:	returns x to the power of y

--III-- number theory:
1.-	abs(n)			:	returns absolute value of n
2.-	mod(a,b)		:	returns a modulo b
3.-	factorize(n),fac(n)	:	prints primefactors of n,
							returns number of primefactors
							returns 0 if n is a prime number
							returns -1 if n is +-1 or 0
							CAUTION: 13-digit number may need 30 s
4.-	factorial(n),f(n)	:	returns n factorial
5.-	gcd(a,b)		:	returns the greatest common divisor of a and b
6.-	lcm(a,b)		:	returns the least common multiple of a and b
7.- bessel(n,x)		:	returns the Bessel function order n of x
************************************************/

pi=4*a(1)

e=e(1)

define sin(x)
{
	return (s(x))
}

define cos(x)
{
	return (c(x))
}

define atan(x)
{
	return (a(x))
}

define tan(x)
{
	return (s(x)/c(x))
}

define asin(x)
{
	if(x==1) return(pi/2)
	if(x==-1) return(-pi/2)
	return(a(x/sqrt(1-(x^2))))
}

define acos(x)
{
	if(x==1) return(0)
	if(x==-1) return(pi)
	return(pi/2-a(x/sqrt(1-(x^2))))
}

define cot(x)
{
	return(c(x)/s(x))
}

define acot(x)
{
	return(pi/2-a(x))
}

define sec(x)
{
	return(1/c(x))
}

define cosec(x)
{
	return(1/s(x))
}

define csc(x)
{
	return(1/s(x))
}
define asec(x)
{
	return(acos(1/x))
}

define acosec(x)
{
	return(asin(1/x))
}

define acsc(x)
{
	return(asin(1/x))
}

define sinh(x)
{
	return((e(x)-e(-x))/2)
}

define cosh(x)
{
	return((e(x)+e(-x))/2)
}

define tanh(x)
{
	return((e(x)-e(-x))/e(x)+e(-x))
}

define coth(x)
{
	return((e(x)+e(-x))/e(x)-e(-x))	
}

define asinh(x)
{
	return(l(x + sqrt(x^2 + 1)))
}

define acosh(x)
{
	return(l(x + sqrt(x^2 - 1)))
}

define atanh(x)
{
	return((l(1 + x) - l(1 - x))/2)
}

define acoth(x)
{
	return(atanh(1/x))
}

define sech(x)
{
	return(1/cosh(x))
}

define cosech(x) 
{
	return(1/sinh(x))
}

define csch(x)
{
	return(1/sinh(x))
}

define asech(x)
{
	return(acosh(1/x))
}

define acosech(x)
{
	return(asinh(1/x))
}

define acsch(x)
{
	return(asinh(1/x))
}

/************************/

define ln(x)
{
	return(l(x))
}

define log(x)
{
	return(l(x)/l(10))
}

define lb(x)
{
	return(l(x)/l(2))
}

define ld(x)
{
	return(lb(x))
}

define pow(x,y)
{
	return(e(y*l(x)))
}

/************************/

define abs(n){
	if(n>=0) return(n)
	return(-n)
}

define mod(a,b){
	auto c,tmp_scale
	tmp_scale=scale(sqrt(2))
	scale=0
	c=a%b
	scale=tmp_scale
	if(a>=0) return(c)
	if(c==0) return(0)
        return(c+b)	
}

define fac(n)
{
	auto tmp,i,factors
	
	if(abs(n)<=1) 
	{
	print abs(n),"\nnumber of factors: "
	return(0)
	}

	if(abs(n)==2) 
	{
	print 2,"\nnumber of factors: "
	return(1)
	}

	tmp=n
	
	while(mod(tmp,2)==0)
	{
		print 2," "
		tmp/=2
		factors+=1
	}

	if(prime[0]==2)		/*primenumbers.bc is loaded*/
	{
		i=0
		
		while((prime[i]*prime[i])<=(n+1))
		{
			if(mod(tmp,prime[i])==0)
			{
			print prime[i]," "
 			tmp/=prime[i]
			factors+=1
			}else{
			i+=1
			if(i>65535)
			{
				break
			}
			}
		}
	}
	
	if(i>65535)
	{
		i=prime[65535]
	}else
	{
		i=3
	}

	while((i*i)<=(n+1))
	{
		if(mod(tmp,i)==0)
		{
		print i," "
		tmp/=i
		factors+=1
		}else{
		i+=2
		}
	}

	if(tmp!=1) 
	{
		factors+=1
		print tmp," " /*BUG: prints zeros after factor*/
	}
	print "\n"
	print "number of factors: "

	return(factors)
}

define factorize(n)
{
	return (fac(n))
}

define f(n)
{
	if (n <= 1) return (1);
	return (f(n-1) * n);
}

define factorial(n)
{
	return(f(n))
}

define gcd(m,n){
	auto a,b,c,tmp_scale
	a=abs(m)         /* a=r[0] */ 
	if(n==0) return(a)
        b=abs(n)         /* b=r[1] */ 
	/*tmp_scale=scale(sqrt(2))*/
        /*c=a%b            /* c=r[2]=r[0] mod(r[1]) */ 
	c=mod(a,b)
        while(c>0){
		a=b
                b=c
                /*(c=a%b    /* c=r[j]=r[j-2] mod(r[j-1]) */
		c=mod(a,b)
        }
	/*scale=tmp_scale*/
	return(b)
}   

define lcm(a,b){
	auto g
	g=gcd(a,b)
	if(g==0) return(0)
	return(abs(a*b)/g)
}

define bessel(n,x){
	return(j(n,x))
}
#!/usr/local/bin/bc -l

### Funcs.BC - a large number of functions for use with GNU BC

  ## Not to be regarded as suitable for any purpose
  ## Not guaranteed to return correct answers

scale=50;
define pi() {
  auto s;
  if(scale==(s=scale(pi_)))return pi_
  if(scale<s)return pi_/1
  scale+=5;pi_=a(1)*4;scale-=5
  return pi_/1
}
e = e(1);
define phi(){return((1+sqrt(5))/2)} ; phi = phi()
define psi(){return((1-sqrt(5))/2)} ; psi = psi()

# Reset base to ten
obase=ibase=A;

## Integer and Rounding

# Round to next integer nearest 0:  -1.99 -> 1, 0.99 -> 0
define int(x)   { auto os;os=scale;scale=0;x/=1;scale=os;return(x) } 

# Round down to integer below x
define floor(x) {
  auto os,xx;os=scale;scale=0
  xx=x/1;if(xx>x).=xx--
  scale=os;return(xx)
}

# Round up to integer above x
define ceil(x) {
  auto os,xx;x=-x;os=scale;scale=0
  xx=x/1;if(xx>x).=xx--
  scale=os;return(-xx)
}

# Fractional part of x:  12.345 -> 0.345
define frac(x) {
  auto os,xx;os=scale;scale=0
  xx=x/1;if(xx>x).=xx--
  scale=os;return(x-xx)
}

# Absolute value of x
define abs(x) { if(x<0)return(-x)else return(x) }

# Sign of x
define sgn(x) { if(x<0)return(-1)else if(x>0)return(1);return(0) }

# Round x up to next multiple of y
define round_up(  x,y) { return(y*ceil( x/y )) }

# Round x down to previous multiple of y
define round_down(x,y) { return(y*floor(x/y )) }

# Round x to the nearest multiple of y
define round(     x,y) {
  auto os,oib;
  os=scale;oib=ibase
  .=scale++;ibase=A
    y*=floor(x/y+.5)
  ibase=oib;scale=os
  return y
}

# Find the remainder of x/y
define int_remainder(x,y) {
  auto os;
  os=scale;scale=0
   x/=1;y/=1;x%=y
  scale=os
  return(x)
}
define remainder(x,y) {
  os=scale;scale=0
   if(x==x/1&&y==y/1){scale=os;return int_remainder(x,y)}
  scale=os
  return(x-round_down(x,y))
}

# Greatest common divisor of x and y
define int_gcd(x,y) {
  auto r,os;
  os=scale;scale=0
  x/=1;y/=1
  while(y>0){r=x%y;x=y;y=r}
  scale=os
  return(x)
}
define gcd(x,y) {
  auto r,os;
  os=scale;scale=0
   if(x==x/1&&y==y/1){scale=os;return int_gcd(x,y)}
  scale=os
  while(y>0){r=remainder(x,y);x=y;y=r}
  return(x)
}

# Lowest common multiple of x and y
define int_lcm(x,y) {
  auto r,m,os;
  os=scale;scale=0
  x/=1;y/=1
  m=x*y
  while(y>0){r=x%y;x=y;y=r}
  m/=x
  scale=os
  return(m)
}
define lcm(x,y) { return (x*y/gcd(x,y)) }

# Remove largest possible power of 2 from x
define oddpart(x){
  auto os;
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 1}
  while(!x%2)x/=2
  scale=os;return x
}

# Largest power of 2 in x
define evenpart(x) {
  auto os;
  os=scale;scale=0
  x/=oddpart(x/1)
  scale=os;return x
}

## Trig / Hyperbolic Trig

# Sine
define sin(x) { return s(x) } # alias for standard library
# Cosine
define c(x)   { return s(x+pi()/2) } # as fast or faster than
define cos(x) { return c(x)        } # . standard library
# Tangent
define tan(x)   { auto c;c=c(x);if(c==0)c=A^-scale;return(s(x)/c) }

# Secant
define sec(x)   { auto c;c=c(x);if(c==0)c=A^-scale;return(   1/c) }
# Cosecant
define cosec(x) { auto s;s=s(x);if(s==0)s=A^-scale;return(   1/s) }
# Cotangent
define cotan(x) { auto s;s=s(x);if(s==0)s=A^-scale;return(c(x)/s) }

# Arcsine
define arcsin(x) { if(x==-1||x==1)return(pi()/2*x);return( a(x/sqrt(1-x*x)) ) } 
# Arccosine
define arccos(x) { if(x==0)return(0);return pi()/2-arcsin(x) }

# Arctangent (one argument)
define arctan(x)  { return a(x) } # alias for standard library

# Arctangent (two arguments)
define arctan2(x,y) { 
  auto p;
  if(x==0&&y==0)return(0)
  p=(1-sgn(y))*pi()*(2*(x>=0)-1)/2
  if(x==0||y==0)return(p)
  return(p+a(x/y))
}

# Arcsecant
define arcsec(x)      { return( a(x/sqrt(x*x-1)) ) }
# Arccosecant
define arccosec(x)    { return( a(x/sqrt(x*x-1))+pi()*(sgn(x)-1)/2 ) }
# Arccotangent (one argument)
define arccotan(x)    { return( a(x)+pi()/2 ) }
# Arccotangent (two arguments)
define arccotan2(x,y) { return( arctan(x,y)+pi()/2 ) }

# Hyperbolic Sine
define sinh(x) { auto t;t=e(x);return((t-1/t)/2) }
# Hyperbolic Cosine
define cosh(x) { auto t;t=e(x);return((t+1/t)/2) }
# Hyperbolic Tangent
define tanh(x) { auto t;t=e(x+x)-1;return(t/(t+2)) }

# Hyperbolic Secant
define sech(x)   { auto t;t=e(x);return(2/(t+1/t)) }
# Hyperbolic Cosecant
define cosech(x) { auto t;t=e(x);return(2/(t-1/t)) }
# Hyperbolic Cotangent
define coth(x)   { auto t;t=e(x+x)-1;return((t+2)/t) }

# Hyperbolic Arcsine
define arcsinh(x) { return( l(x+sqrt(x*x+1)) ) }
# Hyperbolic Arccosine
define arccosh(x) { return( l(x+sqrt(x*x-1)) ) }
# Hyperbolic Arctangent
define arctanh(x) { return( l((1+x)/(1-x))/2 ) }

# Hyperbolic Arcsecant
define arcsech(x)   { return( l((sqrt(1-x*x)+1)/x) ) }
# Hyperbolic Arccosecant
define arccosech(x) { return( l((sqrt(1+x*x)*sgn(x)+1)/x) ) }
# Hyperbolic Arccotangent
define arccoth(x)   { return( l((x+1)/(x-1))/2 ) }

# Length of the diagonal vector (0,0)-(x,y) [pythagoras]
define pyth(x,y) { return(sqrt(x*x+y*y)) }
define pyth3(x,y,z) { return(sqrt(x*x+y*y+z*z)) }

# Gudermannian Function
define gudermann(x)    { return 2*(a(e(x))-a(1)) }
# Inverse Gudermannian Function
define arcgudermann(x) {
  return arctanh(s(x))
}

# Bessel function
define besselj(n,x) { return j(n,x) } # alias for standard library

## Exponential / Logs

# Exponential e^x
define exp(x) { return e(x) } # alias for standard library

# Natural Logarithm (base e)
define ln(x) {
  auto os,len,ln;
  if(x< 0){print "ln error: logarithm of a negative number\n";return 0}
  if(x==0)print "ln error: logarithm of zero; negative infinity\n"
  len=length(x)-scale(x)-1
  if(len<A)return l(x);
  os=scale;scale+=length(len)+1
  ln=l(x/A^len)+len*l(A)
  scale=os
  return ln/1
} # speed improvement on standard library

# workhorse function for pow and log - new, less clever version
# Helps determine whether a fractional power is legitimate for a negative number
# . expects to be fed a positive value
# . returns -odd for even/odd; odd2 for odd1/odd2;
#           even for odd/even;   -2 for irrational
# . note that the return value is the denominator of the fraction if the
#   fraction is rational, and the sign of the return value states whether
#   the numerator is odd (positive) or even (negative)
# . since even/even is not possible, -2 is used to signify irrational
define id_frac2_(y){
  auto os,oib,es,eps,lim,max,p,max2,i,cf[],f[],n,d,t;
  os=scale
  if(cf_max){
    # cf.bc is present!
    .=cf_new(cf[],y);if(scale(cf[0]))return -2;
    .=frac_from_cf(f[],cf[],1)
    d=f[0];scale=0;if(f[1]%2==0)d=-d;scale=os
   return d
  }
  oib=ibase;ibase=A
  scale=0
   es=3*os/4
  scale=os
   eps=A^-es
   y+=eps/A
  scale=es
   y/=1
  scale=0
  if(y<0)y=-y
  d=y-(n=y/1)
  if(d<eps){t=2*(n%2)-1;scale=os;ibase=oib;return t}#integers are x/1
  t=y/2;t=y-t-t
  # Find numerator and denominator of fraction, if any
  lim=A*A;max2=A^5*(max=A^int(os/2));p=1
  i=0;y=t
  while(1) {
    scale=es;y=1/y;scale=0
    y-=(t=cf[++i]=y/1);p*=1+t
    if(i>lim||(max<p&&p<max2)){cf[i=1]=-2;break}#escape if number seems irrational    
    if((p>max2||3*length(t)>es+es)&&i>1){cf[i--]=0;break}#cheat: assume rational
    if(y==0)break;#completely rational
  }
  n=1;d=cf[i]
  if(i==0){print "id_frac2_: something is wrong; y=",y,", d=",d,"\n"}
  if(d!=-2&&i)while(--i){d=n+cf[i]*(t=d);n=t}
  if(d<A^os){d*=2*(n%2)-1}else{d=-2}
  scale=os;ibase=oib
  return d;
}

# raise x to integer power y faster than bc's x^y
# . it seems bc (at time of writing) uses
# . an O(n) repeated multiplication algorithm
# . for the ^ operator, which is inefficient given
# . that there is a simple O(log n) alternative:
define fastintpow__(x,y) {
  auto r,hy;
  if(y==0)return(1)
  if(y==1)return(x)
  r=fastintpow__(x,hy=y/2)
  r*=r;if(hy+hy<y)r*=x
  return( r )
}
define fastintpow_(x,y) {
  auto ix,os;
  if(y<0)return fastintpow_(1/x,-y)
  if(y==0)return(1)
  if(y==1)return(x)
  if(x==1)return(1)
  os=scale;scale=0
  if(x==-1){y%=2;y+=y;scale=os;return 1-y}
  # bc is still faster for integers
  if(x==(ix=x/1)){scale=os;return ix^y}
  # ...and small no. of d.p.s, but not for values <= 2
  if(scale(x)<3&&x>2){scale=os;return x^y}
  scale=os;x/=1;scale=0
  x=fastintpow__(x,y);
  scale=os;return x;
}

# Raise x to a fractional power faster than e^(y*l(x))
define fastfracpow_(x,y) {
  auto f,yy,inv;
  inv=0;if(y<0){y=-y;inv=1}
  y-=int(y)
  if(y==0)return 1;
  if((yy=y*2^C)!=int(yy)){x=l(x);if(inv)x=-x;return e(y/1*x)}
  # faster using square roots for rational binary fractions
  # where denominator <= 8192
  x=sqrt(x)
  for(f=1;y&&x!=1;x=sqrt(x))if(y+=y>=1){.=y--;f*=x}
  if(inv)f=1/f;
  return f;
}

# Find the yth root of x where y is integer
define fastintroot_(x,y) {
  auto os,d,r,ys,eps;
  os=scale;scale=0;y/=1;scale=os
  if(y<0){x=1/x;y=-y}
  if(y==1){return x}
  if(y>=x-1){return fastfracpow_(x,1/y)}
  if(y*int((d=2^F)/y)==d){
    r=1;while(r+=r<=y)x=sqrt(x)
    return x
  }
  scale=length(y)-scale(y);if(scale<5)scale=5;r=e(ln(x)/y)
  scale=os+5;if(scale<5)scale=5
  d=1;eps=A^(3-scale)
  ys=y-1
  while(d>eps){
    d=r;r=(ys*r+x/fastintpow_(r,ys))/y
    d-=r;if(d<0)d=-d
  }
  scale=os
  return r/1
}

# Raise x to the y-th power
define pow(x,y) {
 auto os,p,ix,iy,fy,dn,s;
 if(y==0) return 1
 if(x==0) return 0
 if(0<x&&x<1){x=1/x;y=-y}
 os=scale;scale=0
  ix=x/1;iy=y/1;fy=y-iy;dn=0
 scale=os;#scale=length(x/1)
 if(y!=iy&&x<0){
   dn=id_frac2_(y)# -ve implies even numerator
   scale=0;if(dn%2){# odd denominator
     scale=os
     if(dn<0)return  pow(-x,y) # even/odd
     /*else*/return -pow(-x,y) #  odd/odd
   }
   print "pow error: "
   if(dn>0) print "even root"
   if(dn<0) print "irrational power"
   print " of a negative number\n"
   scale=os;return 0
 }
 if(y==iy) {
   if(x==ix){p=fastintpow_(ix,iy);if(iy>0){scale=0;p/=1};scale=os;return p/1}
   scale+=scale;p=fastintpow_(x,iy);scale=os;return p/1
 }
 if((dn=id_frac2_(y))!=-2){ #accurate rational roots (sometimes slower)
   if(dn<0)dn=-dn
   s=1;if(y<0){y=-y;s=-1}
   p=y*dn+1/2;scale=0;p/=1;scale=os
   if(p<A^3)x=fastintpow_(x,p)
   x=fastintroot_(x,dn)
   if(p>=A^3)x=fastintpow_(x,p)
   if(s<0)x=1/x
   return x
 }
 p=fastintpow_(ix,iy)*fastfracpow_(x,fy);
 scale=os+os
 if(ix)p*=fastintpow_(x/ix,iy)
 scale=os
 return p/1
 #The above is usually faster and more accurate than
 # return( e(y*l(x)) );
}

# y-th root of x [ x^(1/y) ]
define root(x,y) {
  return pow(x,1/y)
}

# Specific cube root function
# = stripped down version of fastintroot_(x,3)
define cbrt(x) {
  auto os,d,r,eps;
  if(x<0)return -cbrt(-x)
  if(x==0)return 0
  os=scale;scale=0;eps=A^(scale/3)
  if(x<eps){scale=os;return 1/cbrt(1/x)}
  scale=5;r=e(ln(x)/3)
  scale=os+5;if(scale<5)scale=5
  d=1;eps=A^(3-scale)
  while(d>eps){
    d=r;r=(r+r+x/(r*r))/3
    d-=r;if(d<0)d=-d
  }
  scale=os
  return r/1
}

# Logarithm of x in given base:  log(2, 32) = 5 because 2^5 = 32
#  tries to return a real answer where possible when given negative numbers
#  e.g.     log(-2,  64) = 6 because (-2)^6 =   64
#  likewise log(-2,-128) = 7 because (-2)^7 = -128
define log(base,x) {
  auto os,i,l,sx,dn,dnm2;
  if(base==x)return 1;
  if(x==0){print "log error: logarithm of zero; negative infinity\n";     return  l(0)}
  if(x==1)return 0;
  if(base==0){print "log error: zero-based logarithm\n";                  return    0 }
  if(base==1){print "log error: one-based logarithm; positive infinity\n";return -l(0)}
  scale+=6
  if((-1<base&&base<0)||(0<base&&base<1)){x=-log(1/base,x);scale-=6;return x/1}
  if((-1<x   &&   x<0)||(0<x   &&   x<1)){x=-log(base,1/x);scale-=6;return x/1}
  if(base<0){
    sx=1;if(x<0){x=-x;sx=-1}
    l=log(-base,x)
    dn=id_frac2_(l)
    os=scale;scale=0;dnm2=dn%2;scale=os
    if(dnm2&&dn*sx<0){scale-=6;return l/1}
    print "log error: -ve base: "
    if(dnm2)print "wrong sign for "
    print "implied "
    if(dnm2)print "odd root/integer power\n"
    if(!dnm2){
      if(dn!=-2)print "even root\n"
      if(dn==-2)print "irrational power\n"
    }
    scale-=6;return 0;
  }
  if(x<0){
    print "log error: +ve base: logarithm of a negative number\n"
    scale-=6;return 0;
  }
  x=ln(x)/ln(base);scale-=6;return x/1
}

# Integer-only logarithm of x in given base
# (compare digits function in digits.bc)
define int_log(base,x) { 
 auto os,p,c;
 if(0<x&&x<1) {return -int_log(base,1/x)}
 os=scale;scale=0;base/=1;x/=1
  if(base<2)base=ibase;
  if(x==0)    {scale=os;return  1-base*A^os}
  if(x<base)  {scale=os;return  0    }
  c=length(x) # cheat and use what bc knows about decimal length
  if(base==A){scale=os;return c-1}
  if(base<A){if(x>A){c*=int_log(base,A);c-=2*(base<4)}else{c=0}}else{c/=length(base)+1}
  p=base^c;while(p<=x){.=c++;p*=base}
  scale=os;return(c-1)
}

# Lambert's W function 0 branch; Numerically solves w*e(w) = x for w
# * is slow to converge near -1/e at high scales
define lambertw0(x) {
  auto oib, a, b, w, ow, lx, ew, e1, eps;
  if(x==0) return 0;
  oib=ibase;ibase=A
  ew = -e(-1)
  if (x<ew) {
    print "lambertw0: expected argument in range [-1/e,oo)\n"
    ibase=oib
    return -1
  }
  if (x==ew) {ibase=oib;return -1}
  # First approximation from :
  #   http://www.desy.de/~t00fri/qcdins/texhtml/lambertw/
  #   (A. Ringwald and F. Schrempp)
  # via Wikipedia
  if(x < 0){
    w = x/ew
  } else if(x < 500){
    lx=l(x+1);w=0.665*(1+0.0195*lx)*lx+0.04
  } else if((lx=length(x)-scale(x))>5000) {
    lx*=l(A);w=lx-(1-1/lx)*l(lx)
  } else {
    lx=l(x);w=l(x-4)-(1-1/lx)*l(lx)
  } 
  # Iteration adapted from code found on Wikipedia
  #   apparently by an anonymous user at 147.142.207.26
  #   and later another at 87.68.32.52
  ow = 0
  eps = A^-scale
  scale += 5
  e1 = e(1)
  while(abs(ow-w)>eps&&w>-1){
    ow = w
    if(x>0){ew=pow(e1,w)}else{ew=e(w)}
    a = w*ew
    b = a+ew
    a -= x;
    if(a==0)break
    b = b/a - 1 + 1/(w+1)
    w -= 1/b
    if(x<-0.367)w-=eps
  }
  scale -= 5
  ibase=oib
  return w/1
}

# Lambert's W function -1 branch; Numerically solves w*e(w) = x for w
# * is slow to converge near -1/e at high scales
define lambertw_1(x) {
  auto oib,os,oow,ow,w,ew,eps,d,iters;
  oib=ibase;ibase=A
  ew = -e(-1)
  if(ew>x||x>=0) {
    print "lambertw_1: expected argument in [-1/e,0)\n"
    ibase=oib
    if(x==0)return 1-A^scale
    if(x>0)return 0
    return -1
  }
  if(x==ew) return -1;
  os=scale
  eps=A^-os
  scale+=3
  oow=ow=0
  w=x
  w=l(-w)
  w-=l(-w)
  w+=sqrt(eps)
  iters=0
  while(abs(ow-w)>eps){
    oow=ow;ow=w
    if(w==-1)break
    w=(x*e(-w)+w*w)/(w+1)
    if(iters++==A+A||oow==w){iters=0;w-=A^-scale;scale+=2}
  }
  scale=os;ibase=oib
  return w/1
}

# LambertW wrapper; takes most useful branch based on x
# to pick a branch manually, use lambertw_1 or lambertw0 directly
define w(x) {
  if(x<0)return lambertw_1(x)
  return lambertw0(x)
}

# Faster calculation of lambertw0(exp(x))
# . avoids large intermediate value and associated slowness
# . numerically solves x = y+ln(y) for y
define lambertw0_exp(x) {
  auto oy,y,eps;
  # Actual calculation is faster for x < 160 or thereabouts
  if(x<C*D)return lambertw0(e(x));
  oy=0;y=l(x);y=x-y+y/x;eps=A^-scale
  while(abs(oy-y)>eps)y=x-l(oy=y)
  return y
}

# Shorthand alias for the above
define w_e(x){ return lambertw0_exp(x) }

# Numerically solve pow(y,y) = x for y
define powroot(x) {
  auto r;
  if(x==0) {
    print "powroot error: attempt to solve for zero\n"
    return 0
  }
  if(x==1||x==-1) {return x}
  if(x<=r=e(-e(-1))){
    print "powroot error: unimplemented for values\n  <0";r
    return 0
  }
  r = ln(x)
  r /= w(r)
  return r
}

## Triangular numbers

# xth triangular number
define tri(x) {
  auto xx
  x=x*(x+1)/2;xx=int(x)
  if(x==xx)return(xx)
  return(x)
}

# 'triangular root' of x
define trirt(x) {
  auto xx
  x=(sqrt(1+8*x)-1)/2;xx=int(x)
  if(x==xx)x=xx
  return(x)
}

# Workhorse for following 2 functions
define tri_step_(t,s) {
  auto tt
  t=t+(1+s*sqrt(1+8*t))/2;tt=int(t)
  if(tt==t)return(tt)
  return(t)
}

# Turn tri(x) into tri(x+1) without knowing x
define tri_succ(t) {
  return(tri_step_(t,0+1))
}

# Turn tri(x) into tri(x-1) without knowing x
define tri_pred(t) {
  return(tri_step_(t,0-1))
}

## Polygonal Numbers

# the xth s-gonal number:
#   e.g. poly(3, 4) = tri(4) = 1+2+3+4 = 10; poly(4, x) = x*x, etc
define poly(s, x) {
  auto xx
  x*=(s/2-1)*(x-1)+1;xx=int(x);if(x==xx)x=xx
  return x
}

# inverse of the above = polygonal root:
#   e.g. inverse_poly(3,x)=trirt(x); inverse_poly(4,x)=sqrt(x), etc
define inverse_poly(s, r) {
  auto t,xx
  t=(s-=2)-2
  r=(sqrt(8*s*r+t*t)+t)/s/2;xx=int(r);if(r==xx)r=xx
  return r
}

# converse of poly(); solves poly(s,x)=r for s
#   i.e. if the xth polygonal number is r, how many sides has the polygon?
#   e.g. if the 5th polygonal number is 15, converse_poly(5,15) = 3
#     so the polygon must have 3 sides! (15 is the 5th triangular number)
define converse_poly(x,r) {
  auto xx
  x=2*((r/x-1)/(x-1)+1);xx=int(x);if(x==xx)x=xx
  return x
}

## Tetrahedral numbers

# nth tetrahedral number
define tet(n) { return n*(n+1)*(n+2)/6 }

# tetrahedral root = inverse of the above
define tetrt(t) {
  auto k,c3,w;
  if(t==0)return 0
  if(t<0)return -2-tetrt(-t)
  k=3^5*t*t-1
  if(k<0){print "tetrt: unimplemented for 0<|t|<sqrt(3^-5)\n"; return 0}
  c3=cbrt(3)
  k=cbrt(sqrt(3*k)+3^3*t)
  return k/c3^2+1/(c3*k)-1
}

## Arithmetic-Geometric mean

define arigeomean(a,b) {
  auto c,s;
  if(a==b)return a;
  s=1;if(a<0&&b<0){s=-1;a=-a;b=-b}
  if(a<0||b<0){print "arigeomean: mismatched signs\n";return 0}
  while(a!=b){c=(a+b)/2;a=sqrt(a*b);b=c}
  return s*a
}

# solve n = arigeomean(x,y)
define inv_arigeomean(n, y){
  auto ns,ox,x,b,c,d,i,s,eps;
  if(n==y)return n;
  s=1;if(n<0&&y<0){s=-1;n=-n;y=-y}
  if(n<0||y<0){print "inv_arigeomean: mismatched signs\n";return 0}  
  if(n<y){x=y;y=n;n=x}
  n/=y
  scale+=2;eps=A^-scale;scale+=4
  ns=scale
  x=n*(1+ln(n));ox=-1
  for(i=0;i<A;i++){
    # try to force quadratic convergence
    if(abs(x-ox)<eps){i=-1;break}
    ox=x;scale+=scale
    b=x+x/n*(n-arigeomean(1,x));
    c=b+b/n*(n-arigeomean(1,b));
    d=b+b-c-x
    if(d){x=(b*b-c*x)/d}else{x=b;i=-1;break}
    scale=ns
  }
  if(i!=-1){
    # give up and converge linearly
    x=(x+ox)/2
    while(abs(x-ox)>eps){ox=x;x+=x/n*(n-arigeomean(1,x))}
  }
  x+=5*eps
  scale-=6;return x*y/s
}
#!/usr/local/bin/bc -l

### Array.BC - tools for managing arrays
###            uses the undocumented pass-by-reference for arrays

max_array_ = 4^8-1

## Conventions used in this library
/*
 * All function names begin with the letter 'a'
 * All array parameters have a double underscore at the end of the name
   since some versions of bc are scope-confused by the undocumented pbr
 * The last letter of function names indicates the type of array parameter(s)
   expected. These are:
   * r  = range; A range of array indices will be provided by the caller and
          the array type is therefore moot.
        * A number before the r suggests different ranges from different
          array parameters.
        * Range-specifying parameters always follow the array parameter.
   * 0  = zero terminated; An element of zero indicates the element after
          the last in the array. First element is always index zero
          Advantage: Functions have the shortest possible parameter lists.
          Disadvantage: Zero can't be used within this type of array.
   * b  = before; All elements before a given sentinel value are treated as
          the array. First element is index zero as for zero terminated.
   * u  = upto; only used for the aprintu function; deliberately displays the
          terminator for arrays that are otherwise zero/sentinel terminated
   * l  = length provided; Array index zero contains the length of the rest
          of the array, putting the first element at index one and the last
          at the index specified by the length.
   * (no last letter) = Array begins at index zero and the length will be
          provided by the function caller
*/
##

## Internal functions ##

# For those functions which use start and end as parameters for a range,
# use POSIX scope to sanitise those variables
define asanerange_() {
  auto t;
  if(start>end){t=start;start=end;end=t}
  if(start<0)start=0;
  if(end>max_array_)end=max_array_;
}
define asanerange2_() {
  auto start,end;
  start=astart;end=aend;.=asanerange_();astart=start;aend=end
  start=bstart;end=bend;.=asanerange_();bstart=start;bend=end
}

## Sorting ##

# Sort a subsection of an array
# . from index 'start' to index 'end' inclusive
define asortr(*a__[],start,end) { # non-recursive run-finding mergesort
  auto r[],b__[],i,j,k,ri,p,p2,ri_p2,m,mn,mid,subend;
  .=asanerange_();
  r[ri=0]=start;
  i=start;while(i<end){
    while(i<end&&a__[j=i]<=a__[++j])i=j
    if(i>r[ri])r[++ri]=++i;
    while(i<end&&a__[j=i]>a__[++j])i=j
    if(i>(k=r[ri])){ # reverse backward runs
      j=i;while(j>k){t=a__[j];a__[j--]=a__[k];a__[k++]=t}
      r[++ri]=++i;
    }
  }
  r[++ri]=++end;
  for(p=1;p<ri;p=p2){
    ri_p2=ri-(p2=p+p)
    for(m=0;m<=ri_p2;m=mn){
      # merge a__[r[m]..r[m+p]-1] with a__[r[m+p]..a[r[m+2p]-1]
      i=r[m];mid=j=r[m+p];subend=r[mn=m+p2];k=0
      while(i<mid&&j<subend)
         if(a__[i]<a__[j]){ b__[k++]=a__[i++]
                     }else{ b__[k++]=a__[j++]}
      while(i<mid          )b__[k++]=a__[i++]
      while(k)a__[--j]=b__[--k]
    }
    if(m<ri){
      # roll in any outlier
      # merge a[r[m-p-p]..a[r[m]-1] with a[r[m]..r[ri]-1]
      i=r[m-p2];mid=j=r[m];k=0
      while(i<mid&&j<end)
         if(a__[i]<a__[j]){b__[k++]=a__[i++]
                     }else{b__[k++]=a__[j++]}
      while(i<mid       )  b__[k++]=a__[i++]
      while(k)a__[--j]=b__[--k]
      r[ri=m]=end
    }
  }
  return 0;
}

define asortr_old(*a__[],start,end) { # plain recursive mergesort
  auto os,i,j,k,t,mid,b__[];
  if(end==start)return 0;
  .=asanerange_();
  if(end-start==1){
    if(a__[start]>a__[end]){t=a__[start];a__[start]=a__[end];a__[end]=t}
    return 0;
  }
  os=scale;scale=0;mid=(start+end)/2;scale=os
  i=start;j=mid+1
  if(i<mid).=asortr_old(a__[],start,mid)
  if(j<end).=asortr_old(a__[],mid+1,end)
  k=0
  while(i<=mid&&j<=end)
     if(a__[i]<a__[j]){b__[k++]=a__[i++]
                 }else{b__[k++]=a__[j++]}
  while(i<=mid        )b__[k++]=a__[i++]
 #while(        j<=end)b__[k++]=a__[j++]
  while(k>0)a__[--j]=b__[--k]
  return 0;
}

# Sort all elements of array before zero terminator
define asort0(*a__[]){
  auto i;
  for(i=0;a__[i];i++){}
  .=asortr(a__[],0,i-1)
}

# Sort all elements of array before given terminator, x
define asortb(*a__[],x){
  auto i;
  for(i=0;a__[i]!=x;i++){}
  .=asortr(a__[],0,i-1);
}

# Sort all elements of array with length in [0]
define asortl(*a__[]){
  .=asortr(a__[],1,a__[0]);
}

# Sort the first n elements of an array
define asort(*a__[],n) { .=asortr(a__[],0,n-1) }

## Unique values / Run length finding ##

# Store values from a in v & how many times they occur together in a run in r
# e.g. if a=={7,8,8,9,9,6,9}, v <- {7,8,9,6,9} and r <- {1,2,2,1,1}
define arunlengthr(*v__[],*r__[], a__[],start,end) {
  auto vri,i,prev;
  .=asanerange_();
  if(end==start)return 0;
  vri=0;prev=v__[vri]=a__[start];r__[vri]=1
  for(i=start+1;i<=end;i++)if(a__[i]==prev){
     .=r__[vri]++
    } else {
      r__[++vri]=1; prev=v__[vri]=a__[i]
    }
  return ++vri
}
define arunlength0(*v__[],*r__[], a__[]) {
  auto vri,i,prev;
  if(!a__[0])return 0;
  vri=0;prev=v__[vri]=a__[0];r__[vri]=1
  for(i=1;i<=max_array_&&a__[i];i++)if(a__[i]==prev){
     .=r__[vri]++
    } else {
      r__[++vri]=1; prev=v__[vri]=a__[i]
    }
  .=vri++
  r__[vri]=v__[vri]=0
  return vri
}
define arunlengthb(*v__[],*r__[], a__[],x) {
  auto vri,i,prev;
  if(a__[0]==x)return 0;
  vri=0;prev=v__[vri]=a__[0];r__[vri]=1
  for(i=1;i<=max_array_&&a__[i]!=x;i++)if(a__[i]==prev){
     .=r__[vri]++
    } else {
      r__[++vri]=1; prev=v__[vri]=a__[i]
    }
  .=vri++
  r__[vri]=v__[vri]=x
  return vri
}
define arunlengthl(*v__[],*r__[], a__[]) {
  auto vri,i,prev;
  if(!a__[0])return 0;
  vri=1;prev=v__[vri]=a__[1];r__[vri]=1
  for(i=2;i<=max_array_&&a__[i]!=x;i++)if(a__[i]==prev){
     .=r__[vri]++
    } else {
      r__[++vri]=1; prev=v__[vri]=a__[i]
    }
  return r__[0]=v__[0]=vri
}
define arunlength(*v__[],*r__[], a__[], n) {
  return arunlengthr(v__[],r__[], a__[],0,n-1)
}

# Fill v with the unique values from a. Works best on a sorted array.
define auniqr(*v__[], a__[],start,end) {
  auto r[];
  return arunlengthr(v__[],r[], a__[],start,end)
}
define auniq0(*v__[], a__[]) {
  auto r[];
  return arunlength0(v__[],r[], a__[])
}
define auniqb(*v__[], a__[],x) {
  auto r[];
  return arunlengthb(v__[],r[], a__[],x)
}
define auniql(*v__[], a__[]) {
  auto r[];
  return arunlengthl(v__[],r[], a__[])
}
define auniq(*v__[], a__[],n) {
  auto r[];
  return arunlengthr(v__[],r[], a__[],0,n-1)
}

## Order reversal ##

# Reverse a subsection of an array
define areverser(*a__[],start,end) {
  auto t;
  .=asanerange_();
  if(end==start)return 0
  while(start<end){t=a__[start];a__[start++]=a__[end];a__[end--]=t}
  return 0;
}

# Reverse order of all elements of array before given terminator, x
define areverseb(*a__[],x){
  auto i;
  for(i=0;a__[i]!=x;i++){}
  .=areverser(a__[],0,i-1);
}

# Reverse order of all elements of array before zero terminator
define areverse0(*a__[]){
  auto i;
  for(i=0;a__[i];i++){}
  .=areverser(a__[],0,i-1)
}

# Reverse order of all elements of array 1 .. a[0]
define areversel(*a__[]) {
  .=areverser(a__[],1,a__[0]);
}

# Reverse the first n elements of an array
define areverse(*a__[],n) { .=areverser(a__[],0,n-1) }

## Copying ##

# Make a__[astart..aend] = b__[bstart..bend]
# . Does not expand a__[] to make room if b__[bstart..bend] is too large!
define acopy2r(*a__[],astart,aend,b__[],bstart,bend){
  auto i,j;
  .=asanerange2_();
  i=astart;j=bstart;while(i<=aend&&j<=bend)a__[i++]=b__[j++]
}

# Make a__[start..end] = b__[start..end]
define acopyr(*a__[],b__[],start,end){
  auto i;
  .=asanerange_();
  for(i=start;i<=end;i++)a__[i]=b__[i]
}

# copy a zero-terminated array; a = b
define acopy0(*a__[],b__[]) {
  auto e,i;
  for(i=0;i<=max_array_&&e=b__[i];i++)a__[i]=e
  if(i<=max_array_)a__[i]=0
}

# copy an x terminated array; a = b
define acopyb(*a__[],b__[],x) {
  auto e,i;
  for(i=0;i<=max_array_&&(e=b__[i])!=x;i++)a__[i]=e
  if(i<=max_array_)a__[i]=x
}

# Copy array whose length is in element [0]
define acopyl(*a__[],b__[]){
  .=acopyr(a__[],b__[],0,a__[0])
}

# Copy first 'count' elements of a from b
define acopy(*a__[],b__[],count){
  auto i;
  if(count<0)count=0;
  if(count>max_array_)count=max_array_+1;
  for(i=0;i<count;i++)a__[i]=b__[i];return 0
}

## Convert between array types ##

define aconv0fromr(*a__[],  b__[],start,end){
  auto i,j;
  .=asanerange_();
  i=0;for(j=start;j<=end;j++)a__[i++]=b__[j]
  a__[i]=0
}
define aconvbfromr(*a__[],x,b__[],start,end){
  auto i,j;
  .=asanerange_();
  i=0;for(j=start;j<=end;j++)a__[i++]=b__[j]
  a__[i]=x
}
define aconvlfromr(*a__[],  b__[],start,end){
  auto i,j;
  .=asanerange_();
  i=1;for(j=start;j<=end;j++)a__[i++]=b__[j]
  a__[0]=end-start+1
}

define aconvrfrom0(*a__[],start,end,b__[]){
  auto i,j;
  .=asanerange_();
  j=0;for(i=start;i<=end&&b__[j];i++)a__[i]=b__[j++]
}
define aconvbfrom0(*a__[],x,        b__[]){
  auto i;
  for(i=0;a__[i]=b__[i];i++){}
  a__[i]=x
}
define aconvlfrom0(*a__[],          b__[]){
  auto i,j;
  i=1;j=0;while(a__[i++]=b__[j++]){}
  a__[0]=j
}

define aconv0fromb(*a__[],          b__[],x){
  auto i;
  for(i=0;(a__[i]=b__[i])!=x;i++){}
  a__[i]=0
}
define aconvrfromb(*a__[],start,end,b__[],x){
  auto i,j;
  .=asanerange_();
  j=0;for(i=start;i<=end&&b__[j]!=x;i++)a__[i]=b__[j++]
}
define aconvlfromb(*a__[],          b__[],x){
  auto i,j;
  i=1;j=0;while((a__[i++]=b__[j++])!=x){}
  a__[0]=j
}

define aconvrfroml(*a__[],start,end,b__[]){
  auto i,j;
  .=asanerange_();
  j=1;for(i=start;i<=end&&j<=b__[0];i++)a__[i]=b__[j++]
}
define aconv0froml(*a__[],          b__[]){
  auto i,j;
  i=0;j=1;while(j<=b__[0])a__[i++]=b__[j++];
  a__[i]=0;
}
define aconvbfroml(*a__[],x,        b__[]){
  auto i,j;
  i=0;j=1;while(j<=b__[0])a__[i++]=b__[j++];
  a__[i]=x;
}

## Copy in a small number of elements ##

define aset8(*a__[],start,a,b,c,d,e,f,g,h){
  auto b[];
  b[0]=a;b[1]=b;b[2]=c;b[3]=d
  b[4]=e;b[5]=f;b[6]=g;b[7]=h
  .=acopy2r(a__[],start,start+7,b[],0,7)
}

define aset16(*a__[],start,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p){
  auto b[];
  b[0]=a;b[1]=b;b[2]=c;b[3]=d
  b[4]=e;b[5]=f;b[6]=g;b[7]=h
  b[8]=i;b[9]=j;b[A]=k;b[B]=l
  b[C]=m;b[D]=n;b[E]=o;b[F]=p
  .=acopy2r(a__[],start,start+F,b[],0,F)
}

## Append one array to another ##

define aappendr(*a__[],aend,b__[],bstart,bend) {
  auto i,j;
  if(aend>max_array_)aend=max_array_;
  if(bstart>bend){j=bstart;bstart=bend;bend=j}
  if(bstart<0)bstart=0;
  if(bend>max_array_)bend=max_array_;
  j=bstart;
  for(i=aend+1;i<=max_array_&&j<=bend;i++)a__[i]=b__[j++]
}

define aappend0(*a__[],b__[]) {
  auto i,j;
  for(i=0;i<=max_array_&&a__[i];i++){}
  if(i>max_array_)return 0;
  for(j=0;i<=max_array_&&b__[j];j++)a__[i++]=b__[j]
  if(i>max_array_)return 0;
  a__[i]=0;
}

define aappendb(*a__[],b__[],x) {
  auto i,j;
  for(i=0;i<=max_array_&&a__[i]!=x;i++){}
  if(i>max_array_)return 0;
  for(j=0;i<=max_array_&&b__[j]!=x;j++)a__[i++]=b__[j]
  if(i>max_array_)return 0;
  a__[i]=x;
}

define aappendl(*a__[],b__[]) {
  .=aappendr(a__[],a__[0],b__[],1,b__[0])
  a__[0]+=b__[0]
}

define aappend(*a__[],aend,b__[],count) {
  return aappendr(a__[],aend,b__[],0,count-1)
}

define aappendelem0(*a__[],e) {
  auto i;
  for(i=0;i<=max_array_&&a__[i];i++){}
  if(i>max_array_)return 0;
  a__[i++]=e;
  if(i>max_array_)return 0;
  a__[i]=0;
}

define aappendelemb(*a__[],x,e) {
  auto i;
  for(i=0;i<=max_array_&&a__[i]!=x;i++){}
  if(i>max_array_)return 0;
  a__[i++]=e;
  if(i>max_array_)return 0;
  a__[i]=x;
}

define aappendelem(*a__[],aend,e) {
  if(++aend>max_array_)return 0;
  a__[aend]=e;return 0
}

define aappendeleml(*a__[],e) {
  if(++a__[0]>max_array_){a__[0]=max_array_;return 0}
  a__[a__[0]]=e
}

## part a, part b, part c

define aparts3r(*a__[],astart,aend,b__[],bstart,bend,c__[],cstart,cend) {
  auto i,j;
  .=asanerange2_();
  if(cstart>cend){i=cstart;cstart=cend;cend=i}
  if(cstart<0)cstart=0;
  if(cend>max_array_)cend=max_array_;
  i=0;
  if(astart>0)for(j=astart;j<aend;j++)if(i++<=max_array_)a__[i]=a__[j];
  for(j=bstart;j<bend;j++)if(i++<=max_array_)a__[i]=b__[j];
  for(j=cstart;j<cend;j++)if(i++<=max_array_)a__[i]=c__[j];
}

## Insertion of elements and other arrays ##

define ainsertatr(*a__[],astart,aend,pos,b__[],bstart,bend){
  auto i;
  .=asanerange2_();
  if(pos>aend-astart)return aappendr(a__[],aend,b__[],bstart,bend);
  if(pos<=0){
    .=aappendr(b__[],bend,a__[],astart,aend);
    .=acopyr(a__[],b__[],bstart,aend-astart+bend)
    return 0;
  }
  .=aparts3r(a__[],astart,astart+pos-1,b__[],bstart,bend,a__[],astart+pos,aend);
}

define ainsertat0(*a__[],pos,b__[]){
  auto i,j,alen,blen;
  for(i=0;i<=max_array_&&b__[i];i++){}
  blen=i
  for(i=0;i<=max_array_&&a__[i];i++){}
  alen=i
  if(pos>=alen)return aappend0(a__[],b__[]);
  if(pos<0)pos=0;
  for(--i;i>=pos;i--){
    if((j=blen+i)>max_array_)continue;
    a__[j]=a__[i]
  }
  for(i=0;i<blen;i++){
    if((j=pos+i)>max_array_)continue;
    a__[j]=b__[i]
  }
  a__[alen+blen]=0
}
define ainsertatb(*a__[],pos,b__[],x){
  auto i,j,alen,blen;
  for(i=0;i<=max_array_&&b__[i]!=x;i++){}
  blen=i
  for(i=0;i<=max_array_&&a__[i]!=x;i++){}
  alen=i
  if(pos>=alen)return aappend0(a__[],b__[]);
  if(pos<0)pos=0;
  for(--i;i>=pos;i--){
    if((j=blen+i)>max_array_)continue;
    a__[j]=a__[i]
  }
  for(i=0;i<blen;i++){
    if((j=pos+i)>max_array_)continue;
    a__[j]=b__[i]
  }
  a__[alen+blen]=x
}
define ainsertatl(*a__[],pos,b__[]){
  auto i;
  if(pos>a__[0])return aappendl(a__[],b__[]);
  if(pos<1)pos=1;
  for(i=a__[0];i>=pos;i--){
    if((j=b__[0]+i)>max_array_)continue;
    a__[j]=a__[i]
  }
  for(i=1;i<=b__[0];i++){
    if((j=pos+i-1)>max_array_)continue;
    a__[j]=b__[i]
  }
  a__[0]+=b__[0]
}
define ainsertat(*a__[],acount,pos,b__[],bcount){
  return ainstertatr(a__[],0,acount-1,pos,b__[],0,bcount-1);
}

define ainsertelematr(*a__[],start,end,pos,e){
  auto b[];b[0]=e
  return ainsertatr(a__[],start,end,pos,b[],0,0);
}
define ainsertelemat0(*a__[],pos,e){
  auto b[];b[0]=e;b[1]=0
  return ainsertat0(a__[],pos,b[]);
}
define ainsertelematb(*a__[],x,pos,e){
  auto b[];b[0]=e;b[1]=x
  return ainsertatb(a__[],pos,b[],x);
}
define ainsertelematl(*a__[],pos,e){
  auto b[];b[0]=1;b[1]=e
  return ainsertatl(a__[],pos,b[]);
}
define ainsertelemat(*a__[],count,pos,e){
  auto b[];b[0]=e
  return ainstertatr(a__[],0,count-1,pos,b[],0,0);
}

## Comparison -> Lexical ##

# Compare a__[astart..aend] and b__[bstart..bend]
define acompare2r(a__[],astart,aend,b__[],bstart,bend){
  auto a,b,i,j;
  .=asanerange2_();
  i=astart;j=bstart;
  while(i<=aend&&j<=bend){
    a=a__[i++];b=b__[j++]
    if(a<b)return -1;
    if(a>b)return  1;
  }
  if(i>aend&&j>bend)return 0;#sub arrays are equivalent
  if(i>aend)return -1;#left array is shorter
  return 1;#right array is shorter
}

# Compare a__[start..end] and b__[start..end]
define acomparer(a__[],b__[],start,end){
  auto i;
  .=asanerange_();
  for(i=start;i<=end;i++){
    if(a__[i]<b__[i])return -1;
    if(a__[i]>b__[i])return  1;
  }
  return 0;
}

# compare zero-terminated arrays; a <=> b
define acompare0(a__[],b__[]) {
  auto i;
  for(i=0;i<=max_array_&&a__[i]&&b__[i];i++){
    if(a__[i]<b__[i])return -1;
    if(a__[i]>b__[i])return  1;
  }
  if(i>max_array_||(a__[i]==0&&b__[i]==0))return 0;
  if(a__[i]==0)return -1;#left array is shorter
  return 1;
}

# compare x terminated arrays; a <=> b
define acompareb(a__[],b__[],x) {
  auto i;
  for(i=0;i<=max_array_&&a__[i]!=x&&b__[i]!=x;i++){
    if(a__[i]<b__[i])return -1;
    if(a__[i]>b__[i])return  1;
  }
  if(i>max_array_||(a__[i]==x&&b__[i]==x))return 0;
  if(a__[i]==x)return -1;#left array is shorter
  return 1;
}

# compare length-specified arrays; a <=> b
define acomparel(a__[],b__[]) {
  auto i;
  for(i=1;i<=max_array_&&i<=a__[0]&&i<=b__[0];i++){
    if(a__[i]<b__[i])return -1;
    if(a__[i]>b__[i])return  1;
  }
  if(i>max_array_||(i>a__[0]&&i>b__[0]))return 0;
  if(i>a__[0])return -1;#left array is shorter
  return 1;
}

# Compare first 'count' elements of a and b
define acompare(a__[],b__[],count){
  auto i;
  if(count<0)count=0;
  if(count>max_array_)count=max_array_+1;
  for(i=0;i<count;i++){
    if(a__[i]<b__[i])return -1;
    if(a__[i]>b__[i])return  1;
  }
  return 0;
}

## Comparison -> Equality ##

# Check equality of a__[astart..aend] and b__[bstart..bend]
define   aequals2r(a__[],astart,aend,b__[],bstart,bend){
return !acompare2r(a__[],astart,aend,b__[],bstart,bend)}

# Check equality of a__[start..end] and b__[start..end]
define   aequalsr(a__[],b__[],start,end){
return !acomparer(a__[],b__[],start,end)}

# Check equality of zero-terminated arrays; a == b
define   aequals0(a__[],b__[]){
return !acompare0(a__[],b__[])}

# Check equality of x terminated arrays; a == b
define   aequalsb(a__[],b__[],x){
return !acompareb(a__[],b__[],x)}

# Check equality of length specified arrays; a == b
define   aequalsl(a__[],b__[]){
return !acomparel(a__[],b__[])}

# Check equality of first 'count' elements of a and b
define   aequals(a__[],b__[],count){
return !acompare(a__[],b__[],count)}

## Subarray matching ##

# Returns position in large that first occurrence of small is found
# . or -1 if no match is found
define amatcharray2r(small__[],astart,aend,large__[],bstart,bend){
  auto i,j;
  .=asanerange2_();
  if(aend-astart>bend-bstart)return -1;
  i=astart;j=bstart;
  while(j<=bend){
    while(         j<=bend&&small__[i]!=large__[j]){.=j++}
    if(j>bend)return -1;
    .=i++   ;.=j++
    while(i<=aend&&j<=bend&&small__[i]==large__[j]){.=i++;.=j++}
    if(i>aend)return j-aend+astart-1;
    i=astart;.=j++
  }
  return -1;
}

# As above but large and small are zero terminated arrays
define amatcharray0(small__[],large__[]){
  auto i,j;
  for(i=0;i<=max_array_&&small__[i];i++){}
  for(j=0;j<=max_array_&&large__[j];j++){}
  if(i>j)return -1;
  return amatcharray2r(small__[],0,i-1,large__[],0,j-1)
}

# As above but large and small are arrays terminated by x
define amatcharrayb(small__[],large__[],x){
  auto i,j;
  for(i=0;i<=max_array_&&small__[i]!=x;i++){}
  for(j=0;j<=max_array_&&large__[j]!=x;j++){}
  if(i>j)return -1;
  return amatcharray2r(small__[],0,i-1,large__[],0,j-1)  
}

# As above but large and small are arrays terminated by x
define amatcharrayl(small__[],large__[]){
  if(small__[0]>large__[0])return -1;
  return amatcharray2r(small__[],1,small__[0],large__[],1,large__[0])  
}

define amatcharray(small__[],scount,large__[],lcount){
  if(scount>lcount) return -1;
  return amatcharray2r(small__[],0,scount-1,large__[],0,lcount-1);
}

## Single element finding ##

define amatchelementr(e,a__[],start,end){
  auto i;
  .=asanerange_();
  for(i=start;i<=end;i++)if(a__[i]==e)return i;
  return -1;
}

define amatchelement0(e,a__[]){
  auto i;
  for(i=0;i<=max_array_&&a__[i];i++)if(a__[i]==e)return i;
  if(i<=max_array_&&e==0)return i; 
  return -1;
}

define amatchelementb(e,a__[],x){
  auto i;
  for(i=0;i<=max_array_&&a__[i]!=x;i++)if(a__[i]==e)return i;
  if(i<=max_array_&&e==x)return i;
  return -1;
}

define amatchelementl(e,a__[]){
  auto i;
  for(i=1;i<=max_array_&&i<=a__[0];i++)if(a__[i]==e)return i;
  return -1;
}

define amatchelement(e,a__[],count){
  return amatchelementr(e,a__[],0,count-1);
}

## Output ##

aprint_wide_=1

# Prints a__[start..end]
define aprintr(*a__[],start,end) {
  auto i;
  if(start>end){print"{}";return 0}
  .=asanerange_();
  print "{";for(i=start;i<end;i++){
    print a__[i],", ";if(!aprint_wide_)print"\n "
  };print a__[i],"}\n"
}

# Treats a__[] as a zero terminated array; prints all elements prior to 0
define aprint0(*a__[]) {
  auto e,f,i;
  print "{";
  if(!(e=a__[i=0])){print "}\n";return 0}
  while(++i<=max_array_&&f=a__[i]){
    print e,", "
    if(!aprint_wide_)print"\n "
    e=f;
  }
  print e,"}\n"
}

# Treats a__[] as an 'x' terminated array; prints all elements [b]efore 'x'
define aprintb(*a__[],x) {
  auto e,f,i;
  print "{";
  if(x==(e=a__[i=0])){print "}\n";return 0}
  while(++i<=max_array_&&(f=a__[i])!=x){
    print e,", "
    if(!aprint_wide_)print"\n "
    e=f;
  }
  print e,"}\n"
}

# Treats a__[] as an 'x' terminated array 
# . but prints all elements [u]pto and including 'x'
define aprintu(*a__[],x) {
  auto i;
  print "{";
  for(i=0;a__[i]!=x&&i<max_array_;i++) {
    print a__[i],", "
    if(!aprint_wide_)print"\n "
  }
  if(i==max_array_){print a__[i]}else{print x}
  print "}\n"
}

# Treats a__[] as a length specified array and prints it
define aprintl(*a__[]) {
  auto e,f,i;
  if(a__[0]==0){print"{}";return 0}
  print "{";
  for(i=1;i<a__[0];i++) {
    print a__[i],", "
    if(!aprint_wide_)print"\n "
  }
  print a__[i],"}\n"
}

# Prints the first 'count' elements of a__[]
define aprint(*a__[],count) {
 .=aprintr(a__[],0,count-1)
}#!/usr/local/bin/bc -l

### CF.BC - Continued fraction experimentation using array pass by reference

# Best usage for the output functions in this library:
#   .=output_function(params)+newline()
# This suppresses the output and also appends a newline which is not added
# by default.

## Initialisation / Tools / Workhorses ##

# Borrowed from funcs.bc
define int(x) { auto os;os=scale;scale=0;x/=1;scale=os;return(x) }
define abs(x) { if(x<0)return(-x)else return(x) }

# Borrowed from output_formatting.bc
define newline() { print "\n" }

# sanity check for the below
define check_cf_max_() {
  auto maxarray;
  maxarray = 4^8-4;cf_max=int(cf_max)
  if(1>cf_max||cf_max>maxarray)cf_max=maxarray
  return 0;
}

# global var; set to halt output and calculations at a certain point
cf_max=-1; # -1 to flag to other libs that cf.bc exists before value is set

# Workhorse function to prepare for and tidy up after CF generation
define cf_tidy_(){
  # POSIX scope; expects vars cf__[], max, p and i
  # Tidy up the end of the CF
  #  assumes the last element of large CFs to be invalid due to rounding
  #    and deletes that term.
  #  for apparently infinite (rather than just long) CFs, uses a bc trick
  #    to signify special behaviour to the print functions.
  #  for apparently finite CFs, checks whether the CF ends ..., n, 1]
  #  which can be simplified further to , n+1]
  auto j,diff,rl,maxrl,bestdiff
  cf__[i]=0
  if(p>max){
    .=i--;
    if(p<max*A^5){ # assume infinite
      cf__[i]=0.0; # bc can tell between 0 and 0.0
      # Identify repeating CFs and store extra information
      #  that is used by the print functions.
      max=i;mrl=0;
      p=max-1;if((i=p-1)>0)for(i=i;i;i--){
        if(cf__[i]==cf__[p]){
          diff=p-i;rl=0
          for(j=p-1;j>diff;j--){if(cf__[j-diff]!=cf__[j])break;.=rl++}
          if(j<=i)rl+=diff
          if(rl>mrl){mrl=rl;bestdiff=diff}
        }
      }
      if(3*mrl>=p){cf__[++max]=p-mrl-1;cf__[++max]=bestdiff;cf__[0]+=0.0}
      return 0;
    }
    cf__[i]=0; # bc can differentiate between 0 and 0.0
  } 
  if(i<2)return 0;
  .=i--;if(abs(cf__[i])==1){cf__[i-1]+=cf__[i];cf__[i]=0}
  return 0;
}

# Workhorse function for cf_new and cfn_new
define cf_new_(near) {
  # POSIX scope; expects array *cf__[] and var x
  auto os, i, p, max, h, n, temp;
  .=check_cf_max_()
  os=scale;if(scale<scale(x))scale=scale(x)
  if(scale<6+near){
    print "cf";if(near)print"n";print"_new: scale is ",scale,". Poor results likely.\n"
  }
  max=A^int(scale/2);p=1
  if(near)h=1/2;
  for(i=0;i<cf_max&&p<max;i++) {
    if(near){
      n=int(temp=x+h);if(n>temp).=n-- # n=floor(x+.5)
    } else {
      n=int(x)
    }
    p*=1+abs(cf__[i]=n);
    x-=cf__[i]
    if(x==0||p==0){.=i++;break}
    x=1/x
  }
  scale=os
  return cf_tidy_();
}

## Making/unmaking continued fractions and ordinary fractions ##

# Create a continued fraction representation of x in pbr array cf__[]
define cf_new(*cf__[],x) {
  return x+cf_new_(0);
}

# Create a continued fraction representation of x in pbr array cf__[]
# using signed terms to guarantee largest magnitude following term
define cfn_new(*cf__[],x) { 
  return x+cf_new_(1);
}

# Copy a continued fraction into pbr array cfnew__[] from pbv array cf__[]
define cf_copy(*cfnew__[],cf__[]){
  auto e,i;
  for(i=0;i<=cf_max&&e=cf__[i];i++)cfnew__[i]=e
  if(i<=cf_max)cfnew__[i]=cf__[i] # might be 0.0
  e=cf__[0];if(int(e)==e&&scale(e)){
    # copy extra info
    if(++i<=cf_max)cfnew__[i]=cf__[i]
    if(++i<=cf_max)cfnew__[i]=cf__[i]
  }
  return (i>cf_max);
}

# Convert pbv array cf__[] into a number
define cf_value(cf__[]) {
  auto n, d, temp, i;
  .=check_cf_max_();
  if(cf__[1]==0)return cf__[0];
  for(i=1;i<cf_max&&cf__[i];i++){}
  n=cf__[--i];d=1
  for(i--;i>=0;i--){temp=d;d=n;n=temp+cf__[i]*d}
  return(n/d);
}

# Convert pbv array cf__[] into a new cf of the other type
# . with respect to nearness.
define cf_toggle(*cf__[],cf2__[]){
  auto os,p,i,x,zero,sign,near;
  sign=1;if(cf2__[0]<0)sign=-1
  near=0
  for(i=1;x=cf2__[i];i++){
    p*=1+abs(x)
    if(x*sign<0)near=1
  }
  zero=x;
  os=scale;scale=0
   for(i=2;p;i++)p/=A
   if(i<os)i=os
  scale=i
   x=cf_value(cf2__[])
   .=cf_new_(1-near)
  scale=os
  for(i=0;cf__[i];i++){}
  cf__[i]=zero;
  return 0
}

# Return the value of the specified convergent of a CF
define cf_get_convergent(cf__[],c){
  auto ocm,v;
  if(c==0)return cf_value(cf__[]);
  .=check_cf_max_();ocm=cf_max
  cf_max=c;v=cf_value(cf[])
  cf_max=ocm;return v;
}

# Return the value of the specified convergent of the CF of x
define get_convergent(x,c){
  auto cf[];
  .=cf_new(cf[],x)
  return cf_get_convergent(cf[],c)
}

# Create denominator, numerator and optional intpart in
# . first three elements of pbr array f__[]
# . from CF in pbv array cf[]()
# NB: returned elements are in reverse of the expected order!
define frac_from_cf(*f__[],cf__[],improper) {
  auto n,d,i,temp;
  .=check_cf_max_();
  improper=!!improper;
  if(cf__[0]==(i=int(cf__[0])))cf__[0]=i
  if(cf__[1]==0){f__[0]=1;f__[1]=0;return f__[2]=cf__[0]}
  for(i=1;i<cf_max&&cf__[i];i++){}
  n=cf__[--i];d=1
  for(i--;i>=!improper;i--){
    temp=n;n=d;d=temp # reciprocal = swap numerator and denominator
    n+=cf__[i]*d
  }
  temp=0
  if(!improper){temp=n;n=d;d=temp}#correct for having stopped early
  if(d<0){n=-n;d=-d} # denominator always +ve
  if(!improper&&cf__[0]!=0){
    temp=cf__[0]
  }
  f__[0]=d;f__[1]=n;f__[2]=temp
  return temp+n/d;
}

# Upscale an allegedly rational number to the current scale
define upscale_rational(x) {
  auto os,f[],cf[];
  if(scale<=scale(x))return x
  os=scale;scale=scale(x)
  .=cf_new(cf[],x);          # Sneaky trick to upscale (literally)
  .=frac_from_cf(f[],cf[],1) # any rational value of x
  scale=os
  x=f[1]/f[0] # x is now (hopefully) double accuracy!
  return x;
}

## Output ##

# Set to 1 to truncate quadratic surd output before repeat occurs
cf_shortsurd_=0

# Output pbv array cf__[] formatted as a CF
define cf_print(cf__[]) {
  auto i,sign,surd,sli,sri;
  .=check_cf_max_();
  sign=1;if(cf__[0]<0||(cf__[0]==0&&cf__[1]<0)){sign=-1;print "-"}
  # Check for surd flag and find lead in and repeat period
  surd=0;sri=int(i=cf__[0]);if(scale(i)&&sri==i){
    for(i=1;cf__[i];i++){}
    sli=cf__[++i]
    surd=cf__[++i]
  }
  print "[", sign*sri;
  if(cf__[1]==0){print "]";return 0}
  print "; ";
  if(surd)if(sli){sri=sli-1}else{sri=surd-1}
  for(i=2;i<=cf_max&&cf__[i];i++){
    print sign*cf__[i-1]
    if(!surd||sri){
      print ", ";if(surd).=sri--
    } else {
      if(sli){
        sli=0
      }else if(cf_shortsurd_){print ";...]";return 0}
      print "; ";sri=surd-1
    }
  }
  print sign*cf__[i-1];
  # detect a 0.0 which signifies that the cf has been determined
  # to be infinite (not 100% accurate, but good)
  if(scale(cf__[i])){
    if(!surd||sri){print ","}else{print ";"}
    print "..."
  }
  print "]";
  return (i>cf_max);
}

# Print a number as a continued fraction
define print_as_cf(x) {
  auto cf[];
  .=cf_new(cf[],x)+cf_print(cf[])
  return x;
}

# Print a number as a signed continued fraction
define print_as_cfn(x) {
  auto cf[];
  .=cfn_new(cf[],x)+cf_print(cf[])
  return x;
}

# Output pbv array cf__[] as a fraction or combination of int and fraction
# . the 'improper' parameter makes the choice.
# . . set to non-zero for top-heavy / improper fractions
define cf_print_frac(cf__[],improper) {
  auto f[],v;
  v=frac_from_cf(f[],cf__[],improper)
  if(f[1]==0){print f[2];return f[2]}
  if(!improper&&cf__[0]!=0){
    print cf__[0]
    if((f[1]<0)==(f[0]<0)){print"+"} # if n and d have same sign...
  }
  print f[1],"/",f[0] # n/d
  return v;
}

# Print x as a fraction or combination of int and fraction
# . the 'improper' parameter makes the choice.
# . . set to non-zero for top-heavy / improper fractions
define print_frac(x,improper) {
  auto cf[]
  .=cf_new(cf[],x)+cf_print_frac(cf[],improper)
  return x;
}

# Print x as a fraction or combination of int and fraction
# . the 'improper' parameter makes the choice.
# . . set to non-zero for top-heavy / improper fractions
# . This alternative function rounds to the nearest integer
# . . for the integer part and then shows the addition
# . . or _subtraction_ of the fraction.
# . . e.g. 1+2/3 is shown as 2-1/3
define print_frac2(x,improper) {
  auto cf[];
  .=cfn_new(cf[],x)+cf_print_frac(cf[],improper)
  return x;
}

define cf_print_convergent(cf__[],c){
  auto ocm,n,v;
  if(c==0)return cf_print_frac(cf__[],0);
  if(c<0){n=1;c=-c}else{n=c}
  .=check_cf_max_();ocm=cf_max;
  for(n=n;n<=c;n++){cf_max=n;v=cf_print_frac(cf__[],1);if(n!=c)print "\n"}
  cf_max=ocm;return v;
}

define print_convergent(x,c){
  auto cf[],v;
  v=cf_new(cf[],x)
  v=cf_print_convergent(cf[],c)
  return v;
}
#!/usr/local/bin/bc -l funcs.bc cf.bc

### CF_ENGEL.BC - Engel expansion experimentation using array pass by reference

# Workhorse: Create an Engel expansion of x in pbr array en__[]
define engel_new_(mode) {
  # expects *en__[] and x to be declared elsewhere
  auto i,fc,max,q,p
  
  # error checking
  .=check_cf_max_()
  p=(mode<1&&abs(x)>=1);
  q=(scale<6);
  if(p||q){print "engel";if(mode==-1)print "fall";if(mode==0)print "alt";print "_new: "}
  if(p){print "Can't work with integer part.\n"; x-=int(x)}
  if(q){print "scale is ",scale,". Poor results likely.\n"}
  
  max=A^scale
  i=fc=0;p=1
  for(i=0;x&&p<max&&i<cf_max;i++){
    q=1/abs(x)
    if(mode==1){
      q=ceil(q) # proper engel expansion
    } else if(mode==-1){
      q=floor(q) # secondary engel expansion
    } else if(fc=!fc){q=floor(q)}else{q=ceil(q)} # tertiary engel expansion
    p*=q
    en__[i]=q*=sgn(x)
    x=x*q-1
  }
  if(p>=max){
    if(!--i)i=1
    max=A^int(scale/2)
    if(abs(en__[i])>max){
      en__[i]=0;return 0
    }else{
      en__[i]=0.0
      if(i-=2<3)return 0;
      q=en__[i]
      if(en__[--i]==q){
        while(en__[i--]==q){}
        en__[i+3]=0
        .=en__[i+2]--
      }
    }
  }else{
    en__[i]=0
  }
  return 0;
}

# Create Engel expansion of x in pbr array en__[]
# . all terms same sign as x
define engel_new(*en__[],x) {
  return x+engel_new_(1);
}

# Create secondary Engel expansion of x in pbr array en__[]
# . first term same sign as x, all other terms opposite sign
# . terms in implied Egyptian fraction sum have alternating signs
define engelfall_new(*en__[],x) {
  return x+engel_new_(-1);
}

# Create tertiary Engel expansion of x in pbr array en__[]
# . first term same sign as x, following terms alternate in sign
# . terms in implied Egyptian fraction alternate pairwise e.g. +--++--++...
define engelalt_new(*en__[],x) {
  return x+engel_new_(0);
}

# Output pbv array en__[] formatted as an Engel expansion
define engel_print(en__[]){
  auto i;
  .=check_cf_max_();
  print "{";
  if(en__[1]==0){print en__[0],"}";return 0}
  for(i=1;en__[i];i++)print en__[i-1],", ";
  print en__[i-1];
  if(scale(en__[i]))print ",...";
  print "}";return 0;
}

# Print a number as an Engel expansion
define print_as_engel(x){
  auto en[];
  .=engel_new(en[],x)+engel_print(en[])
  return x;
}
define print_as_engelfall(x){
  auto en[];
  .=engelfall_new(en[],x)+engel_print(en[])
  return x;
}
define print_as_engelalt(x){
  auto en[];
  .=engelalt_new(en[],x)+engel_print(en[])
  return x;
}

# Turn the Engel expansion in pbv array en__[] into its value
define engel_value(en__[]) {
  auto i,p,v;
  .=check_cf_max_();
  p=1;v=0;for(i=0;i<cf_max&&p*=en__[i];i++)v+=1/p
  return v;
}#!/usr/local/bin/bc -l funcs.bc cf.bc

### CF_MISC.BC - Miscellaneous functions separated from CF.BC

## CF Alteration ##

# Take the absolute value of all terms in pbv array cf__[]
# . WARNING: This irrevocably changes the array!
define cf_abs_terms(*cf__[]) {
  auto i,t,changed;
  .=check_cf_max_();
  changed=0;
  for(i=0;i<cf_max&&cf__[i];i++){
    t=cf__[i];if(t<0){t=-t;changed=1}
    cf__[i]=t
  }
  return changed;
}

# Take the absolute value, less 1, of all terms in pbv array cf__[]
# . WARNING: This irrevocably changes the array!
define cf_abs1_terms(*cf__[]) {
  auto i,err;
  .=check_cf_max_();
  for(i=0;i<cf_max&&cf__[i];i++)
    if(0==(cf__[i]=abs(cf__[i])-1)){err=1;break}
  if(err){
    print "abs1_cf error: invalid cf for this transformation. truncation occurred\n";
  }
  return err;
}

# Return the value of a CF as if all terms are positive
define cf_value_abs(cf__[]) {
  auto cp[];
  .=cf_copy(cp[],cf__[])+cf_abs_terms(cp[])
  return cf_value(cp[])
}

# Return the value of a CF as if all terms are positive and reduced by 1
define cf_value_abs1(cf__[]) {
  auto cp[];
  .=cf_copy(cp[],cf__[])+cf_abs1_terms(cp[])
  return cf_value(cp[])
}

# Convert x through the cfn and abs transformations
# . and return the value of the resultant CF
define cfn_flip_abs(x) {
  auto cf[];
  .=cfn_new(cf[],x)+cf_abs_terms(cf[])
  return cf_value(cf[])
}

# Convert x through the cfn and abs1 transformations
# . and return the value of the resultant CF
define cfn_flip_abs1(x) {
  auto cf[];
  .=cfn_new(cf[],x)+cf_abs1_terms(cf[])
  return cf_value(cf[])
}

## Binary RLE <--> CF conversion ##

# Minkowski Question Mark function - Inverse of Conway Box
# . Treat the fractional part of x as a CF and transform it into a
# . representation of alternating groups of bits in a binary number
define cf_question_mark(cf__[]) {
  auto os,n,i,b,x,t,tmax,sign,c;
  .=check_cf_max_();
  tmax=A^scale
  sign=1;if(cf__[0]<0)sign=-1
  b=0;t=1
  for(i=1;i<cf_max&&cf__[i]&&t<tmax;i++){
    if((c=cf__[i]*sign)<0){
      print "question_mark_cf: terms not absolute values. aborting\n"
      return 0;
    }
    for(j=c;j&&t<tmax;j--){x+=b/t;t+=t}
    b=!b
  }
  os=scale
  if(t<tmax){
    c=0;while(t>1){.=c++;t/=A}
    scale=c
  }
  x=(cf__[0]+sign*x)/1;
  scale=os
  return upscale_rational(x);
}

# As above but only generates a CF as intermediary
define question_mark(x) { # returns ?(x)
  auto cf[];
  .=cf_new(cf[],x)
  return cf_question_mark(cf[])
}

# Conway Box function - Inverse of Minkowski Question Mark
# . Transform the fractional part of x by making a CF from a run-length
# . encoding of the binary digits, and using that as the new fractional part
define cf_conway_box(*cf__[],x) { # cf__[] = [[_x_]]
  auto os,f[],max,p,i,b,bb,n,j,ix,sign,which0;
  os=scale;scale+=scale
  x=upscale_rational(x)
  max=A^os;p=1
  sign=1;if(x<0){sign=-1;x=-x}
  x-=(b=int(x));cf__[0]=sign*b
  b=0
  n=1;j=1
  for(i=0;i<=cf_max&&i<scale;i++){
    x+=x;bb=int(x)
    if(bb==b){.=n++}else{cf__[j++]=sign*n;p*=1+n;n=1}
    b=bb;x-=b
  }
  if(n){cf__[j++]=sign*n;p*=1+n}
  i=j;while(!i).=i--;.=i++
  scale=os
  return cf_tidy_();
}

# As above but only generates a CF as intermediary
define conway_box(x) {
  auto os,f[],cf[];
  .=cf_conway_box(cf[],x)
  return cf_value(cf[])
}
#!/usr/local/bin/bc -l funcs.bc cf.bc

### CF_SYLVESTER.BC - Sylvester expansion experimentation using array pass by reference

# Workhorse: Create an Sylvester expansion of x in pbr array sy__[]
define sylvester_new_(mode) {
  # expects *sy__[] and x to be declared elsewhere
  auto i,max,q,iq,p,h
  
  # error checking
  .=check_cf_max_()
  #p=(abs(x)>=1);
  q=(scale<6);
  #if(p||q){print "sylvester";if(mode)print "2";print "_new: "}
  #if(p){print "Can't work with integer part.\n"; x-=int(x)}
  if(q){print "scale is ",scale,". Poor results likely.\n"}
  
  max=A^int(scale/2)
  i=0;p=1;h=3/2
  for(i=0;x&&p<max&&i<cf_max;i++){
    q=1/abs(x)
    if(!mode){
      q=ceil(q) # proper sylvester expansion
    } else {
      q=floor(q+h) # secondary sylvester expansion
    }
    p*=q
    sy__[i]=q*=sgn(x)
    x-=1/q
  }
  if(p>=max){
    if(!mode)if(!--i)i=1
    if(abs(sy__[i])>max){
      sy__[i]=0;.=i--
      while(iq=int(q=(sy__[i]*sy__[i-1])/(sy__[i]+sy__[i-1]))==q){
        sy__[i]=0;sy__[--i]=iq
      }
    }else{
      sy__[i]=0.0
    }
  }else{
    sy__[i]=0
  }
  return 0;
}
#echo 'scale=250;sylvester_new(a[],7/15);.=sylvester_print(a[])+newline();sylvester_value(a[])' | bc -l funcs.bc *.bc


# Create Sylvester expansion of x in pbr array sy__[]
# . all terms same sign as x
define sylvester_new(*sy__[],x) {
  return x+sylvester_new_(0);
}

# Create secondary Sylvester expansion of x in pbr array sy__[]
# . first term same sign as x, all other terms opposite sign
# . terms in implied Egyptian fraction sum have alternating signs
define sylvester2_new(*sy__[],x) {
  return x+sylvester_new_(1);
}

# Output pbv array sy__[] formatted as an Sylvester expansion
define sylvester_print(sy__[]){
  auto i;
  .=check_cf_max_();
  print "{";
  if(sy__[1]==0){print sy__[0],"}";return 0}
  for(i=1;sy__[i];i++)print sy__[i-1],", ";
  print sy__[i-1];
  if(scale(sy__[i]))print ",...";
  print "}";return 0;
}

# Print a number as an Sylvester expansion
define print_as_sylvester(x){
  auto sy[];
  .=sylvester_new(sy[],x)+sylvester_print(sy[])
  return x;
}
define print_as_sylvester2(x){
  auto sy[];
  .=sylvester2_new(sy[],x)+sylvester_print(sy[])
  return x;
}

# Turn the Sylvester expansion in pbv array sy__[] into its value
define sylvester_value(sy__[]) {
  auto i,p,n,d;
  .=check_cf_max_();
  n=0;d=1;for(i=0;i<cf_max&&p=sy__[i];i++){n=n*p+d;d*=p}
  return n/d;
}#!/usr/local/bin/bc -l

### Collatz.BC - The 3x+1 or hailstones problem

# Global variable
# The original Collatz iteration has rules:
#   odd  x -> 3x+1
#   even x -> x/2
# The condensed Collatz iteration has rules:
#   odd  x -> (3x+1)/2
#   even x -> x/2
# ...since the usual odd step always produces an even value
# The odd-only Collatz iteration has rules:
#   odd  x -> odd part of 3x+1
#   even x -> odd part of x
# This var sets the mode of the functions in this library
#   0 =>  odd-only Collatz
#   1 =>  original Collatz - note that these two entries ...
#   2 => condensed Collatz - ... match the divisor on the odd step
collatz_mode_=1

# sanity check
define check_collatz_mode_() {
  auto os;
  if(collatz_mode_==0||collatz_mode_==1||collatz_mode_==2)return collatz_mode_
  if(collatz_mode_<0||collatz_mode_>2)collatz_mode_=1
  if(scale(collatz_mode_)){os=scale;scale=0;collatz_mode_/=1;scale=os}
  return collatz_mode_
}

## Step forwards and back


# Generate the next hailstone
define collatz_next_(x) {
  auto os,t;
  os=scale;scale=0;x/=1
  t=x/2;if(x!=t+t)t=3*x+1
  if(collatz_mode_){
    if(collatz_mode_==2&&t>x){x=t/2}else{x=t}
  } else {
    while(x==t+t||t>x){x=t;t/=2}
  }
  scale=os;return x
}

define collatz_next(x) {
  .=check_collatz_mode_()
  return collatz_next_(x)
}

# Take a guess at the previous hailstone - since in some cases there are
# two choices, this function always chooses the option of lowest magnitude
define collatz_prev(x) {
  auto os,a,b,c;
  os=scale;scale=0;x/=1
  if(check_collatz_mode_()){
    a=collatz_mode_*x-1;b=a/3
    x+=x
    if(3*b!=a||b==1||b==-1){scale=os;return x}
    if((b>0)==(b<x))x=b
  } else {
    # oddonly mode shouldn't really return an even number
    #  but when x is even or divisible by three, there _is_
    #  no previous odd hailstone, so an even number must suffice.
    if(!x%2||!x%3){scale=os;return x+x}
    for(a=1;1;a+=a){
      b=a*x-1;c=b/3
      if(3*c==b){b=c/2;if(c!=b+b){scale=os;return c}}
    }
  }
  scale=os;return x
}

## Chain examination

max_array_ = 4^8

# Determine whether an integer, x, reaches 1 under the Collatz iteration
# . defined for both positive and negative x, so will
# . return 0 under some circumstances!
define is_collatz(x) {
  auto os,t,i,tape[],tapetop
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 0}
  .=check_collatz_mode_()
  tapetop=-1
  while(x!=1&&x!=-1){
    t = collatz_next_(x)
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;return 0}
    if(tapetop++>max_array_){
      print "is_collatz: can't calculate; chain too long. assuming true.\n"
      scale=os;return 1
    }
    tape[tapetop]=x=t
  }
  return x
}

# Print the chain of iterations of x until a loop or 1
# . was cz_chain
define collatz_print(x) {
  auto os,t,i,tape[],tapetop
  os=scale;scale=0;x/=1
  x;if(x==0){scale=os;return 0}
  .=check_collatz_mode_()
  tapetop=-1
  while(x!=1&&x!=-1){
    t = collatz_next_(x)
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;"looping ";return t}
    if(tapetop++>max_array_){
      print "collatz_print: can't calculate; chain too long.\n"
      scale=os;return t
    }
    tape[tapetop]=x=t;t
  }
}

# Find the number of smallest magnitude under the Collatz iteration of x
# . assuming the conjecture is true, this returns 1 for all positive x
define collatz_root(x) {
  auto os,t,i,tape[],tapetop
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 0}
  .=check_collatz_mode_()
  tapetop=-1
  while(x!=1&&x!=-1){
    t = collatz_next_(x)
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){
      #go back the other way looking for the lowest absolute value
      while(++i<=tapetop)if((tape[i]>0)==(tape[i]<t))t=tape[i]
      scale=os;return t
    }
    if(tapetop++>max_array_){
      print "collatz_print: can't calculate; chain too long.\n"
      scale=os;return (x>0)-(x<0)
    }
    tape[tapetop]=x=t
  }
  return x
}

# Returns the loopsize should the iteration become stuck in a loop
# . assuming the conjecture is true, this returns 3 for the
# . 4,2,1,4,etc. loop for all positive x.
define collatz_loopsize(x) {
  auto os,t,i,tape[],tapetop
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 1}
  .=check_collatz_mode_()
  tapetop=-1
  while(x!=1&&x!=-1){
    t = collatz_next_(x)
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;return tapetop-i+1}
    if(tapetop++>max_array_){
      print "collatz_loopsize: can't calculate; chain too long.\n"
      scale=os;return 0
    }
    tape[tapetop]=x=t
  }
  if(collatz_mode_==0)return 1
  if(collatz_mode_==1)return 3
  if(collatz_mode_==2)return 2
}

# How many iterations to 1 (or loop)?
define collatz_chainlength(x) {
  auto os,t,i,c,tape[],tapetop
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 0}
  .=check_collatz_mode_()
  tapetop=-1
  while(x!=1&&x!=-1){
    .=c++
    t = collatz_next_(x)
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;return 2-c }# infinity
    if(tapetop++>max_array_){
      print "collatz_chainlength: can't calculate; chain too long.\n"
      scale=os;return -c
    }
    tape[tapetop]=x=t
  }
  return c
}

# Highest point on way to 1 or before being stuck in a loop
define collatz_magnitude(x) {
  auto os,t,i,m,tape[],tapetop
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 0}
  .=check_collatz_mode_()
  tapetop=-1
  m=x
  while(x!=1&&x!=-1){
    t = collatz_next_(x)
    if((t>0)==(t>m))m=t
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;return m}
    if(tapetop++>max_array_){
      print "collatz_magnitude: can't calculate; chain too long.\n"
      scale=os;return m
    }
    tape[tapetop]=x=t
  }
  return m
}

# Sum of all values in the iteration
define collatz_sum(x) {
  auto os,t,i,s,tape[],tapetop
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 0}
  .=check_collatz_mode_()
  tapetop=-1
  s=x
  while(x!=1&&x!=-1){
    t = collatz_next_(x)
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;"infinite ";return 0}
    if(tapetop++>max_array_){
      print "collatz_sum: can't calculate; chain too long.\n"
      scale=os;return s
    }
    tape[tapetop]=x=t
    s+=t
  }
  return s
}

# is_collatz_sg(x) # set globals by name of above functions

# All of the above rolled into one.
# Global variables are set with the same names as the above functions
# with the exception of global variable collatz_print, which should be
# set to non-zero if emulation of the collatz_print() function is required
define is_collatz_sg(x) {
  auto os,t,i,s,c,m,tape[],tapetop
  os=scale;scale=0;x/=1
  if(collatz_print)x
  if(x==0){
    collatz_root        = 0
    collatz_loopsize    = 1
    collatz_chainlength = 0
    collatz_magnitude   = 0
    collatz_sum         = 0
    scale=os;return 0
  }
  .=check_collatz_mode_()
  tapetop=-1
  s=m=x
  while(x!=1&&x!=-1){
    .=c++
    t = collatz_next_(x)
    if((t>0)==(t>m))m=t
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){
      collatz_loopsize    = tapetop-i+1
      collatz_chainlength = 2-c # Infinite
      collatz_magnitude   = m
      collatz_sum         = 0   # Infinite
      #go back the other way looking for the lowest absolute value
      while(++i<=tapetop)if((tape[i]>0)==(tape[i]<t))t=tape[i]
      collatz_root        = t
      scale=os;return 0
    }
    if(tapetop++>max_array_){
      print "is_collatz_sg: can't calculate; chain too long.\n"
      collatz_root        = (x>0)-(x<0)
      collatz_loopsize    = 0
      collatz_chainlength = -c
      collatz_magnitude   = m
      collatz_sum         = s
      scale=os;return s
    }
    tape[tapetop]=x=t
    if(collatz_print)x
    s+=t
  }
  collatz_root        = x
  if(collatz_mode_==0) collatz_loopsize = 1
  if(collatz_mode_==1) collatz_loopsize = 3
  if(collatz_mode_==2) collatz_loopsize = 2
  collatz_chainlength = c
  collatz_magnitude   = m
  collatz_sum         = s
  return x
}
#!/usr/local/bin/bc -l funcs.bc collatz.bc

### Collatz_Continuous.BC - Attempt to extend the Collatz iteration to
###                         all real numbers

# For functions with the k parameter:
#  always return x/2 for even x
#  for k=0,     returns 3x+1 for odd x [Standard Collatz]
#  for k=1,     returns (3x+1)/2 for odd x [First Simplification]
#  for k=other, returns (3x+1)/(k+1) for odd x [Side effect]
#  i.e. for integers, return the same as for collatz_next() in
#    collatz.bc
#  for x=non integer, interpolates between odd and even values

# cosine interpolation
define collatz_cos_(x,k) { return x/2+(1-cos(pi()*x))/2*((3*x+1)/pow(2,k)-x/2) }
define collatz_cos(x) { 
  if(!check_collatz_mode_())return 0
  return collatz_cos_(x,collatz_mode_-1)
}

# as above but performs true linear interpolation
define collatz_lin_(x,k) {
  auto l,p,a,b
  l=floor(x);p=l-2*floor(l/2)
  if(l==x)if(p){
    return (3*x+1)/pow(2,k)
  } else {
    return x/2
  }
  if(p){
    a=(3*l+1)/pow(2,k);b=(l+1)/2
  } else {
    a=l/2;b=(3*l+4)/pow(2,k)
  }
  return a+(x-l)*(b-a)
}
define collatz_lin(x) {
  if(!check_collatz_mode_())return 0
  return collatz_lin_(x,collatz_mode_-1)
}

# as above but performs pseudo-linear interpolation
define collatz_linb_(x,k) { return x/2+(1-abs(1-x+2*floor(x/2)))*((3*x+1)/pow(2,k)-x/2) }
define collatz_linb(x) {
  if(!check_collatz_mode_())return 0
  return collatz_linb_(x,collatz_mode_-1)
}

# as above but performs piecewise cosine interpolation
define collatz_pcos_(x,k) {
  auto l,p,a,b
  l=floor(x);p=l-2*floor(l/2)
  if(l==x)if(p){
    return (3*x+1)/pow(2,k)
  } else {
    return x/2
  }
  x=(1-cos(pi()*x))/2
  if(p){
    a=(3*l+1)/pow(2,k);b=(l+1)/2
    x=1-x
  } else {
    a=l/2;b=(3*l+4)/pow(2,k)
  }
  return a+x*(b-a)
}
define collatz_pcos(x) {
  if(!check_collatz_mode_())return 0
  return collatz_pcos_(x,collatz_mode_-1)
}

## Inverse functions

# Workhorse for invlin and arcpcos.
define collatz_piecewise__(y,k) {
  # Assumes a,b,ca,cb,t,s,x are POSIXly defined elsewhere
  a=(pow(2,k)*y-1)/3;b=y+y
  if((y>0)==(a>b)){t=a;a=b;b=t}
  s=1;if(a<0)s=-1
  t=s*floor(s*b);a=s*ceil(s*a)
  ca=collatz_lin_(a,k);cb=collatz_lin_(t,k)
  x=0
  if(y==ca)return x=a
  if(y==cb)return x=b
  cb=collatz_lin_(b=a+s,k)
  while(b*s<=t*s){
    if(y==cb){x=b;break}
    if((ca<y&&y<cb)||(cb<y&&y<ca)){x=1;break}
    ca=cb;a=b;b+=s;cb=collatz_lin_(b,k)
  }
  if(y<0){t=a;a=b;b=t; t=ca;ca=cb;cb=t}
}

# Attempt to find a solution to y=collatz_lin_(x,k) for x
# . Where y is integer, finds a valid Collatz inverse
#   Otherwise finds solution with smallest magnitude
define collatz_invlin_(y,k) {
  auto a,b,ca,cb,t,s,x
  if(y==0)return 0
  if(y==-1||y==1)return y*2^k
  .=collatz_piecewise__(y,k)
  if(cb==ca)return 2*y/1
  if(x==1)x=(y-ca)/(cb-ca)+a
  return x
}
define collatz_invlin(y) {
  if(!check_collatz_mode_())return 0
  return collatz_invlin_(y,collatz_mode_-1)
}

# Attempt to find a solution to y=collatz_pcos_(x,k) for x
# . Where y is integer, finds a valid Collatz inverse
#   Otherwise finds solution with smallest magnitude
define collatz_arcpcos_(y,k) {
  auto a,b,ca,cb,t,s,x
  if(y==floor(y))return collatz_invlin_(y,k)
  .=collatz_piecewise__(y,k)
  if(x!=1)return x
  x=(y-ca)/(cb-ca);x=1-x-x
  x=arccos(x)/pi()+a
  return x
}
define collatz_arcpcos(y) {
  if(!check_collatz_mode_())return 0
  return collatz_arcpcos_(y,collatz_mode_-1)
}

# TO DO: improve the following further

# Attempt to find a solution to y=collatz_cos_(x,k) for x
define collatz_arccos_(y,k) {
  auto os,x,t,d,nd,v,eps;
  if(y==floor(y))return collatz_invlin_(y,k)
  os=scale;eps=A^-os;scale+=length(y)-scale(y)+1
  x=collatz_arcpcos_(y,k) # got to start somewhere
  if(x==floor(x))x-=eps
  v=1/4;d=1
  while(d>eps&&v){
    t=collatz_cos_(x-v,k)
    nd=abs(t-y)
    if(nd>d){
      t=collatz_cos_(x+v,k)
      nd=abs(t-y)
      if(nd>d){nd=d}else{x+=v}
    }else{x-=v}
    d=nd;v/=2
  }
  scale=os;return x/1
}
define collatz_arccos(y) {
  if(!check_collatz_mode_())return 0
  return collatz_arccos_(y,collatz_mode_-1)
}

# Attempt to find a solution to y=collatz_linb_(x,k) for x
define collatz_invlinb_(y,k) {
  auto os,x,t,d,nd,v,eps;
  if(y==floor(y))return collatz_invlin_(y,k)
  os=scale;eps=A^-os;scale+=length(y)-scale(y)+1
  x=collatz_invlin_(y,k) # got to start somewhere
  if(x==floor(x))x-=eps
  v=1/4;d=1
  while(d>eps&&v){
    t=collatz_linb_(x-v,k)
    nd=abs(t-y)
    if(nd>d){
      t=collatz_linb_(x+v,k)
      nd=abs(t-y)
      if(nd>d){nd=d}else{x+=v}
    }else{x-=v}
    d=nd;v/=2
  }
  scale=os;return x/1
}
define collatz_invlinb(y) {
  if(!check_collatz_mode_())return 0
  return collatz_invlinb_(y,collatz_mode_-1)
}
#!/usr/local/bin/bc -l

### Complex.BC - Rudimentary complex number handling for GNU BC

  ## Not to be regarded as suitable for any purpose
  ## Not guaranteed to return correct answers

# Uses the undocumented pass-by-reference method for arrays
# Uses arrays to store complex and imaginary parts

# Most functions are of the form f(*c, otherparams) meaning c = f(otherparams)

# Code can be somewhat unwieldy
# e.g. .= makecomplex(a[],1,2) sets a[] to be the complex number 1+2i

# Non-trivial example: To find the absolute value of the arc-cosine of 1+2i
# i.e. |arccos(1+2i)|, use: .=makecomplex(a[],1,2)+carccos(a[],a[]);cabs(a[])
# ".=" is a bc trick to suppress output of function values
# the "+" sign is used because it is shorter than ";.="
#   i.e. end of statement and further output suppression
# carccos(a[],a[]) means a = arccos(a)
#   n.b. the first a[] is passed by reference, the second is by value
# cabs() is used on its own as it returns a proper bc number

# make a complex number from real and imaginary parts
define makecomplex(*c__[],r,i) {
  c__[0]=r;c__[1]=i
}

.= makecomplex(complex0[],0,0)
.= makecomplex(complex1[],1,0)
.= makecomplex(complex2[],2,0)
.= makecomplex(complexi[],0,1)

define makeomega() {
  auto mh,hs3
  mh=-1/2;hs3=sqrt(3)/2
  .= makecomplex(complexomega[] ,mh, hs3)
  .= makecomplex(complexomega2[],mh,-hs3)
}
.= makeomega()

## Arrays - can't have an array of arrays in bc so workarounds required

define carrayget(*c__[],a__[],i) { # c = a[i]
  c__[0] = a__[i+=i]
  c__[1] = a__[i+=1]
}

define carrayset(*a__[],i,c__[]) { # a[i] = c
  a__[i+=i] = c__[0]
  a__[i+=1] = c__[1]
}

## Useful basics

# copy right hand parameter's contents into left; i.e. c = x
define cassign(*c__[],x__[]) {
  c__[0]=x__[0];c__[1]=x__[1]
}

# Assign the complex conjugate of a complex number; c = x*
define cconj(*c__[],x__[]) {
  c__[0]=x__[0];c__[1]=-x__[1]
}

# Turn a complex into its own conjugate
define cconjself(*c__[]) {
  c__[1]=-c__[1]
}

# Negate a complex; i.e. c*=-1
define cnegself(*c__[]) {
  c__[0]=-c__[0]
  c__[1]=-c__[1]
}

# assign the negative of the right hand side to the left; c = -x
define cneg(*c__[],x__[]) {
  c__[0]=-x__[0]
  c__[1]=-x__[1]
}

# Extract the real part; Re c
define real(c__[]) {
  return c__[0]
}

# Extract the imaginary part; Im c
define imag(c__[]) {
  return c__[1]
}

# Calculates the absolute value of a complex number; |c|
# NB: returns a standard bc number and not a new fangled 'complex'
define cabs(c__[]) {
  return sqrt(c__[0]^2+c__[1]^2)
}

# Print a generated complex number
define printc(c__[]) {
  auto r,i
  r = c__[0]
  i = c__[1]
  print r
  if(i<0){print " -";i=-i}else{print " +"}
  print " i*",i,"\n"
}

## Boolean

define cequal(a__[],b__[]) {
  return (a__[0]==b__[0])&&(a__[1]==b__[1])
}

## Basic math

# Add two complex numbers; c = a + b
define cadd(*c__[],a__[],b__[]) {
  c__[0]=a__[0]+b__[0]
  c__[1]=a__[1]+b__[1]
}

define caddassign(*c__[],b__[]) { # c += b
  c__[0]+=b__[0]
  c__[1]+=b__[1]
}

# Subtract a complex number from another; c = a - b
define csub(*c__[],a__[],b__[]) {
  c__[0]=a__[0]-b__[0]
  c__[1]=a__[1]-b__[1]
}

define csubassign(*c__[],b__[]) { # c -= b
  c__[0]-=b__[0]
  c__[1]-=b__[1]
}

# Multiply two complex, return complex; c = a * b
define cmul(*c__[],a__[],b__[]) {
  c__[0]=a__[0]*b__[0]-a__[1]*b__[1]
  c__[1]=b__[0]*a__[1]+a__[0]*b__[1]
}

define cmulassign(*c__[],b__[]) { # c *= b
  auto a__[];
  return cassign(a__[],c__[])+cmul(c__[],a__[],b__[])
}

# Divide one complex by another, returning a third
define cdiv(*c__[],a__[],b__[]) {
  auto aa;
  aa = b__[0]^2+b__[1]^2
  c__[0]=(a__[0]*b__[0]+a__[1]*b__[1])/aa
  c__[1]=(b__[0]*a__[1]-a__[0]*b__[1])/aa
}

define cdivassign(*c__[],b__[]) { # c /= b
  auto a__[];
  return cassign(a__[],c__[])+cdiv(c__[],a__[],b__[])
}

## Basic Math II - fast[er] squaring, square roots and integer power

# Square a complex number; c = x^2
define csquare(*c__[],x__[]) {
  c__[0]=x__[0]^2-x__[1]^2
  c__[1]=2*x__[0]*x__[1]
}

define csquareself(*c__[]) { # c*=c or c^=2
  auto a__[];
  return cassign(a__[],c__[])+csquare(c__[],a__[]) # a = c; c = a^2
}

# Find the primary square root of a complex number; c = sqrt(x)
define csqrt(*c__[],x__[]) {
  auto r,i, sr, si
  if(x__[1]==0){if(x__[0]>=0){
    c__[0]=sqrt(x__[0]);c__[1]=0
    return;
  } else {
    c__[0]=0;c__[1]=sqrt(-x__[0])
    return;
  }}
  c__[0] = sqrt((sqrt(x__[0]^2+x__[1]^2)+x__[0])/2)
  c__[1] = x__[1]/c__[0]/2
}

define csqrtself(*c__[]) { # c = sqrt(c)
  auto a__[];
  return cassign(a__[],c__[])+csqrt(c__[],a__[]) # a = c; c = sqrt(a)
}

# subfunctions for use by cintpow
define mod(n,m) {auto s;s=scale;scale=0;n%=m;scale=s;return(n)}
define int(n)   {auto s;s=scale;scale=0;n/=1;scale=s;return(n)}

# Raise a complex number [z] to an integer power [n]
# NB: n is a standard bc number and not a complex
define cintpow(*c__[], z[], n) { # c = z^n
  n = int(n)
  if(n<0) { 
    .= cintpow(c__[], z[], -n); # c = z^-n
    .= cdiv(c__[], complex1[], c__[]);   # c = 1/c
    return;
  }
  if(n==0)return( cassign(c__[],one[]) ) ; # c = 1
  if(n==1)return( cassign(c__[],  z[]) ) ; # c = z^1 == z
  if(n==2)return( csquare(c__[],  z[]) ) ; # c = z^2
  .= cassign(c__[],complex1[]) ; # c = 1
  while(n) { 
    if(mod(n,2)) {
      .= cmulassign(c__[], z[]) # c *= z
      n -= 1
    } else {
      .= csquareself(z[])
      n = int(n/2)
    }
  }
}

define cintpowassign(*c__[],n) { # c ^= n
  auto a__[];
  return cassign(a__[],c__[])+cintpow(c__[],a__[],n) # a = c; c = sqrt(a)
}

## Other

# find the sign; c = sgn(x) = x/|x|
define csgn(*c__[],x__[]) {
  auto aa;
  if(x__[0]==0&&x__[1]==0) return c__[0]=c__[1]=0;
  aa = cabs(x__[]);
  c__[0]=x__[0]/aa;c__[1]=x__[1]/aa
}

define csgnself(*x__[]) { # x /= |x|
  auto aa;
  if(x__[0]==0&&x__[1]==0) return;
  aa = cabs(x__[]);
  x__[0]/=aa;x__[1]/=aa
}

# Arctangent (two real arguments)
# . borrowed from funcs.bc
define arctan2(x,y) { 
  auto p;
  if(x==0&&y==0)return(0)
  p=((y<0)+1-(y>0))*2*a(1)*(2*(x>=0)-1)
  if(x==0||y==0)return(p)
  return(p+a(x/y))
}

# Argument of complex number; returns standard bc number
define carg(c__[]) {
  return arctan2(c__[1],c__[0])
}

# cos + i sin -> cis; x is a standard bc number
# . for complex x see ccis()
define cis(*c__[],x) {
  c__[0] = c(x)
  c__[1] = s(x)
}

## Exponentials

define cln(*c__[],x__[]) { # c = ln(x) == l(x)
  c__[0] = l(cabs(x__[]))
  c__[1] = carg(x__[])
}

define clnself(*c__[]) { # c = ln(x) == l(x)
  auto t;
  t = carg(c__[])
  c__[0] = l(cabs(c__[]))
  c__[1] = t
}

define cexp(*c__[],x__[]) { # c = exp(x) == e(x)
  auto e;
  e = e(x__[0])
  c__[0] = e*c(x__[1])
  c__[1] = e*s(x__[1])
}

define cexpself(*c__[]) { # c = exp(c) == e(c)
  auto e;
  e = e(c__[0])
  c__[0] = e*c(c__[1])
  c__[1] = e*s(c__[1])
}

define cpow(*c__[],a__[],b__[]) { # c = a^b
  .= printc
  .= clnself(a__[])          # a = ln(a)
  .= cmulassign(a__[],b__[]) # a *= b
  .= cexp(c__[],a__[])       # c = exp(a) == e(a)
}

define cpowassign(*c__[],b__[]) { # c ^= b
  .= clnself(c__[])          # c = ln(c)
  .= cmulassign(c__[],b__[]) # c *= b
  .= cexpself(c__[])         # c = exp(c) == e(c)
}

## Trig

define csin(*c__[],x__[]) {
  auto e,em;
  e=e(x__[1]);em=1/e
  c__[0]=(e+em)/2*s(x__[0])
  c__[1]=(e-em)/2*c(x__[0])
}

define ccos(*c__[],x__[]) {
  auto e,em;
  e=e(x__[1]);em=1/e
  c__[0]=(em+e)/2*c(x__[0])
  c__[1]=(em-e)/2*s(x__[0])
}

define ctan(*c__[],x__[]) {
  auto e,em,d;
  x__[0]+=x__[0];x__[1]+=x__[1]
  e=e(x__[1]);em=1/e
  d=c(x__[0])+(e+em)/2
  c__[0]=s(x__[0])/d
  c__[1]=(e-em)/(d+d)
}

define ccis(*c__[],x__[]) {
  auto e;
  e = e(-x__[1])
  c__[0]=c(x__[0])*e
  c__[1]=s(x__[0])*e
}

define ccosec(*c__[],x__[]) {
  return csin(c__[],x__[]) + cdiv(c__[],complex1[],c__[]) # c = sin(x); c = 1/c
}

define csec(*c__[],x__[]) {
  return ccos(c__[],x__[]) + cdiv(c__[],complex1[],c__[]) # c = cos(x); c = 1/c
}

define ccotan(*c__[],x__[]) {
  return ctan(c__[],x__[]) + cdiv(c__[],complex1[],c__[]) # c = tan(x); c = 1/c
}

define csinh(*c__[],x__[]) {
  auto e,em;
  e = e(x__[0]);em=1/e
  c__[0]=(e-em)/2*c(x__[1])
  c__[1]=(e+em)/2*s(x__[1])
}

define ccosh(*c__[],x__[]) {
  auto e,em;
  e = e(x__[0]);em=1/e
  c__[0]=(em-e)/2*c(x__[1])
  c__[1]=(em+e)/2*s(x__[1])
}

define ctanh(*c__[],x__[]) {
  auto e,em,d;
  x__[0]+=x__[0];x__[1]+=x__[1]
  e=e(x__[0]);em=1/e
  d=c(x__[1])+(e+em)/2
  c__[0]=(e-em)/(d+d)
  c__[1]=s(x__[1])/d
}

define ccosech(*c__[],x__[]) {
  return csinh(c__[],x__[]) + cdiv(c__[],complex1[],c__[]) # c = sinh(x); c = 1/c
}

define csech(*c__[],x__[]) {
  return ccosh(c__[],x__[]) + cdiv(c__[],complex1[],c__[]) # c = cosh(x); c = 1/c
}

define ccotanh(*c__[],x__[]) {
  return ctanh(c__[],x__[]) + cdiv(c__[],complex1[],c__[]) # c = tanh(x); c = 1/c
}

# Inverse Trig

define carcsin(*c__[],x__[]) {
  .= cmul(c__[],complexi[],x__[]) # c = i*x
  .= csquareself(x__[])           # x = x^2
  .= csub(x__[],complex1[],x__[]) # x = 1-x
  .= csqrtself(x__[])             # x = sqrt(x)
  .= caddassign(c__[],x__[])      # c += x
  .= clnself(c__[])               # c = ln(c)
  .= cmulassign(c__[],complexi[]) # c *= i
  .= cnegself(c__[])              # c = -c
}

define carccos(*c__[],x__[]) {
  .= cmul(c__[],complexi[],x__[]) # c = i*x
  .= csquareself(x__[])           # x = x^2
  .= csub(x__[],complex1[],x__[]) # x = 1-x
  .= csqrtself(x__[])             # x = sqrt(x)
  .= caddassign(c__[],x__[])      # c += x
  .= clnself(c__[])               # c = ln(c)
  .= cmulassign(c__[],complexi[]) # c *= i
     c__[0] += 2*a(1)             # c += pi/2
}

define carctan(*c__[],x__[]) {
  .= cmulassign(x__[],complexi[]) # x *= i
  .= csub(c__[],complex1[],x__[]) # c = 1-x
  .= caddassign(x__[],complex1[]) # x += 1
  .= clnself(c__[])               # c = ln(c)
  .= clnself(x__[])               # x = ln(x)
  .= csubassign(c__[],x__[])      # c -= x
  .= cmulassign(c__[],complexi[]) # c *= i
     c__[0]/=2;c__[1]/=2          # c /= 2
}

define carccis(*c__[],x__[]) {
  .= cassign(c__[],x__[])    # c = x
  .= csquareself(c__[])      # c ^= 2
     c__[0] += 1             # c += 1
  .= caddassign(x__[],x__[]) # x += x == x *= 2
  .= cdivassign(c__[],x__[]) # c /= x
  .= carccos(c__[],c__[])    # c = arccos(c)
}

define carccosec(*c__[],x__[]){
  .= cdiv(x__[],complex1[],x__[]) # x = 1/x
  .= carcsin(c__[],x__[])         # c = arcsin(x)
}

define carcsec(*c__[],x__[]){
  .= cdiv(x__[],complex1[],x__[]) # x = 1/x
  .= carccos(c__[],x__[])         # c = arccos(x)
}

define carccotan(*c__[],x__[]){
  .= cdiv(x__[],complex1[],x__[]) # x = 1/x
  .= carctan(c__[],x__[])         # c = arctan(x)
}

define carcsinh(*c__[],x__[]) {
  .= cassign(c__[],x__[])    # c = x
  .= csquareself(x__[])      # x = x^2
     x__[0] += 1             # x += 1
  .= csqrtself(x__[])        # x = sqrt(x)
  .= caddassign(c__[],x__[]) # c += x
  .= clnself(c__[])          # c = ln(c)
}

define carccosh(*c__[],x__[]) {
  .= cassign(c__[],x__[])    # c = x
  .= csquareself(x__[])      # x = x^2
     x__[0] -= 1             # x -= 1
  .= csqrtself(x__[])        # x = sqrt(x)
  .= caddassign(c__[],x__[]) # c += x
  .= clnself(c__[])          # c = ln(c)
}

define carctanh(*c__[],x__[]) {
  .= cassign(c__[],x__[])         # c = x
     c__[0] += 1                  # c += 1
  .= csub(x__[],complex1[],x__[]) # x = 1-x
  .= clnself(c__[])               # c = ln(c)
  .= clnself(x__[])               # x = ln(x)
  .= csubassign(c__[],x__[])      # c -= x
     c__[0]/=2;c__[1]/=2          # c /= 2
}

define carccosech(*c__[],x__[]){
  .= cdiv(x__[],complex1[],x__[]) # x = 1/x
  .= carcsinh(c__[],x__[])        # c = arcsinh(x)
}

define carcsech(*c__[],x__[]){
  .= cdiv(x__[],complex1[],x__[]) # x = 1/x
  .= carccosh(c__[],x__[])        # c = arccosh(x)
}

define carccotanh(*c__[],x__[]){
  .= cdiv(x__[],complex1[],x__[]) # x = 1/x
  .= carctanh(c__[],x__[])        # c = arctanh(x)
}# cosconst = rootof(x = cos(x))

cosconst=\
.7390851332151606416553120876738734040134117589007574649656806357732\
84654883547594599376106931766531849801246643987163027714903691308420\
31578044057462077868852490389153928943884509523480133563127677223158\
09563537765724512043734199364335125384097800343406467004794021434780\
80271801883771136138204206631633503727799169673122323006138865820362\
17708109978970626842405880948986832618606004858989585487257367640150\
75227608180391459518101628159120096461646067544051326415171064466281\
10936082584878371383955556175141494715939006277527563258634938869730\
14083665152511520426788515302529417180365176420177086071899276016098\
74327154552267565798246297611775539616699549311158566534834953838523\
15963602527499558725250666640131318740139253888805520618698592139252\
52854154110791002998282929864052169046554736696871438735646006521225\
46891499759209699758501364249508565047324972584248371554836483437275\
83746752545335800664200478839718858489014531155060417812337047773953\
4717103451195854600726561464721419787537388023680

/*
  scale=1000;pi_2=a(1)*2
  for(scale=10;scale<=1000;scale+=5){
    eps=A^(1-scale);p=pi_2/1
    oc=0;while(abs(oc-c)>eps){
      oc=c;s=s(c+p);c=(c+s+s)/3
    }
    c
  }
*/#!/usr/local/bin/bc -l

### Digits.BC - Treat numbers as strings of digits

bijective=0
# Returns x mod y, but sets 0 mod y to be y itself in bijective mode
# . Old version: define bmod_(x,y) { if(bijective){return (x-1)%y+1}else{return x%y} }
# . This version sets a global variable called bdiv_ containing the result
# . . of the complementary division
define bmod_(x,y) { return x-y*(bdiv_=(x-=bijective)/y); }

# Workhorse function - use POSIX scope to check
# . 'base' parameter of many functions here
define base_check_() {
  if(base<2-(bijective=!!bijective)){
    if(base<=-2){
      print "Negative bases not currently supported; "
    } else if(base==-1||base==0||base==1) {
      print "Nonsense base: ",base,"; "
    }
    print "Using ibase instead.\n"
    base=ibase
  }
}

# Number of digits in the base representation of x
# (compare the int_log function in funcs.bc)
define digits(base,x) { 
 auto os,p,c;
 os=scale;scale=0;base/=1;x/=1
  if(x<0)x=-x
  .=base_check_()
  if(bijective&&base==1){scale=os;return x}
  if(x==0){scale=os;return !bijective}
  if(bijective)x=x*(base-1)+1
  if(x<base){scale=os;return(1)}
  c=length(x) # cheat and use what bc knows about decimal length
  if(base==A){scale=os;return c-bijective}
  if(base<A){
   if(x>A){c*=(digits(base,A)-1);if(base<4)c-=2}else{c=0}
  }else{
   c/=length(base)
  }
  p=base^c
  while(p<=x){.=c++;p*=base}
 scale=os;return(c-bijective)
}

# Sum of digits in a number: 1235 -> 11 in base ten
define digit_sum(base,x) {
 auto os,t;
 os=scale;scale=0;base/=1;x/=1
  .=base_check_()
  t=0;while(x){t+=bmod_(x,base);x=bdiv_}
 scale=os;return(t)
}

# Workhorse for the next two functions
define digit_distance_(base,x,y,sh) {
  auto os,sgn,dx,dy,d,t;
  os=scale;scale=0;base/=1;x/=1;y/=1
  if(x==y||x==-y){scale=os;return 0}
  if(x==0||y==0){scale=os;return digit_sum(base,x+y)}
  .=base_check_()
  sign=1
  if(x<0){x=-x;sign=-sign}
  if(y<0){y=-y;sign=-sign}
  t=0;
  while(x||y){
    dx=bmod_(x,base);x=bdiv_
    dy=bmod_(y,base);y=bdiv_
    d=dx-dy
    if(d<0)d=-d;if(sh)if(d+d>base)d=base-d
    t+=d
  }
  scale=os;return sign*t
}

# Digit distance between two numbers:
# . e.g. 746(-)196 -> |7-1|+|4-9|+|6-6| = 6+5+0 = 11 in base ten
# . Degenerates to digit_sum if either of x or y is zero
# . Not equivalent to hamming distance
# . + which merely counts the number of differences
# . . See logic_otherbase.bc for hamming distance function
define digit_distance(base,x,y) {
  return digit_distance_(base,x,y,0)
}

# Digit distance between two numbers assuming shortest path modulo
#  the given base, e.g. shortest distance between 2 and 8 mod ten is 4
# . e.g. 746((-))196 -> 4 + 5 + 0 = 9 base ten
define digit_sdistance(base,x,y) {
  return digit_distance_(base,x,y,1)
}

# Product of digits in number
# e.g. 235 -> 2*3*5 = 30 in base ten
# . see digits_misc.bc for two alternatives to this function
define digit_product(base,x) { 
 auto os,t;
 if(x<0)return digit_product(base,-x);
 os=scale;scale=0;base/=1;x/=1
  .=base_check_()
  t=1;while(x&&t){t*=bmod_(x,base);x=bdiv_}
 scale=os;return(t)
}

# Reverse the digits in x using given base
define reverse(base,x) {
 auto os,y;
 os=scale;scale=0;base/=1;x/=1
  .=base_check_()
  y=0;while(x){y=base*y+bmod_(x,base);x=bdiv_}
 scale=os;return(y) 
}

## Palindromes

# Determine if x is a palindrome in the given base
define is_palindrome(base,x){
 if(x<0)x=-x
 return reverse(base,x)==x
}

# Determine if x is a pseudopalindrome in the given base
# - a pseudopalindrome is a number that could be a palindrome
#   if a number of zeroes is prepended to the beginning;
#   e.g. 101 is a palindrome, but 1010 is not, however 01010,
#     which represents the same value, is palindromic
#   All palindromes are also pseudopalindromes since the prepending
#     of no zeroes at all is also an option
define is_pseudopalindrome(base,x){
 auto os
 if(bijective)return is_palindrome(base,x);
 os=scale;scale=0;base/=1;x/=1
  .=base_check_()
  if(x==0){scale=os;return 1}
  if(x<0)x=-x
  while(x%base==0)x/=base
 scale=os;return reverse(base,x)==x
}

# returns an odd-lengthed palindrome in the given base, specified by x
define make_odd_palindrome(base, x) {
  auto s
  .=base_check_()
  s=1;if(x<0){s=-1;x=-x}
  x+=bijective;.=bmod_(x,base)
  x=x*base^(digits(base,x)-1) + reverse(base,bdiv_)
  return s*x
}

# returns an even-lengthed palindrome in the given base, specified by x
define make_even_palindrome(base, x) {
  auto s
  .=base_check_()
  s=1;if(x<0){s=-1;x=-x}
  x+=bijective;
  x=x*base^digits(base,x) + reverse(base,x)
  return s*x
}

   #base ten thoughts:
   #output will have either 2n-1 or 2n digits
   #x=19; => n=digits((19+1)/2)= digits(10)=2
   #block for n=1 runs from 1   to 1  +9  +9  -1=18
   #block for n=2 runs from 19  to 19 +90 +90 -1=198
   #block for n=3 runs from 199 to 199+900+900-1=1998
   #block for n runs from 2*10^(n-1)-1 to 2*10^n-2
   # where is x within that block?
   #  last entry of first half of block is akin to 19+90-1=108 or 199+900-1=1098
   #  i.e. 10^n-10^(n-1)-2 = 11*10^(n-1)-2
   # so if x < 11*10^(n-1)-1, x is in the first half
   #
   # if x is in first  half, must subtract 9 or 99 etc. = 10^(n-1)-1
   # if x is in second half, must subtract 99 or 999 etc. = 10^n - 1
   # depending on half choose odd or even palindrome based on x

# for each integer x, return a unique palindrome in the given base
#  i.e. map the integers into palindromes
#  n.b. map _is_ strictly increasing
define map_palindrome(base, x) {
  auto os,r,s
  if(bijective){"unimplemented for bijective";return 1/0}
  os=scale;scale=0;x/=1
   s=1;if(x<0){s=-1;x=-x}
   .=base_check_()
   r=base^(digits(base,(x+1)/2)-1)
   if(x<(base+1)*r-1){
     x = make_odd_palindrome(base,x-r+1)
   } else {
     x = make_even_palindrome(base,x-r*base+1)
   }
  scale=os;return s*x
}

# from a palindrome in a given base, generate a unique integer
#  i.e. map the class of palindromes into the integers
define unmap_palindrome(base, x) {
  auto os,r,s
  if(bijective){"unimplemented for bijective";return 1/0}
  os=scale;scale=0
   s=1;if(x<0){s=-1;x=-x}
   .=base_check_()
   r=base^(digits(base,x)/2)
   x=x/r+r-1
  scale=os;return s*x
}

## Stringification

# Determine if a small number is a substring of a larger number in the given base
define is_substring(base,large,small) {
 auto os,m;
 if(bijective){"unimplemented for bijective";return 1/0}
 os=scale;scale=0;base/=1;large/=1;small/=1;
  .=base_check_()
  if(large<0)large=-large
  if(small<0)small=-small
  m=base^digits(base,small)
  while(large){if(large%m==small){m=0;break};large/=base}
 scale=os;return(m==0) 
}

# Catenate (join lexically) two integers in the given base
# e.g. in base ten, the catenation of 1412 and 4321 is 14124321
define int_catenate(base, x,y){
 auto os;
 if(bijective){"unimplemented for bijective";return 1/0}
 os=scale;scale=0;base/=1;x/=1;y/=1
  .=base_check_()
  if(x<0)x=-x
  if(y<0)y=-y
 scale=os;return x*base^digits(base,y)+y
}

# Return the specified number of leftmost digits of a number in the given base
define int_left(base, x, count){
 auto os;
 if(bijective){"unimplemented for bijective";return 1/0}
 os=scale;scale=0;base/=1;x/=1;count/=1
  .=base_check_()
  if(count<0)count=0;
  count=base^count;while(x>=count)x/=base;
 scale=os;return x
}

# Return the specified number of rightmost digits of a number in the given base
define int_right(base, x, count){
 auto os;
 if(bijective){"unimplemented for bijective";return 1/0}
 os=scale;scale=0;base/=1;x/=1;count/=1
  .=base_check_()
  if(count<0)count=0;
  x%=base^count
 scale=os;return x
}

# Return the specified digits of a number in the given base
define int_mid(base, x, start, end){
 auto os,lsz;
 if(bijective){"unimplemented for bijective";return 1/0}
 os=scale;scale=0;base/=1;x/=1;start/=1;end/=1
  .=base_check_()
  if(start<0)start=0;
  if(end<start){scale=os;return 0}
  lsz=base^end;while(x>=lsz)x/=base;
  x%=base^(end-start+1)
 scale=os;return x
}

## Cantor reinterpretation

# Set to zero to suppress warnings from cantor()
cantorwarn_=1

# 0 = don't perform baseto modulus on digit; 1 = modulus
cantormod_=0

# Error checker for below
define cantor_trans_(d) {
  d=d*mul+cons;
  if(scale(d)){
   if(os<5)scale=5 else scale=os;
    d+=A^(2-scale)
   scale=0;d/=1
  }
  if(cantormod_){
    d-=bijective
    d%=baseto;if(d<0)d+=baseto
    d+=bijective
  }
  if(cantorwarn_)if((bijective>d||d>=abt+bijective)&&!warned){
    warned=1;print "cantor warning: made ";
    if(d==0){print "bad zero"
    } else if(bijective>d){print "negative"}else{print "oversized"}
    print " digit for destination base\n";
  }
  return d
}

# Workhorse for managing -ve basefroms
define cantor_trans_negabase_(basefrom, baseto, mul, cons, x) {
  auto os,i,bf2,bt2,d,a[],shft,y,p,abt
  os=scale;scale=0;basefrom/=1;baseto/=1
  if(basefrom>1)base=-base
  if(basefrom>-2)base=-obase
  bf2=basefrom*basefrom
  bt2=baseto*baseto
  abt=baseto;if(abt<0)abt=-abt
  bijective=!!bijective
  i=x/1;shft=0;if(x!=i)shft=1
  if(bijective&&shft){
    shft=0
    if(cantorwarn_){
      print "cantor warning: can't do fractional part in bijective mode\n"
    }
  }
  p=bt2
  if(shft){
    d=A^scale(x)
    shft=-1
    p=1;for(i=1;i<=d;i*=bf2){.=shft++;p*=bt2}
    shft+=shft
    x*=i/bf2
  }
  for(i=1;x;i++){
    d=((x-bijective)%basefrom)+bijective;if(d<bijective)d-=basefrom;a[i]=d/1
    if(shft)if(!--shft)a[++i]=-1
    x=(x-d)/basefrom
  }
  if(shft){
    while(shft--)a[i++]=0
    a[i++]=-1
  }
  y=0
  for(--i;i;i--)if((d=a[i])==-1){
   # skip decimal point
  } else {
   y=y*baseto+cantor_trans_(d)
  }
  scale=os;return (y*bt2)/p
}

# Treat x's representation in basefrom as a representation
# in baseto and return the resulting number, allowing for a translation
# of digits via multiplier and offset constant
# e.g. Cantor's original transformation from binary to ternary
#      can be represented here by cantor_trans(2,3, 2,0, x)
#      i.e. from base 2 to base 3, multiplying by 2, adding nothing (0)
define cantor_trans(basefrom, baseto, mul, cons, x) {
  auto d,y,p,ix,fx,os,warned,abt;
  cantorwarn_=!!cantorwarn_; bijective=!!bijective;
  os=scale;scale=0
  basefrom/=1;baseto/=1
  ix=2-bijective;fx=3-bijective;d=0
  if(-2<basefrom&&basefrom<ix)d=basefrom=ix
  if(-2<baseto&&baseto<ix)d=baseto=fx
  if(d&&cantorwarn_)print "cantor warning: bad base supplied.\n"
  if(basefrom==baseto&&mul==1&&cons==0){scale=os;return x}
  if(basefrom<0){scale=os;return cantor_trans_negabase_(basefrom,baseto,mul,cons,x)}
  abt=baseto;if(abt<0)abt=-abt
  ix=x/1;fx=x-ix
  warned=0
  p=1
  # integer part
  while(ix){
    d=bmod_(ix,basefrom)
    ix=bdiv_
    y+=p*cantor_trans_(d)
    p*=baseto
  }
  if(fx==0){scale=os;return y}
  if(bijective){
    if(cantorwarn_){
      print "cantor warning: can't do fractional part in bijective mode\n"
    }
    scale=os;return y
  }
  # fractional part
  p=1
  scale=os+=os
  while(p){
    fx*=basefrom;
    scale=0;d=fx/1;fx-=d;scale=os
    p/=baseto
    scale=0;y+=p*cantor_trans_(d);scale=os
  }
 scale/=2
 return y/1  
}

# Treat x's representation in basefrom as a representation
# in baseto and return the resulting number
define cantor(basefrom, baseto, x) {
  if(basefrom==baseto)return x;
  return cantor_trans(basefrom, baseto, 1, 0, x)
}#!/usr/local/bin/bc -l

### Digits-Describe.BC - Numbers that describe numbers

  ## aka "Look and say" numbers

# Workhorse for the below
define describe_(opt,base,x) {
  auto os,c,od,d,p,y,er;
  os=scale;scale=0
  x/=1;if(x<0)x=-x
  p=1;y=0;er=0;while(x){
   d=x%base;c=0
   while(x%base==d){.=c++;x/=base}
   if(!er&&c>=base){
     er=1;print "describe_count"
     if(opt){print"last"}else{print"first"}
     print ": count too large; unwanted carry\n"
   }
   if(opt){d=d*base+c}else{d=c*base+d}
   y+=p*d
   p*=base^2
  }
  scale=os;return y
}

# Returns a number which describes the input in the given base
# count first 11233 -> 211223 (two ones, one two, two threes)
define describe_countfirst(base,x) { return describe_(0,base,x) }
# count last 11233 -> 122132 (one twice, two once, three twice)
define describe_countlast(base,x) {  return describe_(1,base,x) }

# Workhorse for the below
define parserle_(opt,base,x) {
  auto os,c,d,p,y,er;
  os=scale;scale=0
  x/=1;if(x<0)x=-x
  p=1;y=0;er=0;while(x){
    if(opt){c=x%base;x/=base}
    d=x%base;x/=base
    if(!opt){c=x%base;x/=base}
    if(!er&&c==0){
      er=1;print "parserle_count"
      if(opt){print"last"}else{print"first"}
      print": invalid input detected\n"
    }
    for(.=.;c;c--){y+=p*d;p*=base}
  }
  scale=os;return y
}

# Inverse of the 'describe' functions; Parse the Run Length Encoding
define parserle_countfirst(base,x) { return parserle_(0,base,x) }
define parserle_countlast(base,x) {  return parserle_(1,base,x) }
#!/usr/local/bin/bc -l

### Digits-Happy.BC - Tracking the chain of numbers which leads to happiness

max_array_ = 4^8-1
bijective = 0

# Workhorse function - use POSIX scope to check
# . 'base' parameter of many functions here
define base_check_happy_() {
  bijective=(b=!!bijective)
  if(base<2){
    if(base<=-2){
      print "Negative bases not currently supported; "
    } else if(base==-1||base==0||base==1) {
      print "Nonsense base: ",base,"; "
    }
    print "Using ibase instead.\n"
    base=ibase
  }
}

# Definition of a happy number:
#  In a given base, take the digits of a number,
#    square each one and sum them
#  If, in repeating this process, the number 1
#    is reached (or the value of the given base
#    itself in the case of bijective numeration)
#    then the number is considered to be 'happy'

# Generalised happy number determination
#  returns 1 if x is happy in the given base
#   when raising digits to the given power
#  The original happy numbers are determined using
#   base ten and squaring of digits, i.e. is_happy(A,2,x)
define is_happy(base,pow,x) {
  auto os,t,i,tape[],tapetop,b;
  os=scale;scale=0
  base/=1;pow/=1;x/=1
  .=base_check_happy_()
  if(pow <1)pow=2
  if(x<0)x=-x
  if(x==0){scale=os;return 0}
  tapetop=-1
  while(1){
    for(t=0;x;x/=base)t+=((x-b)%base+b)^pow
    if(t==1||t==base^bijective){scale=os;return 1}
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;return 0}
    if(tapetop++>max_array_){
      print "is_happy: can't calculate happiness; chain too long\n"
      scale=os;return 0
    }
    tape[tapetop]=x=t
  }
}

# Print the chain of iterations of x until a loop or 1
define happy_print(base,pow,x) {
  auto os,t,i,tape[],tapetop,b;
  os=scale;scale=0
  base/=1;pow/=1;x/=1
  .=base_check_happy_()
  if(pow <1)pow=2
  if(x<0)x=-x
  if(x==0){scale=os;return 0}
  tapetop=-1
  while(1){
    for(t=0;x;x/=base)t+=((x-b)%base+b)^pow
    if(t==1||t==base^bijective){scale=os;return t}
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){scale=os;"looping ";return t}
    if(tapetop++>max_array_){
      print "happy_print: can't calculate happiness; chain too long\n"
      scale=os;return 0
    }
    tape[tapetop]=x=t;t
  }
}

# Return 1 for happy numbers or the smallest number in the loop
# that the iteration becomes trapped within.
define happy_root(base,pow,x) {
  auto os,t,i,tape[],tapetop,b;
  os=scale;scale=0
  base/=1;pow/=1;x/=1
  .=base_check_happy_()
  if(pow <1)pow=2
  if(x<0)x=-x
  if(x==0){scale=os;return 0}
  tapetop=-1
  while(1){
    for(t=0;x;x/=base)t+=((x-b)%base+b)^pow
    if(t==1||t==base^bijective){scale=os;return t}
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){
      #go back the other way looking for the lowest value
      while(++i<=tapetop)if(tape[i]<t)t=tape[i]
      scale=os;return t
    }
    if(tapetop++>max_array_){
      print "happy_root: can't calculate happiness; chain too long\n"
      scale=os;return 0
    }
    tape[tapetop]=x=t
  }
}

# For unhappy numbers, returns the size of the loop the iterations
# become trapped within. e.g. 4 -> 16 -> ... -> 20 -> 4 is a loop of 8
define happy_loopsize(base,pow,x) {
  auto os,t,i,tape[],tapetop,b;
  os=scale;scale=0
  base/=1;pow/=1;x/=1
  .=base_check_happy_()
  if(pow <1)pow=2
  if(x<0)x=-x
  if(x==0){scale=os;return 1}
  tapetop=-1
  while(1){
    for(t=0;x;x/=base)t+=((x-b)%base+b)^pow
    if(t==1||t==base^bijective){scale=os;return 1}
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){ scale=os;return tapetop-i+1 }
    if(tapetop++>max_array_){
      print "happy_loopsize: can't calculate happiness; chain too long\n"
      scale=os;return -1
    }
    tape[tapetop]=x=t
  }
}

# Find how many iterations are required to reach 1 = happiness
define happy_chainlength(base,pow,x) {
  auto os,t,i,c,tape[],tapetop,b;
  os=scale;scale=0
  base/=1;pow/=1;x/=1
  .=base_check_happy_()
  if(pow <1)pow=2
  if(x<0)x=-x
  if(x==0){scale=os;return 0}
  tapetop=-1
  while(1){
    .=c++
    for(t=0;x;x/=base)t+=((x-b)%base+b)^pow
    if(t==1||t==base^bijective){scale=os;return c}
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){ scale=os;return 2-c }# infinity
    if(tapetop++>max_array_){
      print "happy_chainlength: can't calculate happiness; chain too long\n"
      scale=os;return -c
    }
    tape[tapetop]=x=t
  }
}

# All of the above rolled into one. Negative values suggest error condition.
# Global variables are set with the same names as the above functions
# with the exception of global variable happy_print, which should be
# set to non-zero if emulation of the happy_print() function is required
define is_happy_sg(base,pow,x) {
  auto os,t,i,c,tape[],tapetop,b;
  os=scale;scale=0
  base/=1;pow/=1;x/=1
  .=base_check_happy_()
  if(pow <1)pow=2
  if(x<0)x=-x
  if(x==0){
    happy_root        = 0
    happy_loopsize    = 1
    happy_chainlength = 0
    scale=os;return 0
  }
  tapetop=-1
  while(1){
    .=c++
    for(t=0;x;x/=base)t+=((x-b)%base+b)^pow;if(happy_print)t
    if(t==1||t==base^bijective){
      happy_root        = t
      happy_loopsize    = 0
      happy_chainlength = c
      scale=os;return 1
    }
    # Search backwards for previous occurrence of t (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==t){
      happy_loopsize    = tapetop-i+1
      happy_chainlength = 2-c # Infinite
      #go back the other way looking for the lowest value
      while(++i<=tapetop)if(tape[i]<t)t=tape[i]
      happy_root        = t
      scale=os;return 0
    }
    if(tapetop++>max_array_){
      happy_root        = -1 # Error: Unknown
      happy_loopsize    = -1 # Error: Unknown
      happy_chainlength = -c
      print "is_happy_sg: can't calculate happiness; chain too long\n"
      scale=os;return 0 # not happy
    }
    tape[tapetop]=x=t
  }
}
#!/usr/local/bin/bc -l digits.bc

### Digits-Misc.BC - Treat numbers as strings of digits II

 ## Functions of interest but questionable worth

# Workhorse function - use POSIX scope to check
# . 'base' parameter of many functions here
define base_check_misc_() {
  if(bijective)print "Bijective mode not supported by this function.\n"
  if(base<2){
    if(base<=-2){
      print "Negative bases not currently supported; "
    } else if(base==-1||base==0||base==1) {
      print "Nonsense base: ",base,"; "
    }
    print "Using ibase instead.\n"
    base=ibase
  }
}
 
# Product of each digit with one added, less 1
# e.g. 235 -> (2+1)(3+1)(5+1)-1 = 3*4*6 - 1 = 71 in base ten
define digit_product1(base,x) { 
 auto os,t;
 if(x<0)return digit_product1(base,-x);
 os=scale;scale=0;base/=1;x/=1
  .=base_check_misc_()
  t=1;while(x){t*=1+(x%base);x/=base}
 scale=os;return(t-1)
}

# Product of each digit's corresponding odd numbers through the relation
# digit -> 2*digit + 1, then the result is passed through the inverse relation x -> (x-1)/2
# e.g. 13462 -> ( (2*1+1)(2*3+1)(2*4+1)(2*6+1)(2*2+1)-1 )/2 = (3*7*9*13*5 - 1)/2 = 6142
define digit_product2(base,x) { 
 auto os,t;
 if(x<0)return digit_product2(base,-x);
 os=scale;scale=0;base/=1;x/=1
  .=base_check_misc_()
  t=1;while(x){t*=1+2*(x%base);x/=base}
  t=(t-1)/2
 scale=os;return(t)
}

## Swap digit pairs
define sdp(base,x) {
  auto os,b2,t,nx,dd,dl,dr,pw;
  if(x<0)return sdp(base,-x)
  .=base_check_misc_()
  os=scale;scale=0;base/=1
   b2=base*base
   nx=x/1
   if(scale(x)&&x!=nx){
     pw=A^os;for(t=1;t<=pw;t*=b2){}
     nx=(x*t)/1
     scale=os;return sdp(base,nx)/t
   }
   x=nx;pw=1
   for(t=0;x;x=nx){dd=x-(nx=x/b2)*b2;dr=dd-(dl=dd/base)*base;t+=pw*(dr*base+dl);pw*=b2;x=nx}
  scale=os;return t
}

## Palindromes

# Determine if x is a negapalindrome (type 1) in the given base
# - an NP is any number whose opposing pairs of digits,
#   (counted in from either end) sum to one less than the base
# e.g. 147258 is an NP(1) in base ten since 1+8 = 4+5 = 7+2 = 9 = ten - 1
define is_negapalindrome(base,x) {
  auto os
  os=scale;scale=0;base/=1;x/=1
   .=base_check_misc_()
   # divisibility by base-1 is a necessary condition for [P]NP(1)s in even bases
   # divisibility by (base-1)/2 is a necessary condition for [P]NP(1)s in odd bases
   if(x%((base-1)/(1+base%2))!=0){scale=os;return 0}
   if(x<0)x=-x
   x += reverse(base,x)+1
   if(x<base){scale=os;return 0}
   while(x%base==0)x/=base
  scale=os;return(x==1)
}

# workhorse function for is_pseudonegapalindrome
define stripbm1s_(base,x) {
 auto d;d=base-1;
 while(x%base==d){x/=base}
 return x
}

# Determine if x is a pseudonegapalindrome (type 1) in the given base
# - a PNP is a number that could be a negapalindrome
#   if a number of zeroes is prepended to the beginning;
# e.g. 1899 is a PNP in base ten since it can be written 001899
#   All NPs are also PNPs since the prepending
#     of no zeroes at all is also an option
define is_pseudonegapalindrome(base,x) {
 auto os
 os=scale;scale=0;base/=1;x/=1
  .=base_check_misc_()
  # divisibility by base-1 is a necessary condition for [P]NP(1)s
  if(x==0||x%(base-1)!=0){scale=os;return 0}
  if(x<0)x=-x
  x = stripbm1s_(base,x)
  x += reverse(base,x)
  x = stripbm1s_(base,x)
 scale=os;return (x==0)
}

# Determine if x is a negapalindrome (type 2) in the given base
# - an NP is any number whose opposing pairs of digits,
#   (counted in from either end) sum to one less than the base
# e.g. 9415961 is an NP(2) in base ten since 9+1 = 4+6 = 1+9 = 5+5 = ten
#   note that the 5 counts double and pairs with itself
define is_negapalindrome2(base,x) {
  auto os
  os=scale;scale=0;base/=1;x/=1
   .=base_check_misc_()
   if(x<0)x=-x
   x += reverse(base,x)+1
   if(x<base){scale=os;return 0}
   while(x%base==1)x/=base
  scale=os;return (x==0)
}

# There is no such thing as a PNP (type 2) as this would require a digit
# to pair with zero that is equal to the value of the base.

define map_negapalindrome(base, x){
  auto os,r,s
  os=scale;scale=0;x/=1
   s=1;if(x<0)x*=(s=-1)
   .=base_check_misc_()
   if(base%2){
     if(x==0){x=base/2;scale=os;return x}
     r=base^(digits(base,(x+1)/2)-1)
     if(x<(base+1)*r-1){
       #make negapalindrome
       x-=r-1
       r*=base
       x=x*r+reverse(base,r-1-x)
     } else {
       #make negapalindrome with central digit
       r*=base
       x-=r-1
       x=(x*base+base/2)*r+reverse(base,r-1-x)
     }
   } else {
     .=x++ # without this x=0 -> a single digit NP(1), which is invalid for even bases
     r=base^digits(base,x)
     x=x*r+reverse(base,r*base-1-x)/base
   }
  scale=os;return s*x
}

define unmap_negapalindrome(base, x) {
  auto os,r,s
  os=scale;scale=0
   s=1;if(x<0)x*=(s=-1)
   .=base_check_misc_()
   if(base%2){
     r=base^((digits(base,x)+1)/2)
     x=x/r+r/base-1
   } else {
     r=base^(digits(base,x)/2)
     x=x/r-1
   }
  scale=os;return s*x
}

  ## To do (one day): map_ functions for remaining NPs and PNPs
  
## Calculator segments

# Return the number of segments of a 7-segment calculator display that
#   are required to display the value of x in the given base.
# Supports up to base 36; Some calculators may have a different number
#   of segments per number than given here.
define calcsegments(base,x) {
  auto os,oib,s[],t;
  oib=ibase;ibase=A
   s[ 0]=s[ 6]=s[ 9]=s[10]=s[32]=6
   s[ 1]=s[27]=2
   s[ 2]=s[ 3]=s[ 5]=s[11]=s[13]=s[14]=s[16]=s[25]=s[26]=s[31]=s[34]=5
   s[ 4]=s[12]=s[15]=s[17]=s[20]=s[24]=s[28]=s[29]=s[35]=4
   s[ 7]=s[19]=s[21]=s[22]=s[23]=s[30]=s[33]=3
   s[ 8]=7
   s[18]=1
  ibase=oib
  os=scale;scale=0;x/=1
  t=0;if(x<0){t=1;x=-x}
  if(x==0){scale=os;return s[0]}
  if(2>base||base>6*6){
    print "calcsegments: only bases 2 to 36 (decimal) supported\n";
    base=A
  }
  while(x){t+=s[x%base];x/=base}
  scale=os;return t
}

## Miscellaneous

# The base number created by appending all base numbers
# from 1 to x, e.g. in base ten: 1, 12, 123, ..., 123456789101112, etc.
define append_all(base,x) {
 auto a,i,m,l,os;
 os=scale;scale=0;base/=1;x/=1
  .=base_check_misc_()
  if(x<=0)return(0);
  m=1;while(x){l=m;m*=base;for(i=l;i<m&&x;i++){a=a*m+i;.=x--}}
 scale=os;return(a)
}

# returns a number with the digits sorted into descending order
define sort_digits_desc(base,x) {
 auto os,i,d[];
 if(x<0)return sort_digits_desc(base,-x)
 os=scale;scale=0
 base/=1;x/=1
 .=base_check_misc_()
 for(i=0;i<base;i++)d[i]=0
 while(x>0){.=d[x%base]++;x/=base}
 for(i=base-1;i>=0;i--)if(d[i])for(j=0;j<d[i];j++)x=base*x+i
 scale=os
 return x
}

# returns a number with the digits sorted into ascending order
define sort_digits_asc(base,x) {
 auto os,i,d[];
 if(x<0)return sort_digits_asc(base,-x)
 os=scale;scale=0
 base/=1;x/=1
 .=base_check_misc_()
 for(i=0;i<base;i++)d[i]=0
 while(x>0){.=d[x%base]++;x/=base}
 for(i=1;i<base;i++)if(d[i])for(j=0;j<d[i];j++)x=base*x+i
 scale=os
 return x
}

## Digit counting / splitting with arrays

# Count the occurrences of a particular digit in a number in the given base
# . caution - only works on integers
define count_digit(base,x,digit) {
  auto os,count;
  if(x<0)x=-x
  os=scale;scale=0
  base/=1;x/=1
  .=base_check_misc_()
  for(count=0;x;x/=base)if(x%base==digit).=count++
  scale=os;return count
}

# Combination of count_digit(), digits() and an array[]
# . sets an array to contain the counts of all digits in the given base
# . array is terminated by -1
# . e.g. count_digits(a[],A,110247544) = 9 and a[] = {1,2,1,0,3,1,0,1,0,0,-1}
# . caution - only works on integers
define count_digits(*d__[],base,x) {
  auto os,count;
  if(x<0)x=-x
  os=scale;scale=0
  base/=1;x/=1
  .=base_check_misc_()
  for(count=0;count<base;count++)d__[count]=0;
  for(count=0;x;x/=base){.=count++;.=d__[x%base]++}
  d__[base]=-1
  scale=os;return count;
}

# Split the digits of x into the given array
# . handles floating point numbers
# . basimal point is always present, and is represented by an array element
#   whose absolute value is the base (since this is too large to be a digit)
# . the sign of the basimal point value carries the sign of x
#   (hence always needing to be present)
# . array is terminated with -1 (an invalid base for a basimal point)
# . e.g. split_digits(a[],10,-15.725) sets a[] to {1,5,-10,7,2,5,-1}
#        split_digits(a[],10,3) sets a[] to {3,10,-1}
define split_digits(*d__[],base,x) {
  auto os,s,b,i,ix,fx,p;
  if(x==0){d__[0]=0;d__[1]=-1;return 0}
  s=1;if(x<0){s=-1;x=-x}
  os=scale;scale=0
  base/=1
  .=base_check_misc_()
  fx=x-(ix=x/1)
  while(ix%base==0){b++;ix/=base}
  ix=reverse(base,ix);i=0
  while(ix){d__[i++]=ix%base;ix/=base}
  while(b--)d__[i++]=0
  d__[i++]=s*base
  for(p=1;fx&&p<A^os;p*=base){fx*=base;fx-=(d__[i++]=fx/1)}
  d__[i++]=-1;scale=os;return 0
}

# Puts an array generated by split_digits() back together
# . since all relevant information is encoded in the array, only the
#   array parameter is required. will complain on finding a problem
# . To convert numbers digitwise to another base, instead see the
#   cantor*() functions
define join_digits(d__[]) {
  auto os,i,m,n,base,d,s,x,p;
  os=scale;scale=0
  m=n=d__[0];for(i=1;(d=d__[i])!=-1;i++)if(m<d){m=d}else if(n>d){n=d}
  s=1;if(-n>=m){s=-1;base=-n}else{base=m}
  for(i=0;(d=d__[i])<base&&d>=0;i++)x=x*base+d
  if(d__[i]!=s*base){print "join_digits: unexpected element in array\n";scale=os;return x/s}
  scale=os+5;x+=5*A^(-1-os)
  for(p=1/base;p&&(d=d__[++i])<base&&d>=0;p/=base)x+=d*p
  if(d__[i]!=-1)print "join_digits: unexpected element in array\n";
  scale=os;return x/s
}

## Pandigital Index

# pdhi(x) - Pan Digital Halving Index
# Returns how many times x must be divided by 2 before
# the result contains all digits from 0 to 9 (if ibase = 10).
# e.g. 3339 -> 1669.5 -> 834.75 -> 417.375 ->
#      208.6875 -> 104.34375 -> 52.171875 ->
#      26.0859375 -> 13.04296875, i.e. 8 times

# Uses ibase as the base for divisions (usually 10)

define pdhi(x) {
  auto d[],xi,xf,c,r,pdhi,lim,i;
  if(x==0){print "pdhi: Infinity\n";return A^scale-1}
  if(x<0)x=-x
  c=1;pdhi=-1;lim=int(A/ibase+3)*scale
  while(c){
    pdhi+=1
    xi=int(x);xf=x-xi
    while(xi){
      r=int(xi/ibase)
      d[xi-ibase*r]=1
      xi=r
    }
    for(i=lim ; i && xf ; i--){
    #while(xf){
      xf*=ibase
      r=int(xf)
      d[r]=1
      xf-=r
    }
    c=ibase
    for(r=0;r<ibase;r++){c-=d[r];d[r]=0}
    x/=2
  }
  return pdhi;
}

# pdmi(x, m) - Pan Digital Multiplying Index
# Returns how many times x must be multiplied by m before
# the result contains all digits from 0 to 9 (if ibase = 10).
# e.g. pdmi(3339,0.5) -> 1669.5 -> 834.75 -> 417.375 ->
#      208.6875 -> 104.34375 -> 52.171875 ->
#      26.0859375 -> 13.04296875, i.e. 8 times

# Uses ibase as the base for divisions (usually 10)

define pdmi(x,m) {
  auto d[],xi,xf,c,r,pdmi,lim,i;
  if(x==0){print "pdmi: Infinity\n";return A^scale-1}
  if(x<0)x=-x
  c=1;pdmi=-1;lim=int(A/ibase+3)*scale
  while(c){
    pdmi+=1
    xi=int(x);xf=x-xi
    while(xi){
      r=int(xi/ibase)
      d[xi-ibase*r]=1
      xi=r
    }
    for(i=lim ; i && xf ; i--){
    #while(xf){
      xf*=ibase
      r=int(xf)
      d[r]=1
      xf-=r
    }
    c=ibase
    for(r=0;r<ibase;r++){c-=d[r];d[r]=0}
    x*=m
  }
  return pdmi;
}
#!/usr/local/bin/bc -l funcs.bc

### Factorial.BC - Approximations to, and methods for calculating factorials
 
 # Requires funcs.bc

# Gosper's approximation to the natural log of x!
define gosper(x) {
 auto os,s,intx,pi;
 pi=pi();
 if(x==0)return 0 
 if(x<0){
   os=scale;scale=0;intx=x/1;scale=os
   if(x==intx) return (-1)^x*A^scale
   x=-x;pi*=x
   s=s(pix)
   if(s<=0) return 1-A^scale
   return l(pix/s)-gosper(x)
 }
 return(  x*(l(x)-1) + ( l(2*x+1/3)+ l(pi) )/2  )
}

# Gosper's approximation to n!
define gfactorial(n) { return ceil(e(gosper(n))) }

# Nemes' approximation to the natural log of x!
# with minor tweak to bring it closer to the true value
define nemes(x) {
 auto os,s,lx,intx,pix,l10,corr;
 pix=pi()*x;
 if(x==0||x==1)return 0 
 if(x<0){
   os=scale;scale=0;intx=x/1;scale=os
   if(x==intx) return (-1)^x*A^scale
   x=-x;pix=-pix
   s=s(pix)
   if(s<=0) return 1-A^scale
   return l(pix/s)-nemes(x)
 }
 lx = l(x)
 s = x*(lx-1) + l(2*pix)/2 + 1/(C*x + 2/(5*x + (5*A+3)/(4*A+2)/x))
 l10 = ((A*5*7-3)*E*B+5)/(A*B*(E*F+1)) # approximation to log 10
 corr = 7*(9/8+lx)
 if(corr/l10 < scale){
   #"correcting ";s
   s -= e(-corr) # minor correction
 }
 return s;
}

# Nemes' approximation to n!
define nemfactorial(n) {
  auto a;
  a=n=nemes(n);if(a<0)a=-a
  if(a+a>A^scale)return n
  return e(n)
}

# Stieltjes approximation to ln(n!)
define stieltjes(n) {
  auto oib,os,ln,intn,pin,a[],s,i
  if(n==0||n==1)return 0 
  if(n<0){
    os=scale;scale=0;intn=n/1;scale=os
    if(n==intn) return (-1)^n*A^scale
    n=-n;pin=pi()*n;s=s(pin)
    if(s<=0) return 1-A^scale
    return l(pin/s)-stieltjes(n)
  }
  oib=ibase;ibase=A;scale+=50
  a[B]=100043420063777451042472529806266909090824649341814868347109676190691/13346384670164266280033479022693768890138348905413621178450736182873
  a[A]=152537496709054809881638897472985990866753853122697839/24274291553105128438297398108902195365373879212227726
  a[9]=26370812569397719001931992945645578779849/5271244267917980801966553649147604697542
  a[8]=455377030420113432210116914702/113084128923675014537885725485;a[7]=29404527905795295658/9769214287853155785;a[6]=109535241009/48264275462
  a[5]=29944523/19773142;a[4]=22999/22737;a[3]=195/371;a[2]=53/210;a[1]=1/30;a[0]=1/12
  s=1;for(i=B;i>=0;i--)s=n+a[i]/s;s-=n
  s+=l(2*pi())/2-n+(n+.5)*l(n)
  obase=oib;scale-=50;return s/1
}

# Stieltjes' approximation to n!
define stielfactorial(n) {
  auto a;
  a=n=stieltjes(n);if(a<0)a=-a
  if(a+a>A^scale)return n
  return e(n)
}

# Spouge factorial - workhorse for below
define spouge_(n,l,exact){
  auto os,h,tltp,tp,a,k,f,e1,z,iz,fz,d,nm,dm;
  os=scale;scale=1;h=1/2;scale=os+os
  if(exact&&os>3){scale=3;a=spouge_(n,0,0);scale=8*length(a)/5+os}
  tltp=2*l(tp=2*pi());a=lambertw0(A^scale*tltp/tp)/tltp
  nm=sqrt(tp);dm=1;e1=e(1)
  f=1;for(k=1;k<a;k++){
    #z=-e((k-h)*l(a-k)+a-k)*(-1)^k
    z=(k-h)*l(a-k)+a-k
    #z=-pow(e1,z)*(-1)^k
    scale=0
     iz=z/1;fz=z-iz
     z=fastintpow__(e1,iz)
    scale=os+os
    if(fz>h){z*=e1/e(1-fz)}else{z*=e(fz)}
    z=-z*(-1)^k
    d=f*(n+k)
    nm=nm*d+dm*z
    dm*=d
    f*=k
  }
  z=(n+h)*l(n+a)-n-a
  if(l){
    z+=l(nm/dm)
  } else {
    #z=pow(e1,z)*nm/dm
    z=e(z)*nm/dm
  }
  scale=os
  return z/1
}

# ... calculate to scale decimal places - slow!
define spougefactorialx(n) { return spouge_(n,0,1) }
define spougex(n)          { return spouge_(n,1,1) }

# ... calculate to scale significant figures
define spougefactorial(n)  { return spouge_(n,0,0) }
define spouge(n)           { return spouge_(n,1,0) }

# generate the Euler's gamma constant to the current scale
# . Warning - Slow to calculate
# . Caches calculated value to save on recalculation for
# . . same or smaller scales
define eulergamma() {
  # Uses fact that eulergamma = -Gamma'(1)
  auto os,eps,g;
  if(scale==(os=scale(eulergamma_)))return eulergamma_
  if(scale<os)return eulergamma_/1
  os=scale;if(scale<5)scale=5
  scale=ceil(scale*(A*A+6)/(6*A+7)) # scale/(1-1/e)
  eps=A^-scale
  scale+=scale
  g=(spouge_(-eps,0,0)-spouge_(eps,0,0))/(eps+eps)
  scale=os;return eulergamma_=g/1
}

# x! - an approximation to the factorial function over the reals
#      is accurate as possible for all integers and half-integers
#      interpolates otherwise
factorial_substrate_=2
define factorial_substrate_(n) {
  if(factorial_substrate_==0)return pow(e(1),gosper(n))
  if(factorial_substrate_==1)return pow(e(1),nemes(n))
  if(factorial_substrate_==2)return pow(e(1),stieltjes(n))
  if(factorial_substrate_==3)return spougefactorial(n)
  if(factorial_substrate_==4)return spougefactorialx(n)
  factorial_substrate_=2
  return factorial_substrate_(n);
}
define factorial(x) {
 auto i,xx,x2,xx2,k,a,b,na,nb,os,oib
 if(x==0||x==1)return 1
 oib=ibase;ibase=A
 if(x==0.5){ibase=oib;return sqrt(pi()/4)}
 if(0<x&&x<1){
  .=x++;ibase=oib
  return factorial(x)/x
 }
 os=scale;scale=0;xx=x/1;scale=os
 if(x<0){
   if(x==xx) return (-1)^xx*A^scale
   x=-x;
   a=pi()*x;
   ibase=oib
   return a/s(a)/factorial(x)
 }
 x2=x+x
 os=scale;scale=0;xx2=x2/1;scale=os
 if(x==xx){
  xx=1;for(i=x;i>=1;i--)xx*=i
  ibase=oib
  return xx;
 } else if (x2==xx2) {
  x-=.5
  xx=1;for(i=x2;i>x;i--)xx*=i
  scale+=x;
   xx/=2^(xx2-1)
   xx*=sqrt(pi()/4)
  scale-=x;
  ibase=oib
  return xx/1;
 }
 /* Other factorial cases here */
 if(factorial_substrate_>=3){ibase=oib;return spouge_(x,0,factorial_substrate_-3)}
  x2=2*(x-xx)
  if(x2>.5){
   x2-=.5
   xx+=.5
  }
  xx+=5
   a=factorial(            xx    )
  na=factorial_substrate_( xx    )
   b=factorial(            xx+0.5)
  nb=factorial_substrate_( xx+0.5)
  k=na/a
  k+=(nb/b-k)*x2
  xx=factorial_substrate_(x+5)/(k*(x+5)*(x+4)*(x+3)*(x+2)*(x+1))
 ibase=oib
 return xx;
}

define lnfactorial_substrate_(n) {
  if(factorial_substrate_==0)return    gosper(n)
  if(factorial_substrate_==1)return     nemes(n)
  if(factorial_substrate_==2)return stieltjes(n)
  if(factorial_substrate_==3)return    spouge(n)
  if(factorial_substrate_==4)return   spougex(n)
  factorial_substrate_=2
  return lnfactorial_substrate_(n);
}
# logarithm of the above
define lnfactorial(x) {
 auto i,xx,x2,xx2,k,a,b,na,nb,os,oib;
 if(x==0||x==1)return 0
 oib=ibase;ibase=A
 if(x==0.5){ibase=oib;return l(pi()/4)/2}
 if(x<=2470){ibase=oib;return ln(factorial(x))} # l(factorial()) is faster below 2470ish
 if(x>1000000){ibase=oib;return stieltjes(x)}
 if(x>10000){ibase=oib;return spouge(x)}
 if(0<x&&x<1){
  .=x++
  return lnfactorial(x)-l(x)
 }
 os=scale;scale=0;xx=x/1;scale=os
 if(x<0){
   x=-x;
   a=pi()*x;
   ibase=oib
   na = s(a)
   if(na<=0) return 1-A^scale
   return l(a/na)-lnfactorial(x)
 }
 x2=x+x
 os=scale;scale=0;xx2=x2/1;scale=os
 if(x==xx){
  xx=0.5*x*A^-scale;for(i=x;i>=1;i--)xx+=l(i)
  ibase=oib
  return xx;
 } else if (x2==xx2) {
  x-=.5
  xx=0.5*x*A^-scale;for(i=x2;i>x;i--)xx+=l(i)
  scale+=scale;
   xx-=(xx2-1)*l(2)
   xx+=0.5*l(pi()/4)
  scale=os;
  ibase=oib
  return xx/1;
 }
 /* Other factorial cases here */
 if(factorial_substrate_>=3){ibase=oib;return spouge_(x,1,factorial_substrate_-3)}
  x2=2*(x-xx)
  if(x2>.5){
   x2-=.5
   xx+=.5
  }
  xx+=5
   a=lnfactorial(            xx    )
  na=lnfactorial_substrate_( xx    )
   b=lnfactorial(            xx+0.5)
  nb=lnfactorial_substrate_( xx+0.5)
  k=na/a
  k+=(nb/b-k)*x2
  #k=(11*k-3)/8 # correction
  xx=(lnfactorial_substrate_(x+5)-l((x+5)*(x+4)*(x+3)*(x+2)*(x+1)))/k
 ibase=oib
 return xx;
}

# Inverse factorial (approximate)
#   Based on a derivation by David W. Cantrell in sci.math
define fast_inverse_factorial(x) {
  auto t,f,eps,os,oib;
  if(x==1||x==2) return x;
  oib=ibase;ibase=A;
  if(0.89<=x&&x<=3.9){
    os=scale
    if(scale>25)scale=25
    eps = A^(5-scale);if(eps>1)eps=1
    t=x;f=x-factorial(t)
    while(abs(f)>eps){t+=f/x;f=x-factorial(t)}
    scale=os;ibase=oib
    return t
  }
  scale += 3
  t = l((x+0.036534)/sqrt(2*pi()))
  t /= lambertw0(t/e(1))
  t -= .5
  scale -= 3
  ibase=oib
  return t/1 
}

# Inverse factorial (as accurate as possible*)
#   *Uses current factorial substrate and the above
#     to iterate to a possible answer
#   Much slower than the above
define inverse_factorial(f) {
  auto os,g0,g1,g2,g3,d,eps
  eps=A^-scale;scale+=5
  os=scale
  g0=fast_inverse_factorial(f)
  if(g0==f||f<1)return g0;
  while(abs(g0-g1)>eps){
    g1=g0
    g2=g1+(f/factorial_substrate_(g1)-1)/l(g1)
    if(g2==g1)break
    g3=g2+(f/factorial_substrate_(g2)-1)/l(g2)
    if(g3==g2){g0=g2;break}
    scale+=scale
     g0=g2
     d=g2+g2-g1-g3
     if(d!=0)g0=(g2*g2-g1*g3)/d #glai
    scale=os
    g0/=1
  }
  scale-=5
  return g0/1
}

# Inverse of lnfactorial (approximate)
define fast_inverse_lnfactorial(x) {
  auto k,f
  if(x<=3)return fast_inverse_factorial(e(x));
  if(x<=6){k=(6-x)/3;f=fast_inverse_factorial(e(x))}
  x-=l(2*pi())/2
  x/=lambertw0(x/e(1))
  x-=1/2
  if(k)x+=k*(f-x)
  return x
}

# Inverse of lnfactorial (as accurate as possible*)
#   *Uses current lnfactorial substrate and the above
#     to iterate to a possible answer
#   Much slower than the above
define inverse_lnfactorial(x) {
  auto g0,g1,g2,n,eps
  eps=A^-scale;scale+=5
  n=x
  g0=fast_inverse_lnfactorial(n)
  if(g0<3){
    scale-=5
    return inverse_factorial(e(x))
  }
  while(abs(g0-g1)>eps) {
    g1=fast_inverse_lnfactorial(n+=x-lnfactorial_substrate_(g0))
    g2=fast_inverse_lnfactorial(n+=x-lnfactorial_substrate_(g1))
    g0=g2
  }
  scale-=5
  return g0/1
}

# Number of permutations of r items from a group of n
# ... using integers only
define int_permutation(n,r) {
 auto i,p,os;
 os=scale;scale=0;n/=1;r/=1
 if(n<0||r<0||r>n)return(0)
 p=1;for(i=n;i>n-r;i--)p*=i
 scale=os;return(p)
}

# ... using real numbers
define permutation(n,r) {
 auto os;os=scale;scale=0
 if(n==n/1&&r==r/1&&n>=0&&r>=0){scale=os;return int_permutation(n,r)}
 if(n<0||r<0){scale=os;return factorial(n)/factorial(n-r)}
 scale=os
 n=lnfactorial(n)-lnfactorial(n-r)
 if(n<=5*A^3)return e(n)
 if(n>=  A^7)print "permutation: calculating huge result; consider using lnpermutation\n"
 return pow(e(1),n)
}

# ... logarithm of the above; good for larger n and r
define lnpermutation(n,r) {
  return lnfactorial(n)-lnfactorial(n-r)
}

# Number of combinations of r items from a group of n
# ... using integers only
define int_combination(n,r) {
 auto c,os;
 os=scale;scale=0;n/=1;r/=1
 if(n<0||r<0||r>n){scale=os;return(0)}
 if(r+r>n)r=n-r
 c=int_permutation(n,r)/factorial(r)
 scale=os;return(c) 
}

# ... using real numbers
define combination(n,r) {
 auto os;os=scale;scale=0
 if(n==n/1&&r==r/1&&n>=0&&r>=0){scale=os;return int_combination(n,r)}
 if(n<0||r<0){scale=os;return factorial(n)/factorial(n-r)/factorial(r)}
 scale=os
 n=lnfactorial(n)-lnfactorial(n-r)-lnfactorial(r)
 if(n<=5*A^3)return e(n)
 if(n>=  A^7)print "combination: calculating huge result; consider using lncombination\n"
 return pow(e(1),n)
}

# ... logarithm of the above; good for larger n and r
define lncombination(n,r) {
  return lnfactorial(n)-lnfactorial(n-r)-lnfactorial(r)
}

# Catalan numbers
define catalan(n) {
  auto os,t;
  if(n==-1)return -1/2;
  t=n+n;os=scale;scale=0
  if(n<0)if(t/1==t){
    t%=2;scale=os
    if(t)return -1+A^os # -ve half-integers -> infinite
    return 0            # -ve integers < -1 -> 0
  }
  scale=os;n=combination(t,n)/(n+1)
  scale=0 ;t=n/1;if(n==t)n=t
  scale=os;return n
}

# double factorial is also written x!! [not equal to (x!)!]
define double_factorial(x) {
 auto i,xx;
 if(x==0||x==1)return 1
 xx=int((x+1)/2)
 if(x<0&&x==xx+xx-1){
   return (-1)^xx*double_factorial(-2*xx-1)
 }
 xx=int(x)
 if(x==xx){
  xx=1;for(i=x;i>=1;i-=2)xx*=i
  return(xx)
 }
 x/=2
 xx=factorial(x)
 x-=.5
 xx*=e(x*l(2))
 xx/=sqrt(pi()/4)
 return xx
}

# number of derangements of n
# . = number of permutations where no element is in its original place
# Is accurate for integers and performs a naive interpolation otherwise
define subfactorial(n){
  auto os,ns,in,fn,a,b,e,sa,sb;
  if(n<0)return 1-A^scale
  if(0<n&&n<1)return (subfactorial(n+1)+c(pi()*n))/(n+1)
  os=scale;scale=0 
  fn=n-(in=n/1)
  if(n==in){
    b=0;for(a=0;a<=n;a++)b=b*a+(-1)^a
    scale=os;return b
  }
  ns=length(factorial(in))-1;if(ns<os)ns=os
  scale=ns
    e=e(1);sb=1/2
    a=factorial(in)/e;b=a*(in+1);n=factorial(n)/e
  scale=0 ;sa=(a+sb)/1;sb=(b+sb)/1
  scale=ns;sa/=a;sb/=b
  scale=os;return n*(sa+fn*(sb-sa))/1
}

# Returns the lowest common multiple of all numbers 1..x
define lcmultorial(x) {
  auto f;
  x=int(x);if(x<=1)return 1
  for(f=1;x>1;x--)f=int_lcm(x,f)
  return f;
}

# y-th factorial of x: x!_y
# ... integers only
define int_multifactorial(y,x) {
 auto i,xx,os;
 os=scale;scale=0;x/=1;y/=1
 xx=1;for(i=x;i>=1;i-=y)xx*=i
 scale=os;return(xx);
}

# only works for x==1 mod y # to fix
#define multifactorial(y,x) {
# auto os,c[],nc[],t,ix,iy
# os=scale;scale=0
# ix=x/1;iy=y/1
# c[00]=int_multifactorial(iy  ,ix)
# if(y==iy&&x==ix&&y>=0&&x>=0){scale=os;return c[00]}
# c[01]=c[00]*(iy  +ix)
# c[10]=int_multifactorial(iy+1,ix)
# c[11]=c[10]*(iy+1+ix)
# scale=os;
# t=lnfactorial(1/iy)
#  nc[00]=e((ix-1)*l(iy)/iy+lnfactorial( ix   /iy)-t)
#  nc[01]=e( ix   *l(iy)/iy+lnfactorial((ix+1)/iy)-t)
# .=iy++
# t=lnfactorial(1/iy)
#  nc[10]=e((ix-1)*l(iy)/iy+lnfactorial( ix   /iy)-t)
#  nc[11]=e( ix   *l(iy)/iy+lnfactorial((ix+1)/iy)-t)
# .=iy--
# for(t=0;t<=11;t++)if(c[t])nc[t]/=c[t]
# c[0]=nc[00]+(nc[01]-nc[00])*(y-iy)
# c[1]=nc[10]+(nc[11]-nc[10])*(y-iy)
# c[0]= c[ 0]+( c[ 1]- c[ 0])*(x-ix)
# return c[0]*e((x-1)*l(y)/y+lnfactorial(x/y)-lnfactorial(1/y))
#}#!/usr/local/bin/bc -l funcs.bc factorial.bc

### Factorial_Gamma.BC - Gamma related functions
 
 # Requires funcs.bc and factorial.bc

# These are all but aliases for functions in factorial.bc

define           gamma(x) { return           factorial(x -1) }
define         lngamma(x) { return         lnfactorial(x -1) }
define   inverse_gamma(x) { return   inverse_factorial(x)+1  }
define inverse_lngamma(x) { return inverse_lnfactorial(x)+1  }

# Derivatives of the above

define   beta(x,y) { return   factorial(x-1)*  factorial(y-1)/  factorial(x+y-1) }
define lnbeta(x,y) { return lnfactorial(x-1)+lnfactorial(y-1)-lnfactorial(x+y-1) }

# For the lowercase Euler gamma constant, see eulergamma() in factorial.bc#!/usr/local/bin/bc -l funcs.bc

### Fibonacci.BC - Fibonacci and Lucas functions

 # Requires funcs.bc

# n-th Fibonacci number over the reals
define fibonacci(n){
  auto a,b,c,intn,count,fracn,s5,os
  if(n==0)return 0
  os=scale;scale=0;count=intn=n/1
  if(n<0){
    scale=os;
    a=-fibonacci(-n)
    if(n==intn)return a*(-1)^(-intn)
    return a*c(pi()*n)
  }
  count+=2;
  a=-1;b=1;c=0
  while(--count){
    c=a+b;a=b;b=c
  }
  scale=os;
  if(n==intn)return c
  
  fracn=n-intn
  s5=sqrt(5)
  a=e(fracn*l( (1+s5)/2 ))
  a*=(s5*c+sqrt(5*c*c+4*(-1)^intn))/2
  a=(a-c(pi()*n)/a)/s5
  return a
}

# inverse of the above - cannot deal with values below 1 (except 0)
# but is accurate to within 'scale' decimal places otherwise
define inverse_fibonacci(f) {
  auto a,b,c,intn,intf,fracf,s5,phinx2,eps,s5f,z5f2,lph,pi,os
  if(f==0)return f
  if(f<1)return 0 # avoid multivalued mess
  os=scale;scale=0;intf=f/1
  a=-1;b=1;c=0
  for(intn=-2;c<=intf;intn++){
    c=a+b;a=b;b=c
  }
  scale=os
  if(f==a)return intn
  c=a
  s5=sqrt(5)
  phinx2=s5*c+sqrt(5*c*c+4*(-1)^intn)
  lph=l( (1+s5)/2 )
  pi=pi()
  s5f=s5*f
  z5f2=5*f*f
  a=0.5 #start guess
  os+=8
  for(scale=8;scale<=os;scale+=8){
    b=0
    eps=A^(2-scale)
    while(abs(a-b)>eps){
      b=a
      a=s5f+sqrt(z5f2+4*c(pi*(intn+a)))
      a/=phinx2
      a=l(a)/lph
    }
    a=(a+b)/2
  }
  os-=8;scale=os;a/=1
  return intn+a
}

# n-th Lucas number over the reals
define lucas(n){
  auto a,b,c,intn,count,fracn,os
  if(n==0)return 2
  os=scale;scale=0;count=intn=n/1
  if(n<0){
    scale=os;
    a=lucas(-n)
    if(n==intn)return a*(-1)^(-intn)
    return a*c(pi()*n)
  }
  count+=2;
  a=3;b=-1;c=2
  while(--count){
    c=a+b;a=b;b=c
  }
  scale=os;
  if(n==intn)return c
  
  fracn=n-intn
  a=e(fracn*l( (1+sqrt(5))/2 ))
  a*=(c+sqrt(c*c-4*(-1)^intn))/2
  a=a+c(pi()*n)/a
  return a
}

# inverse of the above - inaccurate with values below 2 (except -1, 0 and 1)
# but is accurate to within 'scale' decimal places otherwise
define inverse_lucas(l) {
  auto a,b,c,intn,intl,fracl,phinx2,eps,l2,lph,pi,os
  if(l<-1)return -1
  if(-1<=l&&l<1)return ((7-3*l)*l-A)/(2*A)
  if(1<=l&&l<=2)return 2-l # avoid multivalued mess
  os=scale;scale=0;intl=l/1
  a=3;b=-1;c=2
  for(intn=-2;c<=intl;intn++){
    c=a+b;a=b;b=c
  }
  scale=os
  if(l==a)return intn
  c=a
  phinx2=c+sqrt(c*c-4*(-1)^intn)
  lph=l( (1+sqrt(5))/2 )
  pi=pi()
  l2=l*l
  a=0.5 #start guess
  os+=8
  for(scale=8;scale<=os;scale+=8){
    b=0
    eps=A^(2-scale)
    while(abs(a-b)>eps){
      b=a
      a=l+sqrt(l2-4*c(pi*(intn+a)))
      a/=phinx2
      a=l(a)/lph
    }
  }
  os-=8;scale=os;a/=1
  return intn+a
}#!/usr/local/bin/bc -l

### Funcs.BC - a large number of functions for use with GNU BC

  ## Not to be regarded as suitable for any purpose
  ## Not guaranteed to return correct answers

scale=50;
define pi() {
  auto s;
  if(scale==(s=scale(pi_)))return pi_
  if(scale<s)return pi_/1
  scale+=5;pi_=a(1)*4;scale-=5
  return pi_/1
}
e = e(1);
define phi(){return((1+sqrt(5))/2)} ; phi = phi()
define psi(){return((1-sqrt(5))/2)} ; psi = psi()

# Reset base to ten
obase=ibase=A;

## Integer and Rounding

# Round to next integer nearest 0:  -1.99 -> 1, 0.99 -> 0
define int(x)   { auto os;os=scale;scale=0;x/=1;scale=os;return(x) } 

# Round down to integer below x
define floor(x) {
  auto os,xx;os=scale;scale=0
  xx=x/1;if(xx>x).=xx--
  scale=os;return(xx)
}

# Round up to integer above x
define ceil(x) {
  auto os,xx;x=-x;os=scale;scale=0
  xx=x/1;if(xx>x).=xx--
  scale=os;return(-xx)
}

# Fractional part of x:  12.345 -> 0.345
define frac(x) {
  auto os,xx;os=scale;scale=0
  xx=x/1;if(xx>x).=xx--
  scale=os;return(x-xx)
}

# Absolute value of x
define abs(x) { if(x<0)return(-x)else return(x) }

# Sign of x
define sgn(x) { if(x<0)return(-1)else if(x>0)return(1);return(0) }

# Round x up to next multiple of y
define round_up(  x,y) { return(y*ceil( x/y )) }

# Round x down to previous multiple of y
define round_down(x,y) { return(y*floor(x/y )) }

# Round x to the nearest multiple of y
define round(     x,y) {
  auto os,oib;
  os=scale;oib=ibase
  .=scale++;ibase=A
    y*=floor(x/y+.5)
  ibase=oib;scale=os
  return y
}

# Find the remainder of x/y
define int_remainder(x,y) {
  auto os;
  os=scale;scale=0
   x/=1;y/=1;x%=y
  scale=os
  return(x)
}
define remainder(x,y) {
  os=scale;scale=0
   if(x==x/1&&y==y/1){scale=os;return int_remainder(x,y)}
  scale=os
  return(x-round_down(x,y))
}

# Greatest common divisor of x and y
define int_gcd(x,y) {
  auto r,os;
  os=scale;scale=0
  x/=1;y/=1
  while(y>0){r=x%y;x=y;y=r}
  scale=os
  return(x)
}
define gcd(x,y) {
  auto r,os;
  os=scale;scale=0
   if(x==x/1&&y==y/1){scale=os;return int_gcd(x,y)}
  scale=os
  while(y>0){r=remainder(x,y);x=y;y=r}
  return(x)
}

# Lowest common multiple of x and y
define int_lcm(x,y) {
  auto r,m,os;
  os=scale;scale=0
  x/=1;y/=1
  m=x*y
  while(y>0){r=x%y;x=y;y=r}
  m/=x
  scale=os
  return(m)
}
define lcm(x,y) { return (x*y/gcd(x,y)) }

# Remove largest possible power of 2 from x
define oddpart(x){
  auto os;
  os=scale;scale=0;x/=1
  if(x==0){scale=os;return 1}
  while(!x%2)x/=2
  scale=os;return x
}

# Largest power of 2 in x
define evenpart(x) {
  auto os;
  os=scale;scale=0
  x/=oddpart(x/1)
  scale=os;return x
}

## Trig / Hyperbolic Trig

# Sine
define sin(x) { return s(x) } # alias for standard library
# Cosine
define c(x)   { return s(x+pi()/2) } # as fast or faster than
define cos(x) { return c(x)        } # . standard library
# Tangent
define tan(x)   { auto c;c=c(x);if(c==0)c=A^-scale;return(s(x)/c) }

# Secant
define sec(x)   { auto c;c=c(x);if(c==0)c=A^-scale;return(   1/c) }
# Cosecant
define cosec(x) { auto s;s=s(x);if(s==0)s=A^-scale;return(   1/s) }
# Cotangent
define cotan(x) { auto s;s=s(x);if(s==0)s=A^-scale;return(c(x)/s) }

# Arcsine
define arcsin(x) { if(x==-1||x==1)return(pi()/2*x);return( a(x/sqrt(1-x*x)) ) } 
# Arccosine
define arccos(x) { if(x==0)return(0);return pi()/2-arcsin(x) }

# Arctangent (one argument)
define arctan(x)  { return a(x) } # alias for standard library

# Arctangent (two arguments)
define arctan2(x,y) { 
  auto p;
  if(x==0&&y==0)return(0)
  p=(1-sgn(y))*pi()*(2*(x>=0)-1)/2
  if(x==0||y==0)return(p)
  return(p+a(x/y))
}

# Arcsecant
define arcsec(x)      { return( a(x/sqrt(x*x-1)) ) }
# Arccosecant
define arccosec(x)    { return( a(x/sqrt(x*x-1))+pi()*(sgn(x)-1)/2 ) }
# Arccotangent (one argument)
define arccotan(x)    { return( a(x)+pi()/2 ) }
# Arccotangent (two arguments)
define arccotan2(x,y) { return( arctan(x,y)+pi()/2 ) }

# Hyperbolic Sine
define sinh(x) { auto t;t=e(x);return((t-1/t)/2) }
# Hyperbolic Cosine
define cosh(x) { auto t;t=e(x);return((t+1/t)/2) }
# Hyperbolic Tangent
define tanh(x) { auto t;t=e(x+x)-1;return(t/(t+2)) }

# Hyperbolic Secant
define sech(x)   { auto t;t=e(x);return(2/(t+1/t)) }
# Hyperbolic Cosecant
define cosech(x) { auto t;t=e(x);return(2/(t-1/t)) }
# Hyperbolic Cotangent
define coth(x)   { auto t;t=e(x+x)-1;return((t+2)/t) }

# Hyperbolic Arcsine
define arcsinh(x) { return( l(x+sqrt(x*x+1)) ) }
# Hyperbolic Arccosine
define arccosh(x) { return( l(x+sqrt(x*x-1)) ) }
# Hyperbolic Arctangent
define arctanh(x) { return( l((1+x)/(1-x))/2 ) }

# Hyperbolic Arcsecant
define arcsech(x)   { return( l((sqrt(1-x*x)+1)/x) ) }
# Hyperbolic Arccosecant
define arccosech(x) { return( l((sqrt(1+x*x)*sgn(x)+1)/x) ) }
# Hyperbolic Arccotangent
define arccoth(x)   { return( l((x+1)/(x-1))/2 ) }

# Length of the diagonal vector (0,0)-(x,y) [pythagoras]
define pyth(x,y) { return(sqrt(x*x+y*y)) }
define pyth3(x,y,z) { return(sqrt(x*x+y*y+z*z)) }

# Gudermannian Function
define gudermann(x)    { return 2*(a(e(x))-a(1)) }
# Inverse Gudermannian Function
define arcgudermann(x) {
  return arctanh(s(x))
}

# Bessel function
define besselj(n,x) { return j(n,x) } # alias for standard library

## Exponential / Logs

# Exponential e^x
define exp(x) { return e(x) } # alias for standard library

# Natural Logarithm (base e)
define ln(x) {
  auto os,len,ln;
  if(x< 0){print "ln error: logarithm of a negative number\n";return 0}
  if(x==0)print "ln error: logarithm of zero; negative infinity\n"
  len=length(x)-scale(x)-1
  if(len<A)return l(x);
  os=scale;scale+=length(len)+1
  ln=l(x/A^len)+len*l(A)
  scale=os
  return ln/1
} # speed improvement on standard library

# workhorse function for pow and log - new, less clever version
# Helps determine whether a fractional power is legitimate for a negative number
# . expects to be fed a positive value
# . returns -odd for even/odd; odd2 for odd1/odd2;
#           even for odd/even;   -2 for irrational
# . note that the return value is the denominator of the fraction if the
#   fraction is rational, and the sign of the return value states whether
#   the numerator is odd (positive) or even (negative)
# . since even/even is not possible, -2 is used to signify irrational
define id_frac2_(y){
  auto os,oib,es,eps,lim,max,p,max2,i,cf[],f[],n,d,t;
  os=scale
  if(cf_max){
    # cf.bc is present!
    .=cf_new(cf[],y);if(scale(cf[0]))return -2;
    .=frac_from_cf(f[],cf[],1)
    d=f[0];scale=0;if(f[1]%2==0)d=-d;scale=os
   return d
  }
  oib=ibase;ibase=A
  scale=0
   es=3*os/4
  scale=os
   eps=A^-es
   y+=eps/A
  scale=es
   y/=1
  scale=0
  if(y<0)y=-y
  d=y-(n=y/1)
  if(d<eps){t=2*(n%2)-1;scale=os;ibase=oib;return t}#integers are x/1
  t=y/2;t=y-t-t
  # Find numerator and denominator of fraction, if any
  lim=A*A;max2=A^5*(max=A^int(os/2));p=1
  i=0;y=t
  while(1) {
    scale=es;y=1/y;scale=0
    y-=(t=cf[++i]=y/1);p*=1+t
    if(i>lim||(max<p&&p<max2)){cf[i=1]=-2;break}#escape if number seems irrational    
    if((p>max2||3*length(t)>es+es)&&i>1){cf[i--]=0;break}#cheat: assume rational
    if(y==0)break;#completely rational
  }
  n=1;d=cf[i]
  if(i==0){print "id_frac2_: something is wrong; y=",y,", d=",d,"\n"}
  if(d!=-2&&i)while(--i){d=n+cf[i]*(t=d);n=t}
  if(d<A^os){d*=2*(n%2)-1}else{d=-2}
  scale=os;ibase=oib
  return d;
}

# raise x to integer power y faster than bc's x^y
# . it seems bc (at time of writing) uses
# . an O(n) repeated multiplication algorithm
# . for the ^ operator, which is inefficient given
# . that there is a simple O(log n) alternative:
define fastintpow__(x,y) {
  auto r,hy;
  if(y==0)return(1)
  if(y==1)return(x)
  r=fastintpow__(x,hy=y/2)
  r*=r;if(hy+hy<y)r*=x
  return( r )
}
define fastintpow_(x,y) {
  auto ix,os;
  if(y<0)return fastintpow_(1/x,-y)
  if(y==0)return(1)
  if(y==1)return(x)
  if(x==1)return(1)
  os=scale;scale=0
  if(x==-1){y%=2;y+=y;scale=os;return 1-y}
  # bc is still faster for integers
  if(x==(ix=x/1)){scale=os;return ix^y}
  # ...and small no. of d.p.s, but not for values <= 2
  if(scale(x)<3&&x>2){scale=os;return x^y}
  scale=os;x/=1;scale=0
  x=fastintpow__(x,y);
  scale=os;return x;
}

# Raise x to a fractional power faster than e^(y*l(x))
define fastfracpow_(x,y) {
  auto f,yy,inv;
  inv=0;if(y<0){y=-y;inv=1}
  y-=int(y)
  if(y==0)return 1;
  if((yy=y*2^C)!=int(yy)){x=l(x);if(inv)x=-x;return e(y/1*x)}
  # faster using square roots for rational binary fractions
  # where denominator <= 8192
  x=sqrt(x)
  for(f=1;y&&x!=1;x=sqrt(x))if(y+=y>=1){.=y--;f*=x}
  if(inv)f=1/f;
  return f;
}

# Find the yth root of x where y is integer
define fastintroot_(x,y) {
  auto os,d,r,ys,eps;
  os=scale;scale=0;y/=1;scale=os
  if(y<0){x=1/x;y=-y}
  if(y==1){return x}
  if(y>=x-1){return fastfracpow_(x,1/y)}
  if(y*int((d=2^F)/y)==d){
    r=1;while(r+=r<=y)x=sqrt(x)
    return x
  }
  scale=length(y)-scale(y);if(scale<5)scale=5;r=e(ln(x)/y)
  scale=os+5;if(scale<5)scale=5
  d=1;eps=A^(3-scale)
  ys=y-1
  while(d>eps){
    d=r;r=(ys*r+x/fastintpow_(r,ys))/y
    d-=r;if(d<0)d=-d
  }
  scale=os
  return r/1
}

# Raise x to the y-th power
define pow(x,y) {
 auto os,p,ix,iy,fy,dn,s;
 if(y==0) return 1
 if(x==0) return 0
 if(0<x&&x<1){x=1/x;y=-y}
 os=scale;scale=0
  ix=x/1;iy=y/1;fy=y-iy;dn=0
 scale=os;#scale=length(x/1)
 if(y!=iy&&x<0){
   dn=id_frac2_(y)# -ve implies even numerator
   scale=0;if(dn%2){# odd denominator
     scale=os
     if(dn<0)return  pow(-x,y) # even/odd
     /*else*/return -pow(-x,y) #  odd/odd
   }
   print "pow error: "
   if(dn>0) print "even root"
   if(dn<0) print "irrational power"
   print " of a negative number\n"
   scale=os;return 0
 }
 if(y==iy) {
   if(x==ix){p=fastintpow_(ix,iy);if(iy>0){scale=0;p/=1};scale=os;return p/1}
   scale+=scale;p=fastintpow_(x,iy);scale=os;return p/1
 }
 if((dn=id_frac2_(y))!=-2){ #accurate rational roots (sometimes slower)
   if(dn<0)dn=-dn
   s=1;if(y<0){y=-y;s=-1}
   p=y*dn+1/2;scale=0;p/=1;scale=os
   if(p<A^3)x=fastintpow_(x,p)
   x=fastintroot_(x,dn)
   if(p>=A^3)x=fastintpow_(x,p)
   if(s<0)x=1/x
   return x
 }
 p=fastintpow_(ix,iy)*fastfracpow_(x,fy);
 scale=os+os
 if(ix)p*=fastintpow_(x/ix,iy)
 scale=os
 return p/1
 #The above is usually faster and more accurate than
 # return( e(y*l(x)) );
}

# y-th root of x [ x^(1/y) ]
define root(x,y) {
  return pow(x,1/y)
}

# Specific cube root function
# = stripped down version of fastintroot_(x,3)
define cbrt(x) {
  auto os,d,r,eps;
  if(x<0)return -cbrt(-x)
  if(x==0)return 0
  os=scale;scale=0;eps=A^(scale/3)
  if(x<eps){scale=os;return 1/cbrt(1/x)}
  scale=5;r=e(ln(x)/3)
  scale=os+5;if(scale<5)scale=5
  d=1;eps=A^(3-scale)
  while(d>eps){
    d=r;r=(r+r+x/(r*r))/3
    d-=r;if(d<0)d=-d
  }
  scale=os
  return r/1
}

# Logarithm of x in given base:  log(2, 32) = 5 because 2^5 = 32
#  tries to return a real answer where possible when given negative numbers
#  e.g.     log(-2,  64) = 6 because (-2)^6 =   64
#  likewise log(-2,-128) = 7 because (-2)^7 = -128
define log(base,x) {
  auto os,i,l,sx,dn,dnm2;
  if(base==x)return 1;
  if(x==0){print "log error: logarithm of zero; negative infinity\n";     return  l(0)}
  if(x==1)return 0;
  if(base==0){print "log error: zero-based logarithm\n";                  return    0 }
  if(base==1){print "log error: one-based logarithm; positive infinity\n";return -l(0)}
  scale+=6
  if((-1<base&&base<0)||(0<base&&base<1)){x=-log(1/base,x);scale-=6;return x/1}
  if((-1<x   &&   x<0)||(0<x   &&   x<1)){x=-log(base,1/x);scale-=6;return x/1}
  if(base<0){
    sx=1;if(x<0){x=-x;sx=-1}
    l=log(-base,x)
    dn=id_frac2_(l)
    os=scale;scale=0;dnm2=dn%2;scale=os
    if(dnm2&&dn*sx<0){scale-=6;return l/1}
    print "log error: -ve base: "
    if(dnm2)print "wrong sign for "
    print "implied "
    if(dnm2)print "odd root/integer power\n"
    if(!dnm2){
      if(dn!=-2)print "even root\n"
      if(dn==-2)print "irrational power\n"
    }
    scale-=6;return 0;
  }
  if(x<0){
    print "log error: +ve base: logarithm of a negative number\n"
    scale-=6;return 0;
  }
  x=ln(x)/ln(base);scale-=6;return x/1
}

# Integer-only logarithm of x in given base
# (compare digits function in digits.bc)
define int_log(base,x) { 
 auto os,p,c;
 if(0<x&&x<1) {return -int_log(base,1/x)}
 os=scale;scale=0;base/=1;x/=1
  if(base<2)base=ibase;
  if(x==0)    {scale=os;return  1-base*A^os}
  if(x<base)  {scale=os;return  0    }
  c=length(x) # cheat and use what bc knows about decimal length
  if(base==A){scale=os;return c-1}
  if(base<A){if(x>A){c*=int_log(base,A);c-=2*(base<4)}else{c=0}}else{c/=length(base)+1}
  p=base^c;while(p<=x){.=c++;p*=base}
  scale=os;return(c-1)
}

# Lambert's W function 0 branch; Numerically solves w*e(w) = x for w
# * is slow to converge near -1/e at high scales
define lambertw0(x) {
  auto oib, a, b, w, ow, lx, ew, e1, eps;
  if(x==0) return 0;
  oib=ibase;ibase=A
  ew = -e(-1)
  if (x<ew) {
    print "lambertw0: expected argument in range [-1/e,oo)\n"
    ibase=oib
    return -1
  }
  if (x==ew) {ibase=oib;return -1}
  # First approximation from :
  #   http://www.desy.de/~t00fri/qcdins/texhtml/lambertw/
  #   (A. Ringwald and F. Schrempp)
  # via Wikipedia
  if(x < 0){
    w = x/ew
  } else if(x < 500){
    lx=l(x+1);w=0.665*(1+0.0195*lx)*lx+0.04
  } else if((lx=length(x)-scale(x))>5000) {
    lx*=l(A);w=lx-(1-1/lx)*l(lx)
  } else {
    lx=l(x);w=l(x-4)-(1-1/lx)*l(lx)
  } 
  # Iteration adapted from code found on Wikipedia
  #   apparently by an anonymous user at 147.142.207.26
  #   and later another at 87.68.32.52
  ow = 0
  eps = A^-scale
  scale += 5
  e1 = e(1)
  while(abs(ow-w)>eps&&w>-1){
    ow = w
    if(x>0){ew=pow(e1,w)}else{ew=e(w)}
    a = w*ew
    b = a+ew
    a -= x;
    if(a==0)break
    b = b/a - 1 + 1/(w+1)
    w -= 1/b
    if(x<-0.367)w-=eps
  }
  scale -= 5
  ibase=oib
  return w/1
}

# Lambert's W function -1 branch; Numerically solves w*e(w) = x for w
# * is slow to converge near -1/e at high scales
define lambertw_1(x) {
  auto oib,os,oow,ow,w,ew,eps,d,iters;
  oib=ibase;ibase=A
  ew = -e(-1)
  if(ew>x||x>=0) {
    print "lambertw_1: expected argument in [-1/e,0)\n"
    ibase=oib
    if(x==0)return 1-A^scale
    if(x>0)return 0
    return -1
  }
  if(x==ew) return -1;
  os=scale
  eps=A^-os
  scale+=3
  oow=ow=0
  w=x
  w=l(-w)
  w-=l(-w)
  w+=sqrt(eps)
  iters=0
  while(abs(ow-w)>eps){
    oow=ow;ow=w
    if(w==-1)break
    w=(x*e(-w)+w*w)/(w+1)
    if(iters++==A+A||oow==w){iters=0;w-=A^-scale;scale+=2}
  }
  scale=os;ibase=oib
  return w/1
}

# LambertW wrapper; takes most useful branch based on x
# to pick a branch manually, use lambertw_1 or lambertw0 directly
define w(x) {
  if(x<0)return lambertw_1(x)
  return lambertw0(x)
}

# Faster calculation of lambertw0(exp(x))
# . avoids large intermediate value and associated slowness
# . numerically solves x = y+ln(y) for y
define lambertw0_exp(x) {
  auto oy,y,eps;
  # Actual calculation is faster for x < 160 or thereabouts
  if(x<C*D)return lambertw0(e(x));
  oy=0;y=l(x);y=x-y+y/x;eps=A^-scale
  while(abs(oy-y)>eps)y=x-l(oy=y)
  return y
}

# Shorthand alias for the above
define w_e(x){ return lambertw0_exp(x) }

# Numerically solve pow(y,y) = x for y
define powroot(x) {
  auto r;
  if(x==0) {
    print "powroot error: attempt to solve for zero\n"
    return 0
  }
  if(x==1||x==-1) {return x}
  if(x<=r=e(-e(-1))){
    print "powroot error: unimplemented for values\n  <0";r
    return 0
  }
  r = ln(x)
  r /= w(r)
  return r
}

## Triangular numbers

# xth triangular number
define tri(x) {
  auto xx
  x=x*(x+1)/2;xx=int(x)
  if(x==xx)return(xx)
  return(x)
}

# 'triangular root' of x
define trirt(x) {
  auto xx
  x=(sqrt(1+8*x)-1)/2;xx=int(x)
  if(x==xx)x=xx
  return(x)
}

# Workhorse for following 2 functions
define tri_step_(t,s) {
  auto tt
  t=t+(1+s*sqrt(1+8*t))/2;tt=int(t)
  if(tt==t)return(tt)
  return(t)
}

# Turn tri(x) into tri(x+1) without knowing x
define tri_succ(t) {
  return(tri_step_(t,0+1))
}

# Turn tri(x) into tri(x-1) without knowing x
define tri_pred(t) {
  return(tri_step_(t,0-1))
}

## Polygonal Numbers

# the xth s-gonal number:
#   e.g. poly(3, 4) = tri(4) = 1+2+3+4 = 10; poly(4, x) = x*x, etc
define poly(s, x) {
  auto xx
  x*=(s/2-1)*(x-1)+1;xx=int(x);if(x==xx)x=xx
  return x
}

# inverse of the above = polygonal root:
#   e.g. inverse_poly(3,x)=trirt(x); inverse_poly(4,x)=sqrt(x), etc
define inverse_poly(s, r) {
  auto t,xx
  t=(s-=2)-2
  r=(sqrt(8*s*r+t*t)+t)/s/2;xx=int(r);if(r==xx)r=xx
  return r
}

# converse of poly(); solves poly(s,x)=r for s
#   i.e. if the xth polygonal number is r, how many sides has the polygon?
#   e.g. if the 5th polygonal number is 15, converse_poly(5,15) = 3
#     so the polygon must have 3 sides! (15 is the 5th triangular number)
define converse_poly(x,r) {
  auto xx
  x=2*((r/x-1)/(x-1)+1);xx=int(x);if(x==xx)x=xx
  return x
}

## Tetrahedral numbers

# nth tetrahedral number
define tet(n) { return n*(n+1)*(n+2)/6 }

# tetrahedral root = inverse of the above
define tetrt(t) {
  auto k,c3,w;
  if(t==0)return 0
  if(t<0)return -2-tetrt(-t)
  k=3^5*t*t-1
  if(k<0){print "tetrt: unimplemented for 0<|t|<sqrt(3^-5)\n"; return 0}
  c3=cbrt(3)
  k=cbrt(sqrt(3*k)+3^3*t)
  return k/c3^2+1/(c3*k)-1
}

## Arithmetic-Geometric mean

define arigeomean(a,b) {
  auto c,s;
  if(a==b)return a;
  s=1;if(a<0&&b<0){s=-1;a=-a;b=-b}
  if(a<0||b<0){print "arigeomean: mismatched signs\n";return 0}
  while(a!=b){c=(a+b)/2;a=sqrt(a*b);b=c}
  return s*a
}

# solve n = arigeomean(x,y)
define inv_arigeomean(n, y){
  auto ns,ox,x,b,c,d,i,s,eps;
  if(n==y)return n;
  s=1;if(n<0&&y<0){s=-1;n=-n;y=-y}
  if(n<0||y<0){print "inv_arigeomean: mismatched signs\n";return 0}  
  if(n<y){x=y;y=n;n=x}
  n/=y
  scale+=2;eps=A^-scale;scale+=4
  ns=scale
  x=n*(1+ln(n));ox=-1
  for(i=0;i<A;i++){
    # try to force quadratic convergence
    if(abs(x-ox)<eps){i=-1;break}
    ox=x;scale+=scale
    b=x+x/n*(n-arigeomean(1,x));
    c=b+b/n*(n-arigeomean(1,b));
    d=b+b-c-x
    if(d){x=(b*b-c*x)/d}else{x=b;i=-1;break}
    scale=ns
  }
  if(i!=-1){
    # give up and converge linearly
    x=(x+ox)/2
    while(abs(x-ox)>eps){ox=x;x+=x/n*(n-arigeomean(1,x))}
  }
  x+=5*eps
  scale-=6;return x*y/s
}
#!/usr/local/bin/bc -l

### IntDiff.BC - numeric differentiation and integration of 
###              a single variable function

define f(x) { return x^2 } # example - redefine in later code/bc session

# Numerically differentiate the global function f(x)
define dfxdx(x) {
  auto eps;
  eps = A^-scale
  scale *= 2
  x = (f(x+eps)-f(x-eps))/(2*eps)
  scale /= 2
  return x/1
}

# New global variable like 'scale' - determines accuracy of numerical
#   integration at the expense of time. Don't set above 15 unless this
#   is running on a really fast machine!
depth = 10

# Numerically integrate the global function f(x) between x = a and x = b
# . uses the trapezoidal rule
define ifxdx_old(a,b) {
  auto os,h,s,t,i
  if(a==b)return f(a)
  os = scale;if(scale<depth)scale=depth
  scale+=3
  h = 2^-depth
  if(b<a){i=b;b=a;a=i}
  s = (b - a) * h
  t =(f(a)+f(b))/2
  for(i=a+s;i<b;i+=s)t+=f(i)
  scale=os;return t*s/1
}

# Numerically integrate the global function f(x) between x = a and x = b
define ifxdx(a,b) {
  auto oib,od,os,s,s8,t,i,j,ni,fi,fis
  if(a==b)return f(a)
  od=depth;if(depth<3)depth=3
  os=scale;if(scale<(i=depth+depth))scale=i
  scale+=3
  if(b<a){i=b;b=a;a=i}
  s=(b-a)*(2^-depth)
  oib=ibase;ibase=A
  s8 = s*8
  fi = 989*f(a)
  for(i=a;i<b;i=ni){
    ni=j=i+s8;
    t+=   fi+(fis=989*f(j))
    t+= 5888*(f(i+=s)+f(j-=s))
    t-=  928*(f(i+=s)+f(j-=s))
    t+=10496*(f(i+=s)+f(j-=s))
    t-= 4540*f(i+=s)
    fi=fis
  }
  depth=od;scale=os
   t*=s*4/14175
  ibase=oib;return t
}

# glai - guess limit at infinity
#   Assumes p, q and r are 3 consecutive convergents to a limit and
#   attempts to extrapolate precisely what that limit is after an infinite 
#   number of iterations.

# 0 = glai returns function result only
# 1 = glai commentates on interesting convergents
glaitalk = 1

define glai(p,q,r) {
  auto m,n 
  m = q^2-p*r
  n = 2*q-p-r
  if(n==0)if(m==0){
   if(glaitalk)print "glai: Constant series detected\n"
   return p
  }else{
   if(glaitalk)print "glai: Arithmetic progression detected: limit is infinite\n"
   return 1/0
  }
  if(m==0){
   if(glaitalk)print "glai: Geometric progression detected: limit wraps to zero!\n"
   return 0
  }
  return m/n
}

# Examples:
#   glai(x,x+1,x+2) causes a division by zero error as the limit of
#                   an arithmetic progression is infinite
#   glai(a*k,a*k^2,a*k^3) returns zero! The limit of a geometric
#                         progression in p-adics is precisely that,
#                         and somehow this simple function 'knows'.
#   glai(63.9, 63.99, 63.999) returns 64 - correctly predicting the
#                             limit of the sequence.

# Run consecutive convergents to the ifxdx function through glai() 
#   attaining "better" accuracy with slightly fewer calculations
define ifxdx_g(a,b) {
  auto p,q,r
  depth-=3  ; p = ifxdx(a,b)
  .=depth++ ; q = ifxdx(a,b)
  .=depth++ ; r = ifxdx(a,b)
  .=depth++
  return glai(p,q,r)
}

#define f(x){if(x<=0)return 0;x=root(x,x);return x*(x-1)}
#zz=-0.10717762842559665710112408473270837028206726160094438#!/usr/local/bin/bc -l funcs.bc

### Interest.BC - Compound interest, loan amortisation and compound savings

# requires funcs.bc for pow, root, lambertw*

## Conventions in this library

#* ic = initial capital
#* rate = interest rate in form 1+fraction where 0<fraction<1;#
#         Conversions are provided for percent and 'fraction' itself
#* nt = number of terms
#* fc = final capital
#* spt = subterms per term;
#        e.g. one might have nt=25 and spt=12 for a 25-year debt paid monthly
#* paym = payment to make to reduce debt to zero OR additional periodic savings capital
#* tpaym = total of all payments to reduce debt to zero given the above
#* *a__[] = an array parameter passed by reference to return an array of numbers

## Acknowledgement goes to Randy Rysavy for the suggestion to create this
#  library of functions, and who also provided some example code, which
#  - with my apologies to Randy - has not been used here.
#  All code has been derived from first principles in order to make sure
#  I was able to understand the underlying mathematics and to create and
#  manipulate the necessary formulae.

### Conversions for various interest rate formats

define percentage_to_rate(percent) {
  if(0>=percent||percent>=100){
    print "warning: given percentage is outside ]0..100[\n";
  }
  return 1+percent/100;
}
define fraction_to_rate(fraction) {
  if(0>=percent||percent>=100){
    print "warning: given fraction is outside ]0..1[\n";
  }
  return 1+fraction;
}
define rate_to_fraction(rate) {
  if(1>=rate||rate>=2){
    print "warning: given rate is outside ]1..2[\n";
  }
  return rate-1;
}
define rate_to_percentage(rate) {
  return rate_to_fraction(rate)*100;
}

### Compound Interest

# Parameters always given in order:
#   (fc, ic, rate, nt)
# although one or more will be missing

# Find final capital from initial at given rate and number of terms
define compound_fc(ic,rate,nt){
  return ic*pow(rate,nt)
}

# Find initial capital from final at given rate and number of terms
define compound_ic_from_fc(fc,rate,nt){
  return fc/pow(rate,nt)
}

# Find number of terms given rate and final and initial capital
define compound_nt_from_fc(fc,ic,rate){
  return l(fc/ic)/l(rate)
}

# Find rate given number of terms and final and initial capital
define compound_rate_from_fc(fc,ic,nt){
  return root(fc/ic,nt)
}

### Loan Amortisation - Assume payment occurs immediately after interest is added

# Parameters are always given in the order:
#   (*a__[], tpaym, paym, ic, rate, nt, spt)
# although one or more will be missing
# e.g. tpaym and paym never happen together
#
# N.B. ic/fc occur AFTER tpaym/paym here

## Basic Calculations

# Determine payment; +Interest-Payment, Once per term
define loan_paym(ic,rate,nt) {
  auto rn;
  rn = pow(rate, nt)
  return ic*rn*(rate-1)/(rn-1)
}

# Total payment over all terms based on interest and payment once per term
define loan_tpaym(ic,rate,nt) {
  auto rn;
  rn = pow(rate, nt)
  return nt*ic*rn*(rate-1)/(rn-1)
}

# Determine payment; +Interest-Payment, Multiple times per term
define loan_paym_split(ic,rate,nt,spt) {
  return loan_paym(ic,root(rate,spt),nt*spt)
}

# Total payment over all terms based on interest and payment multiple times per term
define loan_tpaym_split(ic,rate,nt,spt) {
  return loan_tpaym(ic,root(rate,spt),nt*spt)
}

# Generate an array of owed capital at each term
define loan_apaym(*a__[],ic,rate,nt){
  auto i,paym;
  paym = loan_paym(ic,rate,nt);
  a__[0]=ic;for(i=1;i<=nt;i++)a__[i]=a__[i-1]*rate-paym;
  a__[i]=0;
  return nt;
}

# Generate an array of owed capital at each subterm
define loan_apaym_split(*a__[],ic,rate,nt,spt) {
  auto i,paym;
  rate = root(rate, spt)
  nt *= spt;
  paym = loan_paym(ic,rate,nt);
  a__[0]=ic;for(i=1;i<=nt;i++)a__[i]=a__[i-1]*rate-paym;
  a__[i]=0;
  return nt;
}

## Reverse calculations

# Given the once-per-term payment, find the initial capital
define loan_ic_from_paym(paym,rate,nt) {
  auto rn;
  rn = pow(rate, nt)
  return paym*(rn-1)/((rate-1)*rn)
}

# Given the total of all once-per-term payments, find the initial capital
define loan_ic_from_tpaym(tpaym,rate,nt) {
  auto rn;
  rn = pow(rate, nt)
  return tpaym*(rn-1)/((rate-1)*rn*nt)
}

# Given the multiple-per-term payment, find the initial capital
define loan_ic_from_paym_split(paym,rate,nt,spt) {
  return loan_ic_from_paym(paym,root(rate,spt),nt*spt)
}

# Given the total of all multiple-per-term payments, find the initial capital
define loan_ic_from_tpaym_split(tpaym,rate,nt,spt) {
  return loan_ic_from_tpaym(tpaym,root(rate,spt),nt*spt)
}

# Given the once-per-term payment, find the interest rate
define loan_rate_from_paym(paym,ic,nt){
  auto os,i,k,rate,ratf,ratg,ratd;
  if(paym*nt==ic)return 1/1;
  k=paym/ic;
  rate=root(k*nt,nt/2); # good initial guess
  os=scale;scale+=scale
  for(i=scale;i>1;i/=2){
    # use of rat plus d, (e,) f, and g is a deliberate pun on 'rate'
    ratf=1+k*(1-pow(rate,-nt));# f and g are iterated approximants
    ratg=1+k*(1-pow(ratf,-nt));
    ratd=(ratf+ratf-rate-ratg);# d is a divisor that could end up as 0
    if(ratd==0){rate=1;break}  # so escape if that happens
    rate=(ratf*ratf-rate*ratg)/ratd;# glai(rate,ratf,ratg)
    # this trick causes the iteration to converge exponentially rather
    # than geometrically as found by repeating ratf=...;rate=ratf
  }
  scale=os;return rate/1
}

# Given the total of all once-per-term payments, find the interest rate
define loan_rate_from_tpaym(tpaym,ic,nt) {
  return loan_rate_from_paym(tpaym/nt,ic,nt);
}

# Given the multiple-per-term payment, find the interest rate
define loan_rate_from_paym_split(paym,ic,nt,spt) {
  return pow(loan_rate_from_paym(paym,ic,nt*spt),spt);
}

# Given the total of all multiple-per-term payments, find the interest rate
define loan_rate_from_tpaym_split(tpaym,ic,nt,spt) {
  return pow(loan_rate_from_tpaym(tpaym,ic,nt*spt),spt);
}

# Given the once-per-term payment, find the number of terms
define loan_nt_from_paym(paym,ic,rate) {
  auto d;
  d=paym-ic*(rate-1);
  return l(paym/d)/l(rate)
}

# Given the total of all once-per-term payments, find the number of terms
define loan_nt_from_tpaym(tpaym,ic,rate) {
  auto q,l;
  q = tpaym/(ic*(rate-1));
  l = l(rate);
  return q + lambertw0(-q*l/pow(rate,q))/l
}

# Given the multiple-per-term payment, find the number of terms
define loan_nt_from_paym_split(paym,ic,rate,spt) {
  return loan_nt_from_paym(paym,ic,root(rate,spt))/spt
}

# Given the total of all multiple-per-term payments, find the number of terms
define loan_nt_from_tpaym_split(tpaym,ic,rate,spt) {
  return loan_nt_from_tpaym(tpaym,ic,root(rate,spt))/spt
}

# Given the payment, determine the number of subterms within the term
define loan_spt_from_paym(paym,ic,rate,nt) {
  auto rn;
  rn = pow(rate, nt)
  return l(rate)/l(1+paym*(rn-1)/(ic*rn));  
}

# Given the total of all payments, determine the number of subterms within the term
define loan_spt_from_tpaym(tpaym,ic,rate,nt) {
  auto q,l,rn,temp;
  rn = pow(rate, nt)
  l = l(rate);
  q = nt*ic*rn/(tpaym*(rn-1));
  return -1/(q + lambertw_1(-q*l/pow(rate,q))/l);
}

### Savings - Assume interest is added before extra payment is added

# Parameters here are always given in the order:
#   (*a__[], fc, ic, tpaym, paym, rate, nt, spt)
# although one or more will be missing
# e.g. ic and fc never happen together
#
# N.B. ic/fc occur BEFORE tpaym/paym here

# Determine final captial savings given initial lump sum, regular payment,
# . interest rate and number of terms (+Interest+Payment)
define saving_fc(ic,paym,rate,nt){
  auto rn;
  rn = pow(rate,nt);
  return ic*rn+paym*(rn-1)/(rate-1)
}

# As above but assumes terms are split into subterms
define saving_fc_split(ic,paym,rate,nt,spt){
  return saving_fc(ic,paym,root(rate,spt),nt*spt)
}

# Generate an array of current capital at each term
define saving_afc(*a__[],ic,paym,rate,nt){
  auto i;
  a__[0]=ic;for(i=1;i<=nt;i++)a__[i]=a__[i-1]*rate+paym;
  a__[i]=0;
  return nt;
}

# Generate an array of current capital at each subterm
define saving_afc_split(*a__[],ic,paym,rate,nt,spt) {
  auto i;
  rate = root(rate, spt);
  nt *= spt;
  #paym = loan_paym(ic,rate,nt);
  a__[0]=ic;for(i=1;i<=nt;i++)a__[i]=a__[i-1]*rate+paym;
  a__[i]=0;
  return nt;
}

## Reverse calculations - given final capital and all but one of the others,
##                        determine the value of the missing parameter

# Determine initial capital (savings starter lump sum) based on final capital
define saving_ic_from_fc(fc,paym,rate,nt) {
  auto rn;
  rn = pow(rate,nt);
  return (fc-paym*(rn-1)/(rate-1))/rn;
}

# as above only with specified number of subterms per term
define saving_ic_from_fc_split(fc,paym,rate,nt,spt) {
  return saving_ic_from_fc(fc,paym,root(rate,spt),nt*spt)
}

# Determine regular payment based on desired final capital and initial lump sum
define saving_paym_from_fc(fc,ic,rate,nt) {
  auto rn;
  rn = pow(rate,nt);
  return (fc-ic*rn)*(rate-1)/(rn-1)
}

# as above only with specified number of subterms per term
define saving_paym_from_fc_split(fc,ic,rate,nt,spt){
  return saving_paym_from_fc(fc,ic,root(rate,spt),nt*spt)
}

# Determine ideal interest rate for given initial and final conditions
define saving_rate_from_fc(fc,ic,paym,nt) {
  auto os,i,ratd,rate,ratf,ratg;
  rate = root(fc/(ic+nt*paym),nt) # good initial guess
  os=scale;scale+=scale
  for(i=scale;i>1;i/=2){
    ratf=root((fc*(rate-1)+paym)/(ic*(rate-1)+paym),nt)
    ratg=root((fc*(ratf-1)+paym)/(ic*(ratf-1)+paym),nt)
    ratd=(ratf+ratf-rate-ratg);# d is a divisor that could end up as 0
    if(ratd==0){rate=1;break}  # so escape if that happens
    rate=(ratf*ratf-rate*ratg)/ratd;# glai(rate,ratf,ratg)
  }
  scale=os;return rate/1
}

# as above only with specified number of subterms per term
define saving_rate_from_fc_split(fc,ic,paym,nt,spt) {
  return pow(saving_rate_from_fc(fc,ic,paym,nt*spt),spt)
}

# Determine number of compounding terms required for desired final capital
define saving_nt_from_fc(fc,ic,paym,rate){
  return l( (fc*(rate-1)+paym)/(ic*(rate-1)+paym) )/l(rate)
}

# as above only with specified number of subterms per term
define saving_nt_from_fc_split(fc,ic,paym,rate,spt) {
  return saving_nt_from_fc(fc,ic,paym,root(rate,spt))/spt
}

# Determine number of subterms per term based on other details
define saving_spt_from_fc(fc,ic,paym,rate,nt) {
  auto rn;
  rn = pow(rate,nt);
  return l(rate)/l(1+paym*(rn-1)/(fc-ic*rn));
}#!/usr/local/bin/bc -l logic.bc

### Logic-ANDM.BC
### Attempts to create bitwise AND multiplications that do not result in zero

# NB: none of these are equivalent to nim multiplication

# Most functions here are asymmetric. f(x,y) does not necessarily equal f(y,x)

# Perform bitwise logical AND 'multiplication' of x and y ???

define x1andm(x,y){
  return xor(xorm(x,y),orm(x,y))
}

define x2andm(x,y){
  return xorm(xor(x,y),or(x,y))
}

define andm(x,y){
  auto os,s,z,hy;
  os=scale;scale=0
  x/=1;y/=1;s=1;if(x<0){x=-x;s=-s};if(y<0){y=-y;s=-s}
  if(x<y){x+=y;y=x-y;x-=y}
  z=x*(y%2);while(z&&y){hy=y/2;if(y-hy-hy)z=and(z,x);x+=x;y=hy}
  scale=os;return z*s
}

# Perform AND-M on binary floating point representations of x and y ???

define x1andmf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=x1andm(x,y)
  if(is_any_sfpr3_(x,y,z)){print "x1andmf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

define x2andmf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=x2andm(x,y)
  if(is_any_sfpr3_(x,y,z)){print "x2andmf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

define andmf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=andm(x,y)
  if(is_any_sfpr3_(x,y,z)){print "andmf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}#!/usr/local/bin/bc -l

### Logic.BC -  Do bitwise functions with GNU bc

# Twos complement is assumed for negative numbers
#  this avoids awkward problems like negative zero

## Word size handling

# Global variable like 'scale' or 'length'
#  When zero, bitwidth is assumed to be infinite
bitwidth=0

# to be used by functions reliant on bitwidth
define checkbitwidth_() {
  auto os;os=scale;scale=0;bitwidth/=1;scale=os
  if(bitwidth<0){
    print "Negative bitwidth, set to 0\n"
    bitwidth=0
  }
  return 0;
}

# returns bitwidth of a variable
#  (is a simplified version of digits() function in digits.bc)
define bitwidth(x) {
  auto os,p,c;
  os=scale;scale=0;x/=1
   if(x<0){x=-x}
   c=0;p=1;while(p<=x){.=c++;p+=p}
  scale=os;return(c)
}

# cast signed values into unsigned values
define unsign(x) {
  auto os,z; x+=checkbitwidth_()
  os=scale;scale=0
  x/=1
  if(x<0){
    if(bitwidth==0){
      x+=2^(bitwidth(x)+1)
    }else{
      x+=2^(bitwidth+1)
    }
  }
  if(bitwidth)x%=2^bitwidth
  scale=os;return x;
}

# cast unsigned values into signed values
define resign(x) {
  auto os,t; x+=checkbitwidth_()
  os=scale;scale=0
  x/=1
  if(bitwidth==0||x<0){scale=os;return x}
    # can't do anything when bitwidth is infinite or x already has a sign!
  x%=(t=2^bitwidth)
  if(x+x>=t)x-=t
  scale=os;return x;
}

## Common bitwise

# Perform a bitwise logical NOT of x
#  not the same as removing the sign!
define not(x) {
  x=-x;return --x # x=-1-x
}

# Perform a bitwise logical AND of x and y
define and(x,y) {
 auto n,z,t,a,b,c,os,qx,qy;
 os=scale;scale=0
 n=0;x/=1;y/=1
 if(x<0){
   if(y<0){scale=os;return -1-or(-1-x,-1-y)}# not(or(not(x),not(y)))
   x=-1-x;n=1
 }
 if(y<0){t=-1-y;y=x;x=t;n=1}
 z=0;t=1;while(x||y){
  qx=x/4;qy=y/4
  a=x-4*qx;if(n)a=3-a
  if((c=a)!=(b=y-4*qy))if((c+=b-3)<0)c=0
  z+=t*c # doing calculations in base 4 is faster
  t*=4;x=qx;y=qy
 }
 scale=os;return (z)
}

# Perform a bitwise logical OR of x and y
define or(x,y) {
 auto z,t,a,b,c,os,qx,qy;
 os=scale;scale=0
 x/=1;y/=1
 if(x<0||y<0){scale=os;return -1-and(-1-x,-1-y)}# not(and(not(x),not(y)))
 z=0;t=1;while(x||y){
  qx=x/4;qy=y/4
  if((c=a=x-4*qx)!=(b=y-4*qy))if((c+=b)>3)c=3
  z+=t*c # doing calculations in base 4 is faster
  t*=4;x=qx;y=qy
 }
 scale=os;return (z)
}

  ## NB: and() and or() are mutually reliant
  ##     though not mutually recursive
  ##     Both could also be reliant on not()
  ##     but this has be avoided

# Perform a bitwise logical EXCLUSIVE-OR of x and y
define xor(x,y) {
 auto n,z,t,a,b,c,os,qx,qy;
 os=scale;scale=0
 n=0;x/=1;y/=1
 if(x<0){x=-1-x;n=!n}
 if(y<0){y=-1-y;n=!n}
 z=0;t=1;while(x||y){
  qx=x/4;qy=y/4;
  c=(a=x-4*qx)+(b=y-4*qy) # doing calculations in
  if(!c%2)c=a+4-b         # base 4 is faster
  z+=t*(c%4)
  t*=4;x=qx;y=qy
 }
 if(n)z=-1-z
 scale=os;return (z)
}

## Bit shifting

# Reverse bits in x
define bitrev(x) {
 auto os,z,w,h; x+=checkbitwidth_()
 os=scale;scale=0
 x/=1;w=bitwidth
 if(x<0){
   if(w==0){scale=os;return -1}
   scale=os
   return -bitrev(-x-1)-1 #not(bitrev(not(x)))
 }
 if(w)x%=2^w
 z=0;for(.=.;x||w>0;w--){h=x/2;z+=z+x-h-h;x=h}
 scale=os;return(z)
}

# Perform a LEFT-SHIFT of x by n places
define shl(x,n) {
 auto os,w,s; x+=checkbitwidth_()
 if(n<0)return shr(x,-n)
 s=1;if(x<0){s=-1;x=-x}
 os=scale;scale=0
  x/=1;x*=2^(n/1)
  if(bitwidth)if(x>=(w=2^bitwidth))x%=w
 scale=os;return s*x
}

# Perform a RIGHT-SHIFT of x by n places
define shr(x,n) {
 auto os
 if(n<0)return shl(x,-n)
 os=scale;scale=0
  x/=2^(n/1)
 scale=os;return x
}

define rol(x,n) {
  auto os,s,w,t; x+=checkbitwidth_();
  if(n<0)return ror(x,-n);
  os=scale;scale=0
   x/=1;if(w=bitwidth)n%=w
   s=1;if(x<0){x=-1-x;s=-1}
   x*=2^(n/1)
   if((w=2^w)==1){
     if(s<0)x=-1-x;
     scale=os;return x
   }
   t=x%w;x=t+(x-t)/w
   if(s<0)x=w-1-x
   if(x+x>=w)x-=w
  scale=os;return x;
}

define ror(x,n) {
  auto os,s; x+=checkbitwidth_();
  if(n<0)return rol(x,-n);
  if(bitwidth)return rol(x,bitwidth-n)
  os=scale;scale=0
   x/=1;n=2^(n/1)
   s=1;if(x<0){x=-1-x;s=-1}
   if(x%n){
     # low order 1s cannot roll to infinite high order positions where
     # 0s should be without invoking a class of infinities
     print "ror: can't rotate low order bits to infinity\n"
     scale=os;return s*(A^scale-1)
   }
   x/=n
   if(s<0)x=-1-x
  scale=os;return x
}

## Gray Code

# Convert a value to its graycode equivalent
define graycode(x) {
  auto n;
  n=0;if(x<0){n=1;x=-1-x}
  x=xor(x,x/2)
  if(n)x=-1-x
  return x
}

# Inverse of graycode
define inverse_graycode(x) {
  auto os,n,a[],b,i,y,hx
  os=scale;scale=0
   x/=1;n=0;if(x<0){n=1;x=-1-x}
   for(i=0;x;i++){hx=x/2;a[i]=x-hx-hx;x=hx}
   y=0;b=0;for(--i;i>=0;i--)y+=y+(b=(b!=a[i]))
   if(n)y=-1-y
  scale=os;return y
}

# Reverse all digits after the first digit
# . is a self inverse permutation of integers
define ungraylike1(x) {
  auto os,ob;
  if(x<0)return -1-ungraylike1(-1-x);
  if(x<1)return 0;
  if(x<2)return 1;
  os=scale;scale=0
   ob=bitwidth;bitwidth=bitwidth(x/=1)-1;
    x=2^bitwidth+bitrev(x);
   bitwidth=ob
  scale=os;return x
}

# Reverse and complement all digits after the first digit
# . is a self inverse permutation of integers
define ungraylike2(x) {
  auto os,ob;
  if(x<0)return -1-ungraylike2(-1-x);
  if(x<1)return 0;
  if(x<2)return 1;
  os=scale;scale=0
   ob=bitwidth;bitwidth=bitwidth(x/=1)-1;
    x=2^(bitwidth+1)-1-bitrev(x);
   bitwidth=ob
  scale=os;return x
}

## Hamming Distance

define hamming(x,y) {
  auto os,a,b,t;
  os=scale;scale=0;x/=1;y/=1
  if(bitwidth){
    if(x<0||y<0)b=2^bitwidth
    if(x<0)x=(b+b+x)%b #x=unsign(x)
    if(y<0)y=(b+b+y)%b #y=unsign(y)
  } else {
    if(x<0&&y<0){x=-1-x;y=-1-y}
    if(x<0||y<0){
      print "hamming: infinite distance from mismatched signs\n";
      b=os;b*=D*D+A*A;b/=9*9 # approximate nearest power of 2 to A^os
      scale=os;return 2^b-1
    }
  }
  t=0;while(x||y){if((a=x%4)!=(b=y%4))t+=1+(a+b==3);x/=4;y/=4}
  scale=os;return t
}

## 'Multiplication'

# NB: none of these are equivalent to nim multiplication

# Perform bitwise logical OR 'multiplication' of x and y
define orm(x,y){
  auto os,s,z,hy;
  os=scale;scale=0
  x/=1;y/=1;s=1;if(x<0){x=-x;s=-s};if(y<0){y=-y;s=-s}
  z=0;while(y){hy=y/2;if(y-hy-hy)z=or(z,x);x+=x;y=hy}
  scale=os;return z*s
}

# Perform bitwise logical EXCLUSIVE-OR 'multiplication' of x and y
define xorm(x,y){
  auto os,s,z,hy;
  os=scale;scale=0
  x/=1;y/=1;s=1;if(x<0){x=-x;s=-s};if(y<0){y=-y;s=-s}
  z=0;while(y){hy=y/2;if(y-hy-hy)z=xor(z,x);x+=x;y=hy}
  scale=os;return z*s
}

# NB: Logical AND 'multiplication' is problematic and not included here
# see logic_andm.bc for alternatives

## Floating point

# Workhorse for the below; Bitwise multiplier
bw_mult_ml_ = 1
bw_mult_sc_ = 0
define bw_mult_(sc) {
  if(bw_mult_sc_!=sc)bw_mult_ml_=2^bitwidth(A^(bw_mult_sc_=sc))
  return 8*bw_mult_ml_
}

sfpr_check_mod_ = 2^5 # power of two = number of bits to warn on
sfpr_check_max_ = sfpr_check_mod_*(.5*sfpr_check_mod_+1)-1 #1000011111

# Set to 0 to stop warnings about sfprs
sfpr_warn = 1

# Check if x contains a secondary floating point representation of a number
# e.g. 0.11111... = sfpr of 1.00000...
define is_sfpr_(x) {
  if(x==0)return 0;
  x/=sfpr_check_mod_
  if(x<0)x=-x;
  if(x>=sfpr_check_max_)
   if(x%sfpr_check_mod_==sfpr_check_mod_-1)
     return 1;
  return 0;
}

# used to check whether parameters and output are sfprs
define is_any_sfpr3_(x,y,z) {
  if(sfpr_warn){
   if(is_sfpr_(x))return 1;
   if(is_sfpr_(y))return 1;
   if(is_sfpr_(z))return 1;
  }
  return 0;
}

define sfpr_warn_msg_() {
  print ": 2ndary fp representation of rational\n"
  return 0;
}

# Perform XOR on binary floating point representations of x and y
define xorf(x,y){
 auto os,t
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t
  z=xor(x,y)
  if(is_any_sfpr3_(x,y,z)){print "xorf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# Perform OR on binary floating point representations of x and y
define orf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t
  z=or(x,y)
  if(is_any_sfpr3_(x,y,z)){print "orf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# Perform AND on binary floating point representations of x and y
define andf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t
  z=and(x,y)
  if(is_any_sfpr3_(x,y,z)){print "andf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

## Floating point + 'Multiplication'

# Perform XOR-M on binary floating point representations of x and y
define xormf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=xorm(x,y)
  if(is_any_sfpr3_(x,y,z)){print "xormf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# Perform OR-M on binary floating point representations of x and y
define ormf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=orm(x,y)
  if(is_any_sfpr3_(x,y,z)){print "ormf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# NB: Bitwise logical AND 'multiplication' would always return 0
# see logic_andm.bc for alternatives

## Gray Code + Floating Point

define graycodef(x) {
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t
  z=graycode(x)
  if(is_any_sfpr3_(x,0,z)){print "graycodef";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

define inverse_graycodef(x) {
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t
  z=inverse_graycode(x)
  if(is_any_sfpr3_(x,0,z)){print "inverse_graycodef";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}
#!/usr/local/bin/bc -l logic.bc

### Logic_Inverse.BC - Inverses for bitwise AND and OR

# Negative numbers not yet supported

# Global variable to control no-solution warning messages
# 0 -> warnings suppressed; 1 -> show warnings
# (Some errors are fatal and cannot be suppressed)
dand_sor_warn_=1

# Workhorse function for the below
define dand_sor_(which, z,y ,n){
  auto x,t,os,hz,hy,hn,b,str;
  os=scale;scale=0
  z/=1;y/=1;n/=1
  if(n<-4||z<0||y<0){
    if(which==2||which==3){print "striped_";which-=2}
    if(which==0)print "dand: "
    if(which==1)print "sor: "
    if(z<0||y<0){print "negative unsupported\n";n=0}
    if(n<-4)print "unknown option for n\n"
    scale=os;return -1
  }
  str=-1;if(which==2||which==3)str=which-2
  x=0;t=1;while(z||y){
    hz=z/2;hy=y/2
    # Set b to be the bit in the result
    # Unless altered by n==-4:
    # b == 0 => actual zero bit
    # b == 1 => actual one but
    # b == 2 => don't-care/both bit. Could be either 1 or 0. Choice set by n parameter.
    # b == 3 => failure/neither bit. There are no solutions
    if(which==0||str==0){b=1-y+hy+hy;b+=b+z-hz-hz}
    if(which==1||str==1){b=z-hz-hz;if(y-hy-hy)b=3-b}
    if(which==2||which==3)str=!str
    if(n==-4||n==-3){
      if(n==-4)if(++b==4)b=0
      x+=t*b
      t*=4
    } else if(n==-2||n==-1) {
      if(b==3){
        scale=os
        if(n==-1){
          if(dand_sor_warn_){
            if(which==2||which==3){print "striped_";which-=2}
            if(which==0)print "dand: "
            if(which==1)print "sor: "
            print "no possible solutions\n"
          }
          return -1
        } else {
          return 0
        }
      }
      if(b==2).=x++
    } else {
      if(b==3){
        scale=os
        if(dand_sor_warn_){
          if(which==2||which==3){print "striped_";which-=2}
          if(which==0)print "dand: "
          if(which==1)print "sor: "
          print "no possible solutions\n"
        }
        return -1
      }
      if(b==2){hn=n/2;b=n-hn-hn;n=hn}
      x+=t*b
      t+=t
    }
    z=hz;y=hy
  }
  if(n==-2)x=2^x
  scale=os;return x
}

# n parameter options:
#  n == -4 => base 4 codification: {neither,0,1,both} <=> {0,1,2,3}
#  n == -3 => base 4 codification: {0,1,both,neither} <=> {0,1,2,3} (default)
#  n == -2 => returns number of solutions = N
#  n == -1 => returns number of don't-care bits = D
#             = log2(number of solutions) = log2(N) or -1 if no solution
#  n >=  0 => returns solution specified by n mod N or -1 if no solution
# Hint:
#  n ==  0 => guaranteed to return a solution (the smallest possible)
#             if one exists

# DivAND / De-AND
# Bitwise division in the sense that bitwise AND is bitwise multiplication
# Attempt to find solutions to z = and(x,y) for x
# . any error will cause the return of -1
define dand(z,y ,n) { return dand_sor_(0, z,y, n) }

# SubtractOR / SubtORct
# Bitwise subtraction in the sense that bitwise OR is bitwise addition
# Attempt to find solutions to z = and(x,y) for x
# . any error will cause the return of -1
define  sor(z,y ,n) { return dand_sor_(1, z,y, n) }

# N.B. There is no bitwise XOR subtraction in the style of the above
# since XOR is its own inverse.

# Striped DivAND / De-AND
# Bitwise division in the sense that bitwise AND is bitwise multiplication
# Attempt to find solutions to z = and(x,y) for x
# . any error will cause the return of -1
define striped_dand(z,y ,n) { return dand_sor_(2, z,y, n) }

# Striped SubtractOR / SubtORct
# Bitwise subtraction in the sense that bitwise OR is bitwise addition
# Attempt to find solutions to z = and(x,y) for x
# . any error will cause the return of -1
define  striped_sor(z,y ,n) { return dand_sor_(3, z,y, n) }

# Workhorse print function
define print_01dx_(x){
  auto os,ai,ni,a[],aai,f2,f3;
  os=scale;scale=0;
  x/=1;if(x<0)x=-x
  ai=0;f3=0;ni=i=x
  while(i){i=ni;ni=i/4;a[++ai]=aai=i-ni*4}
  if(!ai){print 0;scale=os;return i}
  for(--ai;ai;ai--){
    i=a[ai]
    if(i==0){print 0}else if(i==1){print 1
    }else if(i==2){print"d";.=f2++}else{print"X";.=f3++}
  }
  if(f3){
    print " => no solution; ",f3," fail bit"
    if(f3>1)print"s"
  }else{
    f2=2^f2
    print " => ",f2," solution"
    if(f2>1)print"s"
  }
  scale=os;return x
}

define dand_print(z,y) { .=print_01dx_(dand_sor_(0, z,y, -3)) }
define sor_print(z,y)  { .=print_01dx_(dand_sor_(1, z,y, -3)) }
define striped_dand_print(z,y) { .=print_01dx_(dand_sor_(2, z,y, -3)) }
define striped_sor_print(z,y)  { .=print_01dx_(dand_sor_(3, z,y, -3)) }#!/usr/local/bin/bc -l

### Logic-OtherBase.BC - Attempt to extend bitwise functions into other bases

 # see logic.bc for faster bitwise-only functions

## XOR like
# All of these degenerate to being identical
# to bitwise exclusive-or in base 2

# Workhorse function for the others
define digitwise_xor_(which, base, x,y) {
  auto os,n,a,b,c,p,t,z,oddbase,h
  os=scale;scale=0
  /* Nonsense to delete
  # some algorithms are asymmetric. negative which swaps parameters
  if(which<0){x+=y;y=x-y;x-=y;which=-which} #swap
   # ^technically a bug since -0 fails, but that algorithm is symmetric anyway
  # since some algos are asym, add the alternatives in a ratio
  # . specified by the fractional part of which
  if(which>(z=which/1)){
    a=which-z
    z=digitwise_xor_(z,base,x,y)*(1-a)+digitwise_xor_(z,base,y,x)*a
    scale=os;return z
  }
  */
  which/=1
  base/=1;if(base<2)base=ibase
  n=0;x/=1;y/=1
  if(x<0){x=-1-x;n=!n}
  if(y<0){y=-1-y;n=!n}
  oddbase=base%2
  z=0;t=1;p=0;while(x||y){
    a=x-base*(h=x/base);x=h
    b=y-base*(h=y/base);y=h
    if(0){
    } else if(which==-1){
      c=a-b;if(c<0)c=-c
      if(c+c>base)c=base-c
    } else if(which==0){
      c=a-b;if(c<0)c=-c
    } else if(which==1){
      c=a+base-b;c%=base
    } else if(which==2){
      c=a+b;c%=base
    } else if(which==3){
      c=a+b
      if(oddbase||!c%2)c=a+base-b # odd base, or even base with odd parity
      c%=base
    } else if(which==4){
      c=a;b=b%2
      if((!oddbase&&b)||(oddbase&&p))c=base-1-a
      if(oddbase&&b)p=1-p
    }    
    z+=t*c
    t*=base
  }
  if(n)z=-1-z
  scale=os;return z
}

# Digitwise shortest distance
#  each digit is the shortest path from digit
#  in x to digit in y modulo the base
#   e.g. shortest distance between 0 and 4 modulo 6 is 2 (not 4)
define digitwise_sdist(base, x,y) {
  return digitwise_xor_(-1,base,x,y)
}

# Digitwise logical difference
define digitwise_diff(base, x,y) {
  return digitwise_xor_(0,base,x,y)
}

# Digitwise modulo subtraction; no borrows
#  asymmetric since x-y != y-x
define no_borrow_diff(base, x,y) {
  return digitwise_xor_(1,base,x,y)
}

# Digitwise modulo sum / add ignoring carries
define no_carry_add(base, x,y) {
  return digitwise_xor_(2,base,x,y)
}

# A logical 'blend' of the previous two functions
#  also asymmetric
define asym_mixor(base, x,y) {
  return digitwise_xor_(3,base,x,y)
}

# Flip digits of x using parity of digits of y
#  necessarily asymmetric
define asym_parity(base, x,y) {
  return digitwise_xor_(4,base,x,y)
}

## AND-like
# Positive values only for now

define digitwise_modmult(base, x,y) {
  auto os,a,b,c,t,z,h
  os=scale;scale=0
  base/=1;if(base<2)base=ibase
  x/=1;y/=1
  if(x<0||y<0){
    print "digitwise_modmult: unimplemented for -ve numbers\n"
    scale=os;return 0
  }
  z=0;t=1;while(x||y){
    a=x-base*(h=x/base);x=h
    b=y-base*(h=y/base);y=h
    c=(a*b)%base
    z+=t*c
    t*=base
  }
  scale=os;return z
}

define digitwise_min(base, x,y) {
  auto os,a,b,c,t,z,h
  os=scale;scale=0
  base/=1;if(base<2)base=ibase
  x/=1;y/=1
  if(x<0||y<0){
    print "digitwise_min: unimplemented for -ve numbers\n"
    scale=os;return 0
  }
  z=0;t=1;while(x||y){
    a=x-base*(h=x/base);x=h
    b=y-base*(h=y/base);y=h
    c=a;if(a>b)c=b
    z+=t*c
    t*=base
  }
  scale=os;return z
}

## OR like

define digitwise_max(base, x,y) {
  auto os,a,b,c,t,z,h
  os=scale;scale=0
  base/=1;if(base<2)base=ibase
  x/=1;y/=1
  if(x<0||y<0){
    print "digitwise_max: unimplemented for -ve numbers\n"
    scale=os;return 0
  }
  z=0;t=1;while(x||y){
    a=x-base*(h=x/base);x=h
    b=y-base*(h=y/base);y=h
    c=a;if(a<b)c=b
    z+=t*c
    t*=base
  }
  scale=os;return z
}

define digitwise_tlumdom(base, x,y) {
  auto os,a,b,c,t,z,h
  os=scale;scale=0
  base/=1;if(base<2)base=ibase
  x/=1;y/=1
  if(x<0||y<0){
    print "digitwise_tlumdom: unimplemented for -ve numbers\n"
    scale=os;return 0
  }
  z=0;t=1;while(x||y){
    a=x-base*(h=x/base);x=h
    b=y-base*(h=y/base);y=h
    c=base-1-((a+1)*(b+1))%base
    z+=t*c
    t*=base
  }
  scale=os;return z
}

## Gray Code like

define base_graycode(base,x){
  auto os,n,b2,b_1,d,p,g,h;
  os=scale;scale=0
  base/=1;if(base<2)base=ibase
  x/=1;n=0;if(x<0){n=1;x=-1-x}
  b2=base+base;b_1=base-1
  g=0;p=1
  while(x){
    if(x%b2>(d=x-base*(h=x/base)))d=b_1-d
    g+=p*d;p*=base;x=h
  }
  if(n)g=-1-g
  scale=os;return g
}

define inverse_base_graycode(base,x) {
  auto os,n,bp,b_1,a[],b,i,y,h;
  os=scale;scale=0
   base/=1;if(base<2)base=ibase
   x/=1;n=0;if(x<0){n=1;x=-1-x}
   for(i=0;x;i++){a[i]=x-base*(h=x/base);x=h}
   bp=base%2;b_1=base-1
   y=0;b=0;for(--i;i>=0;i--){
     d=a[i];if(b)d=b_1-d
     y=y*base+d
     if(bp){b+=d}else{b=d}
     b%=2
   }
   if(n)y=-1-y
  scale=os;return y
}

## Hamming Distance

# Count the number of differences between two numbers in the given base
# . compare with digit_distance in digits.bc which
# . takes the value of the difference into account
define base_hamming(base,x,y) {
  auto os,t,hx,hy;
  os=scale;scale=0;base/=1;x/=1;y/=1
  if(base<2)base=ibase
  if(x<0&&y<0){x=-1-x;y=-1-y}
  if(x<0||y<0){
    print "base_hamming: infinite distance from mismatched signs\n";
    scale=os;return A^os-1
  }
  t=0;while(x||y){hx=x/base;hy=y/base;if(x-y!=base*(hx-hy)).=t++;x=hx;y=hy}
  scale=os;return t
}
#!/usr/local/bin/bc -l logic.bc

### Logic-Striping.BC -  Do striped bitwise functions with GNU bc

  ## To be used with Logic.BC

## Basic Striping

# workhorse function for striped_and() and striped_or()
#  Matching bit positions in x and y are inherited by the result
#  Mismatched bits are arbitrated by their bit position and the b parameter
#   When the b parameter is 0, even bit positions
#    (LSB being 0 and thus even) are set to 0, odd positions are set to 1
#    This is a Striped AND;
#     The degenerate case for a single bit is equivalent to AND
#   When the b parameter is 1, even bit positions
#    (LSB being 0 and thus even) are set to 1, odd positions are set to 0
#    This is a Striped OR;
#     The degenerate case for a single bit is equivalent to OR
define stripe_(b,x,y){
 auto z,t,os,hx,hy;
 os=scale;scale=0
 x/=1;y/=1;b=!!b
 if((x<0&&y>=0)||(y<0&&x>=0)){
   print "striped_"
   if(b){print "or"}else{print "and"}
   print ": sign mismatch\n"
   # Any return value here would be related to a
   # divergent sum with 'impossible' value -1/3
   scale=os;return 0;
 }
 if(x<0){scale=os;return -1-stripe_(!b,-1-x,-1-y)}# not(stripe_(!b,not(x),not(y)))
 z=0;t=1;while(x||y){
  hx=x/2;hy=y/2
  if((x-hx-hx!=b&&y-hy-hy!=b)!=b)z+=t
  t+=t;b=!b;x=hx;y=hy
 }
 scale=os;return (z)
}

# Perform a bitwise logical STRIPED-AND of x and y
define striped_and(x,y) { return stripe_(0,x,y) }

# Perform a bitwise logical STRIPED-OR of x and y
define striped_or(x,y)  { return stripe_(1,x,y) }

# Generalisation of the stripe functions
#   genstripe(0,2,x,y) == and(x,y)
#   genstripe(0,3,x,y) ==  or(x,y)
#   genstripe(0,5,x,y) == striped_or(x,y)
#   genstripe(0,6,x,y) == striped_and(x,y)
#  Override and Repeat parameters should be of binary form
#   "1 followed by bit pattern"
#   e.g. repeat of binary 110 = decimal 6 implies pattern of
#    ...101010101010 which is the bit pattern for striped_and
#   Some patterns are equivalent e.g. 110 and 11010
#  Override parameter is used override the repeat pattern
#   on the lower order bits
define genstripe(override,repeat,x,y){
 auto o,r,b,z,t,os,h,hx,hy;
 os=scale;scale=0
 x/=1;y/=1;override/=1;repeat/=1

 if(override<0)override=-override
 if(override<2)override+=2
 if(repeat  <0)repeat  =-repeat
 if(repeat  <2)repeat  +=2

 # work out whether the and() or or() functions - which support
 #   parameters of opposing sign - are more appropriate
 #r=repeat;r+=r%2;z=0;for(r/=2;r>1;r/=2)if(z=r%2)break;
 r=repeat;h=r/2;r+=(t=r-h-h)
 z=0;for(r=h;r>1;r=h){h=r/2;if(z=r-h-h)break;}
   # single equals is not an error in the above line!
 if(!z){
   scale=os
   if(t)return or(x,y)
   return and(x,y)
 }

 if((x<0&&y>=0)||(y<0&&x>=0)){
   print "genstripe: sign mismatch\n"
   # Any return value here would be related to
   # a divergent sum with 'impossible' non-integral value
   scale=os;return 0;
 }
 if(x<0){
   z=6;while(z<repeat  )z+=z;repeat  =z-1-repeat
   z=6;while(z<override)z+=z;override=z-1-override
   scale=os
   return -1-genstripe(override,repeat,-1-x,-1-y)
   # not(genstripe(inv@(override),inv@(repeat),not(x),not(y)))
 }
 o=override;r=repeat
 z=0;t=1;while(x||y){
  h=r/2;b=r-h-h;r=h;if(r==1)r=repeat
  if(o){h=o/2;b=o-h-h;o=h}
  hx=x/2;hy=y/2
  if((x-hx-hx!=b&&y-hy-hy!=b)!=b)z+=t
  t+=t;b=!b;x=hx;y=hy
 }
 scale=os;return (z)
}  

## 'Multiplication'

# NB: none of these are equivalent to nim multiplication

# Perform STRIPED-OR 'multiplication' of x and y
define striped_orm(x,y){
  auto os,s,z,h;
  os=scale;scale=0
  x/=1;y/=1;s=1;if(x<0){x=-x;s=-s};if(y<0){y=-y;s=-s}
  z=0;while(y){h=y/2;if(y-h-h)z=stripe_(1,z,x);x+=x;y=h}
  scale=os;return s*z
}

# Perform STRIPED-AND 'multiplication' of x and y
define striped_andm(x,y){
  auto os,s,z,h;
  os=scale;scale=0
  x/=1;y/=1;s=1;if(x<0){x=-x;s=-s};if(y<0){y=-y;s=-s}
  z=0;while(y){h=y/2;if(y-h-h)z=stripe_(0,z,x);x+=x;y=h}
  scale=os;return s*z
}

# Perform generalised stripe 'multiplication' of x and y
define genstripem(override,repeat,x,y){
  auto os,s,z,h;
  os=scale;scale=0
  x/=1;y/=1;s=1;if(x<0){x=-x;s=-s};if(y<0){y=-y;s=-s}
  z=0;while(y){h=y/2;if(y-h-h)z=genstripe(override,repeat,z,x);x+=x;y=h}
  scale=os;return s*z
}

## Floating point

# Perform STRIPED-OR on binary floating point representations of x and y
define striped_orf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t
  z=stripe_(1,x,y)
  if(is_any_sfpr3_(x,y,z)){print "striped_orf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# Perform STRIPED-AND on binary floating point representations of x and y
define striped_andf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t
  z=stripe_(0,x,y)
  if(is_any_sfpr3_(x,y,z)){print "striped_andf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# Perform generalised stripe on binary floating point representations of x and y
define genstripef(o,r,x,y) {
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t
  z=genstripe(o,r,x,y)
  if(is_any_sfpr3_(x,y,z)){print "genstripef";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

## Floating point + 'Multiplication'

# Perform STRIPED-OR-M on binary floating point representations of x and y
define striped_ormf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=striped_orm(x,y)
  if(is_any_sfpr3_(x,y,z)){print "striped_ormf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# Perform STRIPED-AND-M on binary floating point representations of x and y
define striped_andmf(x,y){
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=striped_andm(x,y)
  if(is_any_sfpr3_(x,y,z)){print "striped_andmf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}

# Perform generalised stripe on binary floating point representations of x and y
define genstripemf(o,r,x,y) {
 auto os,t,z;
 os=scale;scale=0
  t=bw_mult_(os);x*=t;y*=t;t*=t
  z=genstripem(o,r,x,y)
  if(is_any_sfpr3_(x,y,z)){print "genstripemf";x+=sfpr_warn_msg_()}
 scale=os;return( z/t )
}
#!/usr/local/bin/bc -l logic.bc logic_striping.bc

### Logic_Striping_Meta.BC - Analysis of genstripe patterns

  ## To be used with Logic.BC and Logic_Striping.BC

## Pattern analysis

# negative pattern values represent flipped bits
# e.g. -1[xyz...] is equivalent to 1[(1-x)(1-y)(1-z)(1-...]
# this matches with the definition in rep_stripe_pattern where
# 'multiplying' by the integer -1 flips all bits.
# Technically this is 1s complement negation, meaning that two zeros would
# exist, but in fact an infinite number of zeros exist in the positive-only
# patterns: 10, 100, 1000 and these are each stated to be equivalent to their
# bit flipped counterparts, so this is not a concern.

# Reduces a pattern to the smallest number that will represent it
# . Patterns take binary form 1[pattern to repeat]
# . e.g. 101 => ...0101010101; 11001 => ...1001100110011001
# . some patterns are equivalent;
# . . e.g. 10101 will create the same pattern as 101
# . Given 21 decimal therefore (10101 binary)
# . . this function will return 5 (101 binary)
define simplify_stripe_pattern(x) {
  auto os,w,wh,wp,dp,d,r,m,s
  os=scale;scale=0;x/=1
  s=0;if(x<0){s=1;x=-x}
  if(x==0||x==1){if(s)x=1-x;scale=os;return x}
  if(x==2||x==3){if(s)x=5-x;scale=os;return x}
  w = bitwidth(x)-1
  wh = w/2;if(wh==0)wh=1
  wp = 2^w
  n = x-wp # trim high/lead bit
  if(s)n = wp-1-n # flip bits for negative
  for(dp=d=1;d<=wh;d++){
    dp+=dp;r=w/d
    if(w==r*d){
      m=(n*dp)/wp # check if this is a minimal bit pattern to spread
      #to make the above the same width as wp-1
      #we need to repeat it r times
      #so that's m*(dp^r-1)/(dp-1)
      if( n*(dp-1) == m*(dp^r-1) ){n = m; break}
    }
  }
  if(d>wh)d=w
  scale=os;return n+2^d
}

# Pattern equivalent of raising to a power or multiplying by integer
define rep_stripe_pattern(x,p) {
  auto d,os,s;
  os=scale;scale=0;x/=1;p/=1
  s=0;if(p<0){p=-p;s=!s}
  if(x<0){x=-x;s=!s}
  if(x==0||x==1){scale=os;return x}
  if(p==0){scale=os;return 1}
  if(p==1&&!s){scale=os;return x}
  d = 2^(bitwidth(x)-1)
  if(s){
    x=3*d-1-x
    if(p==1){scale=os;return x}
  } # negative power flips bits
  p = d^p
  x = (x-d)*(p-1)/(d-1)+p
  scale=os;return x
}

# Given pattern x, find its length with respect to its simplest form
define repsof_stripe_pattern(x) {
  auto os,w,wh,wp,dp,d,r,m;
  os=scale;scale=0;x/=1
  if(x<0)x=-x # sign doesn't matter here
  if(x==0||x==1){scale=os;return 0}
  w = bitwidth(x)-1
  wh = w/2;if(wh==0)wh=1
  wp = 2^w
  n = x-wp # trim high/lead bit
  for(dp=d=1;d<=wh;d++){
    dp+=dp;r=w/d
    if(w==r*d){
      m=(n*dp)/wp # check if this is a minimal bit pattern to spread
      if( n*(dp-1) == m*(dp^r-1) ){d=0;break}
    }
  }
  if(d)r=1 # no minimal found. prime pattern
  scale=os;return r
}

# Produce the next matching stripe pattern in a family
# e.g. 1[011] -> 1[011][011]; 1[10][10] -> 1[10][10][10]
define next_match_stripe_pattern(x) {
  auto os,w,wh,wp,dp,d,r,m,s
  os=scale;scale=0;x/=1
  s=0;if(x<0){s=1;x=-x}
  if(x==0||x==1){scale=os;return x}
  os=scale;scale=0
  w = bitwidth(x)-1
  wh = w/2;if(wh==0)wh=1
  wp = 2^w
  n = x-wp # trim high/lead bit
  if(s)n = wp-1-n # flip bits for negative
  for(dp=d=1;d<=wh;d++){
    dp+=dp;r=w/d
    if(w==r*d){
      m=(n*dp)/wp # check if this is a minimal bit pattern to spread
      if( n*(dp-1) == m*(dp^r-1) ){d=0;break}
    }
  }
  if(d){r=1;dp=wp;m=n}
  wp=dp^(r+1)
  n=wp+(m*(wp-1))/(dp-1)
  scale=os;return n
}

## Convert stripe patterns to and from alternative formats

# Convert stripe pattern of form 1[xyz...] to 2's complement format of
# . [xyz...] if x == 1;
# . not([(1-x)(1-y)(1-z)(1-...]) if x == 0
define stripe_pattern_to_2c(x) {
  auto os,w,s,n,wp;
  os=scale;scale=0;x/=1
  s=0;if(x<0){s=1;x=-x}
  if(x==0||x==1){scale=os;return x-1}
  w=bitwidth(x);wp=2^(w-1);n=x-wp#drop lead bit
  if(s)n=wp-1-n#flip bits if x was negative
  if(n<2^(w-2))n-=wp
  scale=os;return n
}

# Convert stripe pattern of form 1[xyz...] to 1's complement format of
# . [xyz...] for x == 1
# . -[(1-x)(1-y)(1-z)(1-...] if x == 0;
define stripe_pattern_to_1c(x) {
  x = stripe_pattern_to_2c(x);
  if(x<0).=x++
  return x
}

# Inverse of the above
define stripe_pattern_from_1c(x) {
  auto os,w;
  os=scale;scale=0;x/=1
  w=bitwidth(x)
  if(x>0){scale=os;return x+2^w}
  scale=os;return 2^(w+1)+x-1
}  

# Inverse of ..._to_2c
define stripe_pattern_from_2c(x) {
  if(x<=0).=x++
  return stripe_pattern_from_1c(x)
}

### Advanced Pattern Combination.
### . Multiplication-like methods, Division-like inverses to multiplication
### . Addition / Catenation, Subtraction / Decatenation

## 'Standard' multiplication / division / square root

# Pattern multiplication; Largely asymmetrical
# . Repeats the pattern of the left hand parameter either as-is
# . or bit flipped depending on the bits in the pattern of the
# . right hand parameter.
# . e.g. 1[pattern] x 1[0110] =
# . . 1[0=>flipped pattern][1=>pattern][1=>pattern][0=>flipped pattern]
# . e.g. 1[1101] x 1[0110] = 1[0010][1101][1101][0010]
# . Note that this is asymmetrical. With params swapped:
# . e.g. 1[0110] x 1[1101] = 1[0110][0110][1001][0110]
# ..........
# . Powers of two in the right parameter correspond to negative integers in
# . the right parameter in rep_stripe_pattern(), whereas one less than a power
# . of two corresponds to a positive integer in the same place.
# . This suggests that patterns may be a strange class of sub-integer or
# . perhaps some relative of surreal numbers.
# . They are somewhere between bijective unary and binary!
# . i.e rep...(x,p[+ve]) <==> mul...(x,2^(p+1)-1)
# . and rep...(x,p[-ve]) <==> mul...(x,2^(-p))
# . so p = 3 --> 2^(3+1)-1 = 15 decimal = 1111 binary pattern
# . what number would binary pattern 1101 translate back to?
# . This multiplication method preserves integers represented in the above way
# . and is symmetric for these, suggesting that there is something curious
# . about the other patterns.
define mul_stripe_patterns(x,y) {
  auto os,z,bx,by,qx,qz,p[],i,hy;
  os=scale;scale=0;x/=1;y/=1
  if(x==0||y==0){scale=os;return 0}
  if(x==-1||x==1||y==-1||y==1){scale=os;return 1}
  qx = 2^(bx = bitwidth(x)-1)
          by = bitwidth(y)-1
  if(x<0)x=3* qx   +x-1 # Flip bits of -ve params
  if(y<0)y=3*(2^by)+y-1
  if(x==3){scale=os;return y} # pattern 3 == 1[1] is multiplicative identity!
  if(y==3){scale=os;return x} # in either param. works even though asymmetric
  qz = 2^(bx*by)              # n.b. pattern 2 == 1[0] works as negative m.i.
  p[1] = x-qx                 # in either param. too.
  p[0] = qx+qx-1-x
  z=0;for(i=1;i<qz;i*=qx){hy=y/2;z+=i*p[y-hy-hy];y=hy}
  z+=qz
  scale=os;return z
}

# Attempt to solve z = mul...(x,y) for x
define div1_stripe_patterns(z,y){
  auto os,x,bz,by,bx,qz,qy,qx,t,p[],hy;
  os=scale;scale=0;z/=1;y/=1
  if(z==0||y==0){scale=os;return 0}
  if(z==1||z==-1){scale=os;return 1} # 1[] is zero pattern and 0/y = 0 so 1[]/y
  if(y==1||y==-1){
    print "div1_stripe_patterns: division by null pattern\n"
    scale=os;return 0
  }
  bz=bitwidth(z)-1
  by=bitwidth(y)-1
  # Check if bz is divisible by 'by'
    # Return an error if not
  bx=bz/by
  if(bx*by!=bz){
    print "div1_stripe_patterns: parameters of incompatible sizes\n"
    scale=os;return 0
  }
  qz=(qy=2^by)*(qx=2^bx)
  if(z<0)z=3* qz +z-1 # Flip bits of -ve params
  if(y<0)y=3* qy +y-1
  if(y==3){scale=os;return z} # pattern 3 == 1[1] is multiplicative identity
  if(y==2){scale=os;return qx+qz-z-1} # -ve multiplicative identity
  t=z/qx;x=z-qx*t;z=t # extract bits from RHS of z, and assume these are x
  hy=y/2;if(y-hy-hy){x=x;t=qx-1-x}else{t=x;x=qx-1-x}
  # ^ check last bit of y to see if we have obtained x or !x and swap accordingly
  y=hy;qy/=2
  p[0]=t # = bitflipped x
  p[1]=x
  while(qy>1){
    hy=y/2;t=z/qx
    if(p[y-hy-hy]!=z-t*qx) { # if last bits of z don't match what was found
      print "div1_stripe_patterns: parameters are incompatible\n"
      scale=os;return 0
    }
    qy/=2;y=hy;z=t
  }
  scale=os;return qx+x
}

# Attempt to solve z = mul...(x,y) for y
define div2_stripe_patterns(z,x){
  auto os,y,bz,bx,by,qz,qx,qy,nx,p2,fz,t;
  os=scale;scale=0;z/=1;x/=1
  if(z==0||x==0){scale=os;return 0}
  if(z==1||z==-1){scale=os;return 1} # 1[] is zero pattern and 0/y = 0 so 1[]/y = 1[]
  if(x==1||x==-1){
    print "div2_stripe_patterns: division by null pattern\n"
    scale=os;return 0
  }
  bz=bitwidth(z)-1
  bx=bitwidth(x)-1
  # Check if bz is divisible by 'bx'
    # Return an error if not
  by=bz/bx
  if(by*bx!=bz){
    print "div2_stripe_patterns: parameters of incompatible sizes\n"
    return 0
  }
  qz=(qx=2^bx)*(qy=2^by)
  if(z<0)z=3* qz +z-1 # Flip bits of -ve params
  if(x<0)y=3* qx +x-1
  x-=qx
  nx=qx-1-x
  y=0
  for(p2=1;z>1;p2+=p2){
    fz=z/qx
    t=z-fz*qx
    if(t==x){
      y+=p2
    } else if(t!=nx) {
      print "div2_stripe_patterns: parameters are incompatible\n"
      scale=os;return 0
    }
    z=fz
  }
  scale=os;return qy+y
}

# Attempt to solve z = mul...(x,x) for x
define sqrt_stripe_pattern(z){
  # Usual preamble
  auto os,y,bz,bx,qz,qx,hy,p[],t;
  os=scale;scale=0;z/=1
  if(z==0){scale=os;return 0}
  if(z==1||z==-1){scale=os;return 1} # 1[] is zero pattern and sqrt(0) = 0 so sqrt(1[]) = 1[]
  bz=bitwidth(z)-1
  # Check if bz is a square
    # Return an error if not
  bx=sqrt(bz)
  if(bx*bx!=bz){
    print "sqrt_stripe_pattern: parameter does not have square size\n"
    return 0
  }
  qz=(qx=2^bx);qz*=qx
  if(z<0)z=3* qz +z-1 # Flip bits of -ve param
  if(z==3){scale=os;return 3} # 3 => 1[1] is multiplicative id. and so sqrt(1[1]) = 1[1] => 3
  if(z+z<=3*qz){
    # square root of a "negative" pattern (one that starts 1[0...])
    print "sqrt_stripe_pattern: impossible square root\n"
    return 0
  }
  t=z/qx;x=z-qx*t;z=t # extract bits from RHS of z, and assume these are x
  y=x;hy=y/2 # set y to x and assign x and !x to associated bits of y
  p[t=y-hy-hy]=x
  p[!t]=qx-1-x
  y=hy
  while(z>1){
    hy=y/2;t=z/qx
    if(p[y-hy-hy]!=z-t*qx){
      print "sqrt_stripe_pattern: parameter has no square root\n"
      return 0
    }
    z=t;y=hy
  }
  # since square root has two possible values (1[pattern] and 1[!pattern])
  # set x to the 'positive' / larger of the two options
  x=p[0];if(x<p[1])x=p[1]
  scale=os;return qx+x
}

## NXOR and modular arithmetic multiplication-like pattern combination

# Mix stripe patterns so that the new length is the LCM of the old lengths
# . patterns extended to the right length and the bits are NXORed
# Is symmetric with respect to x and y, i.e. mix...(x,y) = mix...(y,x)
define mix_stripe_patterns(x,y) {
  auto os,bx,by,qx,r,gcd,t
  os=scale;scale=0;x/=1;y/=1
  if(x==0||y==0){scale=os;return 0}
  if(x==1||x==-1||y==-1||y==1){scale=os;return 1}
  qx = 2^(bx = bitwidth(x)-1)
          by = bitwidth(y)-1
  if(x<0)x=3* qx   +x-1 # Flip bits of -ve params
  if(y<0)y=3*(2^by)+y-1
  if(bx!=by){
    gcd=bx
    for(t=by;t>0;t=r){r=gcd%t;gcd=t}
    x=rep_stripe_pattern(x,  by/gcd)
    y=rep_stripe_pattern(y,t=bx/gcd)
    bx=by*=t # = bz
    qx=2^bx
  }
  x=xor(x,y) # bits flip incorrectly and q' bit is lost
  x=qx+qx-1-x # correct the above
  scale=os;return x
}

# Inverse of the above; Given a mixed pattern and one of the constituents
# . derive the other constituent (up to repeat-equivalence)
# . See notes elsewhere how patterns can be equivalent to each other
# . in some uses. This is one.
define unmix_stripe_patterns(z,x) {
  auto os,bz,bx,by,qz;
  os=scale;scale=0;z/=1;x/=1
  if(z==0||x==0){scale=os;return 0}
  if(z==1||z==-1){scale=os;return 1} # 1[] is zero pattern; 0/x=0
  if(x==1||x==-1){
    print "unmix_stripe_patterns: can't unmix null pattern\n"
    scale=os;return 0
  }
  bz=bitwidth(z)-1
  bx=bitwidth(x)-1
  # Check if bz is divisible by 'bx'
    # Return an error if not
  by=bz/bx
  if(by*bx!=bz){
    print "unmix_stripe_patterns: parameters of incompatible sizes\n"
    return 0
  }
  qz=2^bz
  if(z<0)z=3* qz    +z-1 # Flip bits of -ve params
  #if(x<0)y=3*(2^bx) +x-1# << handled by rep...() below
  x = rep_stripe_pattern(x,by) # increase x to length of z
  z = 3*qz-1-z # flip bits of z
  x = xor(x,z) # nXor (self-inverse) of repeated x and z
  x += qz # put back missing q' bit;
  x = simplify_stripe_pattern(x)
  scale=os;return x
}

# Modular sum of patterns so that the new length is the LCM of the old lengths
# . patterns extended to the same length and then modular arithmetic is done
# Is symmetric with respect to x and y, i.e. mix...(x,y) = mix...(y,x)
define modsum_stripe_patterns(x,y) {
  auto os,bx,by,qx,r,gcd,t
  os=scale;scale=0;x/=1;y/=1
  if(x==0||y==0){scale=os;return 0}
  if(x==1||x==-1||y==-1||y==1){scale=os;return 1}
  qx = 2^(bx = bitwidth(x)-1)
          by = bitwidth(y)-1
  if(x<0)x=3* qx   +x-1 # Flip bits of -ve params
  if(y<0)y=3*(2^by)+y-1
  if(bx!=by){
    gcd=bx
    for(t=by;t>0;t=r){r=gcd%t;gcd=t}
    x=rep_stripe_pattern(x,  by/gcd)
    y=rep_stripe_pattern(y,t=bx/gcd)
    bx=by*=t # = bz
    qx=2^bx
  }
  x=x-qx+y-qx # add together modulo qx
  if(x<qx)x+=qx # put back any missing q' bit
  scale=os;return x
}

# Inverse of the above; Given a modular sum of patterns and one of the
# . constituents, derive the other constituent (up to repeat-equivalence)
# . See notes elsewhere how patterns can be equivalent to each other
# . in some uses. This is one.
define unmodsum_stripe_patterns(z,x) {
  auto os,bz,bx,by,qz;
  os=scale;scale=0;z/=1;x/=1
  if(z==0||x==0){scale=os;return 0}
  if(z==1||z==-1){scale=os;return 1} # 1[] is zero pattern; 0/x=0
  if(x==1||x==-1){
    print "unmodsum_stripe_patterns: can't extract null pattern\n"
    scale=os;return 0
  }
  bz=bitwidth(z)-1
  bx=bitwidth(x)-1
  # Check if bz is divisible by 'bx'
    # Return an error if not
  by=bz/bx
  if(by*bx!=bz){
    print "unmodsum_stripe_patterns: parameters of incompatible sizes\n"
    return 0
  }
  qz=2^bz
  if(z<0)z=3* qz    +z-1 # Flip bits of -ve params
  #if(x<0)y=3*(2^bx) +x-1# << handled by rep...() below
  x = rep_stripe_pattern(x,by) # increase x to length of z
  if(z<x)z+=qz
  x=qz+z-x
  x = simplify_stripe_pattern(x)
  scale=os;return x
}

## Addition / Subtraction :: Catenation / Decatenation

# Pattern catenation; Asymmetrical
# . 1[x] + 1[y] = 1[x][y]
define cat_stripe_patterns(x,y) {
  auto os,qy;
  os=scale;scale=0;x/=1;y/=1
  if(x==0||y==0){scale=os;return 0}
  qy = 2^(bitwidth(y)-1)
  if(x<0)x=3*2^(bitwidth(x)-1)+x-1 # Flip bits of -ve params
  if(y<0)y=3*       qy        +y-1
  if(x==1){scale=os;return y} # pattern 1 == 1[] is catenate identity!
  if(y==1){scale=os;return x} # in either param. works even though asymmetric
  .=x--
  scale=os;return x*qy+y
}

# Pattern decatenation; Like subtraction but not
# . 1[z]-1[y]=1[x] if [z] is of form [x][y], else 1[z]-1[y]=1[z]+1[!y]=1[z][!y]
define decat_stripe_patterns(z,y) {
  auto os,x,bz,by,qy;
  os=scale;scale=0;z/=1;y/=1
  if(z==0||y==0){scale=os;return 0}
          bz = bitwidth(z)-1
  qy = 2^(by = bitwidth(y)-1)
  if(z<0)z=3* 2^bz +z-1 # Flip bits of -ve params
  if(y<0)y=3* qy   +y-1
  if(z==y){scale=os;return 1} # pattern - self = 1[] (catenate identity)
  if(y==1){scale=os;return z} # pattern - 1[]  = self
  if(bz<by){
    # if left pattern is shorter than right pattern
    # no subtraction can occur so 1[z]-1[y] -> 1[z]+1[!y]
    y = 3*qy-y-1 # (re)flip bits
    .=z--
    scale=os;return z*qy+y
  }
  # Check if last bits of z are equal to y
  x = z/qy
  if(z-x*qy==y-qy){scale=os;return x}
  # Guess not
  y = 3*qy-y-1 # (re)flip bits
  .=z--
  scale=os;return z*qy+y
}

# Overlap cancelling decatenation
# . 1[z]-1[y] = 1[a][b]-1[b][c] = 1[a][!c] = 1[x]
# . any of a, b or c may be empty
# . and b is of maximal size
define decat2_stripe_patterns(z,y) {
  auto os,x,qy,qc,b;
  os=scale;scale=0;z/=1;y/=1
  if(z==0||y==0){scale=os;return 0}
  qz = 2^(bitwidth(z)-1)
  qy = 2^(bitwidth(y)-1)
  if(z<0)z=3* qz +z-1 # Flip bits of -ve params
  if(y<0)y=3* qy +y-1
  if(z==y){scale=os;return 1} # pattern - self = 1[] (catenate identity)
  if(y==1){scale=os;return z} # pattern - 1[]  = self
  b = y-(qb=qy); qc = 1 # b will contain overlap bits
  if(qz<qy){qc=qy/qz;b/=qc;qb/=qc}
    # if z is shorter than y, truncate b to length of z;
    # there cannot be a longer match
  for(qc=qc;qb;qc+=qc){x=z/qb;if(z-x*qb==b)break;b/=2;qb/=2}
  #qc-1-y%qc        # RHS of result: flipped RH bits of y that did not match [!c]
  #z/(qb/qc) = x*qc # LHS of result: z with matching LH bits from y removed [a]
  .=x++;x=x*qc-y%qc;.=x-- # x=x*qc+qc-1-y%qc
  scale=os;return x
}

# Largest total mismatch cancelling pattern catenation
# . 1[z]+1[y] = 1[a][b]+1[!b][c] = 1[a][c] = 1[x]
# . If z ends with a group of bits of opposite parity to a group of
# . bits at the start of y, then these bits ([b] and [!b]) are erased.
# . The remaining bits are then catenated.
# . This form of catenation has the advantage of preserving addition
# . for the integers as represented by powers of two and
# . one less than powers of two.
# . e.g. (-3) + 2 -> 1000 + 111 -> 1[0][00] + 1[11][] = 1[0][] = 10 -> -1
# . The standard catenation would have returned 1[000][111] = 1000111 -> ???
define undecat2_stripe_patterns(z,y) {
  return decat2_stripe_patterns(z,-y)
}
#!/usr/local/bin/bc -l

### MelancholyB.BC - A collatz-like iteration leading to zero, or loops.
###                  Variant of Melancholy.BC

max_array_ = 4^8-1

# Determine if x is one of the 2.5% of numbers
# . that are melancholy with this method
define is_melancholyb(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(x==0){scale=os;return 0}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){scale=os;return 1}
    if(tapetop++>max_array_){
      print "is_melancholyb: can't calculate ...; chain too long\n"
      scale=os;return 1
    }
    tape[tapetop]=x
  }
}

# Print the chain of iterations of x until a loop or zero
define melancholyb_print(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return x}
  tapetop=-1;
  while(1){
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(x==0){scale=os;return x}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){scale=os;"looping ";return x}
    if(tapetop++>max_array_){
      print "melancholy_printb: can't calculate ...; chain too long\n"
      scale=os;return 1
    }
    tape[tapetop]=x;x
  }
}

# Return 0 for non-melancholy numbers or the smallest number in the loop
# that the iteration becomes trapped within.
define melancholyb_root(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(x==0){scale=os;return 0}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){
      #go back the other way looking for the lowest value
      while(++i<=tapetop)if(tape[i]<x)x=tape[i]
      scale=os;return x
    }
    if(tapetop++>max_array_){
      print "melancholy_rootb: can't calculate ...; chain too long\n"
      scale=os;return -1 # Error: Unknown
    }
    tape[tapetop]=x
  }
}

# Find the maximum 'hailstone' i.e. the largest number in the chain of
# iterations from x to loop or zero.
define melancholyb_max(x) {
  auto os,n,i,max,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;max=x
  while(1){
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(x>max)max=x
    if(x==0){scale=os;return max}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){scale=os;return max}
    if(tapetop++>max_array_){
      print "melancholyb_max: can't calculate ...; chain too long\n"
      scale=os;return max
    }
    tape[tapetop]=x
  }
}

# For melancholy numbers, returns the size of the loop the iterations
# become trapped within.
define melancholyb_loopsize(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(x==0){scale=os;return 0}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){ scale=os;return tapetop-i+1 }
    if(tapetop++>max_array_){
      print "melancholyb_loopsize: can't calculate ...; chain too long\n"
      scale=os;return -1 # Error: Unknown
    }
    tape[tapetop]=x
  }
}

# Find how many iterations are required to find a repeated iteration (loop)
# or zero
define melancholyb_chainlength(x) {
  auto os,n,i,c,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    .=c++
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(x==0){scale=os;return c}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){ scale=os;return 2-c }# infinity
    if(tapetop++>max_array_){
      print "melancholyb_chainlength: can't calculate ...; chain too long\n"
      scale=os;return -c
    }
    tape[tapetop]=x
  }
}

# Perhaps a misnomer. This returns the square root of the perfect square
# which dropped the iteration to zero on the following step
# Returns -1 in the case of a melancholy number since the iteration loops
# and there is no 'last' term.
define melancholyb_lastsqrt(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(x==0){scale=os;return n}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){ scale=os;return -1 }# there isn't one
    if(tapetop++>max_array_){
      print "melancholyb_lastsqrt: can't calculate ...; chain too long\n"
      scale=os;return -1 # Error: Unknown
    }
    tape[tapetop]=x
  }
}

# All of the above rolled into one. Negative values suggest error condition.
# Global variables are set with the same names as the above functions
# with the exception of global variable melancholy_print, which should be
# set to non-zero if emulation of the melancholy_print() function is required
define is_melancholyb_sg(x) {
  auto os,n,i,max,c,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){
    melancholyb_root        = 0
    melancholyb_max         = 0
    melancholyb_loopsize    = 0
    melancholyb_chainlength = 0
    melancholyb_lastsqrt    = 0
    scale=os;return 0
  }
  tapetop=-1;
  while(1){
    .=c++
    n=sqrt(x);if((i=n*n)<x){i+=n+n+1;.=n++};x=n*(i-x)
    if(melancholy_print)x
    if(x>max)max=x
    if(x==0){
      melancholyb_root        = 0
      melancholyb_max         = max
      melancholyb_loopsize    = 0
      melancholyb_chainlength = c
      melancholyb_lastsqrt    = n
      scale=os;return 0 # is not melancholy
    }
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){
      melancholyb_max         = max
      melancholyb_loopsize    = tapetop-i+1
      melancholyb_chainlength = 2-c # Infinite
      melancholyb_lastsqrt    = -1 # Error: Unknown
      #go back the other way looking for the lowest value
      while(++i<=tapetop)if(tape[i]<x)x=tape[i]
      melancholyb_root        = x
      scale=os;return 1 # is melancholy
    }
    if(tapetop++>max_array_){
      print "is_melancholyb_sg: can't calculate ...; chain too long\n"
      melancholyb_root        = -1 # Error: Unknown
      melancholyb_max         = -max
      melancholyb_loopsize    = -1 # Error: Unknown
      melancholyb_chainlength = -c
      melancholyb_lastsqrt    = -n
      scale=os;return 1 # is melancholy
    }
    tape[tapetop]=x
  }
}
#!/usr/local/bin/bc -l

### Melancholy.BC - A collatz-like iteration leading to zero, or loops.

max_array_ = 4^8-1

# Much like the Collatz conjecture, the conjecture here is that numbers x,
# under the iteration x -> floor(sqrt(x))*(x-floor(sqrt(x))^2)
# will eventually reach zero (or equivalently x reaches a perfect square,
# since the following step is necessarily zero), OR the iteration enters
# a loop (the simplest example being 8 -> 2*(8-2^2) = 8 again).

# It is unproven whether there is some number or numbers for which the
# iteration increases to infinity, never looping nor reaching zero.
# Theoretically this is possible, since the iteration will, half the time,
# generate a number larger than x. [When x is one less than a perfect square,
# the generated number is 2*floor(sqrt(x))^2, or equivalently, 2*(x^2-2*x+1)]
# Probabilistically however, the average generated value is floor(sqrt(n))^2,
# which is a perfect square and also less than x (thus heading towards zero)
# and there are many cases where a perfect square is generated "unexpectedly",
# (due to a non-squarefree number being created by the subtraction,)
# both increasing the chance that the following step will be zero.

# In a parallel with Happy/Sad numbers, I have named those numbers which
# DO NOT reach zero, Melancholy numbers. Of the numbers <= 2500000,
# approximately 5% of these are melancholy. Of melancholy numbers, around
# two-thirds of these become trapped in the aforementioned 8 -> 8 cycle.

## Notes and example uses

# scale=0;for(i=0;i<65536;i++)root[i]=count[i]=0;rci=0;"*";for(i=0;i<10^20;i++){n
# =melancholy_root(i);f=-1;for(j=0;j<=rci;j++)if(root[j]==n){f=j;break};if(f==-1)
# {rci+=1;root[rci]=n;count[rci]=1}else{count[f]+=1};if(i%10000==0){print "@",i,"
# \n";for(j=0;j<=rci;j++)print root[j],": ",count[j],"\n";print"\n"}}

#@2500000
#0: 2371650
#8: 83591
#1927: 39499
#18469: 3268
#46208: 1639
#39852: 328
#1816705: 26

# c=0;m=0;for(i=0;i<1000000;i++){om=m;m=is_melancholy(i);if(om&&m){if(c==0)f=i-1;
# c+=1}else if(c){for(j=0;j<=c;j++)print f+j," ";print"\n";c=0}}

# 43823 43824 43825 43826 are a chain of four consecutive melancholy numbers
# 184894 184895 184896 184897 ditto
# 330397 330398 330399 330400 ditto
# 380168 380169 380170 380171 ditto
# 502477 502478 502479 502480 ditto
# 658871 658872 658873 658874 ditto
# 673771 673772 673773 673774 ditto
# 876977 876978 876979 876980 ditto

# max=0;for(i=0;i<1000000;i++)if(m=melancholy_chainlength(i)>max){max=m;i}
# 1
# 2
# 3
# 10
# 22
# 33
# 46
# 58
# 75
# 158
# 185
# 393
# 673
# 771
# 834
# 835
# 1019
# 1223
# 2586
# 2699
# 5137
# 11428
# 11581
# 27753
# 53307
# 65516
# 86406
# 125833
# 148916
# 175463
# 189804
# 274509
# 491106
# 584753
# 681782
# 823866
# 881217

# Determine if x is one of the 5% of numbers that are melancholy
define is_melancholy(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);x=n*(x-n*n)
    if(x==0){scale=os;return 0}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){scale=os;return 1}
    if(tapetop++>max_array_){
      print "is_melancholy: can't calculate ...; chain too long\n"
      scale=os;return 1
    }
    tape[tapetop]=x
  }
}

# Print the chain of iterations of x until a loop or zero
define melancholy_print(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return x}
  tapetop=-1;
  while(1){
    n=sqrt(x);x=n*(x-n*n)
    if(x==0){scale=os;return x}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){scale=os;"looping ";return x}
    if(tapetop++>max_array_){
      print "melancholy_print: can't calculate ...; chain too long\n"
      scale=os;return 1
    }
    tape[tapetop]=x;x
  }
}

# Return 0 for non-melancholy numbers or the smallest number in the loop
# that the iteration becomes trapped within.
define melancholy_root(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);x=n*(x-n*n)
    if(x==0){scale=os;return 0}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){
      #go back the other way looking for the lowest value
      while(++i<=tapetop)if(tape[i]<x)x=tape[i]
      scale=os;return x
    }
    if(tapetop++>max_array_){
      print "melancholy_root: can't calculate ...; chain too long\n"
      scale=os;return -1 # Error: Unknown
    }
    tape[tapetop]=x
  }
}

# Find the maximum 'hailstone' i.e. the largest number in the chain of
# iterations from x to loop or zero.
define melancholy_max(x) {
  auto os,n,i,max,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;max=x
  while(1){
    n=sqrt(x);x=n*(x-n*n)
    if(x>max)max=x
    if(x==0){scale=os;return max}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){scale=os;return max}
    if(tapetop++>max_array_){
      print "melancholy_max: can't calculate ...; chain too long\n"
      scale=os;return max
    }
    tape[tapetop]=x
  }
}

# For melancholy numbers, returns the size of the loop the iterations
# become trapped within. e.g. 8 -> 8 is a loop of 1
define melancholy_loopsize(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);x=n*(x-n*n)
    if(x==0){scale=os;return 0}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){ scale=os;return tapetop-i+1 }
    if(tapetop++>max_array_){
      print "melancholy_loopsize: can't calculate ...; chain too long\n"
      scale=os;return -1 # Error: Unknown
    }
    tape[tapetop]=x
  }
}

# Find how many iterations are required to find a repeated iteration (loop)
# or zero
define melancholy_chainlength(x) {
  auto os,n,i,c,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    .=c++
    n=sqrt(x);x=n*(x-n*n)
    if(x==0){scale=os;return c}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){ scale=os;return 2-c }# infinity
    if(tapetop++>max_array_){
      print "melancholy_chainlength: can't calculate ...; chain too long\n"
      scale=os;return -c
    }
    tape[tapetop]=x
  }
}

# Perhaps a misnomer. This returns the square root of the perfect square
# which dropped the iteration to zero on the following step
# Returns -1 in the case of a melancholy number since the iteration loops
# and there is no 'last' term.
define melancholy_lastsqrt(x) {
  auto os,n,i,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){scale=os;return 0}
  tapetop=-1;
  while(1){
    n=sqrt(x);x=n*(x-n*n)
    if(x==0){scale=os;return n}
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){ scale=os;return -1 }# there isn't one
    if(tapetop++>max_array_){
      print "melancholy_lastsqrt: can't calculate ...; chain too long\n"
      scale=os;return -1 # Error: Unknown
    }
    tape[tapetop]=x
  }
}

# All of the above rolled into one. Negative values suggest error condition.
# Global variables are set with the same names as the above functions
# with the exception of global variable melancholy_print, which should be
# set to non-zero if emulation of the melancholy_print() function is required
define is_melancholy_sg(x) {
  auto os,n,i,max,c,tape[],tapetop;
  os=scale;scale=0
  x/=1
  if(x<0)return 1;
  if(x==0){
    melancholy_root        = 0
    melancholy_max         = 0
    melancholy_loopsize    = 0
    melancholy_chainlength = 0
    melancholy_lastsqrt    = 0
    scale=os;return 0
  }
  tapetop=-1;
  while(1){
    .=c++
    n=sqrt(x);x=n*(x-n*n);if(melancholy_print)x
    if(x>max)max=x
    if(x==0){
      melancholy_root        = 0
      melancholy_max         = max
      melancholy_loopsize    = 0
      melancholy_chainlength = c
      melancholy_lastsqrt    = n
      scale=os;return 0 # is not melancholy
    }
    # Search backwards for previous occurrence of x (which is more
    #   likely to be near end of tape since chains lead to loops)
    for(i=tapetop;i>0;i--)if(tape[i]==x){
      melancholy_max         = max
      melancholy_loopsize    = tapetop-i+1
      melancholy_chainlength = 2-c # Infinite
      melancholy_lastsqrt    = -1 # Error: Unknown
      #go back the other way looking for the lowest value
      while(++i<=tapetop)if(tape[i]<x)x=tape[i]
      melancholy_root        = x
      scale=os;return 1 # is melancholy
    }
    if(tapetop++>max_array_){
      print "is_melancholy_sg: can't calculate ...; chain too long\n"
      melancholy_root        = -1 # Error: Unknown
      melancholy_max         = -max
      melancholy_loopsize    = -1 # Error: Unknown
      melancholy_chainlength = -c
      melancholy_lastsqrt    = -n
      scale=os;return 1 # is melancholy
    }
    tape[tapetop]=x
  }
}
#!/usr/local/bin/bc -l

## Find the nearest sum of powers of 2, 3, and 5 to make a number

define print235(x) {
 auto max5,lx,ni,nj,n,found,diff,near,sn,si,sj,sk;
 max5 = l(x)/l(5)+1
 found = 0
 near = x;
 for(i=0;i<=max5;i++){
  ni=5^i
  nj=ni
  for(j=0;x>nj;j++){
   nj=ni+3^j
   n=nj
   for(k=0;x>n;k++){
    n = nj+2^k;#print "n: ",0*n,", i: ",i,", j: ",j,", k: ",k,"\n";
    diff = x-n;if(diff<0)diff=-diff
    if(diff<near){near=diff;sn=n;si=i;sj=j;sk=k}
    if(x==n){found=1;print x," == 2^",k," + 3^",j," + 5^",i,"\n"}
   }#end for k
  }#end for j
 }#end for i
 if(!found){
  print "nearest found: ",sn
  print " == 2^",sk
  print  " + 3^",sj
  print  " + 5^",si
  print "\n"
 }
 return( found );
}
#!/usr/local/bin/bc -l

## Calculate the hyper-exponential Ackermann function

# There's not much point to this function as it's pretty much
# incalculable for most values... and burns CPU while it tries

define ack(x,y) {
  if (x==0)return(y+1)
  if (x==1)return(y+2)
  if (x==2)return(y+y+3)
  if (x==3)return(2^(y+3)-3)

  if (y==0)return(ack(x-1,1))
  return(ack(x-1,ack(x,y-1)))
}

k_l2 = l(2);
define ackz(x,y) {
  if (x<=0)return(y+1)
  if (x<=1)return(y+2)
  if (x<=2)return(y+y+3)
  if (x<=3)return(e(l2*(y+3))-3)

  if (y<=0)return(ack(x-1,1))
  return(ack(x-1,ack(x,y-1)))
}

#!/usr/local/bin/bc -l funcs.bc

### AnglePow.BC - exponentional functions that are semi-linear,
#   changing gradient at each power of the base.

# run with funcs.bc

## Specific functions for base 10

# Generate the x-th number in the sequence:
# 1,2,3,4,5,6,7,8,9,10,20,30,...,90,100,200,300,...,900,1000,2000,...
# e.g. anglepow10(0) = 1 ; anglepow10(11) = 30
define anglepow10(x) {
  return( (remainder(x,9)+1) * A^int(x/9) )
}

# Invert the above
# e.g. anglelog10(50) = 13 ; ial10(1) = 0
define anglelog10(x) {
  auto k;
  k = int_log(A,x)
  return( 9*k + x/A^k - 1 )
}

## Generalised functions for any base b

# anglepow(10,x) is equivalent to the above anglepow10(x)
define anglepow(b,x) {
  return( (remainder(x,b-1)+1) * b^int(x/(b-1)) )
}

# Invert the previous function
define anglelog(b,x) {
  auto k
  k = int_log(b,x)
  return( (b-1)*k + x/b^k - 1)
}
#!/usr/local/bin/bc -l funcs.bc

## Find the nearest perfect power to a number
## (picks the lower number in the case of a tie)
## e.g. 26 -> 25 = 5^2 and not 27 = 3^3
##      26.01 -> 27 however because it is closer.

#scale=10;sy=0;x=7;x;min=x;for(p=2;int(root(x,p-1))>1;p++){n=int(root(x,p))-1;fo
#r(m=0;m<2;m++){n+=1;y=n^p;y;diff=abs(x-y);if(diff<min){min=diff;sy=y}}};sy

# Uses array pass by reference to fill the given array
# with [0] the perfect power
#      [1] the number which is raised
#      [2] the power itself
#      [3] the sign of the original parameter
# e.g. -124 -> {125,5,3,-1} and returns -125
define nearest_perfect_power_a(*a__[],x){
  auto os,s,min,p,n,m,y,diff;
  s=1;if(x<0){s=-1;x=-x}
  if(x+x<5){
    a__[0]=a__[1]=!!x;a__[2]=2;a__[3]=s
    return s*a__[0]
  }
  os=scale;scale=20
  min=n=x
  for(p=2;n>2;p++){
    n=int(root(x,p))-1
    for(m=0;m<2;m++)if((diff=abs(x-(y=(++n)^p)))<min){
      a__[0]=y;a__[1]=n;a__[2]=p;
      if(!min=diff){n=0;break}
    }
  }
  a__[3]=s
  scale=os;return s*a__[0];
}

define nearest_perfect_power(x){
  auto dummy[];
  return nearest_perfect_power_a(dummy[],x)
}
#!/usr/local/bin/bc -l

### SRR.BC - Sum of Repeated Roots (less one);
###          calculate the value of sum[n=1..oo] x^(2^(-n))-1

define srr(x) {
  auto s,t,os;
  if(x<=0){print "srr: Negative Infinity\n";return 1-A^scale}
  scale+=6
  s=x ; os=s+1
  t=0;while(os!=s){
    os=s
    s=sqrt(s)
    t+=s-1
  }
  scale-=6;t/=1
  return(t);
}

define srr_n(n,x) { # Generalisation of srr; srr(x) == srr_n(2,x)
  auto s,t,os;
  if(x<=0){print "srr_n: Negative Infinity\n";return 1-A^scale}
  if(n==2)return(srr(x))
  if(n<=1){print "srr_n: Infinity\n";return A^scale-1}
  scale+=6
  s=x ; os=s+1
  t=0;while(os!=s){
    os=s
    s=e(l(s)/n)
    t+=s-1
  }
  scale-=6;t/=1
  return(t);
}
#!/usr/local/bin/bc -l funcs.bc factorial.bc primes.bc

### OrialC.BC - Variants of primorial and lcmultorial
###             Some extended to be continuous over the positive reals

## N.B. extensions to the reals are not to be considered to be 'correct'
## in any sense other than the values returned for fractional values of
## the input are between the values returned for the preceding and
## succeeding integer input values and that there is some logic to the
## calculation chosen for that interpolation.

#### requires primes.bc, funcs.bc and factorial.bc

### Primorials

# Use a factorial substrate
# . Maps the gradient of the logarithm of the factorial function 
# . (taken here to be continuous, as a shifted Gamma function)
# . between two primes onto the space between the logarithm of their
# . primorials and then returning the antilogarithm of the result
define primorialc_fact(x) {
  auto p,q,pp,qq,xx
  if(x<0)return 1
  if(x<=3)return factorial(x)
  if(x==int(x)&&is_prime(x))return primorial(x)
  p=prevprime(x)
  q=nextprime(x)
  pp=primorial(p)
  qq=lnfactorial(q)/l(pp*q) #.../l(primorial(q))
  pp=lnfactorial(p)/l(pp)
  xx=(x-p)*(qq-pp)/(q-p)+pp
  return e(lnfactorial(x)/xx)
}

## Geometric variants

# Multiply by a fractional power of the next prime
# (equivalent to dividing by a fractional power of the previous prime)
# i.e. 6# = 5# * 7^(1/2); (5+1/3)# = 5# * 7^(1/6)
define primorialc_nextp(x) { # next prime
  auto p,q,pp,c
  if(x<0)return 1
  if(x<=3)return factorial(x)
  if(x==int(x)&&is_prime(x))return primorial(x)
  p=prevprime(x)
  q=nextprime(x)
  pp=primorial(p)
  c=(x-p)/(q-p)
  return pp*e(l(q)*c)
}

# Multiply by a fractional power of x, which tends to the next prime
# i.e. 6# = 5# * 6^(1/2); ; (5+1/3)# = 5# * (5+1/3)^(1/6)
define primorialc_self(x) { # power of self
  auto p,q,pp,c
  if(x<0)return 1
  if(x<=3)return factorial(x)
  if(x==int(x)&&is_prime(x))return primorial(x)
  p=prevprime(x)
  q=nextprime(x)
  pp=primorial(p)
  c=(x-p)/(q-p)
  return pp*e(l(x)*c)
}

# Backstepping
# as x moves from p to q, c moves from 0 to 1 and p*q/x moves backward(!) from q to p
# by taking the (1-c) power of p*q/x and dividing qq by it, we arrive at a value
# between pp and qq
define primorialc_backstep(x) {
  auto p,q,qq,c
  if(x<0)return 1
  if(x<=3)return factorial(x)
  if(x==int(x)&&is_prime(x))return primorial(x)
  p=prevprime(x)
  q=nextprime(x)
  qq=primorial(q)
  c=(x-p)/(q-p)
  return qq*e( (l(p)+l(q)-l(x)) *(c-1)) # qq/[p*q/x]^(1-c)
}

# as above but the logarithm of p*q/x has been miscalculated
# ... by chance this provides rational values for some non-prime x
# ... and is actually nearer the factorial substrate approximation
# 4 -> 15; 9 -> 770; 14 -> 63813.75; 25 -> 718854803+1/3
# 64 -> 982290193885033381984886.25
# 81 -> 29673835076586205706180446443643+1/3
# 144 -> 124348529244939943338239644717986755712298655277238710867.5
# 225 -> 5554080608320289669170856425325402549408978069390687643641198516538486176108852697155674
# 249 -> 21422110305969548290776878409368904436960062197203069371414919560299383455960234384175066914411473410
# 324 -> 356034387670665137061613427387632108186745506097843755843955808839176060801252605904504975998092127868894051024069337085229799569148+1/3
# 441 -> 5085683323024301173004199827150236333411871189788725295515084157086768337985718219869705458593441981460396117256011585703398191894858977077274060373508432687656189696902577543317890
define primorialc_accident(x) {
  auto p,q,qq,c
  if(x<0)return 1
  if(x<=3)return factorial(x)
  if(x==int(x)&&is_prime(x))return primorial(x)
  p=prevprime(x)
  q=nextprime(x)
  qq=primorial(q)
  c=(x-p)/(q-p)
  return qq*e(l(p+q-x)*(c-1)) # not qq/[p*q/x]^(1-c)
}

define primorialc(x) {
  print "Please use one of:\n"
  print "* primorialc_fact(",    x,")\n"
  print "* primorialc_nextp(",   x,")\n"
  print "* primorialc_self(",    x,")\n"
  print "* primorialc_backstep(",x,")\n"
  print "* primorialc_accident(",x,")\n"
  return primorial(int(x))
}

## Submodulus

# submodulus superprimorial/factorial
#  = product of x mod k for all 2 <= k < x
define submodorial(x) {
  # is zero for composite x, < factorial(x) and > primorial(x) for prime x
  auto os,i,p;
  os=scale;scale=0;x/=1;scale=os
  if(x==0||x==1)return 1
  if(x<0||!is_prime(x))return 0
  if(x<4)return 1
  scale= 0;p=1;for(i=2;i<x;i++)p*=x%i
  scale=os;return p
}

# generalised submodulus superprimorial / factorial
# = product of n+(x mod k) for all 2 <= k < x
# . equal to the above for n==0
# ? possibly only interesting for n==1
#   since submodprimorialg(1,x-1) == submodprimorial(x) for x prime
#   [for 1 <= k < x, multiply the result by n]
define submodorialg(n,x) {
  auto os,i,p;
  if(n==0)return submodprimorial(x)
  n/=1
  os=scale;scale=0;x/=1;if((p=n/1)==n)n=p
  p=1;for(i=2;i<x&&p;i++)p*=n+(x%i)
  scale=os;return p
}

### LCMultorials

# Multiply by a fractional power of the next step up
define lcmultorialc(x) {
  auto ix,l,m
  if(x<=1)return 1
  l=lcmultorial(ix=int(x))
  if(x==ix)return l;
  m=int_lcm(l,ix+1)
  if(m==l)return l;
  return l*e(l(m/l)*(x-ix))
}

# Subprimorial using LCM of terms rather than multiplying
define lcmsubprimorial(n) {
  auto i,pm,p;
  pm=1;p=2
  if(prime[max_array_])for(i=2;i<=max_array_&&p=prime[i]<=n;i++)pm=int_lcm(pm,p-1)
  for(.=.;p<=n;p=nextprime(p))pm=int_lcm(pm,p-1)
  return pm
}

# Submodulus product using lcm rather than multiplication
define lcmsubmodorial(x) {
  # is zero for composite x, < factorial(x) and > primorial(x) for prime x
  auto os,i,p;
  os=scale;scale=0;x/=1;scale=os
  if(x==0||x==1)return 1
  if(x<0||!is_prime(x))return 0
  if(x<4)return 1
  scale= 0;p=1;for(i=2;i<x;i++)p=int_lcm(p,x%i)
  scale=os;return p
}

# Generalisation of the above
define lcmsubmodorialg(n,x) {
  auto os,i,p;
  if(n==0)return lcmsubmodorial(x)
  n/=1
  os=scale;scale=0;x/=1;if((p=n/1)==n)n=p
  p=1;for(i=2;i<x&&p;i++)p=int_lcm(p,n+(x%i))
  scale=os;return p
}
#!/usr/local/bin/bc -l

### Output-Formatting.BC - Formatted output

 # Functions in this library with a name containing "print" return a result
 # equivalent to what has been output, meaning that to use them properly,
 # they must be assigned to a dummy variable to prevent bc from inadvertently
 # printing out the return value!

 # An example usage might be q=printfrac(0,5,0.25)+newline()
 #  q here is a dummy variable, printfrac will print 0.25 as a fraction and
 #  the newline function prints a carriage return. Net result should be:
 #   1/4

 # Literally and figuratively adding the newline() and printspc/tabs()
 # (q.v.) is recommended, as these neaten the output.

## Bases < 36

# Set this to non-zero to make output non-standard lowercase
output_lcase_=0

# Workhorse functions for the below
define letteru__(a) { # expects an integer 0 <= a <= 35
  auto oib,oob;
  oib=ibase;oob=obase;ibase=A;obase=F+1
  if(a< 0)print "_";
  if(0<=a&&a<16)print a;obase=A
  if(a==16)print "G";if(a==17)print "H";if(a==18)print "I";if(a==19)print "J"
  if(a==20)print "K";if(a==21)print "L";if(a==22)print "M";if(a==23)print "N"
  if(a==24)print "O";if(a==25)print "P";if(a==26)print "Q";if(a==27)print "R"
  if(a==28)print "S";if(a==29)print "T";if(a==30)print "U";if(a==31)print "V"
  if(a==32)print "W";if(a==33)print "X";if(a==34)print "Y";if(a==35)print "Z"
  if(a>=36)print " ",a
  ibase=oib;obase=oob;return a
}

define letterl__(a) { # expects an integer 0 <= a <= 35
  auto oib,oob;
  oib=ibase;oob=obase;ibase=obase=A
  if(a< 0)print "_";
  if(0<=a&&a<=9)print a;
  if(a==10)print "a";if(a==11)print "b"
  if(a==12)print "c";if(a==13)print "d";if(a==14)print "e";if(a==15)print "f"
  if(a==16)print "g";if(a==17)print "h";if(a==18)print "i";if(a==19)print "j"
  if(a==20)print "k";if(a==21)print "l";if(a==22)print "m";if(a==23)print "n"
  if(a==24)print "o";if(a==25)print "p";if(a==26)print "q";if(a==27)print "r"
  if(a==28)print "s";if(a==29)print "t";if(a==30)print "u";if(a==31)print "v"
  if(a==32)print "w";if(a==33)print "x";if(a==34)print "y";if(a==35)print "z"
  if(a>=36)print " ",a
  ibase=oib;obase=oob;return a
}

define letter_(mode,a) { # expects an integer 0 <= a <= 35
  auto t;
  t=a
  if(mode){if(a==0){print "_";return 0};a+=9}
  if(output_lcase_){a=letterl__(a)}else{a=letteru__(a)}
  return t
}

# By default bc will use decimal groups for 'digits' when outputting
# numbers with ibase set above 16. When ibase <= 16 letters are used as
# digits. This function outputs using letters right up to base 36 which uses
# Z as the base-1 digit. Uses obase, so no base need be specified.

# TO DO: allow setting of a sub-base for bases over the new maximum
#        rather than defaulting to bc's own decimal mode

define printbase(x) {
  auto os,sign,i,ni,f,g,a[],ai,q;
  if(2^4-6*(!!output_lcase_)>=obase){print x;return x}
  if(obase>6^2){print x;return x}
  os=scale;scale=0
  sign=1;if(x<0){sign=-1;x=-x}
  f=x-(i=x/1)
  ai=0;ni=i
  while(i){i=ni;ni=i/obase;a[++ai]=i-ni*obase}
  if(sign<0)print"-"
  if(ai){for(--ai;ai;ai--)q=letter_(0,a[ai])}else{print 0}
  if(os==0||f==0){scale=os;return sign*x}
  print"."
  g=A^scale(x)
  for(i=1;i<g;i*=obase){f*=obase;f-=letter_(0,f/1)}
  scale=os;return sign*x
}

# To do: marry these with the trunc function?

# Print numbers in 'special' format where digits are _ and A onwards
define printbase_letters(x) {
  auto os,sign,i,ni,f,g,a[],ai,q;
  if(obase> 3^3){return q=printbase(x)}
  os=scale;scale=0
  sign=1;if(x<0){sign=-1;x=-x}
  f=x-(i=x/1)
  ai=0;ni=i
  while(i){i=ni;ni=i/obase;a[++ai]=i-ni*obase}
  if(sign<0)print"-"
  if(ai){for(--ai;ai;ai--)q=letter_(1,a[ai])}else{q=letter_(1,0)}
  if(os==0||f==0){scale=os;return sign*x}
  print"."
  g=A^scale(x)
  for(i=1;i<g;i*=obase){f*=obase;f-=letter_(1,f/1)}
  scale=os;return sign*x
}

## Bijective base output

define printbijective(bbase,x) {
  auto os,sign,i,f,g,a[],ai,q;
  if(bbase<1)bbase=obase
  if(bbase>5*7){
    print "printbijective: bbase too large, using "
    if(obase>5*7){print "decimal\n";bbase=A}else{print "obase\n";bbase=obase}
  }
  os=scale;scale=0
  sign=1;if(x<0){sign=-1;x=-x}
  bbase/=1
  f=x-(i=x/1)
  ai=0;while(i)i=(i-(a[++ai]=((i-1)%bbase)+1))/bbase
  if(sign<0)print"-";g=0
  if(ai){for(.=.;ai;ai--)q=letter_(0,a[ai])}else{print".";g=1}
  if(os==0||f==0){scale=os;return sign*x}
  # Fractional part - not really valid for bijectional so made something up
  # New terminology .{3}2A2 = 0.000302 {3} representing the shift-right of 3 places
  if(!g)print ".";if(bbase==1){print "{}";scale=os;return sign*x}
  g=f;for(i=-1;g<=1;i++)g*=bbase
  if(i){print "{";i=printbijective(bbase,i);print "}"}
  g=A^scale(x)-1
  for(i=1;i<g;i*=ibase)f*=bbase
  f=printbijective(bbase,f)
  scale=os;return sign*x
}

# Print numbers in 'special' format where digits are _ and A onwards
define printbijective_letters(bbase,x) {
  auto os,sign,i,f,g,a[],ai,q;
  if(bbase<1)bbase=obase
  if(bbase>2*D){
    print "printbijective_letters: bbase too large, using "
    if(obase>2*D){print "hexavigintimal\n";bbase=2*D}else{print "obase\n";bbase=obase}
  }
  os=scale;scale=0
  sign=1;if(x<0){sign=-1;x=-x}
  f=x-(i=x/1)
  ai=0;while(i)i=(i-(a[++ai]=((i-1)%bbase)+1))/bbase
  if(sign<0)print"-";g=0
  if(ai){for(.=.;ai;ai--)q=letter_(1,a[ai])}else{print ".";g=1}
  if(os==0||f==0){scale=os;return sign*x}
  # Fractional part - not really valid for bijectional so made something up
  # New terminology .{C}BJB = .___C_B {C} representing the shift-right of 3 places
  if(!g)print ".";if(bbase==1){print "{}";scale=os;return sign*x}
  g=f;for(i=-1;g<=1;i++)g*=bbase
  if(i){print "{";i=printbijective_letters(bbase,i);print "}"}
  g=A^scale(x)-1
  for(i=1;i<g;i*=ibase)f*=bbase
  f=printbijective_letters(bbase,f)
  scale=os;return sign*x
}

## Negative base output. Workhorse for universal printsbase() function

define printnegabase_(base,x) {
  auto os,i,b2,d,a[],shft
  if(x==0){.=letter_(!!printsbase_letters_,0);return 0}
  os=scale;scale=0;base/=1
  if(base>1)base=-base
  if(base>-2)base=-obase
  if(base<-6*6){}
  b2=base*base;bijective=!!bijective
  i=x/1;shft=0;if(x!=i)shft=1
  if(shft){
    d=scale(x);if(bijective)d=os
    d=A^d
    shft=-1
    for(i=1;i<=d;i*=b2).=shft++
    shft+=shft
    x*=i/b2
  }
  for(i=1;x;i++){
    d=((x-bijective)%base)+bijective;if(d<bijective)d-=base;a[i]=d/1
    if(shft)if(!--shft)a[++i]=-1
    x=(x-d)/base
  }
  if(shft){
    if(!bijective){
      while(shft--)a[i++]=0
    } else {
      a[i++]=-1-shft
    }
    a[i++]=-1
  }
  for(--i;i;i--)if((d=a[i])<-1) {
    print "{";.=printnegabase_(base,-1-d);print "}"
  } else if(d==-1){
   print "."
  } else {
   .=letter_(!!printsbase_letters_,a[i])
  }
  scale=os;return 0
}

## Universal output

# Uses global variable 'bijective' and internal setting 'printsbase_letters_' 
# to choose from the above print{base|bijective}[_letters] functions, allowing
# the same function template to be used for all cases

bijective=0 # intended for global use like 'scale'
printsbase_letters_=0 # internal

define printsbase(base,x) {
  auto os,oob;
  os=scale;scale=0
   base/=1
   if(0<=base&&base<2)base=obase
   if(base==-1)base=-obase
  scale=os
  if(base<0){return x+printnegabase_(base,x)}
  if(bijective){
    if(printsbase_letters_){
      return printbijective_letters(base,x);
    } else {
      return printbijective(base,x);
    }
  }
  oob=obase;obase=base
  if(printsbase_letters_){
    x=printbase_letters(x)
  } else {
    x=printbase(x)
  }
  obase=oob;return x
}

define printsobase(x) {
  if(bijective){
    if(printsbase_letters_){
      return printbijective_letters(obase,x);
    } else {
      return printbijective(obase,x);
    }
  }
  if(printsbase_letters_){
    return printbase_letters(x);
  } else {
    return printbase(x);
  }
}

## Factorial base

pfactb_zero_=0 # set to 1 to show useless 1! places
define printfactorialbase(x) {
  auto os,f,t,x[],f[],xi,fi,b,bf,max
  if(x<0){print "-";x=-x}
  os=scale;scale=0
  x-=(f=x-x/1)
  max=f*A^(os-1)
  bf=1;xi=fi=0
  #for(b=1;x        ;b++){x[xi++]=x-(t=x/b)*b ;x=t }
  x+=(bijective=!!bijective)
  for(b=1;x        ;b++){x[xi++]=x-(t=(x-bijective)/b)*b ;x=t }
  if(f)if(bijective){
    print "printfactorialbase: warning - fp bijective mode undefined\n";
    f=0
  }else{
    scale=os;f+=A^-os;scale=0
  }
  for(b=1;f&&bf<max;b++){t=(f*=b)/1;f-=t;f[fi++]=t;bf*=b}
  .=--xi;.=--fi
  for(xi=xi;xi>=(!pfactb_zero_||bijective);xi--)print " ",x[xi]
  if(fi<0){scale=os;return 0}
  for(fi=fi;fi>=0&&!f[fi];fi--){};.=fi++
  print "."
  for(xi=!pfactb_zero_;xi<fi;xi++){if(xi!=!pfactb_zero_)print " ";print f[xi]}
  scale=os;return 0;
}

#scale=100;a=sqrt(2)-1;max=10^(scale-1);bf=1;for(b=1;bf<max&&a;b++){a*=b;a-=(n=int(a))
#;print n,",";bf*=b};-1

## Fractions

# Prints a and b as a fraction in smallest terms
# ** This function requires gcd() and int() from funcs.bc
define printsft(a,b) { #smallest fractional terms
  auto c,d,e
  c=gcd(a,b);
  d=int(a/c);
  e=int(b/c);
  print a,"/",b," = ",d,"/",e;
  return(d/e)
}

# Prints x as the most accurate fraction possible under the restraint of
# a maximum denominator. Can choose improper fraction style if required.
# Will always choose a/b style for fractions less than one.
# e.g. q=printfrac(0, 9, 1.75) will print 1+3/4 (one plus three quarters)
#      q=printfrac(1, 9, 1.75) will print 7/4 (seven quarters)
# output can be copy/pasted back into bc as valid syntax, hence using "+"
# (or "-" in the case of negative fractions) to separate whole part from
# fractional part in proper fractions.
#
# cf.bc contains a better/faster version of this function but with
# only the "improper" parameter
#
define printfrac(improper, maxdenom, x) {
  auto os,oib,best,sign,fx,f,sd,d,eps;
  eps=A^(3-scale);if(eps>1)eps=1
  improper=!!improper
  sign=1;if(x<0){sign=-1;x=-x}
  if(x<1)improper=1
  if(maxdenom<0)maxdenom=-maxdenom
  if(maxdenom<5)maxdenom=5
  if(maxdenom<obase)maxdenom=obase-1
  os=scale;scale=0
  oib=ibase;ibase=A
  fx=x-x/1;best=1
  for(d=1;d<=maxdenom;d++){
    f=fx*d;f-=f/1;if(2*f>1)f=1-f
    if(f<best){
      best=f;sd=d
      if(best<eps)break
    }
  }
  if(sign<0){print "-"}else{print " "}
  if(improper){
    x=(x*sd+.5)/1
    print x
    if(sd>1)print"/",sd
    ibase=oib;scale=os;return x/sd
  } else {
    x/=1
    fx=(fx*sd+.5)/1
    if(sd==1){x+=fx;fx=0}
    print x
    if(fx>0){
      if(sign<0){print "-"}else{print "+"}
      print fx,"/",sd
    }
    ibase=oib;scale=os;return sign*(x+fx/sd)
  }
}
  
# Time/Degrees output
# e.g. q=printdms(54.671) prints 54:40:15.600
define printdms(x){
  auto os,ox,h,m;
  os=scale;scale=0;ox=x
  h=x/1;x-=h;x*=F*4
  m=x/1;x-=m;x*=F*4
  print h,":",m,":",x
  scale=os;return ox
}

## Other formatting

# Truncate trailing zeroes or nines (in base ten at least) from a scaled number

#  This function is to counter bc's habit of multiple repeated zeroes or
#  base-minus-ones to the far right after the 'basimal' point, especially
#  when the 'scale' was set too high for the calculation which created x

# example code:
# scale=10;x=1/4;x;trunc(x);x-=10^-scale;x;trunc(x)
# .2500000000
# .25
# .2499999999
# .25

define trunc(x) {
  auto os,ts,s,d,tx;
  os=scale
  d=length(x)-scale(x)
  if(d<5||d>scale)d=5
  ts=scale-d
  if(scale>=d+d){
    scale=ts
    s=1;if(x<0)s=-1
    x+=s*A^-scale
    .=scale--;x/=1
  }
  for(scale=0;scale<=ts;scale++)if(x==(tx=x/1)){x=tx;break}
  scale=os;return(x)
}

# Print an integer in a field width
define intprint(w, n){ # w is field width
 auto os,m,i;
 os=scale;scale=0;n/=1
 m=n;w+=(m!=0);if(m<0){m=-m;.=w--}
 for(.=.;m>0;w--){m/=obase}
 for(i=1;i<w;i++)print " "
 scale=os;return(n)
}

# workhorse function for the below
define comma_(x,gp) {
  t=x%gp
  if(x>=gp){
    t+=comma_(x/gp,gp);print ","
    for(gp/=obase;gp>=obase;gp/=obase)if(t<gp)print 0
  }
  print t;return 0
}

# Print a number with comma dividers using given spacing
#  e.g. commaprint(1222333, 3) prints 1,222,333
define commaprint(x,g){
  auto os,sign;
  if(g<1)g=1
  sign=1;if(x<0){sign=-1;x=-x}
  os=scale;scale=0
  if(sign<0)print "-"
  x+=comma_(x,obase^(g/1))
  scale=os;return sign*x
}

# C-like printf %f function
#  format is to be given as two numbers
# prints a number in a set field width with a specified precision
# Special features:
#  negative    width     specifies left alignment within the field
#  non-integer precision specifies leading zeroes where field is right aligned
#  zero        precision specifies integer formatting only. No decimal point
#  0.0         precision combines  the above two features (zero filled integer)

define printff(width, precision, n) {
  auto os, align, leadz, signn, intn, fracn, i;
  if(obase>6^2){print "[obase>max]";return n}
  os=scale;scale=0
   leadz=0
   if(scale(precision)>0){precision/=1;leadz=1}
   if(precision<0)precision=-precision
   align=1 #right
   width/=1
   if(width<0){width=-width;align=-1} #left
   signn=1
   if(n<0){n=-n;signn=-1;.=width--}
   i=intn=n/1;fracn=n-intn
   .=width--
   for(.=.;i/=obase;width--){}
   if(precision)width-=precision+1
   
   if( leadz&&signn==-1)print "-"
   if(align== 1)for(i=0;i<width;i++)if(leadz){print "0"}else{print " "}
   if(!leadz&&signn==-1)print "-"
   i=printbase(intn) # bijective unsupported
   if(precision>0){
     print "."
     fracn*=obase^precision
     i=printff(precision, 0.0, fracn/1)
   }
   if(align==-1)for(i=0;i<width;i++)print " "
  scale=os
  return n
}

# C-like printf %e function
#  format is to be given as two numbers
# prints a number in a set field width with a specified precision
# Special features as for printff above, plus:
#  negative precision specifies grouped engineering notation

define printfe(width, precision, n) {
  auto os,oib,op,on,explen,engstep,exp,align,signn,i;
  if(obase>6^2){print "[obase>max]";return n}
  op=precision
  on=n
  os=scale;scale=0
   oib=ibase;ibase=A
    explen=9/(obase-0.72)+2
    engstep=sqrt(135/obase)/1
   ibase=oib
   signn=1
   if(n<0){signn=-1;n=-n}
   align=1
   if(width<0){align=-1;width=-width}
   if(precision<0){precision=-precision}else{engstep=1}
   exp=0
   if(n)while(n/1<1){n*=obase;.=exp--}
   precision+=precision
   precision+=engstep-1
   while(n/1>=obase){scale=precision;n/=obase;scale=0;.=exp++}
   for(.=.;exp%engstep;exp--)n*=obase
   width-=explen+2
   if(width<0)width=0
   i=printff(align*width, op, signn*n)
   print "e"
   if(exp>=0)print "+"
   i=printff(explen, 0.0, exp)
  scale=os
  return n
}

# Print the specified whitespace characters
define printspc(n)  { if(n>0)for(i=0;i< n;i++)print " "  }
define printtabs(n) { if(n>0)for(i=0;i< n;i++)print "\t" }
define newline() { print "\n" }
#!/usr/local/bin/bc -l

### Output-Graph.BC - rudimentary functions for creating rudimentary drawings

screen_x = .75 * 80 + 1
screen_y = .75 * 40 + 1

# Perform a bitwise logical OR of x and y
#  taken from an old version of logic.bc
#  Only works on positive integers
#  which is fine for this library
define or_(x,y) {
 auto z,t,os;os=scale;scale=0;z=0;t=1
 while(x||y){if(x%2||y%2)z+=t;t+=t;x/=2;y/=2}
 scale=os;return (z)
}

define screen_printchar_(c) {
  if(c==0)print" "
  if(c==1)print"|"
  if(c==2)print"-"
  if(c==3)print"+"
  if(c==4)print"."
  if(c==5)print"!"
  if(c==6)print"o"
  if(c==7)print"*"
  if(c==8)print","
  if(c==9)print"_"
  if(c==A)print"~"
  if(c==B)print"$"
  if(c==C)print";"
  if(c==D)print":"
  if(c==E)print"="
  if(c==F)print"#"
  if(0>c||c>F)print "?"
  return c;
}

define screen_clear() {
  auto x,y;
  for(y=0;y<screen_y;y++)for(x=0;x<screen_x;x++)screen[y*screen_x+x]=0
  return 0;
}

define screen_plot(x,y,c) {
  auto os,s;
  os=scale;scale=0
  x/=1;y/=1;c/=1
  if(0>x||x>=screen_x||0>y||y>=screen_y){
    scale=os
    return 0
  }
  if(c<0){
    c=-c
    s=screen[y*screen_x+x]
    c=or_(c,s)
  }
  screen[y*screen_x+x]=c
  scale=os
  return 1
}

define screen_axes(xx,yy) {
  auto x,y,q,e;
  q=1
  for(y=0;y<screen_y;y++){e=screen_plot(xx,y,-1);q*=e}
  for(x=0;x<screen_x;x++){e=screen_plot(x,yy,-2);q*=e}
  return q
}

define screen_print() {
  auto x,y,q;
  for(x=0;x<screen_x;x+=2)print"-=";print"\n"
  for(y=screen_y-1;y>=0;y--){
    for(x=0;x<screen_x;x++)q=screen_printchar_(screen[y*screen_x+x])
    print "\n"
  }
  for(x=0;x<screen_x;x+=2)print"-=";print"\n"
  return 0;
}

/* define graphx(a[],si,ei) {
  auto i, j, k, l, max, min, range, pagepos, sub_x, sign, midbar, len_ei, len_diff, len_bar

  if(1- ( 0 <= si && si < ei && ei <= 65535 ) ) {
    print "Bad parameters in graphx()\n"
    return(1/0)
  }

  max = a[si]
  min = max
  for(i=si+0;i<=ei;i++){
    if(a[i] < min) min = a[i]
    if(a[i] > max) max = a[i]
    print "a[",i,"] = ",a[i],"\n";
  }

  print " max : ", max ,"\n";
  print " min : ", min ,"\n";

  sign = 1
  midbar = 0
  sub_x = 1

  if(min < 0) {
    if(max < 0) {

      sign   = -1
      sub_x  =  min
      min    = -max
      max    = -sub_x

    } else { # min < 0, max > 0 

      midbar = 1
      sub_x  = 0

    }
  }
  sub_x *= 0.9 * min
  range  = max - min

  print "range: ",range,"\n";
  print " max : ", max ,"\n";
  print " min : ", min ,"\n";
  print "sub_x: ",sub_x,"\n";

  len_ei = length(ei)
  len_line = screen_x - len_ei - 2;
  pagepos=1;

  for(i=si;i<=ei;i++) {

    len_diff = len_ei - length(i)
    if (len_diff) for(j=1;j<=len_diff;j++) print " ";
    print i,":";

    if (midbar) {
      if (len_bar < 0) {
        len_bar = ((a[i]-min) / range) * len_line
        for(j=1;j<len_bar;j++)print" ";
        if(j-len_bar){print "<";}else if(len_bar){print " ";}
        for(j=len_bar;j<=min/range*len_line;j++)print "#";
        print "|";
      } else {
        len_bar = (a[i] / range) * len_line
        for(j=1;j<=min/range*len_line;j++)print " ";
        print "|";
        for(j=1;j<len_bar;j++)print"#";
        if(j-len_bar)print ">";
      }
    } else {
      print "|";
      len_bar = ((sign*a[i]-sub_x) / max) * len_line
      if (len_bar>=1){for(j=1;j<=len_bar;j++) print "#";} 
      if (len_bar-j) print ">";
    }
    print "\n";
    .=pagepos++;
    if(pagepos >= screen_y) {
      print "Type 0 then hit [Enter]...\n";
      pagepos = read()*0 + 1
    }
  } # end for
  return
}

for(i=0;i<=10;i++)x[i]=i-5

graphx(x[],0,10)
quit
*/#!/usr/local/bin/bc -l output_formatting.bc

### Output-Roman.BC - Print numbers with extended Roman-style numerals

# Set this to non-zero to make output non-standard lowercase
output_lcase_=0

define printroman(n) {
  auto os,t[],ti,i,d,f,x;
  if(n==0){if(output_lcase_){print"n"}else{print "N"};return 0}
  os=scale;scale=0
  f=n-(x=n/1);
  for(ti=0;x>=4000;ti++){t[ti]=x%1000;x/=1000}
  t[ti]=x
  for(.=.;ti>=0;ti--){
    x=t[ti]
    if(x){if(ti<5){for(i=0;i<ti;i++)print"("}else{print"("}}
    d=(x/1000)%10
    for(i=d;i;i--)if(output_lcase_){print"m"}else{print"M"}
    d=(x/100)%10
    if(d==4)if(output_lcase_){print"cd"}else{print"CD"}
    if(d==9)if(output_lcase_){print"cm"}else{print"CM"}
    if(4<d&&d<9)if(output_lcase_){print"d"}else{print "D"}
    if((i=d%5)<4)for(.=.;i;i--)if(output_lcase_){print"c"}else{print"C"}
    d=(x/10)%10
    if(d==4)if(output_lcase_){print"xl"}else{print"XL"}
    if(d==9)if(output_lcase_){print"xc"}else{print"XC"}
    if(4<d&&d<9)if(output_lcase_){print"l"}else{print "L"}
    if((i=d%5)<4)for(.=.;i;i--)if(output_lcase_){print"x"}else{print"X"}
    d=x%10
    if(d==4)if(output_lcase_){print"iv"}else{print"IV"}
    if(d==9)if(output_lcase_){print"ix"}else{print"IX"}
    if(4<d&&d<9)if(output_lcase_){print"v"}else{print "V"}
    if((i=d%5)<4)for(.=.;i;i--)if(output_lcase_){print"i"}else{print"I"}
    if(x){if(ti<5){for(i=0;i<ti;i++)print")"}else{print")[";ti=printroman(ti);print"];"}}
  }
  if(!f){scale=os;return n}
  if(x)print " "
  x=A^(os/2-1)
  scale=os;f+=A^-os;scale=0
  while(x&&f){
    f*=C;d=f/1;f-=d
    if(d>=6){if(output_lcase_){print"s"}else{print"S"};d-=6}
    if(d==1)print".";if(d==2)print":"
    if(d==3)print":.";if(d==4)print"::"
    if(d==5)print"::.";
    x/=C;if(x&&f)print"/"
  }
  scale=os;return n
}
#!/usr/local/bin/bc -l

### Rand.BC - Random number generator for GNU BC

# Random number generator algorithm and code
# Not guaranteed for any purpose
# Chi-square tests prove this algorithm to be favourable

# ********************************************************
# ******************  IMPORTANT NOTICE  ******************
# ********************************************************
# An external seed source is required to start this library!
# See the bash randbc script for an example of how to do this.
# (It's available from the same website you found this file)

scale=50;ibase=A
# Global variables. Not to be changed in code without really good reason
rand_seed_ = 3482.2023+sqrt(8)
rand_mult_ = sqrt(2)+sqrt(3)
rand_smax_ = 2^32
rand_last_ = 0

define srand(x) {
  auto os,z,f,i;
  if(x<0){
    .=srand(x=-x);z=rand_seed_
    .=srand(sqrt(x)+x)
    rand_seed_=(z+rand_seed_)/2
    return 0
  }
  os=scale
  z=x+=sqrt(5);x+=sqrt(x);x-=sqrt(x)
  x+=1/2;x*=20/13
  scale=0
   f=(x-(i=x/1))
  scale=os
  z-=f*i;if(z<0)z=-z
  rand_seed_=z
  scale=os;return 0
}

define rand(x) {
  auto i, f, os;

  if(x<0)return srand(x)
  if(x<1)return(rand_last_)

  os = scale + 10
  scale = 0  ; i = rand_seed_ / 1
  scale = os ; f = rand_seed_ - i

  rand_seed_ = rand_mult_ * (1+i) * (1+f)

  while(rand_seed_>rand_smax_)rand_seed_-=rand_smax_

  scale = 0  ; i = rand_seed_ / 1
  scale = os ; f = rand_seed_ - i

  rand_last_ = f
  if(x==1){scale=os-10;return(rand_last_/=1)}

  rand_last_ = f * x + 1
  scale = 0        ; rand_last_ /= 1
  scale = scale(x) ; rand_last_ /= 1
  scale = os - 10
  
  return(rand_last_)
}
#!/usr/local/bin/bc -l

### Thermometer.BC - Conversions of temperature scales to other scales

# Caution: These functions will not operate correctly if ibase is not
# set to base ten (A) nor if scale is set too low

define   celcius_to_farenheit( c ) { return (c * 1.8 + 32)           }
define   celcius_to_kelvin(    c ) { return (c + 273.15)             }
define   celcius_to_reamur(    c ) { return (c * 0.8)                }
define   celcius_to_rankine(   c ) { return (c * 1.8 + 491.67)       }
define farenheit_to_celcius(   f ) { return ((f - 32)/1.8)           }
define farenheit_to_kelvin(    f ) { return ((f + 459.67)/1.8)       }
define farenheit_to_reamur(    f ) { return ((f - 32)/2.25)          }
define farenheit_to_rankine(   f ) { return (f + 459.67)             }
define    kelvin_to_celcius(   k ) { return (k - 273.15)             }
define    kelvin_to_farenheit( k ) { return (k * 1.8 - 459.67)       }
define    kelvin_to_reamur(    k ) { return ((k - 273.15)*0.8)       }
define    kelvin_to_rankine(   k ) { return (k * 1.8)                }
define    reamur_to_celcius(   r ) { return (r / 0.8)                }
define    reamur_to_farenheit( r ) { return (r * 2.25 + 32)          }
define    reamur_to_kelvin(    r ) { return (r / 0.8 + 273.15)       }
define    reamur_to_rankine(   r ) { return (r * 2.25 + 491.67)      }
define   rankine_to_celcius(   r ) { return (r / 1.8 + 273.15)       }
define   rankine_to_farenheit( r ) { return (r - 459.67)             }
define   rankine_to_kelvin(    r ) { return (r / 1.8)                }
define   rankine_to_reamur(    r ) { return ((r / 1.8 + 273.15)*0.8) }
#!/usr/local/bin/bc -l

### Primes.BC - Primes and factorisation (rudimentary)

 ## All factor finding is done by trial division meaning that many
 ## functions will eat CPU for long periods when encountering
 ## certain numbers. Primality testing uses better techniques and
 ## is much faster if no factors are required.
 ## e.g. 2^503-1 is identified as non-prime by the primality testers
 ## but no factors will be found in any sensible amount of time
 ## through trial division.
 ##
 ## Steps have been taken to make the trial division as fast as
 ## possible, meaning much code re-use.


max_array_ = 4^8-1

# Greatest common divisor of x and y - stolen from funcs.bc
define int_gcd(x,y) {
  auto r,os;
  os=scale;scale=0
  x/=1;y/=1
  while(y>0){r=x%y;x=y;y=r}
  scale=os
  return(x)
}

### Primality testing ###

# workhorse function for int_modpow and others
define int_modpow_(x,y,m) {
  auto r, y2;
  if(y==0)return(1)
  if(y==1)return(x%m)
  y2=y/2
  r=int_modpow_(x,y2,m); if(r>=m)r%=m
  r*=r                 ; if(r>=m)r%=m
  if(y%2){r*=x         ; if(r>=m)r%=m}
  return( r )
}

# Raise x to the y-th power, modulo m
define int_modpow(x,y,m) {
  auto os;
  os=scale;scale=0
  x/=1;y/=1;m/=1
  if(x< 0){print "int_modpow error: base is negative\n";    x=-x}
  if(y< 0){print "int_modpow error: exponent is negative\n";y=-y}
  if(m< 0){print "int_modpow error: modulus is negative\n"; m=-m}
  if(m==0){print "int_modpow error: modulus is zero\n";  return 0}
  x=int_modpow_(x,y,m)
  scale=os
  return( x )
}

## Pseudoprime tests

# Global variable to limit the number of Rabin-Miller iterations to try
# 0 => Run until sure number is prime
rabin_miller_maxtests_=0

# Uses the Rabin-Miller test for primality
#   uses a shortcut for numbers < 300 decimal digits
define is_rabin_miller_pseudoprime(p) {
  auto os,a,inc,top,next_a,q,r,s,d,x,c4;
  os=scale;scale=0
  if(p!=p/1){scale=os;return 0}
  if(p<=(q=F+2)){scale=os;return(p==2||p==3||p==5||p==7||p==B||p==D||p==q)}
  s=0;d=q=p-1;x=d/2;while(0==d-x-x){.=s++;d=x;x=d/2}
  if(p<A^(1+3*A*A)){
    # Takes a few liberties for the sake of speed compared to a
    # . full RM; Assumes small primes and perrin tests have been run
    inc=(p-4)/(C+length(p));if(inc<1)inc=1
    top=q
  } else {
    # This bizarre construct sets inc to an approximation of
    # . log to base 4 of p, meaning the loop below should
    # . run enough times to guarantee that p is prime
    inc=((B*B+F+F)*B*(length(p)+1))/A^3;if(inc<1)inc=1
    if(!inc%2).=inc++ # inc needs to be odd to ensure good mix of candidates
    top=inc*(inc+1)
  }
  if(rabin_miller_maxtests_){
    rabin_miller_maxtests_/=1
    if(rabin_miller_maxtests_<=0){
      rabin_miller_maxtests_=0
      print "Warning: rabin_miller_maxtests_ set to invalid value. Now = 0\n"
      print "         This calculation may take longer to run than expected\n"
    }else{
      inc=top/rabin_miller_maxtests_+1
    }
  } 
  for(a=2;a<top;a+=inc){
    next_a=0
    x=int_modpow_(a,d,p)
    if(x!=1&&x!=q){
      for(r=1;r<s;r++){
       x*=x;x%=p
       if(x==1){scale=os;return 0}#composite
       if(x==q){next_a=1;break}
      }#end for
      if(!next_a){scale=os;return 0}
    }#end if
  }#end for
  scale=os;return 1
}

# Determine whether p is a Perrin pseudoprime
#   returns 0 if definitely composite
#   returns 1 if possibly prime (but not definitely)
define is_perrin_pseudoprime(p) {
  auto os,i,h,rp,m[],r[],t[];#,m[];
  os=scale;scale=0
  if(p!=p/1){scale=os;return 0}
  if(p==2){scale=os;return 1}
  if(p<2||p%2==0){scale=os;return 0}
  #set rp to reverse of p
  # would love to use int_modpow to calculate powers but it doesn't work
  #  on matrices!
  # could use an array to store bits of p, but arrays are limited to
  #  65536 elements; integers have no such limits
  rp=0;i=p;while(i){h=i/2;rp+=rp+i-h-h;i=h}
  # Quick Mersenne test; if rp == p then p could be 2^i - 1 for some i.
  # if i is not prime then neither is p, and it's faster to check i first.
  # this test is unnecessary, but since half the work is already done
  # we might as well check
  if(rp==p){
    for(i=0;rp;i++)rp/=2
    if(2^i-1==p&&!is_perrin_pseudoprime(i)){scale=os;return 0}
    rp=p # restore rp; if we're here then the test failed
  }
  # m[]={0,1,1;1,0,0;0,1,0}
  #m[0]=0; m[1]=1; m[2]=1;
  #m[3]=1; m[4]=0; m[5]=0; # Never actually used
  #m[6]=0; m[7]=1; m[8]=0;
  # r[]={1,0,0;0,1,0;0,0,1}=Unit
  r[0]=1; r[1]=0; r[2]=0;
  r[3]=0; r[4]=1; r[5]=0;
  r[6]=0; r[7]=0; r[8]=1;
  while(rp) {
    # square r
    t[0]=r[1]*r[3]; t[1]=r[2]*r[6]; t[2]=r[0]+r[4]
    t[3]=r[2]*r[7]; t[4]=r[0]+r[8]
    t[5]=r[1]*r[5]; t[6]=r[5]*r[6]; t[7]=r[5]*r[7]; t[8]=r[4]+r[8]
    t[9]=r[2]*r[3]; t[A]=r[3]*r[7]; t[B]=r[1]*r[6]
    r[0]*=r[0];r[0]+=t[0]+t[1]; r[1]*=t[2];r[1]+=t[3]; r[2]*=t[4];r[2]+=t[5]
    r[3]*=t[2];r[3]+=t[6]; r[4]*=r[4];r[4]+=t[0]+t[7]; r[5]*=t[8];r[5]+=t[9]
    r[6]*=t[4];r[6]+=t[A]; r[7]*=t[8];r[7]+=t[B]; r[8]*=r[8];r[8]+=t[1]+t[7]
    h=rp/2
    if(rp-h-h){# odd
      # multiply r by m
      #  this is a hack that assumes m is {0,1,1;1,0,0;0,1,0}
      #  without actually using m.
      #  if m is changed, this will need to be rewritten
      t[0]=r[0]+r[2]; t[1]=r[3]+r[5]; t[2]=r[6]+r[8]
      r[2]=r[0]; r[0]=r[1]; r[1]=t[0]
      r[5]=r[3]; r[3]=r[4]; r[4]=t[1]
      r[8]=r[6]; r[6]=r[7]; r[7]=t[2]
    }
    for(i=0;i<9;i++)r[i]%=p
    rp=h
  }
  r[0]=(2*r[6]+3*r[8])%p
  scale=os;
  return (r[0]==0)
}

# Determine whether x is possibly prime through division by small numbers
define is_small_division_pseudoprime(x) {
 auto os,j[],ji,sx,p,n;#oldscale,jump,jump-index,sqrtx,prime,nth
 if(x<2)return 0;
 os=scale;scale=0
 if(x!=x/1){scale=os;return 0}
 j[0]=4;j[1]=2;j[2]=4;j[3]=2;j[4]=4;j[5]=6;j[6]=2;j[7]=6
 for(p=2;p<7;p+=p-1){if(x==p){scale=os;return 1};if(x%p==0){scale=os;return 0}}
 sx=sqrt(x);if(sx>(n=A^5))sx=n;# 100000(decimal) upper limit
 if(prime[A^4]){ #primes-db is present
   for(n=4;(p=prime[n])<=sx;n++)if(x%p==0){scale=os;return 0}
 } else {
   ji=7;p=7;n=2*A-1
   while(p<=sx){
    if(x%p==0){scale=os;return 0}
    if(ji++==8)ji=0;p+=j[ji];
    if(p>n)while(p%7==0||p%B==0||p%D==0||p%n==0){if(ji++==8)ji=0;p+=j[ji]}
   }
 }
 scale=os;return(1)
}

## Primality / Power-freedom tests

define is_prime(x) {
  # It is estimated that all numbers will not be misidentified
  # using the tests below, but it may take time
  if(!is_small_division_pseudoprime(x))return 0
  if(x<A^A)return 1 # pairs with the A^5 in is_s.d.pp()
  if(x<A^(1+3*A*A)||rabin_miller_maxtests_){
    # 300 digits or less; faster doing RM, then PP
    # and shortcut RM may miss something (hard to prove)
    if(!is_rabin_miller_pseudoprime(x))return 0
    if(!is_perrin_pseudoprime(x))return 0
  } else {
    # Tests reversed because full RM is slower than PP
    if(!is_perrin_pseudoprime(x))return 0
    if(!is_rabin_miller_pseudoprime(x))return 0
  }
  return 1
}

# Determine whether x is prime through trial division only
define is_prime_td(x) {
 auto os,j[],ji,sx,p,n;#oldscale,jump,jump-index,sqrtx,prime,nth
 if(x<2)return 0;
 os=scale;scale=0
 if(x!=x/1){scale=os;return 0}
 j[0]=4;j[1]=2;j[2]=4;j[3]=2;j[4]=4;j[5]=6;j[6]=2;j[7]=6
 for(p=2;p<7;p+=p-1){if(x==p){scale=os;return 1};if(x%p==0){scale=os;return 0}}
 if(!is_perrin_pseudoprime(x)){scale=os;return 0}#cheat a bit
 sx=sqrt(x);p=7;ji=7
 if(prime[max_array_])for(n=4;n<=max_array_&&(p=prime[n])<=sx;n++)if(x%p==0){scale=os;return 0}
 if(p>7)ji=4#assume p is now prime[max_array_]
 n=2*A-1
 while(p<=sx){
  if(x%p==0){scale=os;return 0}
  if(ji++==8)ji=0;p+=j[ji];
  if(p>n)while(p%7==0||p%B==0||p%D==0||p%n==0){if(ji++==8)ji=0;p+=j[ji]}
 }
 scale=os;return(1)
}

### Storage and output of prime factorisations ###

# Output the given array interpreted as prime factors and powers thereof
# . this function plus fac_store() make for a "delayed" equivalent
# . to the fac_print() function
define printfactorpow(fp[]) {
 auto i,c;
 for(i=0;fp[i];i+=2){
  print fp[i]
  if((c=fp[i+1])>1)print "^",c
  if(fp[i+2])print " * "
 }
 print"\n"
 return (fp[1]==1&&fp[2]==0) # fp[] is prime?
}

# Workhorse function for the below
# . for retaining a copy of the last calculated factorisation
# . in factorpow global array to save time if further functions
# . are to be called on same number
define factorpow_set_(fp[]) {
  auto i;
  for(i=0;fp[i];i++)factorpow[i]=fp[i]
  return factorpow[i]=factorpow[i+1]=0;
}

# Workhorse function for the below
# . appends newly found factor and power thereof to the provided array
# . outputs that information if the print_ flag is set
define fac_store_(*fp[],m,p,c,print_) {
  auto z;
  if(!m%2).=m++ # m should be position of last element and thus odd
  # even elements are prime factor, odd elements are how many.
  # 9 -> {3,2} -> 3^2 , 60 -> {2,2,3,1,5,1} -> 2^2*3^1*5^1
  # negative c means we know this is the end and we can write two zeroes
  z=0;if(c<0){z=1;c=-c}
  fp[++m]=p;fp[++m]=c
  if(print_){
    print p;if(c>1)print "^",c
    if(!z){print " * "}else{print "\n"};
  }
  if(z){fp[++m]=0;fp[++m]=0}
  return m
}

# Workhorse function for the below
# . performs action that otherwise occurs three times
# . relies on inherited scope (POSIX style)
# . returns 0 if parent should also return
define fac_sp_innerloop_() {
  for(c=0;x%p==0;c++)x/=p
  if(c){
    if(x==1)c=-c
    m=fac_store_(fp[],m,p,c,print_);
    if(x==1)return factorpow_set_(fp[]); # = 0
    if(is_prime(x)){
      m=fac_store_(fp[],m,x,-1,print_);
      return factorpow_set_(fp[]); # = 0
    }
  }
  return 1;
}

# Workhorse function for the below
# . factorises x through trial division, using the above functions
# . for output, storage, retention, etc.
define fac_sp_(*fp[],x,print_) {
 auto os,j[],ji,sx,p,c,n,m,f;#oldscale,jump,jump-index,sqrtx,prime,count,nth,mth
 os=scale;scale=0;x/=1
 # Check to see if last calculation was the same as this one - save work
 f=1;for(m=0;p=factorpow[m]&&f<=x;m+=2)f*=(fp[m]=p)^(fp[m+1]=factorpow[m+1]);
 if(f==x){
   if(print_).=printfactorpow(fp[]);
   scale=os;return fp[m]=fp[m+1]=0;
 }
 # Main algorithm
 m=-1
 if(x<0){m=fac_store_(fp[],m,-1,1,print_);x=-x}
 if(x<=1||is_prime(x)){m=fac_store_(fp[],m,x,-1,print_);scale=os;return (x>1)}
 j[0]=4;j[1]=2;j[2]=4;j[3]=2;j[4]=4;j[5]=6;j[6]=2;j[7]=6
 for(p=2;p<7;p+=p-1)if(!fac_sp_innerloop_()){scale=os;return 0} #1
 sx=sqrt(x);p=7;ji=7
 if(prime[max_array_])for(n=4;n<=max_array_&&(p=prime[n])<=sx;n++){
   if(!fac_sp_innerloop_()){scale=os;return 0} #2
 }
 if(p>7)ji=4#assume p is now prime[max_array_]
 n=2*A-1;sx=sqrt(x)
 while(p<=sx){
   if(!fac_sp_innerloop_()){scale=os;return 0} #3
   if(c)sx=sqrt(x)
   if(ji++==8)ji=0;p+=j[ji];
   if(p>n)while(p%7==0||p%B==0||p%D==0||p%n==0){if(ji++==8)ji=0;p+=j[ji]}
 }
 if(x>1)m=fac_store_(fp[],m,x,-1,print_)
 scale=os;return factorpow_set_(fp[]);
}

# Output the prime factors of x with powers thereof
# . displays factors as they are found which allows more chance
# . of some factors being output before becoming bogged down
# . finding larger factors by trial division
define fac_print(      x) { auto a[];x=fac_sp_( a[],x,1);return ( a[1]==1&& a[2]==0); }

# Store the prime factors of x into the given array
define fac_store(*fp[],x) {          x=fac_sp_(fp[],x,0);return (fp[1]==1&&fp[2]==0); }

# Can be slow in the case of a large spf
define smallest_prime_factor(x) {
 auto os,j[],ji,sx,p,n;#oldscale,jump,jump-index,sqrtx,prime,nth
 os=scale;scale=0;x/=1
 if(x<0){scale=os;return -1}
 if(x<=1||is_prime(x)){scale=os;return x}
 j[0]=4;j[1]=2;j[2]=4;j[3]=2;j[4]=4;j[5]=6;j[6]=2;j[7]=6
 for(p=2;p<7;p+=p-1)if(x%p==0){scale=os;return p}
 sx=sqrt(x);p=7;ji=7
 if(prime[max_array_])for(n=4;n<=max_array_&&(p=prime[n])<=sx;n++)if(x%p==0){scale=os;return p}
 if(p>7)ji=4#assume p is now prime[max_array_]
 n=2*A-1;sx=sqrt(x)
 while(p<=sx){
  if(x%p==0){scale=os;return p}
  if(ji++==8)ji=0;p+=j[ji];
  if(p>n)while(p%7==0||p%B==0||p%D==0||p%n==0){if(ji++==8)ji=0;p+=j[ji]}
 }
 scale=os;return(-sx) #if we ever get here, something is wrong!
}

# Non trivial = slow
define largest_prime_factor(x) {
 auto i,fp[];
 .=fac_store(fp[],x);
 for(i=0;fp[i];i+=2){}
 return fp[i-2];
}

# Largest prime power within x
# e.g. 992 = 2^5*31 and 2^5>31 so 992 -> 2^5 = 32
define largest_prime_power(x) {
 auto i,fp[],p,max;
 .=fac_store(fp[],x);
 for(i=0;(p=fp[i]^fp[i+1])!=1;i+=2)if(max<p)max=p
 return max;
}

# Return powerfree kernel of x (largest powerfree number which divides x)
define rad(x) {
 auto i,r,f,fp[];
 .=fac_store(fp[],x)
 r=1;for(i=0;f=fp[i];i+=2)r*=f
 return r;
}

# Return square part of x
define squarepart(x) {
 auto os,i,r,f,p,fp[];
 .=fac_store(fp[],x)
 os=scale;scale=0
  r=1;for(i=0;f=fp[i];i+=2){p=fp[i+1];p-=p%2;r*=f^p}
 scale=os;return r
}

# Return squarefree core of x
define core(x) {
 auto os;
 os=scale;scale=0
 x/=squarepart(x)
 scale=os;return x
}

# Count the number of (non-unique) prime factors of x
# e.g. 60 = 2^2*3^1*5^1 -> 2 + 1 + 1 = 4
define count_factors(x) {
  auto i,c,fp[];
  if(x<0)return count_factors(-x)+1;
  if(x==0||x==1)return 0;
  .=fac_store(fp[],x)
  for(i=0;fp[i];i+=2)c+=fp[i+1]
  return c;
}

# Count the number of unique prime factors of x
# e.g. 84 = [2]^2*[3]^1*[7]^1 -> #{2,3,7} = 3
define count_unique_factors(x) {
  auto i,d,fp[];
  if(x<0)return count_unique_factors(-x)+1;
  if(x==0||x==1)return 0;
  .=fac_store(fp[],x);
  for(i=0;fp[i];i+=2).=d++
  return d;
}

# Determine whether x is y-th power-free
#  e.g. has_freedom(51, 2) will return whether 51 is square-free
#  + sign of result indicates (-1)^[number of prime factors]
#    making has_freedom(x,2) equivalent to the mobius function
#  Special case: has_freedom(x, 1) returns whether x is prime
#  Pseudo-boolean, since always returns 0 for false, but not always 1 for true
define has_freedom(x,y) {
 auto os,i,p,m,fp[];
 os=scale;scale=0;if(x<0)x=-x
 if(x!=x/1){scale=os;return 0}
 if(x==1){scale=os;return 1}
 if(y==1){scale=os;return is_prime(x)}
 if(x>A^A)if(is_prime(x)){scale=os;return -1}
 if(x<0||y<1){scale=os;return 0}
 .=fac_store(fp[],x);
 m=1
 for(i=1;p=fp[i];i+=2){
  if(p>=y){scale=os;return 0}
  m*=p*(-1)^p
 }
 return m
}

# Returns 0 if non-squarefree,
# 1 for 1 and all products of an even number of unique primes
# -1 otherwise
define mobius(x) {
  return has_freedom(x,2);
}

# Determine the so-called arithmetic derivative of x
define arithmetic_derivative(x) {
  auto os,i,f,n,d,fp[];
  if(x<0)return -arithmetic_derivative(-x)
  os=scale;scale=0;x/=1
  if(x==0||x==1){scale=os;return 0}
  .=fac_store(fp[],x);n=0;d=1
  for(i=0;f=fp[i];i+=2){n=n*f+d*fp[i+1];d*=f}
  n=(n*x)/d
  scale=os;return n
}

### Storage and output of divisors of a number ###

# Count the number of divisors of x (prime or otherwise)
define count_divisors(x) {
  auto i,c,p,fp[];
  i=scale;x/=1;scale=i
  if(x<0)return 2*count_divisors(-x);
  if(x==0||x==1)return x
  .=fac_store(fp[],x);
  c=1;for(i=1;p=fp[i];i+=2)c*=1+p
  return c
}

# Workhorse function for the below
define divisors_sp_(*divs[],x,print_) {
  # opts: 1 -> print; 0 -> store
  auto os,s,sx,c,ch,p,m,i,j,k,f,fp[]
  os=scale;scale=0;x/=1
  if(x==0||x==1){
    if(!print_){divs[0]=x;divs[1]=0}
    scale=os;return x;
  }
  .=fac_store(fp[],x)
  c=1;for(i=1;(p=++fp[i++])>1;i++)c*=p
  .=c--
  s=1;if(x<0){s=-1;x=-x}
  if(print_){
    print s,", "
  } else {
    divs[0]=s
    sx=0
    ch=(c+1)/2
    if(c>max_array_){
      sx=sqrt(x)
      print "too many divisors to store. storing as many as possible\n"
    }
  }
  for(i=1;i<c;i++){
    j=i;k=0;f=1
    while(j){if(m=j%(p=fp[k+1]))f*=fp[k]^m;j/=p;k+=2} # generate a divisor
    if(print_){print s*f,", "}else{
      if(sx){
        # Only applies if all divisors won't fit in the array
        # Divisors <= sqrt(x) can be used to reconstruct missing divisors
        #   These can be overlooked due to the way the generator works
        k=f;if(k<0)k=-k
        if(k>sx){
          # Store divisors > sqrt(x) in any space that would otherwise have
          #   been available at the high end of the array or else skip them
          if(ch<max_array_)divs[ch++]=s*f
          continue;
        }
      }
      if(i<=max_array_){divs[i]=s*f}else{break}
    }
  }
  if(print_){x}else{if(c>max_array_-1)c=max_array_-1;divs[c]=s*x;divs[c+1]=0}
  scale=os;return s*x
}

# Displays all divisors of x in a logical but unsorted order
define divisors_print(     x) { auto d[]; return divisors_sp_(d[],x,1); }

# Store calculated divisors in given array in same logical but unsorted order
# . see array.bc for sorting and rudimentary printing of arrays
define divisors_store(*d[],x) {           return divisors_sp_(d[],x,0); }

# Returns the sum of the divisors of x where each divisor is raised
# to the power n; e.g. sigma(2,6) -> 1^2 + 2^2 + 3^2 + 6^2 = 50
# . only supports integer n at present
define sigma(n,x) {
  auto os,i,u,d,f,fp[];
  os=scale;scale=0;x/=1;n/=1
  if(n==0){scale=os;return count_divisors(x)}
  if(n<0){scale=os;n=-n;return sigma(n,x)/x^n}
  .=fac_store(fp[],x);u=d=1
  if(x<0)x=0
  if(x==0||x==1)return x;
  for(i=0;fp[i];i+=2){u*=(f=fp[i]^n)^(fp[i+1]+1)-1;d*=f-1}
  u/=d;scale=os;return u;
}

# Old slow version of sigma
#   supports integer and half-integer n
#define sigma_slow(n,x) {
#  auto os,c,p,m,h,i,j,k,f,sum,fp[];
#  if(n==0)return count_divisors(x);
#  n+=n
#  os=scale;scale=0;x/=1;n/=1
#  if(x<0)x=0
#  if(x==0||x==1){scale=os;return x;}
#  
#  p=h=n;n/=2;h-=n+n
#  if(p<0){scale=os;n=-n;sum=sigma(-p/2,x)/x^n;if(h)sum/=sqrt(x);return sum}
#  .=fac_store(fp[],x)
#  c=1;for(i=1;(p=++fp[i++])>1;i++)c*=p
#  .=c--;p=x^n;if(h){scale=os;p*=sqrt(x);scale=0};sum=1+p
#  for(i=1;i<c;i++){
#    j=i;k=0;f=1
#    while(j){if(m=j%(p=fp[k+1]))f*=fp[k]^m;j/=p;k+=2}
#    p=f^n;if(h){scale=os;p*=sqrt(f);scale=0}
#    sum+=p
#  }
#  scale=os;return sum
#}

# Returns the sum of the divisors of x, inclusive of x
# e.g. primes -> prime + 1, 2^x -> 2^(x+1)-1, 6 -> 12
define sum_of_divisors(x) {
  return sigma(1,x);
}

# Computes the Euler totient function for x
define totient(x) {
  auto i,t,f,fp[];
  .=fac_store(fp[],x);t=1
  if(x==0||x==1)return x;
  for(i=0;fp[i];i+=2)t*=((f=fp[i])-1)*f^(fp[i+1]-1)
  return t
}

# Number of iterations of the totient function to reach 1
define totient_itercount(x) {auto t;while(x>1){x=totient(x);.=t++};return t}

# Sum of iterating the totient function down to 1
define totient_itersum(x) {auto t;while(x>1){x=totient(x);t+=x};return t}

# Returns if x is a perfect totient number
define is_perfect_totient(x) { return totient_itersum(x)==x }

# Computes Ramanujan's c_q function for n (given q)
define ramanujan_c(q,n) {
  auto i,c,d,t,f,p,fp[];
  if(q<0||n<0)return 0;
  if(q==1)return 1;
  if(n==1)return mobius(q);
  if(n==q)return totient(q);
  n=q/int_gcd(q,n)
  if(n==1)return totient(q);
  .=fac_store(fp[],n);t=1;c=d=0;
  for(i=0;fp[i];i+=2){
    t*=((f=fp[i])-1)*f^((p=fp[i+1])-1)
    c+=p;.=d++
  }
  if(c!=d){c=0}else{c=(-1)^d}
  return c*totient(q)/t # mobius(n')*totient(q)/totient(n')
}

# Determines whether a number is a practical number
define is_practical(x) {
  auto os,i,ni,s,p,f,nf,fp[];
  if(x<0)return 0;
  if(x==1)return 1;
  os=scale;scale=0;i=x%2;scale=os
  if(i)return 0
  .=fac_store(fp[],x)
  if(!fp[2])return 1;# x is power of 2
  scale=0
  #fp[0] has to be 2 here, so replace with 2
  s=2^(fp[1]+1)-1
  f=fp[i=2]
  while(1){
    if(f>1+s){scale=os;return 0}
    if((nf=fp[ni=i+2])==0){scale=os;return 1}
    s*=(f^(fp[i+1]+1)-1)/(f-1)
    f=nf;i=ni
  }
  return -1;# should never get here
}

### Exploring prime neighbourhood ###

# Finds and returns the nearest prime > x
define nextprime(x) {
  auto os,ox;
  if(x<0)return -prevprime(-x)
  if(x<2)return 2
  if(x<3)return 3
  os=scale;scale=0
   ox=x
   if(x/1<x).=x++ #ceiling
   x/=1            #truncate
   x+=1-x%2        #make odd
   if(x==ox)x+=2   #same as we started with
   #while(!is_prime(x))x+=2 # could use jumps here, but is not much faster
   while(1){
     while(!is_small_division_pseudoprime(x))x+=2
     if(x<A^A)break; # pairs with the A^5 in is_s.d.pp()
     if(is_rabin_miller_pseudoprime(x)){
       if(rabin_miller_maxtests_){
         if(is_perrin_pseudoprime(x))break;
       } else {
         break;
       }
     }
     x+=2
   }
  scale=os;return x
}

# nearest prime >= x
define nextprime_ifnotprime(x) {
  if(is_prime(x))return x;
  return nextprime(x)
}

# Finds and returns the nearest prime < x
define prevprime(x) {
  auto os,ox;
  if(x<0)return -nextprime(-x)
  if(x<=2)return -2
  if(x<=3)return 2
  if(x<=5)return 3
  os=scale;scale=0
   ox=x;x/=1
   if(x%2){if(x==ox)x-=2}else{.=x--}
   #while(!is_prime(x)&&x>0)x-=2
   while(x>0){
     while(!is_small_division_pseudoprime(x))x-=2
     if(x<A^A)break; # pairs with the A^5 in is_s.d.pp()
     if(is_rabin_miller_pseudoprime(x)){
       if(rabin_miller_maxtests_){
         if(is_perrin_pseudoprime(x))break;
       } else {
         break;
       }
     }
     x-=2
   }
   if(x<2)return x=-2
  scale=os;return x
}

# nearest prime <= x
define prevprime_ifnotprime(x) {
  if(is_prime(x))return x;
  return prevprime(x)
}

# Find the nearest prime to x (inclusive)
define nearestprime(x) {
  auto np,pp;
  if(is_prime(x))return x;
  np=nextprime(x)
  pp=prevprime(x)
  if(np-x>x-pp)return pp
  return np
}

### Relatives of the Primorial / Factorial

# Primorial  
define primorial(n) {
  auto i,pm,p;
  pm=1;p=2
  if(prime[max_array_])for(i=1;i<=max_array_&&p=prime[i]<=n;i++)pm*=p
  for(p=p;p<=n;p=nextprime(p))pm*=p
  return pm
}

# Subprimorial
define subprimorial(n) {
  auto i,pm,p;
  pm=1;p=2
  if(prime[max_array_])for(i=2;i<=max_array_&&(p=prime[i])<=n;i++)pm*=p-1
  for(p=p;p<=n;p=nextprime(p))pm*=p-1
  return pm
}
#!/usr/local/bin/bc -l primes.bc primes_db_minipack.bc

### Primes_DB_Code.BC - prime counting / retrieval functions reliant on a DB

## Technical details:
## . Modulo 2310 [=primorial(11)] there are 480 possible primes
## . Each array entry in the pd_[] packed prime data array should represent
## . the primality of the 480 possibilities within the integers from
## . 2310*index to 2310*(index+1)-1
## . The last 24 bits of each array entry should be the cumulative count of
## . . actual primes up to the end of that entry. 
## . Primes 2 to 11 are handled seperately as they are not relatively prime
## . . to 2310
## . This file and its minipack and bigpack siblings are designed to replace
## . . the older, unpacked, primes_db.bc. The prime[] array from the latter
## . . can be recreated using the fillprimearray() function herein.


max_array_ = 4^8-1

# Create metadata arrays which allow the below to operate correctly
define makemods2310_() {
  auto oib,c,i;
  oib=ibase;ibase=A
  if(!pd_2310_[239]){c=0;for(i=1;i<=1155;i++)if(int_gcd(i,2310)==1)pd_2310_[c++]=i}
  if(!pd_0112_[max_array_]){for(c=1;c<=32768;c+=c)for(i=c;i<c+c;i++)pd_0112_[i]=1+pd_0112_[i-c]}
  ibase=oib;return 0
}

# Return the nth prime up to the limit of the database
# . TO DO: slow follow-on using nextprime()
define prime(n) {
  auto oib,os,ma,i,l,m,h,k,hk,c,cm,b;
  if(n<0)return -prime(-n)
  if(n<1)return 1;if(n<2)return 2;if(n<3)return 3
  if(n<4)return 5;if(n<5)return 7;if(n<6)return B
  if(n<=max_array_&&k=prime[n]){return k} # deliberate assignment!
  oib=ibase;ibase=A
  os=scale;scale=0
  n-=6;n/=1
  h=pd_max_;cm=16777216#=16^6
  if(n>=(c=pd_[h]%cm)){
    print "prime() knows only the first ",c+5," primes\n";
    scale=os;return -1
  }
  l=0;m=(l+h)/2;.=makemods2310_()
  while(l<=m){
    k=pd_[m];hk=k/cm;c=k-hk*cm;k=hk
    if(c<=n){
      l=m+1
    } else {
      b=0;if(m>0)b=pd_[m-1]%cm
      if(b>n){
        h=m
      } else {
        # main routine
        ma = 1+max_array_
        i=-1;while(k&&b<=n){
          if(n-b<16){
            hk=k/2;if(k-hk-hk).=b++;.=i++;k=hk
          } else {
            hk=k/ma;b+=pd_0112_[k-ma*hk];i+=16;k=hk # addition to i should be log2(max_array_+1)
          }
        }
        if(i<240){
          m= m   *2310+pd_2310_[    i]
        } else {
          m=(m+1)*2310-pd_2310_[479-i]
        } # end if i
        scale=os;ibase=oib;return m
      } # end if b
    } # end if c
    m=(l+h)/2
  } # end while
  scale=os;ibase=oib;return -1
}

# Return the number of primes up to (and including) p
# . as long as p is less than or equal to the maximum db entry
define primepi(p){
  auto oib,os,ma,q,f,i,b,l,m,h,k;
  if(p<0)return -primepi(-p);
  p=prevprime_ifnotprime(p);
  if(p<2)return 0;if(p<3)return 1;if(p<5)return 2
  if(p<7)return 3;if(p<B)return 4;if(p<D)return 5
  oib=ibase;ibase=A
  os=scale;scale=0
  if(q=prime[max_array_]&&p<=q){ # assignment of q is deliberate
    l=1;h=max_array_;m=(max_array_+1)/2
    while(p!=(q=prime[m])){
      if(p>q){l=m+1}else{h=m-1}
      m=(l+h)/2
    }
    ibase=oib;scale=os;return m
  }
  q=(1+pd_max_)*2310-1
  if(p>q){
    #q=prevprime_ifnotprime(q)
    print "primepi() only knows the count of primes up to ";q
    ibase=oib;scale=os;return -1
  }
  .=makemods2310_()
  i=p/2310; q=p-i*2310
  f=0;if(q>1155){f=1;q=2310-q}
  #find q in pd_2310_
  l=0;h=239;m=120
  while(q!=(k=pd_2310_[m])){
    if(q<k){
      h=m-1;
    } else {
      l=m+1;
    }
    m=(l+h)/2
  }
  if(f)m=479-m
  b=0;if(i)b=pd_[i-1]%16777216
  k=pd_[i]/16777216;ma=1+max_array_
  while(m){
    if(m<16){
      h=k/2;if(k-h-h).=b++;.=m--;k=h
    } else {
      h=k/ma;b+=pd_0112_[k-ma*h];m-=16;k=h # subtraction from m should be log2(max_array_+1)
    }
  }
  ibase=oib;scale=os;return b+6;
}

# Unpack the first max_array_ primes from the global pd_ array into the
# . global prime array which is used by some functions in primes.bc
# . to speed up trial division code.
define fillprimearray() {
  auto oib,os,ma,i,j,k,h,mi,s,ip
  oib=ibase;ibase=A
  os=scale;scale=0
  .=makemods2310_()
  prime[0]=1;prime[1]=2;prime[2]=3
  prime[3]=5;prime[4]=7;prime[5]=B
  ip=6;mi=0;ma=1+max_array_
  for(i=0;i<356;i++){
    k=pd_[i]/16777216;s=1
    for(j=0;k&&j<240;j++){
      h=k/2;if(k-h-h)prime[ip++]=mi+pd_2310_[j];k=h
      if(ip==ma){i=ip;break}
    }
    mi+=2310
    for(j=239;k&&j>=0;j--){
      h=k/2;if(k-h-h)prime[ip++]=mi-pd_2310_[j];k=h
      if(ip==ma){i=ip;break}
    }
  }
  ibase=oib;scale=os;return 0
}#!/usr/local/bin/bc -l primes.bc primes_db_code.bc

### Primes_DB_Minipack.BC - The primes from 13 to 822347 packed into a global bit array

## Technical details:
## . Modulo 2310 [=primorial(11)] there are 480 possible primes
## . Each array entry represents the primality of the 480 possibilities within
## . . the integers from 2310*index to 2310*(index+1)-1
## . The last 24 bits of each array entry is the cumulative count of actual
## . . primes up to the end of that entry. e.g. pd_[1] ends 00026A, meaning
## . . that the first two array entries (0 and 1) contain 618 (dec) primes
## . Primes 2 to 11 cannot be stored here as they are
## . . not relatively prime to 2310
## . This file and it's sibling primes_db_code.bc are designed to replace the
## . . older, unpacked, primes_db.bc, exchanging disk space for a few extra
## . . seconds of initialisation code. This counterintuitive step is so that
## . . a larger version of this packed database may be used instead, allowing
## . . for knowledge/storage of more than 2^16 primes.

ibase=4^2
if(pd_max_!=0){print "Warning: load order error ",pd_max_,"!=";0}
pd_[0]=EDCB9B12BE7F34B7FC662DFCA97A6DCB8F17FB7E65FD7F94D41DFF19EDBCCDFC7EDE6F5771EF3ED5BF6ABBFBBDF58FB7FBEDDBF7AFF7EFF7FFFFFFFE000152
pd_[1]=2D198F6CDC7516B41F76DE09DE6D8E3DD11BF96BACB3A2D79D3BA4EDFB53F4633D9EF0BC767708E39ADAC3E52DA3DA7E59FDFDE9CC8F99075EAFE5F100026A
pd_[2]=5A2E9F2F30DB6DC499F7141730C36FAD75F45F8A6E8F55D31425853FF3BE0F2AE7F882EA3DCE97BF60D47391E2AB50DEC95BD9FF58B40B7E2B649AFD000375
pd_[3]=D39A735A0B73E1CBA28E5F632BEBDB339CA8EE40DBC19C859EE3DA2B88BF5C872099D67AA70C1C9DBE389BEF6DAF351908DA690EDE6896B0671CEDEC000474
pd_[4]=8A3E6365A269CACF848ED2E2F690AB2B0AE7AC1549D631E7571418B53CE2497AB4ED8A47EE1DBA30C14AE66B4ED3B3CC6CB3D441E53377F399768B8500056A
pd_[5]=96154E9F7F12B31516296E1DA236CC2A5C1ED8DE09B1E6DA77C092DA86CCB2EC7AA8F5D7999CDC1B0AF6D2C0EC3F0CF0C5F3B3661F73C14CEC84C6A1000660
pd_[6]=64AEFC854709F3C82BB2DF80DFD4CCA6498B7297B475B7CD2724B66AD8984AD616B2BC2F77B245BE187F92613DBB21B9283846678087A98F0C1AF1E000752
pd_[7]=1DB264E53D971F2A8FE14BF047F17750AD1385B28D60CB3CA15F62ACBE5D6E04539C515390BEC5C979BA0B9106C86D3DA616A28D8E7C0DAA48563C1E00083F
pd_[8]=B3E9A8A345427531C34371EEC2A53245AE7E46675D9A9C31CC6A26D55B100D69B832FDFEBE01324E9BC633103E4664C60F41420EA2D31CC112C13393000921
pd_[9]=D5EDF92CC4A5701C796B5D87B80E7450D3A135981AFA880CBAECCDAF2728B24ADC664DB2A2960EF7C3DF902577067854459D5B954385F9996B9C500C000A0F
pd_[A]=91571782EB0A761E548E21DA4EA25C4AA6484ED064843554E0CF12D148107C634997EEA9DA7211EF91F24EF203F07BCBED24125441A35BA885795244000AEC
pd_[B]=1E22928C1790E29CD0C1413D70550123A7CA32C7949E6AAA511FDDD1A834684D46355C933583E92B6C8F482A6748EF454D2385B8A8E9ADBC8E003EA3000BC9
pd_[C]=B0A122C3E4D221C94270B28F8384A1AC7E25A6A4666D557882C3E81247527534CAC2AD2FBDB5BB1B1478EC0C0BBC02A991136CB1C64D76520CDF9E7E000CAB
pd_[D]=73C0732BA26C2EF8CD55004656118653C91D88CA9E3938001F11B9077BC6EF981E9298547848F6E70D413D5AB0113A978C4C16253A46A955A9CF7124000D87
pd_[E]=916E055F6699113A5F95E27066F80062D1061E4C7466A774C8416FBF62D4BB04E90FB6B0109CE2C34D9969ED1CE121E1F9207942A5CBB387A46DA1FB000E6F
pd_[F]=67ACB2653EB85B5938ACB6E0DEC80384CB659531862994E11FB644AC5572E2E30030015CC3F640B59C945E1D30C207A6EB78301350C957890B9A8AB5000F4B
pd_[10]=17D551D9EB071846A7922EA468B3BB38D8E87A0103E4046276DA43536AC2849509E1E0136B11A6041385694EF3A7E919247C65C628669C23143A3A8A001022
pd_[11]=838E946833A55022B7D67AB4C1972C845B0CCBDE52CA0B80325B08B96D47810E800D0B88D6C75508E63A2509ADEE26A56A2D05A1651780D866798E500010F6
pd_[12]=89001FD81C296676E3084C54AF00171461264948A8368C95CB8C06BA0EAD3FE47042744173FB1DAA9C761175BA8A07691E597C5EC9C192E160AAE5F60011D2
pd_[13]=F43A0DA70C193C014E5F016C82DB148B16A8B406A9247B4E6281584FC0AC0532E528D4E155C8A2D87DC149F5741810EA8013FA1754879E4ABCB7AA110012A7
pd_[14]=5F248E6498714A887A82D2A11A079B3429316D839F09CA96A8BB70129A74D1F5491110BBE306C1181122568F6067193D3A4B1A89D33E0C40D5A3A0A8001379
pd_[15]=272484A188BC1E530622C6B2D46B0710473D6B3AC58177094AA7385C92B8D54073C1364DCC71614CC13E744EC495ECD140456E3D3BC300EB326287600144F
pd_[16]=E5D46072EC93398472292F5285A0DDC968188077028E1E48AEB1442D8349CA958E8B4D310E1D298F34A3A7977D10BE1314E4F0B710166858D9498CAB001528
pd_[17]=848A1FA2035EC1445C33C29355321A4609720F0693A4767378471EC789D532042992A2C150DA125CF8E262E413321BDF88C430899718A328F160D34C0015F7
pd_[18]=5B952CC2C58C161414B51B04F54CB38E5559381E365EE449F0F130E6B0CB485D77A4E4CB42141C70D2C8ABD098351279E135FB48273575EA60A8A4250016D5
pd_[19]=1A6452940A420B296CB0F4DC23A0C8E5CD75760068D794566AB6C2F64CAF700203152CAB3049952C20C6D6B78158045EF8DC468DE6446314C95A1BD10017A9
pd_[1A]=186B8809D623E88A78D3CD29054A60414B26AEEE23B135B8838CA6C1A18C409A52406B140AAF786029371D261BD7A006A605892A2B218E8341AB4774001874
pd_[1B]=F03B56602343306302A6340E865C225186742112C0B64EAA537C6B17DA4D4D70CE396D9D30305842354D4303D82E51A86192951618E9592A1ED80C42001940
pd_[1C]=62EB056E12A26D4D0628AB27551B1185B702841105C8839B1702C54E112F68A20FB947635CBE6120D7529864A38849F2B9E291DC112E1E981A6440A2001A0E
pd_[1D]=1D64B8B8B02C1AB04897F2038566AC99862248D57B1D01484481849781946A26880D76E2A2931ADED2842154BA5C7B15DE843844D24F6A6EA0CDA42001ADB
pd_[1E]=60ACA13CAB7C1FF433AC121ED425429379D395AF209242511A5D0CC943735C13883652279CEA67A26A2F811C488D76078C262508202207D72C6E8186001BAE
pd_[1F]=49558C0A50BA7151DD58682D49837462A44C0140740A671D19DA76B806218DA97B8581268396828194C51733D01E20EF16A1B538D3B34E24897C2890001C7A
pd_[20]=2803A5370123FA0E2224246E8979C34B439BB610143E95592325B8AE444603B802168F66B824E8FE4104D4D8732264E1D6163A215EAEA8718CB20958001D48
pd_[21]=8E54864408A5C623873D1A1115532A460A19426A5ADBA26386FE363E0960BB9417CF0A86B018A1AD21B070B13A43991234C83893967509917241187B001E15
pd_[22]=B2A7964A7EAD58145466190898E30B92EC9CF060C5099D0C1D39CDE14803E91ED61A60442397295AA722C2D2EC5109A02C0945E648FE025583444AE3001EE5
pd_[23]=84B3C49C44815C0533A38F100C9D47A317BA042A740A263F2EA9A00297F87574C88D120E523AB36A03F3500A24A0FC8730191DA849957DEA2477402001FB2
pd_[24]=BAC8158CA816B5C09537854D26D0601B04CC14D9C9C602064DC9AD66C863B0457A588F811F028C432C992889908CA14CE55C20255B6EA260A395F60400207B
pd_[25]=458C7C9FA1CEE78B06CC210AD99C343832D89163254BC007D082649A320309C872516A496DD14F2F82DA8E70A80DA4018A40BEC9044D1699DCA22E04002147
pd_[26]=BB0BF5712BA42DA59C0017E2AF1C2F511A99B604A8C8B69042F999636C491556A3FE21A409F818C04530E069080D860CD10500A250227B6298B90856002211
pd_[27]=FB723212EE5E142C315068DF240A19F06622920542B8289878A9B7021786B0D0FF43300955424B911D950112A326B2405EA2C0C79CC024D157B510C40022D9
pd_[28]=A80C196B764293D8C8739A2614C1307A13486B65AEE421310C44C40143178C7F20290E03D1CBF0268B9571C0150E94C3E1AB4D2CEDAE614D80CA704B0023A7
pd_[29]=7AA610E058ECAEB831C402D0C29B5D484427835C2E46990121A1932D171E20DBA135E004F314B311B9ACA90530B72F4E128EF505781623223F26E086002476
pd_[2A]=4091D90683FA38496D155BEB92346039C863308B29255C973311E30983A204C211307154B40CFE48D808848C071EF12C1AB02FC08C421905F8942809002538
pd_[2B]=458A43EDC919266722F802EA753E51415984BA80318E886868C416205AFC9906B4E489A610AD262302704B180CC3A3D54513E2B2261D97052122E58C002600
pd_[2C]=32421CE42021B270C5DB110630D782894C00C82C2117B18149218C391498E0013A58350F68E4298D0615382D69E868B8DD2D66C5613A70549B629130026BF
pd_[2D]=20F1C81D8803325D2AA4A088074A15A60B80A7BD1120BAF3E016CB2828A12206C512C9854C61B4CB7DCA48645D90AE02334436703C21AE1B31549F6F002788
pd_[2E]=659381D29196017316D744999446BA506632ABA05A29CD2185C8800C06D0012D240E2926A02C71D9212752617C109CF69ABD2E100F0441D59AD8B6CF002851
pd_[2F]=A20E82B31021CCD7F686991D002134566680841409CA504251BA8BF9301860584E2E47322CD90B5C2D49211C1AF2D146118F736FE031B4C930836005002915
pd_[30]=FFEACDA77C944BE84A414AC4018A84CDD2061104301BB0F4F6B4449AAA705131C2843D746F11C10734B30195E11B2042D48390F180CEA81AC118DFA90029E4
pd_[31]=8681440CDF682A4A271D1158398A109289316778234F61B98A00AD2048309A8D4267874087A1C4AB54BA00C62768F042430828C9C24841DCB0180298002A9C
pd_[32]=CB38759D2180D1A7C01B21363485568CC60D504BB0CB47A89134B8069275101107C12A9AA154D00B9602D518BA01921D031AF7B9AFF541231A78AC12002B67
pd_[33]=2CD1C2AEA16149AD972923CDCAC46E849011610C067885C0E90C3B956805037E28923417147C84CB232022E29A9A40133C384724091D606E44ABC171002C2B
pd_[34]=7C22391E43F06324926FE60F36189800C2034A11E65AD29D13C441DE7CC70805D48809C4F620F769CDD81671666959275428101A7508C33064B2681002CF6
pd_[35]=99A709044C721B25C00CF8BC8649B4ACC510047E2688848F4611E945A34CC724F42AD738226430672211A2C611C0DAA0CD75025B1141306C4C53D51A002DBB
pd_[36]=7004352801B6010FAE50263441C27D64A1015AE052F5042B125176E031F32402AD04E7596D6280A4D09265688A59252ED02A7D0A125E082D02861BEA002E7B
pd_[37]=5023E81D6900F2C2955ED722199D8033042DE14D0B070DE58DD07963226CD4E07400CA1188580D6CD091779EAD0FE0A45514118A251E5E8D228D0861002F45
pd_[38]=65850A15B8DC40B41DC0B164129341622C6C820091AB19020783EF050AD8DA52E0B9C185E48E4846279A6206C8CD048123532410D89D13D793E1309003004
pd_[39]=E204032A343017999B0125311907096835C8F64259303D4CA884771228F4201F4B6A65E6403F5220CB13932585D8219A1A09609053E2B0AC07AB23C50030C8
pd_[3A]=6452AC61854C9640C0A6689504C29E606D3FD508517A72B17148F122CD8852A1672A030F1336085128674105F0005A2144C3D7439A4B4AD043B3580B00318C
pd_[3B]=DF90331728F30A68A1E04F2B0B35902C85B303918A2854D029A1A50449A5A4F1EC4418A17B0B5834020F6B802E6A0C15B4D80E1708BD99D32FCCAEAA00325B
pd_[3C]=F0E1E85B168B98B730E580634FC493612A562CF22406C017B0C954618522BAE2302A72122B86345CE71F8C1019A04E2602802A2C78C497022C0625A400331F
pd_[3D]=84461E0A0027CA0738305C58870880B737D0412348D1051041B469E05617AA21C7140CCCA8E8276F67C90161B426150B02E1B5B51981A8B8A0340280033D8
pd_[3E]=745B5956120632C0B48065114B70AC511E05485AD54838126B8C113292E60A4D4AB0887C4081C18A39404380F5C80AA6632511D4FCEC25441300E3B8003495
pd_[3F]=44B74C593496851E14C1C19C8B65E183744A60BA1309D0AB0C1789451448F185888678105325B10EE428AE284131756CCE581890728CE1B1CAC1940F00355C
pd_[40]=105EB88686516C58D2435371003882D4F3C113D9C692927442AE82F55CB9439E88BC144C91D19C2C83099A2D0A5994A188310F17C81330511112011A003620
pd_[41]=B3D36802689936C0451723CA06307943465B032AF2A9D2ADD3384686C2E09C7C2A1DA2041C2E71C29FA1305704450282CEA899481671E130D019FE090036EB
pd_[42]=A9615623876211508AA132A6669930C38497BA21C0EA63608200AE9240546860FE225DB066A50BE4008098C5E800E4DC2C46F69CA0E01A6B30C391010037A9
pd_[43]=1E4684CC268056320AACBD172C8114E104C0169481759001A744584B0000471B2A6586F3CB82B4E4CA84A8A5F0156488AB8E8887422B181706E288AC003864
pd_[44]=84D14A00E37D80C4A81C2484D05980917C8102A9D6B49910295217682454EA8234806123E0118B543D30C5900B2D00AD1A3421D2098C6FB6FD342C3100391F
pd_[45]=208C94BC9CC1700C54746260E10359052B65258218E429C61D2D32BDC5C44198288D4D41C009498B8847E1364301860F30BDD0D5AE074472CB2745460039E3
pd_[46]=7F0024A7D12945604D1DA42C421F013C86966016258E33500C1CA8C50B52BE0D0E66AE25AA2B1D291A30C12007B6260010624305CBA838782887AB64003AA3
pd_[47]=BA24A4595808444F044A82688CE1021FC32035977A035D01E269C501318C4411C760344808901AA231218CA1E2C805428EF02D5154A6B4D230C62523003B59
pd_[48]=C6011B162E48405305B50A6028A198AC84880D7B0049A9120A8BD180290C4FD4901A70350A33303E78F745C44A03FD1580D092E9FE1C1004911F02E0003C13
pd_[49]=509A3A746F21C8874C2198AA4308E7F10A59DAB4848E2546461B8E3047A2B641396AC4C28A1D48128699F086C323248B2E41744289E31010AAAC4603003CD8
pd_[4A]=82CE84C151530F60201B710C85470DAC976A91A403BD046AD2C48792CE21988E50015C27A19D070B53B3502A9A82F2919009231B2042F082B3CC4046003D98
pd_[4B]=21864962B0328D16090002823720A608B5A451443D24429D992C05039A951127164722105710DBB0D4E02D5152A4786566EC4889741D206001901716003E4C
pd_[4C]=628E1B0058411202C45A83D0C12C48913C0A06D401172C25CD0281DD8B0D10A4F4476BB1C17545DF60236DA1C303579C35962B26A9037066E49A102003F0D
pd_[4D]=904023A88F37A6F00AFA10A98E74A1DC9344D671AD28B06648E0B08B543E41427BA998BBA1800E819FC3C62B48E1582D454365264529360C8917169E003FDD
pd_[4E]=B92A860B82911C28D973D0CDB2529B98C1086BD5C8610B8062AC03125A100770A2DC848818C4A6028044840B8C62049234018F1D28230CC59DA67941004094
pd_[4F]=822D9533985B058D4C14084E46D144B46260E2D385B4343806500C03B88226F019F5AB0179539E99012120418A742271D342C9A58203A8ED758942A004153
pd_[50]=15C62501408AE900A7951D93945D100038910D8217155B230F07A04B36AB6570C4DC5172B6E0C228DFE0B41410781BA21281ADB853F0570D426212F0004218
pd_[51]=564BA0C2734889A400C61D20FA4479E069215EE2258240D0C939321A27DC500555A04000782943B569103090528ABC1124940F1ACAF2C10607A6E87F0042D6
pd_[52]=4B9C829134FCC7F82004C0C4338124E61895B09002CE20DB59E03A0D54AF85C408001B326A68D404224A182860B5B24ACB14606A2715273225599E0F004395
pd_[53]=49243E02F6A3395A64244178D50A837483F42848580564D8089A46AE91A3AD46592D01121DD3CD60C18212E1C780E781D1529C0ECA8A245808F1AA0C004459
pd_[54]=5069C202DF10C343A2CF03AAD8031C57C99100190324CA495506CA439545872E2547982682349E2780C87C7AA022A11A191210320880E40325232E64004511
pd_[55]=D9271130936C9B10D6431E30D8224D81A603EAD38028C2DA0D70705C39490848C2DA70B9F29300D54B5829B040A62D1A20C92AB3A0498D98C54A00A00045D1
pd_[56]=C756A04B2054A2482B700208CA0CD56A1888E175848108EBC140E84C8AF51B512E448C94087C1C9E3132843103446030817425EE8604FF81211122004684
pd_[57]=823B8904400527274B485912909EC8894DA2291426040CE3624D00A88C0359391862AD66E02FABB52295A1966181BD0E13410A2506472348D842618F00473F
pd_[58]=83952B6AF9A08A9414968A572A68B20684B825813E06490504AD8503C317612F8E58024002DB0A064769CC1D0690B2780201F46158900068F2E5B3E20047FD
pd_[59]=A125618870B54A18DC7CFAA4516363514D07904E05439880DBD2801ECC200801D8580C32732174A381AEB6AB7104074F55A3E48302941180A01E2A60048BC
pd_[5A]=B9936CC48D26CCB411C8F51846D14AC13E6908D5428DD5643B3ACA94204C1A3830E1340A1504323550C8D086DE3CC2760662E51E900E9C155171CD50004987
pd_[5B]=509AAC8920064064E4C2A910941143E03F403560DA1C76114D203C14A8861CC6915B9D0C418BF010193781659C122780A2A3004E17304BC0D3894CD8004A3F
pd_[5C]=58EB1D04ED26218ADB3A6096602282A2C926C0666E72C794945342408B801B59418C829501387164E54D6A86C8C90B86A015A5DC85200043CA815980004AFC
pd_[5D]=1C09214E288D622A85E3A5212F120EC092821467116106098194ADA28280CCA960B4C306920E940415029C9D813A2C9631600D9B2029100313042899004BA8
pd_[5E]=60C4D80E982282212AD266C7B8C8092E99224BC196752833E04F272AA80030948842E71F10487018E02860982D8795040EC0628C55A8FF3C0A2E7034004C65
pd_[5F]=4BF0370C8C9C0A9B4370004E216B78C800BF4840205AFBB206E92059AC041CD5301842E4F8A2D00842738800A078777A898D52E7C723C62B54174907004D2A
pd_[60]=CD490513200BF008F048C8641239094C3A2231DA79BBB00260D0D91C9ABA856322EC0250458548194B02112633B662100E1B29C2CCDAC3C04A08CC82004DE3
pd_[61]=C842884647505C64209A6AB50461521B328590374D01CE930602C7C158A9E03DA60B61409464EAA824424D54A819C6C051965310342B92CAACA63241004E9F
pd_[62]=4051DAD13E19D3A10DC3C4526E4059A12828C86008C21050095614CCED71D39D8A2D6800C931A8D7499A084840145C211E7514051AF4909C88C58C25004F5A
pd_[63]=8A8F00AD2A8BC4A1268088750326C40796D39626E9015567621218DC06036C8FF536A036AE1E3152853C228A04DD5AAB3612006261C33BABA1C46714005024
pd_[64]=624950AB30C2600813084E568D42341A2A2A2C642921AC729A2180100A6889CB8C058198CA346E62002A1228EA5B614D93604ADC738422080982494D0050D3
pd_[65]=54466D380E040890CA06851D00E44D079DD22A19A3CD0CE849848B21D945E20088D70EA11BF2B28B1121290CF06290022610F311D40E0424079026CE00518A
pd_[66]=9431C08662C574029151010880246492A7908A1BF00674864C1029FC00A6C9D7129110491586D046703C1C104B014A32720C2250C5B0819E0C421B01005234
pd_[67]=34314B523E5A2558231E46308CD4414A554DD1047A1C14C12ABC04B0A415434110E3171B414913B2C6902211A23C6521B2AA434EB15D83AC1AAC7A00052F5
pd_[68]=268B2E998C8820CD1186898656012792763E22EB412439AC0F1CA1C86550C676A85E110B09213AD5107409B6924429D6844A8AD102D303402BA2065C0053B5
pd_[69]=B820C566998E26C74892ACA772E8BC158C446D5180954888944B4A199003C632A3A09F03E1D1C108281871C1696A9808A880342E00EAA2622D1EC901005472
pd_[6A]=4012E045125FEA00CF5B093984E3A2916D0C102465382638BB310F104414F420F10B081A74C868AE1C60F91C08F2804C96E008F1188683A101601A7005529
pd_[6B]=22FC2A4550861B26078D5108834003EB69A5C32CC826A9D4584391619130BE2490CB63315B589E0584AC31345A299C0D1FA0A69024D23D1C290A98520055ED
pd_[6C]=8410306936051ECB72E828A8438E36F35A1137C829760813473720F667841040201A02C980480A2700204C2444F75273110AF15448AC22A40744399C0056A3
pd_[6D]=243CCD5343A9906ADD512315CF0AAC34517C0DD85010C8003886109024D22EED03A01616C8208B288C208D96542269D11252DD81100A6961C6D8CB0900575E
pd_[6E]=30A48A90013D326C28A6C1748E935E040728C13D986420ED728604684402F1BB85B14E68D33C58A791C4B8DC88191840444304629A8084E143922508005817
pd_[6F]=6C643BC592A988D36A11D9286850996F4182C3C28493F101C009E3244910489D25A0728D29B930C26891652024452467009304431215852D888F30420058CE
pd_[70]=72655089BA0C455160C3110F3C818D43D421480604EF20422410BCC46C2023D23844C692FC8A0996038A9702120602E97D184002557A8604848C5217005980
pd_[71]=2133A47698194F442841489A8822303C96878C28AC5D0A08A64D5482A32507EB8618445D01028108B4C8B420F25750C406BC228CE1141D0030109563005A32
pd_[72]=741738CA5269900E40E9E0A1B6A32012793451D41647ADE0204B23314602460284EA8A98050383D2CB0CC21D568BB1D00C5802585B15372C05CB620005AEE
pd_[73]=923EAA32D45CF03EFB5A4E3CF46DB68445C643AE90D8100511B9A55E0C6861805BF468620410783068AE207A42405316BB3C732181053ACB189A7800005BBB
pd_[74]=86B4436E0870E1183A0B42002C64E484631193380A0F47C2D208317A7A1908E3638E05E288CF97B5A10230C081EDD08410008039A21A8912094C0A01005C6C
pd_[75]=62E08230DA7BDA24F986F41408294713094C4F5193114481B130C604D5921436200BAA94360628551D05A6A4025234662965849EAEA221D4912159A5005D2B
pd_[76]=9D7CC34526D502238028127448072045532B2E33AA4849470D6C41062A823900B590121682210006858EC880B0A3515F20FA4178C801C2E132428111005DD9
pd_[77]=2B40066A04C458B628BF0361220C0B0F4614C8DC051AD6091744742421C3EBA98EF1201282A0B246690EE198987C638A2360542523E6030B5244E908005E95
pd_[78]=60A5A408AA0200B1C1BD02098C4083C7465F02B126429F28F80FA1104A4AA0151AB2438E118D1282025E144870781315C1C68D26800D81209333456005F44
pd_[79]=6D58A609BCF067AC8000F012D39587A13162205A2822DAED6531403A13EC09778B60D4440C08598C47395806470A15AA4930116280B416286D556743006006
pd_[7A]=D121D1211A8805867C7084490734F1426C240684001290034CC673908279903C5465147003BEC0129E000E122774207682E800688F9304D8A6E144AE0060B7
pd_[7B]=54698105014021408416619B8C80041980BD15A2CF1A0B9B10F89004042BC22854523AA44A242814C84E78C7FCCA3541D1A663646A2A48423AF0A27900616D
pd_[7C]=30171E002D3C0D183630D06A42D1D6010852C220818815F0C581102AC04911A0380240581B42F1BA0B6B15C32019C010024214BB25690938C2E31EAE006219
pd_[7D]=38369C08432CC50611C1F87CC0AE4AC1D86958A001932C232A213DE92B2032FC02162F0053032C4822744C4A4C29C9E119CB67865D9EA263046D48150062DC
pd_[7E]=528805C2D1CC32DA0104702504A64D2285E9B0611A4C86F49029941A225C062680DA4582E008695990A0A61D13080394B184E207D3034B016B840F2400638D
pd_[7F]=200050E460087B043230AD493208641C1E17438D31412EEB84208B50009298A850B40F3CD47350F6310169AE81402860C294435194D98010125CA220006438
pd_[80]=99086C8A86D08293093D940258F244B1501042E8044C444DA0C1D82AC004F31CDE859A103CF03C7830016C022E74C50464520C7225E0B7D7A09A841A0064F0
pd_[81]=881741CB431204553950661A02146558E20C8184E478832CF0D83048235125A0E3328050101A98C4C527D2194E20085084E0C3A621293A6E0151195100659E
pd_[82]=EF680A2122B00024DD01A3384900200BD06CB8A348C17028E394570081EE2CC234C8811E60E54C031A511E8C06A60E94FAC29CD83CA00FC22E10465D006658
pd_[83]=79919156D350854890732E999CCCAA40C860B21B104DCAAD411922284A891353C3838E8F41CD02A2F8D57A402081E21D187D5E95644D70C95220888800671D
pd_[84]=4CE24AD40784078AECD1D04549D05800D22CE5A97229B3080F408CD550C0AC9082540574888F6300432BA2890BE25F87360244D50006DD0477031360067D8
pd_[85]=B12D630A1A071BAA22190EC710EF404F89070B424094243212C93B710A908877B0881800F538829502084A3495002109C8BC4342E414112C99809EF200688B
pd_[86]=C68074C7940303EE004288A24E8F20103788A5002AA921305981E2A83F98444096D03A4D68227090D05E05403C3831C24070227092682941C1C12C9006937
pd_[87]=8A702C04FF334AE18805235D1531AB7685060014E29CB8C62602E71180329B1F0505302193259C09CB961502109745C98B5ACFC1013333710AA0044C0069F6
pd_[88]=A2A249321C331D642C292A7042E20BC148A10703D414CE173629592C4D4082AC2298012A95219419542084C3511B402B1DA18930A44E06A820F75823006AAB
pd_[89]=7425EA5053C0441552C08CB7762C75C45182008DBE064412617C0F6A1907F14409C19A50ACB807C126A4083348AC43A26A3A0DAD809D9A682B020F1006B6B
pd_[8A]=6158A00B65055D02190469C8B10C650548926814ACE18E046C78C5B4C5A173404F400D707E040AD462AD4BCA60D9C284519149E616B814083D642AE3006C2A
pd_[8B]=3E8E0023A0A00B43720878A531554020F5110113B39B16A060D70039401BB44304199DB0EA1602A037C846AB0244B51D4040632AA697BC015B530809006CE0
pd_[8C]=F542624438C49E8A08345C113674A100B2A75F8D42C61836CAA128A718E10D68CF68E0854E00A5E22CB34C8841065984045D0A05C01C26E45181C30A006D9C
pd_[8D]=41924A1733DC22324AC85135C4EDE19B401E7929839240C025037C83C48F820060606E709D93B80C92C0013088018244BF3331421A0D88F4A051D38A006E56
pd_[8E]=B0C83E704362835CCCAB8092C00D640D47B16AE0C9126024D0126BAD2479244A728110842C781948F102444B986808E0806A272B8970A10181AD0754006F0C
pd_[8F]=2C03C0317CA530001C948377321912883C34A5B90C4438909C28069C3EDA0310530B965169A155908913248081A53A61C44B1B9B2623402021761825006FC1
pd_[90]=101C9100ED658D1B4A009C3A80BCAA88D1422416D0A1425A83244C408814F9239AA12824862BA1EE144BA16C852504A3C12BC1C1A44D0A02A5489401007072
pd_[91]=1E90104551952D20968A8E34F822366A27693CD082250A81202E9E8878EC88B0401A119129E021A86B4A11522A41B868306109941603C572CB69392007129
pd_[92]=42504208824152215A4126CCE1A0830204482D025AA49194010F84410D4CEC8735ABA65ABE64000152194178FC8444A885AA58C80EB0C30491AE495D0071D9
pd_[93]=A49A039904A8CE54944A8B620013B5B6034A504818E492113FF50A0ABA20950DA457922030E42DA0C8518418880FC376C481102421BC84E1116E664A007291
pd_[94]=FD00C10918825C4E007CCB009095585E36D0500A4F80D791CA462CA403991088440A39C4E06101AB40704C511360C2E7C858271DC05053ED0247C440007345
pd_[95]=23F67B55544605648F18D0708A08923520E93379552D07386982CE220401302C340A06844229A93C8E52C8D7038216929A42100B043405318677D5C0073FF
pd_[96]=2B144062A865E1013DECD0A08916E6862400A8A56FBA607410A42D4CA084A8D328E100A280451341B4B3E3C087EC1019A12389020521C0DE4A83E210074B3
pd_[97]=8CEF89E8C09C940AD8BD50A858A3210807F906180141918A110670070899FF0127AAC285503080A94296E009FF95548010D3C095985826027A3013500756A
pd_[98]=94811CC820830D35492D061235308973809B0441192B028A6CC8DE2F4650E9A29004B4E38910A0E846C8B1ACE141C8061124A2A4A74670DC715010C3007620
pd_[99]=38451912333EE45250263648200484093B2D79AF6008785C252B20D58C4146C006D622DC97B05F020B388621F5C042BAAC11A96484B86ED0143093320076DF
pd_[9A]=1016A008211AA790F23BF0B2FD0381016051E10B63458A0638E1101B52E0A80B201260C09040AE48A25E014045490D04431D95204800CF1886A29292007787
pd_[9B]=953B2386DC00189948A0084845001352A80A644CD412706325181AE4C930375180C256B884799D225253ADB01178C2826A66808465EE13A89C0183900783C
pd_[9C]=41811482005A6A4F7C368066625A0B4AC429B2371C101F1918149D00095C72CE9C04F5C0606F8420098808B78F018363D0E10000321180C0D03224400078E7
pd_[9D]=914D1D21040BA22C94CA243A5066AC8C16AB184A3A05841C06052B46990E186E14151024775D0A88E1CFC9603901A33C200738C6CD254340080F8C9000799E
pd_[9E]=662D34A17088279D351995B521802DE500858021D139CA481D332A1795F2A5208E9090E0801611AAC02C4348638772F89B05214F03911525650C1196007A5C
pd_[9F]=106400D0038051232E808E82D0B603A0054246220F9059040E85882AA9158281C180D84E144CAB6C928005020E9AE0B8B1A4965A89B4882610A2405C007B00
pd_[A0]=419AC050091030D4152032928238675661DC858B41368300010436C105820415B04EC29322B8EEA500000251AC29452AC2B6C6462215D180A9413480007BA6
pd_[A1]=A2652AB98F18CD50A0612028C1885A5401A0258E80127E43880CEDE6081490B070C123A3D70D54725C6700049152C1B2D019CF1200E25A01E648A56C007C5E
pd_[A2]=943E00588404D00E0A4528C4546ED81430128139A07051A941E39825E0A8F20833E5982B1EF83471F1286D0709B2C6CBE2C08825044470282E33C008007D15
pd_[A3]=3A2465229C1855A92E0C505128106A9A825B285904CA2400828A625A9231445468E56895000A6570714244B12C20A4280A5E0E0DB762C4A945731E05007DC8
pd_[A4]=30D2562CA8A1B1CA882128036C10A08223B282A0E733221F4159009303940CE50E461221CD6C48538A8B025C8F214636000AECA86D051D172A2A20007E79
pd_[A5]=82C61044D4A0602962E746A5112901F18385999A0D8C2E4E268303022710834B02140142E111E82C600C84306B150A1C4062F23530D37318B04D904C007F28
pd_[A6]=60401D64F70C94A049E421C34E08312BC4749290A0952039606319384165B04853E04189492793C4551A8C632249B2961207574E0C13696C6197030007FE1
pd_[A7]=4C0103E07006202A2CC8391642844380960C10528590874E904741253A814302420104E8D074E12348A20738DC3872476013D6CA078852191C89651300808B
pd_[A8]=AB6224A02761C0FD5200D66CEB114234AA2923450579750C920C49003AC0709E514A85B8A0C387A2151B104BC4C08050A87E40093903133188FE08E9008146
pd_[A9]=8311151192568640A5B21BF56D11E4D91A2248C45B5485241D98C84B604428203807DC942A865845A4503D1E18F001D4894A15F60C60008253791675008202
pd_[AA]=2CE240520BE40AFC841E44D118E420188F0504552622C28449452924D10FA02116364F2323F2E30708163A0859458338D4B4F2168CE0E921DDC071900082BE
pd_[AB]=3B062A8C308A1715151D90740800008E8917C468F9020D4838C25C1942EC20B248D820A82568600812C89641514059883AC418036A5510E25D7610A600836A
pd_[AC]=6478931E814B684003D0CC4673165A9409429A228B8028324D0158697049F26485B8A95517009478573C82AA118122341F38290A0388F618638019C4008422
pd_[AD]=8B10C47030418988C2889940C01694327140B146405499951026608272800C9A8C3417210200C8A6280AB64BA1A414454C9843898CA43003AD3834860084C6
pd_[AE]=851CB0391029E5A621299340C2268E482694E85201803287251AC202318517E038038805F0AA1FA018008AF253D1010519DB1A2A4C200784CB5C0D0E008577
pd_[AF]=C47C4048C439980D4085C0284A128E2B04A3A1A4590B6F520710934F206544388528F6A11200663629EA80001DA06801308000409E6B0C787881911D008622
pd_[B0]=C4162D21B692D2012C0A547A545610946BF0C0E0544924750A6464A6E035B0A9922D01ADA02045743AD54B6B0688089102A2004A423880293229805F0086D6
pd_[B1]=491648D63E420860122A61D4A264782060772603785652316C20C2CC28821D2AA27A62D8348D6604826C09C4B458168F40CF0844A8108D13952D0B0000878B
pd_[B2]=4424C0080146541D1B263F229091C0D01884841080359AB3820345008A0684B0C2D725594B17AA84760402B6085DB990C735A0C970C484C50883A846008838
pd_[B3]=E08162F699C4B45498884702100C84932BA32B45222B0C9C90868F869FE4D3066444478C9632660E88F844136558B8208285722430C8B582209866C00088F3
pd_[B4]=8B8A6663D413308A264FC2116A0E6498D19103C0D494294BE43628013A4520068E9040804224160B04979933BF08402978480BC093002D2BD82320190089A4
pd_[B5]=891B5F63A4230480320B43014F088070F428168109EAF148DB67108212B8520B9940043E01B095A33B4E7A944A051C70300884A6054FD92A411AD408008A5A
pd_[B6]=1C808282EE8008C214B447189D288068FF7240A820A40121880D3F4335601022AE84D48562850204B6562B058A8506840F03C6AD01700130D8263489008B04
pd_[B7]=C140C43B0D7D0390CAAA1018D6A094468402D203DA828D574D0129F491019D109E984D02411299834BCB290144AF35A4B0165D3A1922034EFC115078008BC1
pd_[B8]=28C307C8122091F1858606E32C404BE74D821C422E2012019582126404C986082D900332441C33B32E000A1090320A4CA318E16832B70B054184624C008C69
pd_[B9]=A405C8D7C9D19A86C807926CA1335100850430042A91B11280BB0E005F529601180890708C700DBC0501F8F33A3072810D08BC10018C80B604BFC869008D1B
pd_[BA]=98A774C78906243C1D888260435826C18946C9A48A818CB265C282DB5365C9F2740900D6283A8094901292728004014838C03D32BBED1871A01D11F008DD6
pd_[BB]=5349544478A0298265006B40C3A2611CEB103102C313228F91487E51A818ADCB208E30C285281C835C00C6232B24E61711D15955852183BC845D68D2008E92
pd_[BC]=10CE21F149009073A448065883C409A48C2CD1B081556204F6C2BEA8210B37096121CD0C3C5C9C02300B35F415ABD9090C7048162C0494E18DD54256008F4D
pd_[BD]=CA33811424A1C34A891F1143155012916AAA810B020189212A2411545014986C3A00416B70E004B1608568C4503B0D5810B1B80844549804F45430C5008FF4
pd_[BE]=3A903E98B22E0D83222298262B0F34003CF4784341D41E28A459875081A0348AD408A9E0A55D145C62923D124458B60A6811510449652042018E69820090AA
pd_[BF]=12123D51AC0354DE29F8688BB0D7B008888FA97AA4C800963C191B154061858290A96B97250487782455140F1380915044B4236690930900E1108D88009163
pd_[C0]=8A8C30340A70B60C189528004452D408165202E40F093450DBCA34C410914B4445ABC16D88C01E05E90047C876281A1F02C557D4013788CC210CC752009217
pd_[C1]=9422A0EA8440D622F321603281940611509BC94022C8074B998189492058924B3882500B8980090342A40869416C4945330E0E816430283032A02D140092BA
pd_[C2]=152AB507C996AC28571B0195AD640210A52D101DE84A23D800246352269E2EC470D6354A201F102447F446841515107240824001042B685A01205CAD00936E
pd_[C3]=840990324A1F620120512080D42A9458201C06B094757291C1A8A09ADE2A4868C4403092234D982019C801E2321184C737274FE502A44584DA860AF100941E
pd_[C4]=290A4E27461E108583606049461C2C80C1451C4A90A768868104C2E8A94CA90CA3004438B4F260E8400282036126E2166C8CB24220C0A3020310AC820094C3
pd_[C5]=60A486E52543223C1C56918231C016438504C3CB96735603A2612610240C84230710254BD498908A32308459C2847312D0FA1CB909DA158748BA0830009579
pd_[C6]=50CB6800321E1305678CA2435070091805ECBFA59512097011488C5A94E4C26040384C5B000429E806007D4438104A2066602214F544C0B41C0A095F009625
pd_[C7]=2C4260C482600015D2287290222238E4483D63261288C2282C1C7E346D10D4660059095B4451400520756140688494AA44AF9488010B2101A62110030096C7
pd_[C8]=963888CC3F09224B3620CB2D3894AC30926C8104EE11F40508CEB42D9651005000C088522D58C80103711DB422E5A0EA14E83431814214C04B534102009779
pd_[C9]=A0BAA20814501A2A26CC02345107D1AA141326806564262221684142940284A0E0331BA00C2FC452F88F68BDA92143E3DD012121A61AC8195541A10500982B
pd_[CA]=23E550E2919AD359AD8A09B264411306098B0168DAE13A1682A907BC06848D915D576303B1B789920919181306921589900DA030720304450F5008640098E6
pd_[CB]=A3646072420B03745CC0D07046443E15E425653793B0249712A2F49B103E888262214B0625A2D0C34632188C844128A2E8A11A9D2422A8820A20A90009999
pd_[CC]=BB71C994386546841BC54C45001520832C212C98260EB20E022CC401481AC89954970060E7980D86102CE688B092A20D5768699264CC4C06C201338B009A4E
pd_[CD]=9D132D94771C72408D044ADA364E1BC099015C1B62200517D7012831532303A140D968750388705CB2108A4295A21AD6259974A5980209B801146420009B07
pd_[CE]=C289271014C504895B6A189C0302C131D3905104230AC444250088408C2BCB005862B20886A546270EE001C3203987304841B2088A1CD46E5A1166AC009BB0
pd_[CF]=36151D5D428000C0D61A87E3C05D03584AA4B700400342A648D490780B213930DA580D802017121974CAAAB90CEC920AC278050B1D7D9058806D82A9009C68
pd_[D0]=AB29E732D0C80AF90195EA985048B98A0033845D9011020DBA3908C21DAA90A84892114316880F0088E39EA5A550AE94E9081248A4B1404400CD2DB8009D1F
pd_[D1]=11A94442080090805D1824032E9024070D4623448C82486A8C78494541143111A7184F8B50453205691A90A3298550A0F9C130A085044045858584A2009DC0
pd_[D2]=5C240B2241668042ACE0AA51D88103612D028BEB9253093A81A13B0AE69026532288A2CE8224446801E0108D124503521064406D1958080201A0E0D3009E68
pd_[D3]=6E611027302A2ACC8C54122B09518A640A85644853220E1A1675302EB8508502443720BFE21B73C2F0801505D30481D02E8D25CE50E43A08012FC8E009F21
pd_[D4]=E8344110CCD0B41690A66A34078F840D019BE19941883A500C4C04CDCB8919802C14040CB417B7232703084206173519290EA0234CA631C4CE578112009FD7
pd_[D5]=4819B22208B0D68AA2381D08D81E882672048C8E868025487848846C157C39FB210C6A22005944408BC2D0355B444448C60ADA4010D0720000050CF400A081
pd_[D6]=10830405DD540901A6F0431288180392142DA6188469B67054512BCCF82843B29559C9A3085442EB80C710420D98430130F6D371C69874610861472B00A13A
pd_[D7]=4D1046209EBA01A163250C70C7207C30A0826090588268A809D702083954460D5A3608533916D4A1620249DE62011533904E0CC240DE5486221428C800A1E8
pd_[D8]=41B6E85E2282ED047763A491A205E330082520352D14C618C6502BC91E82E4A2440E490AC2044A0699FE5A584A194C8515190C8CA090B6FD20C3602700A2A6
pd_[D9]=27004826A97922544B99014E0089090444C084D497011644CC980685C81A540048413510281885CD84C33212044F4280A7810958A00521416A11842500A342
pd_[DA]=580340F0466A9CD82896A58934324F47018A3196D4AE70395B0A31C31A20206E0B2C091C0660047394E8441530F8884A05B1CAD0530E2E921405436A00A3FD
pd_[DB]=44810AE067095236202A6B0A18CA142E2408F041448F89A4001180BC747210D08A16CA505A816079122E2A7152685122FC0A54092C24A941000A90A400A4A5
pd_[DC]=43C01B205344755888985EDA0A0CA5816381A21E1E9548AEB8A010A4CC609362230803289190C05BCBE04514A40124094C0EA96531301164C3192B200A556
pd_[DD]=A898C38AC437785A708450804942460101140604872862858B28550405920712E646455B1460CD068956A7B098832B2403A44026A864065401E3930800A600
pd_[DE]=10C01000434226DB862BE2053E40149E9008C911A8C2A3949211A4B3C1D90561181A00B5743D12810018C382698354F1644081E51C4B5B6921B6803100A6B0
pd_[DF]=DAA8A094D758E8881FA2025D6462C2A62040F5628EB84332855D126D0C4A77166F04090C30822AC14D828F860574E2A62212040411E514240F0221A00A768
pd_[E0]=612A231458772A043456700CD2B2205075E40C47088441827C5DE9180819305240E1363009148278CAB1EB23208A92348682A000F700063B5B81F56C00A81D
pd_[E1]=C8464018CF213995A490DA0222FB2D4110E5E134528823E9220278D09E8C114C2106436504D6233200033B2EEA1DA0211008550E258A135D2A004E8800A8D0
pd_[E2]=BC0424E73A281C9B70091148C29105362902E9C29C99270C529038850102A180458012910D840E9AC847516798908249C461419B0260B4BCA8B0481B00A97F
pd_[E3]=CE74498A164A4C1F4009E4865C311827B500C7AA3302182C27D14241650E262C7233B80901B0B61D5080096CDFF229D0C34014334040B000F404130C00AA35
pd_[E4]=384441E0B53200B2B8720080B1A023D4805942229430B1604C2BC02A494C1C80D4182058E8A1084162F30CC0544438CD304BB0060B7180B1C03638B100AADD
pd_[E5]=D1250A38A4690450B880889EC28AB4D41A81E097B400C82C29C3897516A0B06099627B2A004237003927A5448304B88803920B2D0C9A21863E803E8700AB92
pd_[E6]=25060401C058541D43A963491122B11EA0C1202C265CAC13286DC025E140F34984E50DA4078D4028A14B700250D5DCC00109183B1598124100041EC000AC3B
pd_[E7]=808D00AA54943C14CB0865D000261688820D4A5528C02198046A8286C94008241F3963884848121830B3882A1614112B2E75C7854A885C841764205000ACE0
pd_[E8]=603E3C986114008AA85822F1C28642056442080009941A1150A4169260A63CF48A6D23340D7947258924830C649FD1446121F4AE980D0E478528C9C00AD94
pd_[E9]=8E014303E9C0C58914F95311210080204C89E028499894BE008083C8180A039BA3419407A4FC0143101B80504D69C66E00C20AB87C34414C1463C8AC00AE3F
pd_[EA]=541A5238E0001A96E8B18C04200864D11564D7CB6839712105043113B03A8B088743FB091420D660A4C9929096050612A0800C3908C78813F00B948D00AEEF
pd_[EB]=34438A380264A6F212929879024690028696110C3000039041380E9C001F63011BB3A49EC00B32C47C0641C0808463A1ED32B923F448082C583DA11000AF9C
pd_[EC]=2409ADC21469B0020D1D044482DA414E200201547615C9910905400087D50C53890C342E331640279B14240C8B520138E8439C2E1A80480808928A2100B03F
pd_[ED]=46E6D85C899393C20D44900741325183D887102F40B08D86DE0A56092B2282A4ACC83A538A6122099CA028C68A2060180948C5C46B2209996A98527700B0F9
pd_[EE]=834C50B4CE013068367C32B002E3C28C222432315240694409360E152CDB0C0338D20C46A4F2D8112B08D7400A442390832D82F02C88C60B0854188000B1A7
pd_[EF]=28102D18619982D0D101A630718A48421D30CC98979549C2D39802A01066134A2C878DD08A400C589CA70713812804E1069AC00390504958C448049700B252
pd_[F0]=FA092EB9094689018453A1BE550640848CB620294004C38014C1356100C1060C121828A21B2382404429B8B400AA18F03E974B51C2C74A180C404C4C00B2FB
pd_[F1]=18A0B1258183CA0A244445623D35C8744008498349A28A2CC285214008D0E2194DD908C1884A4CC30B1007064C5A00303000A2DD93299051EBAE9A4600B3A7
pd_[F2]=28104416900BD9D080A0D07B428A9D222A4B1881641FA942402833A07FAAD974F02AC250434A328E306065C6C0D6B761290820E862222FC31243246000B45F
pd_[F3]=20B0580D098F42384084410A0C7918787579916106112692ECE8D53C026C28ADC0798FCD0818A1212010D4A995800286451090200280B480090A16A600B506
pd_[F4]=46CC2408C606001A46B370D959703E45926B3826E026025443E4271280219200F264854002828D52E9F02F0D47064A5160E83250B02C8AD810C4001400B5B4
pd_[F5]=1C1BB9A15112A322F027AA84535102BE218103869340AD4060130011C08961C23534508118904145DCCC6401BF40017F140414080E51AC41A491243000B65D
pd_[F6]=AACDE383E75020002582A493AF3D2481143C575C8D26E0AC0BCE0085112F00803003BC670C62879C2EE402E90451182129648A84144119700CC8022A00B711
pd_[F7]=C13AD2101ACF38B74861968B9210F5122A10E420B1DCC00C2821F542D65878C420CE0280188838A0A909839C0590A886A18748951DB0081646BB424400B7C6
pd_[F8]=611F0268C20E2C50080CD006EC929E200646C81E08B0035C8048CF045118C4349419AB2330E620A85000D06DBCC421A1A46498044C42D004860C3C3100B86D
pd_[F9]=2560864B388928211B848AE24612600AC000193DCDAB91830DE4864B81604CE001F496852404F491C9941D4811145794C29B8C0A581648680600F93200B91F
pd_[FA]=83309A88BA6671EDC4451882211ED2031009A308350580C086DC8B0251E222E6A182DD445C1909F0481CA4090491A40C4D6C5894C4321004362914F600B9D1
pd_[FB]=8110338C2C311E429294C36290B08E3022591A336A9063435C701A31902A09CB14A0CC7298E917104E2416002873646820B2330809803093B015D10800BA7F
pd_[FC]=D351A02312021248091C2A55022867402B48A08CC79080CEC5506D44981AA9945CA901202F09D18243824AF17864290A118340B2D11006200CEC2D8C00BB2A
pd_[FD]=242481DD58607171848E4194C08840AAE1362130207B75F02517B026244D7304A14508C2318562048122707AF632C45A3A404660BAC982BB0C22030400BBDE
pd_[FE]=8C008EC49C1440D162151E803027A4818363204893412722C2E8A25CD2A1649484C7625342EC24EF116358581015B804AA36AC4F26071D6B0933AC2100BC99
pd_[FF]=10C99420246591A7040C30B10229C8444E016C9630A00801837301D05D81424FC4302E1800910CD2351E0608060EE00C51990220C60E21CB3B09300200BD39
pd_[100]=1DC2A815DD4C2398230E263B8D2C50D2682CA1529AD0040D9828CE2B49292CD840E36CB9082E2013A25345008880D51A0147C092705615026114A64400BDEF
pd_[101]=7F9003084C0053C400901CC3410C041CAA6A3E90CC6751ED70251C365023C4434A224B101E49D03619C94135D044CA7A2680290CC44185480290018800BE9B
pd_[102]=4050E366150E0141030D1A2C876002BD309D9531084CBA9E0181C924041E011C801C8F244F4C464B050E8AAAE041A081841842367588426326B452100BF47
pd_[103]=A41205B24E1E23DA8F320C0054CA04C88F0512908C222BA506B406461601DB2684C28C4880F081201B9B830959212D00D8E4F0804180E15591B020600BFF2
pd_[104]=99415099A2EC82996050A5C6214A15791D0E190B85B89E00A580AC88B70E61244841300C1102A4921339A55A370110469D80D6D03E2560808479115100C0A6
pd_[105]=4708B03127412A844E176514E70160E9851206072232E1C917202200006A2690337FA2EB0D4B242909501EAC485442C08281044E44231C41269618800C151
pd_[106]=410801C02BBF0160A91F1974DA1E1E829035C440BE004E81354545806486025B007080C02A1E33D151524DD50228009200E5F11B1A3021D0474801AF00C200
pd_[107]=130C3814A02EF9035C822A6D708A6A95586982C5980390E072BA4811560C3C43380071450E5D7941C60032491D2C018985BA4312B8020B94B0180A0900C2B4
pd_[108]=E1C275E58AF512C0F340210A2244887C4125D14C0090C8C0510130E2C8A889138B23DC9C8E4C4AAA067622052AA200B0A911634C08042081E00DC48800C360
pd_[109]=860A024728020756A50A601668023125700CE0436319194438E79408E203973666CA030240E0B1302658F5091B024D18A100450103174CD8303425800C407
pd_[10A]=C4B20C300B04BF298C670C0E9249D859B9A1C4228449119074635E681905312115CC174D50E130698042907025480D02629388027CA56E33C164C21400C4BE
pd_[10B]=D835B485205CD420002C14290FE212008CB025B95331820A0502067005D021C4865170F3F16001406A0F31190E74899780C2A6A49CA4D0D224A3903E00C56F
pd_[10C]=9370941368001C450A6D444B30A11D01D290C6B2216A2921872AA649A81BA34B01480260DD005104ABD0AB08B280DB49410600052811A75405AA10C000C619
pd_[10D]=BE2A608854040353634A37B0240400202C8DA8A88545008B0464028CEC3B1C5C0083049CA1078034E73233862403494C11214A939416D1009804A9A000C6BE
pd_[10E]=C2832C260D289000C39B930052AA10090CA12328C92E06390A2125A0080278EC617309281E206356CC22804EC0CAE3A12A4508F09A69A16CA040D23C00C76B
pd_[10F]=9218177A02860793025C16012076829203CC7204C20E0880F0C414360A328A8BB441046A70208C252A96B883FB402A060200C93A801482E650C0091100C80F
pd_[110]=29F1058AC440406099111065E094088D0D2173C9A13151CAB820B8CC08CC28AA3858208980828508220CF883160484AF8E094F100144403504C29A8000C8B2
pd_[111]=A4483C2060C62684E903023A5200D5E3CC361D1034A5E0A40F0164D1EC6206D60D0419595CA37C22B0C812370C069F200120982117C50B1400CE942000C964
pd_[112]=8070061040B110A1D342E44A06D38E1C0B1C175A4208850B5479645759055208A834E80A028FC9A00058692E00057E129C44285E04A81900A6112CC100CA0E
pd_[113]=26A51C4D031CEB582860A9809A0039252C0491706D4E1088A806BC08300B80D269A56188058606C943E84D35095A101CC83109860AA11CD2337C53A700CAC3
pd_[114]=73000055BBA4C1A714C702A021431A0F80826E8060D03C6448206212020318C0D0310105163800A4540C0813591405B10000708A05A0788FE910478200CB5D
pd_[115]=2E2A069030380C9B66F4C2C06101A01830E25A671200925222B020B0B6300475A5509D00981A033A2C380304A50280C1062767882CB284B9760AC18000CC06
pd_[116]=806851FA40A18A0E2F79907911270A0E9C0010463E0F481950920D9A20C00610298980245A5CD1195863C8874A0C05401208A9E0820A616000216ACC00CCAC
pd_[117]=14404050D3070E600216A901074F880EDD00C284A850306D158220AD258B529E0347A44D522A240044014150358B6E1092E27941E2664A6325C3513500CD5B
pd_[118]=2FA102C68CAC59010A02515336808008205807C350D38A66C02562B65224C1981B121A5CC30CC94E18CC5095185CD5418069045744AB09E1171F12D000CE10
pd_[119]=180898365A636864B18458444AC0F4B408C00410194CCD10704091091A1A4141C00052A018540894F324FF142903EF03614F364721900A5E808105C200CEB8
pd_[11A]=394171C93197450200184606883A0181C21081C4BED02662107F82058379BE0580E260E6EC1C47548103072288820848F6CB90C382C8D204001C690C00CF65
pd_[11B]=A0104874838080107281E81B335644880966305ACDC82102C24394E105A224ACCD0E432406DA44F2A009A41284D011E4CF44222C754B1E1AC028D44A00D014
pd_[11C]=8EA19A154356C0A701144B12085122041603C0A71151E626488904DA4881A00E8E53146264A0802A8C9B0679403D0414194188B0BD7162400AAB009000D0BC
pd_[11D]=A0DF0E55A0100D34D8238649A29528F512C89C24698A043248CD8A76145C6544C0108D2109502E4408790A56C4354C3A421801127876A6011454492500D16F
pd_[11E]=7E1182390A620C6A58820ADA2A280C09D64634621058308D24B05A497C440182110C80D803430722311226002CC4B804FF090A8A14674191ED11D01100D219
pd_[11F]=C4AAC626F113AB114A0090E01CD104EBC2EDD5318244A4350504C482621CFA288637F102A58389084610E20FDDE900420C094493618313A1042660E000D2CF
pd_[120]=47C932627817452123220605C940070E1142448740C6D14B3A14032C8433E40084105060B30C30EC2F160C3100904F4A1A0441A93A88740460AA805A00D376
pd_[121]=43F400C820BEEA0C11080324D9750253A1800682F3210C1463420F20A5096CA600BA346EC04009001010208AC2320584D86C1212238AC8A291B4590000D417
pd_[122]=A4CAE359331163CF304A02C25244190C611910E25212C88D27244832A0B6194C2848C560A06838898271313167450285329444BD620A8600F82886D300D4CB
pd_[123]=11091422C8281CAC0E60A92580851510280436D080018F1C2AC4891F99F81946314478107CCD104157448B81B6E540405340A8411841800C2AA7210E00D572
pd_[124]=880A6AE11201A40104300F1A5603434340844705F461C83826CDA120B08004AE96D8208B07100A2A0DE215B8C69B020246A08277A09E9EF34404024600D61D
pd_[125]=641097011360C521A83F57001FC799940ACA27C98D030087E55080C48A808D20102048E211038950119E003D4404916C003C80641E184CC3DABB286000D6C8
pd_[126]=8AE070C485E9009254619C97A42207604A254021149493063902D1750733C4A0E518190E450D538ADE656490F42AA0C3408664492AC5B129310E426600D781
pd_[127]=CCAEC180D08014FB50C30E2B08C4100A981A0C481290200024524E8C6221202252945780A1B3685691078006890B74C92203923A06826253228986C100D825
pd_[128]=56CE6D1040180848BE885157201671128D0A71918464085089EAB2524D4408A246C7634081A22A744118AD4283A27204C1140F9022282232E675B43400D8D6
pd_[129]=88A12230C488B11561940A86A803622D1492C0E8244C722B5CB608E75204809A5B44A2FADE204E4940E48781182088483230C94038D826002CC3A42C00D984
pd_[12A]=A404650A86642E94511027820088CA88910033C5ADE431D680A6002A3B1808071846948725632204295BA2920AC812380254ADA4563C09428811CA5600DA2E
pd_[12B]=2343A10A0419549C85C20643A80395BB23316F144205A114E4154C12CF30F4A0C7C9E2940E884061242889E2288283E1C9C1144180428660C450406000DADA
pd_[12C]=E4B3020414BD2A0DD8C044B8302C886000C94C752C3C8113D77601F023C0040F528811880074986A17C3F3063060795005BC132C0820202D545A218800DB88
pd_[12D]=35820DC46C5CF10421E00E10AB4B628E30850B833B105530A187601126B825506E8582D900102071DC084005227460AA8A226995397005451832708E00DC38
pd_[12E]=2014C5858802A4148DE215A84E8861C8A1CE4C982CC418A048640430280D204900212F91889394A289CBE00120021434C535433200C043385E81400DCD4
pd_[12F]=85A606E4480580D8044409062165168372C119B63876532425103A0C4822015320899554585492050C1D06782420A1C1C72930C1E5840639D41080D700DD7E
pd_[130]=8C409E9180813BA32C38A654943B942C072A4904288F2CCA000C3018B308918E5122BE410DE040290C0108D4E1B1416A99009AC55B608D94A3BD832400DE32
pd_[131]=5A0A8BF18323560244AA204A0C90DD2413A87634135368C5212A1741D524101220020A2C213520005469015BC1B1294BBA04C047D8B9DA4A1A904A6D00DEE6
pd_[132]=763080600F1296C0CA1002205094078E051B888207B225922C44C35881FD66B9E8265347130A95CD4016241028E108888A4902346932090CA6243C9000DF92
pd_[133]=A05120A14A88048727414093A6E4CF25BC2260022884EE0F07AA8AC05719CC4C0D08002060C3229C1E8ABAC628684F4C0E422CA04E5A08649360654000E043
pd_[134]=117000A8458A042E500B547930D4E81D5C54091102AD16381E5040118F48461A086EC1730024E6601224D0948140915672644AB20399DC18515412AC00E0F0
pd_[135]=41020CBC8B5EAC5A9228130F2836490A06CC22642D035C0CBC24269241138B693D0968A10980108762F1C880014A00424620558C090A0284D625838400E199
pd_[136]=1E16D10510067088307009880E18143500810B3840C92F2209962002A8CA08081EA6B01029459130B0686078A5586429310AE3C3581014A14001A29400E236
pd_[137]=294A06C30885402172E017B0E55984A07060C945C29002AAA8CB8AE8606724108142890C8112190FD70882C91A105630851600B2A418290858640E1700E2DE
pd_[138]=803A08B20254D0252030628446614A11496A9D68B0805F0C43919152814C1C00A00C1D0C2E22C84220A0172999518BD4F8E70A3C2B54696555019E1000E38D
pd_[139]=79220015078B23120B0A50310A8A3A66C002DD6AB272AAE8480046A54051041E6400271B43B81A69E089800805CC6C81B4A2E4989067C2A2BC5F919B00E444
pd_[13A]=250490836524282314A79C15560C02C83AE092D80B06982017454E7810B12D098B6061B00040D570F8842DB08A261C12A026805A406A02A42194194D00E4EE
pd_[13B]=74B030841A3430AAB2C9DC46C8C0A2E830A3202DA0C00093608CB36AB9F60233AD425401B9302A0541A024AB400C880D044429505804C3154F16691400E59D
pd_[13C]=439CF44819C130884764929CC4C770C052BC21472020421C50517C9AE41180368286086552ACB71C402C192CEC8012B08C10442C222242208909224C00E647
pd_[13D]=4B40278B95208849624D4D24421219549CC0D9DAA03C0140A108180E12451F42794D8300553B581003434892245D20A49A508450015272A80040293700E6EE
pd_[13E]=98628A02193088104002030F1CFE00039E0031215C1D954C6248B08A410AD191C1002460275CE0CE38C4A50CB698717908827514D0A360A35687440000E798
pd_[13F]=E5207C561C54527095A88E0A2A102102C14949284ED123A0423904A09894928903414B4170AA38194A4638736600CC01A45F140630A6950BC454A4C200E848
pd_[140]=B3D04C8878020470320BC4D661E11285C04010049CAD600E853A05A0602A4E45012032CC85054680DC8803C489CA08C02798418BA0C307BA9CE5090500E8F2
pd_[141]=A4C090B3401131804008220A1911E4128FCF9114905C8C0D8001128C076CA0A24672D0110494451345AEE0313019148941501AEC63000C5D880C18C000E992
pd_[142]=CE04395A85620484400FABC211642899018000D4B02843A0B40A24048E911A288206E214594273060260A80843E640490348CA04A070240C0670A06600EA2D
pd_[143]=144E84B10DA481030113258930479F2088B206104AC546383C316484C1A890C0620C08D004BA41A6183663A401A802031879C04C05243112736D9000EAD0
pd_[144]=874938890441A2444D102030802983F1F1310908433360A838694861150021400076B8C83486295294DD40B44141C84835A3ECA81B58871B4425155300EB7C
pd_[145]=59A203294A36E8840E605426403A30B2208500FEA00FD0516A08495128E4B48A506D58463EC112300950A05B4E79A127B0F91218331492402C25D8800EC30
pd_[146]=519C0A58A066821E4426F8D4E241105053E00520B844428A164F058372556630BE954D08C57000262F10B34F094E3A120C186C8AA48802081C27404800ECE0
pd_[147]=14208E2868A41AC625A985702154060188401C0C151302082366A251A18D0030AC8080E0E8E21252B0C028902A0062E018CD08E1202866C82242C27500ED7B
pd_[148]=2746488091828AAE2DD857E8491A3061504AA2060BA2249053491D28162930C4BCE9206246506681A89433220F170E84C1D2148E0168A4006E05846A00EE2D
pd_[149]=86E904004205B17342809B0463804C2702AB0CB41AA795F560140F12CEC1C21108D82AAB843850A8304054D02D9A6935280A111CB1E1333A649080400EEDD
pd_[14A]=382910854411219C25641111612474760536BB122624E804491E669824992DCA460183828886448946D24D039CC10E2494800B404B6A84A001BBC02800EF88
pd_[14B]=547803E1C220A1308436864CD12AD894469790B8132A8A20C4C8AE4F0C0D912026068701A3229823842D385B1E48F4D82785CE203E0AC4300383040F00F03F
pd_[14C]=80561468956184B012E82AAA08011DC88A20251954AED9C80C847CE16309A90014010BAB20978443055340F362209048C5D1A08080D48D88912049C00F0E6
pd_[14D]=4B8A46CD03007C815864208546EC944314B8E251C4000D709799A8805A290C031842C4F206D03DD0D591481020AA07C053050ECF0023A5C1050A526700F197
pd_[14E]=D421A038B18078B861C4284AA842491A4C01A08B31783090F817800888154F8908E044426C09E8691300C4162906C405C38C22EA0084A403A25E462200F23D
pd_[14F]=A8C42650885E208A05890B84252AB084270414221D8100D300C3A04746A1208348058AF59081538A0F428A11828010530A01D8996EA13214F06C142E00F2E1
pd_[150]=8216C1C9D0059511236AC70A16005437110652C0361982A2800691F0E4C1818E16772C2A2051CD44226A91900E284822083E0569B08482050499311E00F38C
pd_[151]=2CACD224C20420924374620218A4CC814005F02E02825C1218732160E07ED89909000811F60012A82446184C22CA4956382488F06AEB12051CDB8000F431
pd_[152]=C02369A21421280340131B8420404268A240F41450342A3837B19180FAF811C6831820C40A41AA460F9608E723C1B523254282F0994469D09199AAB800F4E2
pd_[153]=97B5D510EC0B4E70211221918831C0A021C285088B4E0A6D62C2D31B8829E1A222D622040084006021FD9EDD9462A0F1C04801C198B412D10E03D6000F594
pd_[154]=404514885BCAA2F0018E1144429422825DA20355C26906880845F0B04460E00844C902237010C493484813C990130D04C8387134211462B85464305200F636
pd_[155]=20DC4008594200AB8F10A4CC8A4C8109350A9001140509A7920D1C29A8B790C1480225242205AB84922C7DF0688605857044EC1E5940831806B5758100F6E2
pd_[156]=4F32B701243D072F046239D8308FA0001130610F210241A6129078438658112990A25E36102CC4B12170780D853113C8892CA29381B41468C02342D300F794
pd_[157]=353A92F102AC42400056756DAC4D1CB8D45850AC11991BA4C0B160AA7705804405C32084269069821003A44A9280230888DEA7C951B481CA044D2000F843
pd_[158]=7404EE1B1B206E442853A64285811BC30685208DC708218026C1F1818067C624E23F80A427292A44000D6500CCD10699DD008F060C0E00802160882F00F8F0
pd_[159]=81C010C0B06144023D08802128D29C23424102E8C6815480A08B41CE61D87B90812149924888051A2A81323F7A0D08062A3086380030194806EE984D00F992
pd_[15A]=D21224836129C16410894048C6425F3282719001291E355F0C722BB92C333028C8700EE02C9F15188BA242088C85A0CF004E378228C8B94501650F4000FA47
pd_[15B]=4A06001740990D8C083332F09C22A426251110443074805488C080326E56502B82AC80C50A908104A0582202E6DE4102E4516002114E10823A80A58100FAE2
pd_[15C]=43146216EE24044A7E0350456880600C91B726413241765724E12282D9B1F1C0369645688178154103CB8A3984302130E618421D460B4B229594154600FB9A
pd_[15D]=108C64BF8180C2985A808A013088753030052833110098C0A12CEC815CD020885865E08397400A443A5404095C41200A2043031A226005F024A3C21200FC35
pd_[15E]=90B08045A00747C5349957CF44856288C0D0455C2898025A20F8E25F53000847603120DA9CA62451A696587015128868C4400920331B1560947A181400FCE6
pd_[15F]=4F094B0182200A8040608F943A320028E70A06CFC16498A8EA14104721386684580211DA474269510C1AA14A10A09017318595661120C023AA54A22000FD8C
pd_[160]=748058459C2884A9001530101E8DA24C1AA609202C5988E0C31086B40A420719A80B04BDA7B0C0850C5990441184114948A2D008C46C20E748BE048300FE33
pd_[161]=764512080D1804510C210F25C08423E1A3A34A01556ACB73816202B13007498842144212A500425F23C6AA41A2094B42888B4000487723892358A13100FEDC
pd_[162]=400C814D004E4B68C94469CA4809F9AD5CCC01E46F40155204A839317201202780000D3840487200811049AAB93382A423109700070A0935DC340EA400FF84
pd_[163]=6366253C51E9102493B0830495CB704D40049C0822029B7604300626840305722E4D94545036C404061D2A1C2DA91230092266856D80B3D296065215010035
pd_max_=163
ibase=A
#!/usr/local/bin/bc -l primes.bc

### Primes-Other.BC - Extra functions to go along with Primes.BC

# Both Funcs.BC and Primes.BC are required to use functions herein

# Returns 2, 3, or number of form 6n[+-]1
define aq(x) {
 if(x<0)return(-aq(-x))
 if(x<3)return(x+1)
 x-=3;x+=int(x/2)
 return(x+x+5)
}

# Inverse of the above
define iaq(x) {
 if(x<0)return(-iaq(-x))
 if(x<4)return(x-1)
 return((remainder(x+3,6)+x+x)/6+1)
}

# Returns 2, 3, 5 or number of form 30n[+-]{1,7,11,13}
define aq30(x) {
 auto os, e, r, rh, s
 os=scale;scale=0;x/=1
 if(x<0){x=-aq30(-x);scale=os;return(x)}
 if(x<4){x=x+1+x/3  ;scale=os;return(x)}
 x-=3     ; e=x/8
 r=x%8    ; rh=r/4
 s=1-2*rh ; r=s*r+7*rh
 scale=os;return( 3*A*(e+rh)-s*(r*(r-7)-1) )
}
 
# Inverse of the above
define iaq30(x) {
 auto os, e, r
 os=scale;scale=0;x/=1
 if(x<0){x=-iaq30(-x);scale=os;return(x)}
 if(x<7){x=x-1-x/5   ;scale=os;return(x)}
 e=x/30;r=x%30
 r=r/6+(r-2)/7
 scale=os;return(8*e+r +3)
}

# Cyrek's Approximation to the Prime Counting Function pi(x)
define aprimepi(x) { 
 auto la,b,lx,k,oib;
 if(x<=0)return 0
 if(x<A){return x*aprimepi(A)/A}
 oib=ibase;ibase=A;scale+=4
 lx=l(x)/2.3026 #l(10)
 la=2*l(lx)/(3*lx)
 #b=1+2/(17*pow(cosh(lx-e(2)),1/32))
 b=e(lx-e(2))
 b=(b+1/b)/2 #cosh b
 b=17*sqrt(sqrt(sqrt(sqrt(sqrt(b))))) #17.b^(1/32)
 b=2/b+1
 k=1+la-l(b)
 ibase=oib;scale-=4
 return(x*k/l(x))
}

# Use the above approximation to find a
# number close to the nth prime
define fastguessprime(n) {
  auto os,l,x,ox,i;
  os=scale;scale=10
  s=1;if(n<0)n*=(s=-1)
  n+=.5;l=l(n);x=n*l
  ox=1
  while(ox!=i){
    ox=i;x+=l*(n-aprimepi(x))
    scale=0;i=x/1;scale=10
  }
  scale=os;return ox
}

# Use the above to find a prime close to the nth prime
# (is almost always wrong, but is generally within 0.5%)
define guessprime(n) {
  n=fastguessprime(n)
  return nearestprime(n)
}

# Sum of prime factors of a number
# . e.g. 150 = 2*3*5^2 -> 2+3+5*2 = 15
define sum_of_factors(x) {
  auto i,c,fp[];
  if(x<0)return sum_of_factors(-x)-1;
  if(x==0||x==1)return 0;
  .=fac_store(fp[],x)
  for(i=0;fp[i];i++)c+=fp[i]*fp[++i]
  return c;
}

# As above but with no splitting of powers into multiplies
# . e.g. 150 = 2*3*5^2 -> 2+3+5^2 = 30
define sum_of_factor_terms(x) {
  auto i,c,fp[];
  if(x<0)return sum_of_factor_terms(-x)-1;
  if(x==0||x==1)return 0;
  .=fac_store(fp[],x)
  for(i=0;fp[i];i++)c+=fp[i]^fp[++i]
  return c;
}

# Raise the powers of the prime factors to the
# power of their primes and multiply
# . e.g. 150 = 2*3*5^2 -> 1^2*1^3*2^5 = 1*1*32 = 32
define factor_invert(x) {
  auto i,c,fp[];
  if(x<0)return factor_invert(-x)+1;
  if(x==0||x==1)return 0;
  .=fac_store(fp[],x)
  c=1;for(i=0;fp[i];i+=2)c*=fp[i+1]^fp[i]
  return c;
}
#!/usr/local/bin/bc -l primes.bc

### Primes-Twin.BC - A few functions for handling twin primes

# Determine whether x is a member of a prime twin pair
#  Returns 0 for no, and the other member of the pair for yes.
#  e.g. is_twin_prime(17) returns 19;
#       is_twin_prime(23) returns 0 because 21 and 25 are not prime
#  Pseudo-boolean, since always returns 0 for false, but not 1 for true
define is_twin_prime(x) {
  auto os;
  if(x<=2)return 0;
  if(x==3)return 5;
  if(!is_prime(x))return 0;
  os=scale;scale=0
   if(x%6==5){x+=2}else{x-=2}
  scale=os
  if(!is_prime(x))return 0;
  return x
}

define nexttwinprime(x) {
  auto os,ox,t;
  if(x<0)return -prevtwinprime(-x)
  if(x<3)return 3
  if(x<5)return 5
  os=scale;scale=0
   ox=x
   x/=1         # truncate
   t=5-(x+1)%6  # {5,0,1,2,3,4} mod 6 -> {5,4,3,2,1,0} mod 6
   x+=1+t%4     # make x into next candidate adding 1+{1,0,3,2,1,0}
   while(!(t=is_twin_prime(x)))x+=6
   if(x>t&&t>ox)x=t
  scale=os;return x
}

define prevtwinprime(x) {
  auto os,ox,t;
  if(x<0)return -nexttwinprime(-x)
  if(x<=3)return -3
  if(x<=5)return 3
  os=scale;scale=0
    ox=x
    if((t=x/1)<x).=t++ # ceiling
    x=t         # truncate
    t=(x-2)%6   # {0,1,2,3,4,5} mod 6 -> {4,5,0,1,2,3} mod 6
    x-=1+t%4    # make x into prev candidate subtracting 1+{0,1,0,1,2,3}
    while(!(t=is_twin_prime(x)))x-=6
  scale=os;return x
}