File: misc.gel

package info (click to toggle)
genius 1.0.27-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 25,308 kB
  • sloc: ansic: 75,620; xml: 71,565; sh: 4,445; makefile: 1,927; lex: 523; yacc: 298; perl: 54
file content (165 lines) | stat: -rw-r--r-- 4,985 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
# Miscellaneous Combinatorial functions

# Hofstadter's function q(n) is defined for positive integers by
# q(1)=1, q(2)=1, q(n)=q(n-q(n-1))+q(n-q(n-2))
# Note: the Hofstadter function is described in Godel, Escher, Bach:
# An Eternal Golden Braid.
# It's kinda chaotic (and becomes increasingly so) -- it starts off
# looking like n/2 or such...
SetHelp("Hofstadter", "combinatorics", "Hofstadter's function q(n) defined by q(1)=1, q(2)=1, q(n)=q(n-q(n-1))+q(n-q(n-2))")
function Hofstadter(n) = (
    if(IsMatrix(n)) then
	return ApplyOverMatrix(n,Hofstadter)
    else if not IsPositiveInteger(n) then
    	(error("Hofstadter: argument not a positive integer");bailout);
    # reason for doing this is that it's just plain faster then calling self
    # again
    function h (n) = (
    	if n <= 2 then
		1
	else
		h(n - h(n-1)) + h(n - h(n-2))
    );
    h (n)
)


# return the Fibonacci number, calculated using an iterative method
SetHelp("Fibonacci", "combinatorics", "Calculate nth Fibonacci number");
function Fibonacci(x) = (
	if(IsMatrix(x)) then
		return ApplyOverMatrix(x,fib)
	else if(not IsInteger(x)) then
		(error("Fibonacci: argument not an integer");bailout)
	else if(x<0) then
		(error("Fibonacci: argument less than zero");bailout)
	else (([1,1;1,0]^x)@(1,2))
);
SetHelpAlias ("Fibonacci", "fib");
fib=Fibonacci

## Harmonic Numbers
## H_n^(r) (the nth harmonic number of order r)
## = sum_{i=1}^n 1/i^r
SetHelp("HarmonicNumber", "combinatorics", "Harmonic Number, the nth harmonic number of order r");
function HarmonicNumber(n,r) = (
  	if IsMatrix (n) or IsMatrix (r) then
  		return ApplyOverMatrix2 (m, n, HarmonicNumber);
	sum x=1 to n do x^(-r)
)
SetHelpAlias ("HarmonicNumber", "HarmonicH");
HarmonicH = HarmonicNumber;


# return the Frobenius number
SetHelp("FrobeniusNumber", "combinatorics", "Calculate the Frobenius number for a coin problem");
function FrobeniusNumber(v,arg...) = (
	if not IsMatrix(v) and not IsValue(v) then
		(error("FrobeniusNumber: argument not a value or vector");bailout);
	# Not perfect argument checking

	if IsNull (arg) then
		m = [v]
	else
		m = [v, arg];

	if (gcd (m) != 1) then
		(error("FrobeniusNumber: gcd of arguments not 1");bailout);

	# Trivial
	if (elements (m) == 1) then
		return -1;

	# Sylvesters Formula
	if (elements (m) == 2) then
		return (m@(1)*m@(2) - (m@(1)+m@(2)));

	m = SortVector (m);

	if m@(1) == 1 then
		return -1;

	k = 1;
	# Vitek's inequality for upper bound
	#  See: Y. Vitek, Bounds for a Linear Diophantine Problem of Frobenius,
	#  J. London Math.  Soc., (2) 10 (1975), 79–85.
	for j = 2 to IntegerQuotient((m@(2)-1)*(m@(elements(m))-1),2)-1 do (
		if IsNull(GreedyAlgorithm(j,m)) then
			k = j
	);
	k
);

SetHelp("GreedyAlgorithm", "combinatorics", "Use greedy algorithm to find c, for c . v = n.  (v must be sorted)");
function GreedyAlgorithm(n,v) = (
	if not IsMatrix(v) then
		(error("GreedyAlgorithm: argument not a nonempty vector");bailout);

	elts = elements(v);

	if (n == 0) then (
		return zeros(elts);
	);


	if elts == 1 then (
		if Divides (v@(1), n) then
			return [IntegerQuotient(n,v@(1))]
		else
			return null
	);

	k = IntegerQuotient (n, v@(elts));
	for m = k to 0 by -1 do (
		c = GreedyAlgorithm (n - m * v@(elts),
				     v@(1:(elts-1)));
		if not IsNull(c) then (
			return [c,m]
		)
	);
	null
);

SetHelp("StirlingNumberFirst", "combinatorics", "Stirling number of the first kind");
function StirlingNumberFirst(n,m) = (
  	if IsMatrix (m) or IsMatrix (n) then
  		return ApplyOverMatrix2 (n, m, StirlingNumberFirst)
	else if not IsNonNegativeInteger(n) or not IsNonNegativeInteger(m) then
		(error("StirlingNumberFirst: arguments not positive integers");bailout);
	if m == 0 then (
		if n == 0 then 1 else 0
	) else if m > n then (
		0
	) else if m == n then (
		1
	) else (
		StirlingNumberFirst(n-1,m-1) - n * StirlingNumberFirst(n-1,m)
	)
)
SetHelpAlias ("StirlingNumberFirst", "StirlingS1");
StirlingS1 = StirlingNumberFirst;

SetHelp("StirlingNumberSecond", "combinatorics", "Stirling number of the second kind");
function StirlingNumberSecond(n,m) = (
  	if IsMatrix (m) or IsMatrix (n) then
  		return ApplyOverMatrix2 (n, m, StirlingNumberSecond)
    	else if not IsNonNegativeInteger(n) or not IsNonNegativeInteger(m) then
    		(error("StirlingNumberSecond: arguments not positive integers");bailout);

	1/(m!) * (sum j=0 to m do ((-1)^j * Binomial(m,j)*(m-j)^n))
)
SetHelpAlias ("StirlingNumberSecond", "StirlingS2");
StirlingS2 = StirlingNumberSecond;

## More: BernoulliPolynomial,
## EulerNumber, EulerPolynomial
#??
#function BernoulliB(n) = BernoulliNumber(n)
#function BernoulliB(n,x) = BernoulliPolynomial(n,x)
#function EulerE(n) = EulerNumber(n)
#function EulerE(n,x) = EulerPolynomial(n,x)
#function PartitionsP(n) = PartitionsUnrestricted(n) # Unrestricted partitions of n
#function PartitionsQ(n) = PartitionsDistinct(n) # Partitions of n into distinct parts

# Partity (of a permutation)
# ClebschGordan, ThreeJSymbol, SixJSymbol