#######################################################################
# APPL Software (c) 2001,2002,2008 Andrew Glen, Larry Leemis, Diane Evans
# Version 2.3, dated 11 March April 2008
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: startup6.map
#
# Procedure name: None
#
# Other APPL Procedures Called: None
#
# Date Revised: March 20, 2001
#
# Purpose: Start up file for APPL
#
# Arguments: None
#
#
# Unprotect the Maple system name Product, so we can name the product
# of 2 random variables the procedure Product
#
unprotect(Product):
print(`PROCEDURES:`):
print(`AllPermutations(n)`, `AllCombinations(n, k)`, `Benford(X)`,
`BootstrapRV(Data)`,
`CDF:CHF:HF:IDF:PDF:SF(X, [x]))`, `CoefOfVar(X)`,
`Convolution(X, Y)`, `ConvolutionIID(X, n)`,
`CriticalPoint(X, prob)`, `Determinant(MATRIX)`,
`Difference(X, Y)`, `Display(X)`, `ExpectedValue(X, [g])`,
`KSTest(X, Data, Parameters)`, `Kurtosis(X)`, `Maximum(X, Y)`,
`MaximumIID(X, n)`, `Mean(X)`, `MGF(X)`, `Minimum(X, Y)`,
`MinimumIID(X, n)`, `Mixture(MixParameters, MixRVs)`,
`MLE(X, Data, Parameters, [Rightcensor])`,
`MLENHPP(X, Data, Parameters, obstime)`,
`MLEWeibull(Data, [Rightcensor])`, `MOM(X, Data, Parameters)`,
`NextCombination(Previous, size)`, `NextPermutation(Previous)`,
`OrderStat(X, n, r, ["wo"])`, `PlotDist(X, [low], [high])`,
`PlotEmpCDF(Data, [low], [high])`,
`PlotEmpCIF(Data, [low], [high])`, `PlotEmpSF(Data, Censor)`,
`PlotEmpVsFittedCDF(X, Data, Parameters, [low], [high])`,
`PlotEmpVsFittedCDF(X, Data, Parameters, [low], [high])`,
`PlotEmpVsFittedSF(X, Data, Parameters, Censor, low, high)`,
`PPPlot(X, Data, Parameters)`, `Product(X, Y)`,
`ProductIID(X, n)`, `QQPlot(X, Data, Parameters)`,
`RangeStat(X, n, ["wo"])`,
`Skewness(X)`, `Transform(X, g)`, `Truncate(X, low, high)`,
`Variance(X)`, `VerifyPDF(X)`):
print(``):
print(`Procedure Notation:`):
print(`X and Y are random variables`):
print(`Greek letters are numeric or symbolic parameters`):
print(`x is numeric or symbolic`):
print(`n and r are positive integers, n >= r`):
print(`low and high are numeric`):
print(`g is a function`):
print(`Brackets [] denote optional parameters`):
print(`"double quotes" denote character strings`):
print(`MATRIX is a 2 x 2 array of random variables`):
print(`A capitalized parameter indicates that it must be`):
print(`entered as a list --> ex. Data := [1, 12.4, 34, 52.45, 63]`):
print(``):
print(`Variate Generation:`):
print(`ArcTanVariate(alpha, phi)`, `BinomialVariate(n, p, m)`,
`ExponentialVariate(lambda)`, `NormalVariate(mu, sigma)`,
`UniformVariate()`,
`WeibullVariate(lambda, kappa, m)`):
print(``):
print(`DATA SETS:`):
print(`BallBearing`, `HorseKickFatalities`, `Hurricane`, `MP6`,
`RatControl`, `RatTreatment`, `USSHalfBeak`):
DataSets():
print(``):
#
# Define structured types for discrete random variables
#
#
# 9/5/2000: `type/dot` is Maple's type range
#
`type/dot` := {constant .. constant, symbol .. constant, constant ..
symbol, symbol .. symbol}:
#
# Define binary type as integers 0 or 1
#
`type/binary` := {0, 1}:
#
# Constructs an indexing function that returns infinity for all
# unassigned entries in an array (similar to the sparse indexing
# function which returns zero)
#
`index/infinity` := proc(Idx :: list, Tbl :: table, Entry :: list)
if (nargs = 2) then
if (assigned(Tbl[op(Idx)])) then
Tbl[op(Idx)]:
else
infinity:
fi:
elif Entry = [infinity] then
infinity:
else
Tbl[op(Idx)] := op(Entry);
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: allcombos3.map
#
AllCombinations := proc(n :: posint, k :: posint)
local A, i, MoveLeft, h, m:
#
# Check for the appropriate number of arguments
#
if (nargs <> 2) then
print(`ERROR(AllCombinations): This procedure requires 2 arguments`):
print(`k items chosen from n`):
RETURN():
fi:
#
# Check that k is no greater than n
#
if (k > n) then
print(`ERROR(AllCombinations): k must be less than or equal to n`):
RETURN():
fi:
A := [seq(i, i = 1 .. k)]:
print(`A is`, A):
while (A[1] <> n - k + 1) do
if (A[k] <> n) then
A[k] := A[k] + 1:
else
MoveLeft := true:
for h from 1 to (k - 1) while (MoveLeft = true) do
if (A[k - h] < n - h) then
A[k - h] := A[k - h] + 1:
for m from (h - 1) to 0 by -1 do
A[k - m] := A[k - (m + 1)] + 1:
od:
MoveLeft := false:
fi:
od:
fi:
print(`A is`, A):
od:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: allperms1.map
#
AllPermutations := proc(n :: posint)
local A, i, Continue, All, swapped, j, OrigVal, MiniMaxIndex, k, Temp1,
l, Temp2, m:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(AllPermutations): This procedure requires 1 argument:`):
print(`n, the number of items to be permuted`):
RETURN():
fi:
A := [seq(i, i = 1 .. n)]:
print(`A is`, A):
Continue := true:
for All from 1 to n! - 1 do
swapped := false:
for j from n - 1 to 1 by -1 while (Continue = true) do
# print(A[j]):
# print(A[j + 1]):
if ((A[j] < A[j + 1]) and not(swapped)) then
OrigVal := A[j]:
MiniMaxIndex := j + 1:
# print(`MiniMaxIndex is`, MiniMaxIndex):
for k from n to j + 1 by -1 do
# print(`swapping is needed since A[j] < A[j + 1]`):
swapped := true:
if ((A[k] < A[MiniMaxIndex]) and (A[k] > OrigVal)) then
# print(`A[k] is`, A[k]):
# print(`A[Mini] is`, A[MiniMaxIndex]):
MiniMaxIndex := k:
fi:
od:
Temp1 := A[MiniMaxIndex]:
A[MiniMaxIndex] := A[j]:
A[j] := Temp1:
# print(`A after swap is`, A):
#
# don't need to reverse if haven't swapped
#
if (swapped = true) then
for l from j + 1 to n do
Temp2[l] := A[l]:
od:
for m from j + 1 to n do
A[m] := Temp2[n + j + 1 - m]:
od:
# print(`A after reversal is`, A):
fi:
fi:
# Continue := false:
od:
# Continue := true:
print(`A is`, A):
od:
RETURN():
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: arctanvariate1.map
#
# Procedure Name: ArcTanVariate(alpha, phi)
#
# Other APPL Procedures Called: None
#
# Date: June 1, 1999
#
# Purpose:
#
# Arguments:
#
# Algorithm:
#
ArcTanVariate := proc(alpha, phi)
local variate:
variate := phi + 1 / alpha * tan(Pi / 2 - (1 - (rand() / 1000000000000))
* (arctan(alpha * phi) + Pi / 2)):
RETURN(variate):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: benford7.map
#
# Procedure Name: Benford(X)
#
# Other APPL Procedures Called: PDF, CDF, TruncateRV, Transform,
# MixtureRV
#
# Date: May 28, 1999
#
# Purpose: Given a continuous random variable X, this procedure returns
# the PDF of Z, as defined in Leemis, Schmeiser, and Evans
# (2000)
#
# Arguments: X: A continuous random variable.
#
# Algorithm:
# 1. Check for 1 argument, the RV X
# 2. Check that the RV X is in the list of 3 lists format
# 3. Check that the RV X is continuous
# 4. Convert the RV X to PDF form
# 5. Check that the RV supports are numeric and finite
# 6. Compute the lower and upper summation limits
# 7. Create lists Weight, TruncX, and Xprime that will hold
# (Hi - Lo + 1) elements
# 8. Compute each "weight" and "truncated distribution" for the
# intervals [Lo, Lo + 1], [Lo + 1, Lo + 2], ..., [d, d + 1], ...,
# [Hi - 2, Hi - 1], [Hi - 1, Hi]
# 9. For each value d, where d is a value s.t. Lo <= d <= Hi,
# transform the truncated distribution by the function x -> x - d
# 10. Send the list of weights along with its list of truncated
# distributions to the procedure Mixture to compute the PDF of Z,
# as defined in Leemis, Schmeiser, and Evans (2000)
#
Benford := proc(X :: list(list))
local NumLists, fX, NumSegs, Lo, Hi, Weight, i, TruncX, Xprime, counter,
d, n, NewWt, BenfX:
#
# Check for 1 argument, the RV X
#
if (nargs <> 1) then
print(`ERROR(Benford): This procedure requires 1 argument:`):
print(`A random variable`):
RETURN():
fi:
#
# Check that the random variable is in the list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(Benford): The RV must be in a list of 3 lists format`):
RETURN():
fi:
#
# Check that the random variable is continuous
#
if not(X[3][1] = "Continuous") then
print(`ERROR(Benford): Random variable must be continuous`):
RETURN():
fi:
#
# Convert RV to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif ((X[3][2] = "CDF") or
(X[3][2] = "CHF") or
(X[3][2] = "HF") or
(X[3][2] = "IDF") or
(X[3][2] = "SF")) then
fX := PDF(X):
else
print(`ERROR(Benford): RV must be given as`):
print(`CDF, CHF, ,HF, IDF, PDF, or SF`):
RETURN():
fi:
#
# Check that the RV supports are numeric and finite
#
NumSegs := nops(fX[1]):
for i from 1 to (NumSegs + 1) do
if (type(evalf(fX[2][i]), {symbol, infinity})) then
print(`ERROR(Benford): Must specify numeric values for the`):
print(`supports of the RV X`):
RETURN():
fi:
od:
#
# Compute the lower and upper summation limits
#
Lo := floor(fX[2][1]):
Hi := ceil(fX[2][NumSegs + 1]) - 1:
#
# Create lists Weight, TruncX, and Xprime that will hold (Hi - Lo + 1)
# elements
#
Weight := []:
TruncX := [seq(0, i = 1 .. (Hi - Lo + 1))]:
Xprime := [seq(0, i = 1 .. (Hi - Lo + 1))]:
counter := 1:
#
# Compute each "weight" and "truncated distribution" for the intervals
# [Lo, Lo + 1], [Lo + 1, Lo + 2], ..., [d, d + 1], ...,
# [Hi - 2, Hi - 1], [Hi - 1, Hi]
# For each value d, where d is a value s.t. Lo <= d <= Hi, transform
# the truncated distribution by the function x -> x - d
#
for d from Lo to Hi do
for n from 1 to NumSegs do
if (evalf(floor(fX[2][n])) <= evalf(d) and
evalf(d + 1) <= evalf(ceil(fX[2][n + 1]))) then
NewWt := CDF(fX, d + 1) - CDF(fX, d):
fi:
od:
Weight := [op(Weight), NewWt]:
TruncX[counter] := Truncate(fX, d, d + 1):
Xprime[counter] := Transform(TruncX[counter], [[x -> x - d], [-infinity,
infinity]]):
counter := counter + 1:
od:
#
# Send the list of weights along with its list of truncated distributions
# to the procedure MixtureRV to compute the PDF of Z
#
BenfX := Mixture(Weight, Xprime):
end:#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: binomialvariate1.map
#
# Procedure name: BinomialVariate(n, p, m)
#
# Other APPL Procedures Called: UniformVariate
#
# Date Revised: September 12, 1999
#
# Purpose: Given the parameters n and p for the binomial distribution,
# BinomialVariate returns m binomial variates, and the mean and variance
# of the m binomial variates
#
# NOTE: only works for n = 16 at this moment
#
BinomialVariate := proc(n :: posint, p :: positive, m :: posint)
local pdf, pdfvalue, i, cdfvalue, counter, BinVars, k, U, BinVar, mean, j, variance:
pdf := n! / ((n - x)! * x!) * p ^ x * (1 - p) ^ (n - x):
pdfvalue := [seq(0, i = 1 .. n)]:
for i from 1 to n do
pdfvalue[i] := subs(x = i, pdf):
od:
# print(pdfvalue):
cdfvalue := [seq(0, i = 1 .. n)]:
cdfvalue[n] := 1 - pdfvalue[n]:
counter := n - 1:
while (counter > 0) do
cdfvalue[counter] := cdfvalue[counter + 1] - pdfvalue[counter]:
counter := counter - 1:
od:
# print(cdfvalue):
BinVars := array(1 .. m):
for k from 1 to m do
U := UniformVariate():
if ((U >= 0) and (U < cdfvalue[1])) then
BinVar := 0:
elif ((U >= cdfvalue[1]) and (U < cdfvalue[2])) then
BinVar := 1:
elif ((U >= cdfvalue[2]) and (U < cdfvalue[3])) then
BinVar := 2:
elif ((U >= cdfvalue[3]) and (U < cdfvalue[4])) then
BinVar := 3:
elif ((U >= cdfvalue[4]) and (U < cdfvalue[5])) then
BinVar := 4:
elif ((U >= cdfvalue[5]) and (U < cdfvalue[6])) then
BinVar := 5:
elif ((U >= cdfvalue[6]) and (U < cdfvalue[7])) then
BinVar := 6:
elif ((U >= cdfvalue[7]) and (U < cdfvalue[8])) then
BinVar := 7:
elif ((U >= cdfvalue[8]) and (U < cdfvalue[9])) then
BinVar := 8:
elif ((U >= cdfvalue[9]) and (U < cdfvalue[10])) then
BinVar := 9:
elif ((U >= cdfvalue[10]) and (U < cdfvalue[11])) then
BinVar := 10:
elif ((U >= cdfvalue[11]) and (U < cdfvalue[12])) then
BinVar := 11:
elif ((U >= cdfvalue[12]) and (U < cdfvalue[13])) then
BinVar := 12:
elif ((U >= cdfvalue[13]) and (U < cdfvalue[14])) then
BinVar := 13:
elif ((U >= cdfvalue[14]) and (U < cdfvalue[15])) then
BinVar := 14:
elif ((U >= cdfvalue[15]) and (U < cdfvalue[16])) then
BinVar := 15:
elif ((U >= cdfvalue[16]) and (U <= 1)) then
BinVar := 16:
fi:
BinVars[k] := BinVar:
od:
# print(BinVars):
mean := sum(BinVars[j], j = 1 .. m) / m:
variance := sum((BinVars[j] - mean) ^ 2, j = 1 .. m) / (m - 1):
print(`Mean is `, mean):
print(`Variance is `, variance):
RETURN():
end:
# Filename: bootstraprv1.map
#
# Procedure Name: BootstrapRV(Data)
#
# Date: May 6, 2001
#
# Purpose:
#
# Arguments: Data: list of data
#
# Algorithm:
#
BootstrapRV := proc(Data :: list)
local n, sublist1, i, sublist2, sublist3:
n := nops(Data):
sublist1 := [seq(1 / n, i = 1 .. n)]:
# print(sublist1):
sublist2 := Data:
sublist3 := ["Discrete", "PDF"]:
return([sublist1, sublist2, sublist3]):
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: bruteforceconvolutionmethod1.map
#
# Procedure Name: BruteForceConvolutionMethod()
#
# Other APPL Procedures Called: HeapSort
#
# Date: October 4, 2000
#
# Purpose:
#
# Arguments: X, Y: Continuous random variables
#
# Algorithm:
BruteForceConvolutionMethod := proc()
global fX, fY:
local n, m, fV, s, Probs, k, i, j:
n := nops(fX[1]):
m := nops(fY[1]):
#
# If n = 1 and m = 1, return the convolution immediately and avoid
# sending a small one element array to HeapSort
#
if (n = 1) and (m = 1) then
s := [fX[2][1] + fY[2][1]]:
Probs := [1]:
return(s, Probs):
fi:
s := array(1 .. n * m):
Probs := array(1 .. n * m):
k := 1:
for i from 1 to n do
for j from 1 to m do
s[k] := fX[2][i] + fY[2][j]:
Probs[k] := fX[1][i] * fY[1][j]:
k := k + 1:
od:
od:
s := convert(s, list):
Probs := convert(Probs, list):
# print(`s is`, s):
# print(`Probs is`, Probs):
return(HeapSort(s, Probs)):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: bruteforceproductmethod1.map
#
# Procedure Name: BruteForceProductMethod()
#
# Other APPL Procedures Called: HeapSort
#
# Date: October 4, 2000
#
# Purpose:
#
# Arguments: X, Y: Continuous random variables
#
# Algorithm:
BruteForceProductMethod := proc()
global fX, fY:
local n, m, fV, s, Probs, k, i, j:
n := nops(fX[1]):
m := nops(fY[1]):
#
# If n = 1 and m = 1, return the convolution immediately and avoid
# sending a small one element array to HeapSort
#
# Also return the convolution immediately if either fX = 0 or fY = 0
#
if (n = 1) and (m = 1) or (n = 1 and fX[2][1] = 0) or
(m = 1 and fY[2][1] = 0) then
s := [fX[2][1] * fY[2][1]]:
Probs := [1]:
return(s, Probs):
fi:
s := array(1 .. n * m):
Probs := array(1 .. n * m):
k := 1:
for i from 1 to n do
for j from 1 to m do
s[k] := fX[2][i] * fY[2][j]:
Probs[k] := fX[1][i] * fY[1][j]:
k := k + 1:
od:
od:
s := convert(s, list):
Probs := convert(Probs, list):
return(HeapSort(s, Probs)):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: bruteforceproductq1q31.map
#
# Procedure Name: BruteForceProductQ1Q3()
#
# Other APPL Procedures Called: HeapSort
#
# Date: January 9, 2001
#
# Purpose:
#
# Arguments: X, Y: Continuous random variables
#
# Algorithm:
BruteForceProductQ1Q3 := proc()
global fXNeg, fXPos, fYNeg, fYPos:
local xneg, xpos, yneg, ypos, Q1Prod, Q1Prob, Q3Prod, Q3Prob, k, i1,
j1, i3, j3, Q1Q3Prod, Q1Q3Prob:
xneg := nops(fXNeg[1]):
xpos := nops(fXPos[1]):
yneg := nops(fYNeg[1]):
ypos := nops(fYPos[1]):
Q1Prod := array(1 .. xpos * ypos):
Q1Prob := array(1 .. xpos * ypos):
Q3Prod := array(1 .. xneg * yneg):
Q3Prob := array(1 .. xneg * yneg):
k := 1:
for i1 from 1 to xpos do
for j1 from 1 to ypos do
Q1Prod[k] := fXPos[2][i1] * fYPos[2][j1]:
Q1Prob[k] := fXPos[1][i1] * fYPos[1][j1]:
k := k + 1:
od:
od:
k := 1:
for i3 from 1 to xneg do
for j3 from 1 to yneg do
Q3Prod[k] := fXNeg[2][i3] * fYNeg[2][j3]:
Q3Prob[k] := fXNeg[1][i3] * fYNeg[1][j3]:
k := k + 1:
od:
od:
Q1Prod := convert(Q1Prod, list):
Q1Prob := convert(Q1Prob, list):
Q3Prod := convert(Q3Prod, list):
Q3Prob := convert(Q3Prob, list):
Q1Q3Prod := [op(Q1Prod), op(Q3Prod)]:
Q1Q3Prob := [op(Q1Prob), op(Q3Prob)]:
return(HeapSort(Q1Q3Prod, Q1Q3Prob)):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: bruteforceproductq2q41.map
#
# Procedure Name: BruteForceProductQ2Q4()
#
# Other APPL Procedures Called: HeapSort
#
# Date: January 9, 2001
#
# Purpose:
#
# Arguments: X, Y: Continuous random variables
#
# Algorithm:
BruteForceProductQ2Q4 := proc()
global fXNeg, fXPos, fYNeg, fYPos:
local xneg, xpos, yneg, ypos, Q2Prod, Q2Prob, Q4Prod, Q4Prob, k, i2,
j2, i4, j4, Q2Q4Prod, Q2Q4Prob:
xneg := nops(fXNeg[1]):
xpos := nops(fXPos[1]):
yneg := nops(fYNeg[1]):
ypos := nops(fYPos[1]):
Q2Prod := array(1 .. xneg * ypos):
Q2Prob := array(1 .. xneg * ypos):
Q4Prod := array(1 .. xpos * yneg):
Q4Prob := array(1 .. xpos * yneg):
k := 1:
for i2 from 1 to xneg do
for j2 from 1 to ypos do
Q2Prod[k] := fXNeg[2][i2] * fYPos[2][j2]:
Q2Prob[k] := fXNeg[1][i2] * fYPos[1][j2]:
k := k + 1:
od:
od:
k := 1:
for i4 from 1 to xpos do
for j4 from 1 to yneg do
Q4Prod[k] := fXPos[2][i4] * fYNeg[2][j4]:
Q4Prob[k] := fXPos[1][i4] * fYNeg[1][j4]:
k := k + 1:
od:
od:
Q2Prod := convert(Q2Prod, list):
Q2Prob := convert(Q2Prob, list):
Q4Prod := convert(Q4Prod, list):
Q4Prob := convert(Q4Prob, list):
Q2Q4Prod := [op(Q2Prod), op(Q4Prod)]:
Q2Q4Prob := [op(Q2Prob), op(Q4Prob)]:
return(HeapSort(Q2Q4Prod, Q2Q4Prob)):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: cdf17.map
#
# Procedure Name: CDF(X, [x])
#
# Other APPL Procedures Called: PDF, Convert
#
# Date: March 19, 2001
#
# Purpose: CDF is a procedure that:
# (1) Returns the cumulative distribution function of a
# random variable X in the APPL list of 3 lists format if
# the only argument given is X, or
# (2) Returns the value Pr(X <= x) if it is given the optional
# argument x in addition to the RV X
#
# Arguments: X: A continuous or discrete random variable;
# x (optional argument): A numeric value entered when
# trying to determine Pr(X <= x)
#
# Algorithm: 1. Perform error checking on user entered arguments
# 2. The CDF of X is determined by sending it to its
# appropriate category, which is based on whether:
# A. X is continuous or discrete
# B. X is entered in its PDF, CDF, SF, HF, CHF, or IDF
# format
# 3. If only 1 argument (the random variable X) is entered
# by the user, return the cumulative density function of
# X in the APPL list of 3 lists format
# 4. If 2 arguments are provided, return the value
# Pr(X <= x)
#
CDF := proc(X :: list(list), st)
local numlists, nsegments, FX, supp, fX, FCUM, i, FFX, t, prob, Y, Range,
lo, hi, incr, transf, hf, SX, chf, sf, pdf, idf, pieces, numops,
noceil, ceilpiece, solns, nsolns, cdf, val, invfound, j, idfval,
losupp, hisupp, sublist1, n, IDX2, notfound, count, k:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 2)) then
print(`ERROR(CDF): This procedure requires 1 or 2 arguments:`):
print(`A random variable X and an optional argument x for`):
print(`computing Pr(X <= x)`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
numlists := nops(X):
if (numlists <> 3) then
print(`ERROR(CDF): The RV X must be a list of 3 lists`):
return:
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(CDF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the RV X is continuous, find and return the CDF of X
#
if (X[3][1] = "Continuous") then
nsegments := nops(X[1]):
if (X[3][2] = "CDF") then
FX := X[1]:
supp := X[2]:
else
fX := PDF(X):
# print(`fX is`):
# print(fX):
FX := []:
supp := fX[2]:
FCUM := 0:
for i from 1 to nsegments do
# print(`i is`): print(i): print(fX[2][i]):
FFX := unapply(FCUM + int(fX[1][i](t), t = fX[2][i] .. x), x):
# print(FFX):
if (i < nsegments) then
FCUM := FFX(fX[2][i + 1]):
fi:
FX := [op(FX), unapply(simplify(FFX(x)), x)]:
# print(FX):
od:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([FX, supp, ["Continuous", "CDF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if not(type(evalf(st), {numeric, infinity})) then
if nsegments = 1 then
prob := FX[1](st):
return(prob):
else
print(`ERROR(CDF): Symbolic second arguments with a piecewise`):
print(`CDF is not allowable in APPL at this time`):
return:
fi:
fi:
if (evalf(st) < evalf(supp[1])) then return(0):
elif (evalf(st) >= evalf(supp[nsegments + 1])) then return(1) fi:
for i from 1 to nsegments do
if ((evalf(st) >= evalf(supp[i])) and (evalf(st) < evalf(supp[i
+ 1]))) then
break:
fi:
od:
prob := FX[i](st):
return(prob):
fi:
#
# If the RV X is discrete, find and return the CDF of X
#
elif (X[3][1] = "Discrete") then
#
# If the RV X is discrete, then call the procedure Convert(X) to
# convert the discrete random variable's support to a standard APPL
# discrete RV support format. Assign the converted random variable
# to the Maple variable Y.
#
Y := Convert(X):
FX[1] := Y[1]:
FX[2] := Y[2]:
#
# X has dot support
#
if type(Y[2][1], range) then
Range := Y[2][1]:
lo := lhs(Range):
hi := rhs(Range):
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
incr := Y[2][2]:
transf := Y[2][3]:
#
# Report the support of new random variable back to the user in its
# simplest form
#
if (incr = 1 and unapply(transf(x))(x) = x) then
FX[2] := [Range]:
elif (not(incr = 1) and unapply(transf(x))(x) = x) then
FX[2] := [Range, incr]:
elif (incr = 1 and not(unapply(transf(x))(x) = x)) then
FX[2] := [Range, Y[2][3]]:
else
FX[2] := [Range, incr, Y[2][3]]:
fi:
fi:
#
# APPL is not programmed to convert to a CDF format when the increment
# is not 1 and/or the transformation is not x -> x
#
# elif not(incr = 1 or unapply(transf(x))(x) = x) then
# print(`ERROR(CDF): APPL is currently unable to evaluate`):
# print(`this RV`):
# return:
# fi:
# fi:
#
# If X is given in its PDF or SF form
#
if member(Y[3][2], {"PDF", "SF"}) then
fX := PDF(X):
FX[1] := [unapply(simplify(sum(op(unapply(fX[1](w))(w)),
w = lo .. x)), x)]:
#
# If X is given in its CDF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "CDF") then
#
# The RV X is given in its HF form
#
elif (Y[3][2] = "HF") then
hf := unapply(op(Y[1])(w))(w):
# assume(x < hi):
sf := simplify(product(1 - hf, w = lo .. (x - 1))):
# print(sf):
FX[1] := [unapply(simplify(1 - sf), x)]:
# SX[1] := [unapply(product(1 - hf, w = lo .. (x - 1)), x)]:
# print(SX[1]):
# SX := [SX[1], Y[2], ["Discrete", "SF"]]:
# fX := PDF(SX):
# FX[1] := [unapply(simplify(sum(op(unapply(fX[1](w))(w)),
# w = lo .. x)), x)]:
#
# If X is given in its CHF form
#
elif (Y[3][2] = "CHF") then
chf := unapply(op(Y[1])(x))(x):
sf := exp(-chf):
pdf := simplify(subs(x = w, sf) - subs(x = w + 1, sf)):
FX[1] := [unapply(simplify(sum(pdf, w = lo .. x)), x)]:
#
# If X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
# need to look for a ceil function here!
idf := unapply(op(Y[1])(y))(y):
# print(`idf is`, idf):
# print(`[op(idf)] is`, [op(idf)]):
pieces := [op(idf)]:
numops := nops(pieces):
# print(numops):
noceil := true:
for i from 1 to numops while noceil do
if has(pieces, ceil) then
# print(`has ceil`):
noceil := false:
ceilpiece := i:
fi:
od:
if not(noceil) then
# print(pieces[ceilpiece]):
pieces[ceilpiece] := op(pieces[ceilpiece]):
idf := sum(pieces[k], k = 1 .. numops):
fi:
solns := [solve(idf = x, y)]:
# print(solns):
nsolns := nops(solns):
# Find the correct inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to cdf.
cdf := solns[1]:
else
if lo = -infinity then
if hi = infinity then
val := 0:
else
val := hi:
fi:
else
val := lo:
fi:
# print(`val is`, val):
invfound := false:
for j from 1 to nsolns do
# Evaluate each inverse of the IDF at the value "val" assigned
# above. If CDF(IDF(val)) = val, then assign idf equal to that
# inverse.
idfval := subs(x = val, idf):
if evalf(subs(x = idfval, solns[j])) = evalf(val) then
cdf := solns[j]:
invfound := true:
break:
fi:
od:
if not(invfound) then
print(`ERROR(CDF): Could not find the appropriate inverse`):
fi:
fi:
FX[1] := [unapply(cdf, x)]:
# CAUTION: losupp is incorrect in some cases -- currently don't know
# how to fix this, need to be able to retrieve the first cdf value and
# sub it into idf as lo
losupp := evalf(subs(y = lo, idf)):
hisupp := evalf(subs(y = hi, idf)):
FX[2] := [losupp .. hisupp]:
fi:
#
# X has no dot support
#
else
sublist1 := Y[1]:
n := nops(sublist1):
#
# If X is given in its PDF, HF, or CHF form
#
if member(Y[3][2], {"PDF", "HF", "CHF"}) then
fX := PDF(Y):
# print(fX):
FX[1][n] := 1:
for i from n - 1 to 1 by -1 do
FX[1][i] := FX[1][i + 1] - fX[1][i + 1]:
od:
#
# If X is given in its CDF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "CDF") then
#
# If X is given in its SF form
#
elif (Y[3][2] = "SF") then
for i from 1 to n - 1 do
FX[1][i] := 1 - sublist1[i + 1]:
od:
FX[1][n] := 1:
#
# If X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
IDX2 := Y[1]:
FX[1] := FX[2]:
FX[2] := IDX2:
fi:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([FX[1], FX[2], ["Discrete", "CDF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if type(Y[2][1], range) then
if (evalf(st) < lo) then
prob := 0:
elif (evalf(st) >= hi) then
prob := 1:
else
cdf := op(unapply(FX[1](w))(w)):
cdf := subs(w = floor(x), cdf):
# prob := op(FX[1](st)):
# need an evalf to get a float value with floor or ceil
prob := evalf(subs(x = st, cdf)):
fi:
else
# print(`FX[2][n] is`, FX[2][n]):
if (evalf(st) < FX[2][1]) then
prob := 0:
elif (evalf(st) >= FX[2][n]) then
prob := 1:
else
prob := 0:
notfound := true:
count := 1:
# print(`n is`, n):
for k from 1 to n - 1 while notfound do
if (evalf(st) < evalf(FX[2][k + 1])) and
(evalf(st) >= evalf(FX[2][k])) then
# print(`st is`, st):
notfound := false:
prob := FX[1][k]:
# print(`prob for k`, k):
# print(prob):
fi:
count := count + 1:
od:
fi:
fi:
return(prob):
fi:
#
# X is neither continuous nor discrete
#
else
print(`ERROR(CDF): The random variable X must be continuous or`):
print(`discrete`):
fi:
end: #1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: chf6.map
#
# Procedure Name: CHF(X, [x])
#
# Other APPL Procedures Called: HF, Convert, SF
#
# Date: March 20, 2001
#
# Purpose: CHF is a procedure that:
# (1) Returns the cumulative hazard function of a distribution
# in the APPL list of 3 sublists form if given only the one
# argument X, or
# (2) Returns the value -log(1 - Pr(X <= x)) if it is given the
# optional argument x in addition to the RV X
#
# Arguments: X: A continuous or discrete random variable;
# x (optional argument): A numeric value entered when
# trying to determine -log(1 - Pr(X <= x))
#
# Algorithm: 1. Perform error checking on user entered arguments
# 2. The CHF of X is determined by sending it to its
# appropriate category, which is based on whether:
# A. X is continuous or discrete
# B. X is entered in its PDF, CDF, SF, HF, CHF, or IDF
# format
# 3. If only 1 argument (the random variable X) is entered
# by the user, return the cumulative hazard function of
# X in the APPL list of 3 lists format
# 4. If 2 arguments are provided, return the value
# -log(1 - Pr(X <= x))
#
CHF := proc(X :: list(list), st)
local numlists, nsegments, hX, supp, CHX, HCUM, i, HHX, prob, Y, Range,
lo, hi, incr, transf, SX, sf, chf, hf, idf, pieces, numops,
noceil, ceilpiece, solns, nsolns, cdf, val, invfound, j, idfval,
pdf, losupp, hisupp, sublist1, n, notfound, count, k:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 2)) then
print(`ERROR(CHF): This procedure requires 1 or 2 arguments:`):
print(`A random variable X and an optional argument x for`):
print(`computing -log(1 - Pr(X <= x))`):
return:
fi:
#
# Check that the RV X is in the list of 3 sublists format
#
numlists := nops(X):
if (numlists <> 3) then
print(`ERROR(CHF): The RV X must be a list of 3 lists`):
return:
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(CHF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the RV X is continuous, find and return the CHF of X
#
if (X[3][1] = "Continuous") then
nsegments := nops(X[1]):
if (X[3][2] = "HF") then
hX := X:
else
hX := HF(X):
fi:
supp := hX[2]:
CHX := []:
HCUM := 0:
for i from 1 to nsegments do
HHX := unapply(HCUM + int(hX[1][i](index),
index = hX[2][i] .. x), x):
if (i < nsegments) then
HCUM := HHX(hX[2][i + 1]):
fi:
CHX := [op(CHX), op([unapply(simplify(HHX(x)), x)])]:
od:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([CHX, supp, ["Continuous", "CHF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if not(type(evalf(st), {numeric, infinity})) then
if nsegments = 1 then
prob := CHX[1](st):
return(prob):
else
print(`ERROR(CHF): Symbolic second arguments with a piecewise`):
print(`CHF are not allowable in APPL at this time`):
return:
fi:
fi:
for i from 1 to nsegments do
if ((evalf(st) >= evalf(supp[i])) and (evalf(st) <
evalf(supp[i + 1]))) then
break:
fi:
od:
prob := CHX[i](st):
return(prob):
fi:
#
# The RV X is a discrete random variable
#
elif (X[3][1] = "Discrete") then
#
# If the RV X is discrete, then call the procedure Convert(X) to
# convert the discrete random variable's support to a standard APPL
# discrete RV support format. Assign the converted random variable
# to the Maple variable Y.
#
Y := Convert(X):
CHX[1] := Y[1]:
CHX[2] := Y[2]:
#
# X has dot support
#
if type(Y[2][1], range) then
Range := Y[2][1]:
lo := lhs(Range):
hi := rhs(Range):
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
incr := Y[2][2]:
transf := Y[2][3]:
#
# Report the support of new random variable back to the user in its
# simplest form
#
if (incr = 1 and unapply(transf(x))(x) = x) then
CHX[2] := [Range]:
#
# APPL is not programmed to convert to a PDF format when the increment
# is not 1 and/or the transformation is not x -> x
#
elif not(incr = 1 or unapply(transf(x))(x) = x) then
print(`ERROR(CHF): APPL is currently unable to evaluate`):
print(`this RV`):
return:
fi:
fi:
#
# X is given in its PDF, CDF, or SF form
#
if member(Y[3][2], {"PDF", "CDF", "SF"}) then
SX := SF(Y):
sf := unapply(op(SX[1])(x))(x):
chf := -log(sf):
CHX[1] := [unapply(chf, x)]:
#
# X is given in its HF form
#
elif (Y[3][2] = "HF") then
hf := unapply(op(Y[1])(w))(w):
SX[1] := [unapply(product(1 - hf, w = lo .. (x - 1)), x)]:
sf := unapply(op(SX[1])(x))(x):
chf := -log(sf):
CHX[1] := [unapply(chf, x)]:
#
# If X is given in its CHF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "CHF") then
#
# X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
# need to look for a ceil function here!
idf := unapply(op(Y[1])(y))(y):
# print(`idf is`, idf):
pieces := [op(idf)]:
numops := nops(pieces):
# print(numops):
noceil := true:
for i from 1 to numops while noceil do
if has(pieces, ceil) then
# print(`has ceil`):
noceil := false:
ceilpiece := i:
fi:
od:
if not(noceil) then
# print(pieces[ceilpiece]):
pieces[ceilpiece] := op(pieces[ceilpiece]):
idf := sum(pieces[k], k = 1 .. numops):
fi:
solns := [solve(idf = x, y)]:
# print(solns):
nsolns := nops(solns):
# Find the correct inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to cdf.
cdf := solns[1]:
else
if lo = -infinity then
if hi = infinity then
val := 0:
else
val := hi:
fi:
else
val := lo:
fi:
# print(`val is`, val):
invfound := false:
for j from 1 to nsolns do
# Evaluate each inverse of the IDF at the value "val" assigned
# above. If CDF(IDF(val)) = val, then assign idf equal to that
# inverse.
idfval := subs(x = val, idf):
if evalf(subs(x = idfval, solns[j])) = evalf(val) then
cdf := solns[j]:
invfound := true:
break:
fi:
od:
if not(invfound) then
print(`ERROR(CHF): Could not find the appropriate inverse`):
fi:
fi:
pdf := simplify(subs(x = w, cdf) - subs(x = w - 1, cdf)):
sf := 1 - sum(pdf, w = lo .. x - 1):
chf := -log(sf):
CHX[1] := [unapply(chf, x)]:
# CAUTION: losupp is incorrect in some cases -- currently don't know
# how to fix this, need to be able to retrieve the first cdf value and
# sub it into idf as lo
losupp := evalf(subs(y = lo, idf)):
hisupp := evalf(subs(y = hi, idf)):
CHX[2] := [losupp .. hisupp]:
fi:
#
# X has no dot support
#
else
sublist1 := Y[1]:
n := nops(sublist1):
#
# If X is given in its PDF, CDF, SF, or HF form, convert X to its HF
# form. Then compute its cumulative hazard function.
#
if member(Y[3][2], {"PDF", "CDF", "SF", "HF"}) then
hX := HF(Y):
CHX[1][1] := 0:
for i from 2 to n do
CHX[1][i] := CHX[1][i - 1] - log(1 - hX[1][i - 1]):
od:
#
# If X is given in its CHF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "CHF") then
#
# X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
hX := HF(Y):
CHX[1][1] := 0:
for i from 2 to n do
CHX[1][i] := Y[1][i - 1] - log(1 - hX[1][i - 1]):
od:
CHX[2] := hX[2]:
fi:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([CHX[1], CHX[2], ["Discrete", "CHF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if type(Y[2][1], range) then
prob := op(CHX[1](st)):
else
prob := 0:
notfound := true:
count := 1:
for k from 1 to n while notfound do
if evalf(CHX[2][k]) = evalf(st) then
notfound := false:
prob := CHX[1][count]:
fi:
count := count + 1:
od:
fi:
return(prob):
fi:
#
# X is neither continuous nor discrete
else
print(`ERROR(CHF): The random variable X must be continuous or`):
print(`discrete`):
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: cleanup1.map
#
# Procedure name: CleanUp(X)
#
# Other APPL Procedures Called:
#
# Date: August 8, 2000
#
# NEED TO WORK ON COMMENTS AT A LATER TIME (6/28/2000)
#
# Purpose: Clean up the list of sublists data structure
#
# Arguments: X: Random variable
#
# Algorithm:
# 1. Check for the appropriate number of arguments
#
CleanUp := proc(X :: list(list))
local fX, nsegs, i:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(CleanUp): This procedure requires 1 argument`):
RETURN():
fi:
fX := X:
nsegs := nops(fX[1]):
#
# Construct the list y
#
for i from 1 to (nsegs - 1) do
# print(fX[1][i]):
# print(unapply(fX[1][i](x))(x)):
# print(evalb(fX[1][i] = fX[1][i + 1])):
if evalb(fX[1][i] = fX[1][i + 1]) then
fX[1] := [op(fX[1][1 .. i]), op(fX[1][i + 2 .. nsegs])]:
fX[2] := [op(fX[2][1 .. i]), op(fX[2][i + 2 .. (nsegs + 1)])]:
fi:
od:
RETURN(fX):
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888#
# Filename: coefofvar1.map
#
# Procedure Name: CoefOfVar(X)
#
# Other APPL Procedures Called:
#
# Updated: June 30, 2000
#
# Purpose: Returns the
#
# Arguments: X: Random Variable
#
# Algorithm:
CoefOfVar := proc(X :: list(list))
local NumLists, fX, mu, sigma, cov:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(CovOfVar): This procedure requires 1 argument:`):
print(`A random variable`):
RETURN():
fi:
#
# Check that the RV X is in a list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(Skewness): The RV X must be in a list of 3 lists format`):
RETURN():
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
else
if ((X[3][2] = "CDF") or
(X[3][2] = "CHF") or
(X[3][2] = "HF") or
(X[3][2] = "IDF") or
(X[3][2] = "SF")) then
fX := PDF(X):
else
print(`ERROR(CoefOfVar): RV must be given as`):
print(`CDF, CHF, HF, IDF, PDF, or SF`):
RETURN():
fi:
fi:
mu := Mean(fX):
# print(`mu is`, mu):
sigma := Variance(fX):
# print(`sigma is`, sigma):
cov := sqrt(sigma) / mu:
RETURN(cov):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
#
# NOTE (Jan. 21, 2000): error checking parameters with statements
# like lambda :: {symbol, positive} can have its problem, since
# lambda will not allowed to be entered as something like 3 ^ 2
# (7/25/00) -- no longer a problem in Maple 6 (8/3/2000) -- Yes, still
# a problem with some examples: WeibullRV(sqrt(Pi) / 6, 2.0)
#
# 7/25/00:
# (1) if have thing :: {finite, symbol}, then infinity will make it
# thru as thing since infinity is of type symbol, so thing ::
# {finite, symbol} means that thing can either be of type finite OR
# symbol
#
# (2) added double quotes to "Continuous" and "PDF"
#
# (3) made parameters global variables
#
# (4) type(x, infinity) returns true if x is infinity or -infinity in
# Maple 6
#
# Filename: contdist2.map
#
# Procedure names:
# ArcSinRV
# ArcTanRV
# BetaRV
# CauchyRV
# ChiRV
# ChiSquareRV
# DoublyNoncentralFRV
# DoublyNoncentralTRV
# ErlangRV
# ErrorRV
# ExponentialRV
# ExponentialPowerRV
# ExtremeValueRV
# FRV
# GammaRV
# GeneralizedParetoRV
# GompertzRV
# HyperbolicSecantRV
# HyperExponentialRV
# HypoExponentialRV
# IDBRV
# InverseGaussianRV
# InvertedGammaRV
# KSRV
# LaPlaceRV
# LogGammaRV
# LogisticRV
# LogLogisticRV
# LogNormalRV
# LomaxRV
# MakehamRV
# MuthRV
# NoncentralChiSquareRV
# NoncentralFRV
# NoncentralTRV
# NormalRV
# ParetoRV
# RayleighRV
# StandardCauchyRV
# StandardNormalRV
# StandardTriangularRV
# StandardUniformRV
# TRV
# TriangularRV
# UniformRV
# WeibullRV
#
# Other APPL Procedures Called: HypoExponentialRV calls
# ExponentialRV and Convolution
#
# Date: July 25, 2000
# Stopped making changes at Inverse Gaussian ...
# pick up there in the future
# Re-examine Hypo and Hyperexponential in the future
#
# Purpose: Define the common parametric continuous univariate
# probability distributions shown below:
#
# Distribution Support Parameters ParameterRestrictions
# ------------ ------- ---------- ---------------------
# ArcSin 0 < x < 1 none
# ArcTan x >= 0 alpha, phi alpha > 0;
# -inf < phi < inf
# Beta 0 <= x <= 1 Shape alpha, alpha > 0; beta > 0
# shape beta
# Cauchy -inf < x < inf Location a, -inf < a < inf;
# Scale alpha alpha > 0
# Chi x >= 0 Shape n positive integer n
# ChiSquare x >= 0 Shape n positive integer n
# DblyNoncentralF
# DblyNoncentralT
# Erlang x >= 0 Scale lambda, lambda > 0
# shape n positive integer n
# Error -inf < x < inf mu, alpha, mu > 0; alpha >= 1;
# location d -inf < d < inf
# Exponential x >= 0 Scale lambda lambda > 0
# Exponent Pwr x >= 0 Scale lambda, lambda > 0; kappa > 0
# shape kappa
# ExtremeValue -inf < x < inf Scale ? alpha, alpha > 0; beta > 0
# shape ? beta
# F x >= 0 Shape n1, positive ints n1, n2
# shape n2
# Gamma x >= 0 Scale lambda, lambda > 0; kappa > 0
# shape kappa
# GenPareto x >= 0 gamma, delta, kappa
# Gompertz x >= 0 Shape delta, delta > 0; kappa > 1
# shape kappa
# HyperbolicSecant -inf < x < inf none
# HyperExponential x >= 0 list p, list l all elts of list p:
# 0 <= p <= 1
# all elts of list l:
# l > 0
# HypoExponential x >= 0 list l all elts of list l:
# l > 0
# IDB x >= 0 Shape gamma, gamma, delta >= 0,
# delta, kappa kappa >= 0
# InverseGaussian x > 0 Scale lambda, lambda > 0; mu > 0
# location mu
# InvertedGamma x >= 0 alpha, beta alpha > 0; beta > 0
# KS
# LaPlace -inf < x < inf omega, theta omega > 0
# LogGamma -inf < x < inf alpha, beta alpha > 0; beta > 0
# Logistic -inf < x < inf Scale kappa kappa > 0; lambda > 0
# shape (?) lambda
# Log logistic x >= 0 Scale lambda, lambda > 0; kappa > 0
# shape kappa
# LogNormal x >= 0 Scale mu, -inf < mu < inf;
# shape sigma sigma > 0
# Lomax x > 0 kappa, lambda kappa > 0; lambda > 0
# Makeham x >= 0 Shape gamma, gamma, delta > 0;
# delta, kappa kappa > 1
# Muth x >= 0 Shape kappa 0 < kappa <= 1
# NoncentralChiSqre 0 <= x <= 1
# NoncentralF 0 <= x <= 1
# NoncentralT 0 <= x <= 1
# Normal -inf < x < inf Location mu, -inf < mu < inf;
# scale sigma sigma > 0
# Pareto x >= lambda Location lambda,
# shape kappa lambda > 0; kappa > 0
# Rayleigh x > 0 Scale lambda lambda > 0
# StandardCauchy -inf < x < inf none
# StandardNormal -inf < x < inf none
# StandardTriangular0 <= x <= 1 m 0 <= m <= 1
# StandardUniform 0 <= x <= 1 none
# T -inf < x < inf Shape n positive integer n
# Triangular a <= x <= b Min a, mode m, a < m < b
# max b
# Uniform a <= x <= b Min a, max b -inf < a < b < inf
# Weibull x >= 0 Scale lambda, lambda > 0; kappa > 0
# shape kappa
#
# Arguments: The parameters of the distribution of the random variable
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check parameter space when parameters are numeric
# 3. Check to see that the parameters are finite
# 4. Make assumptions about any symbolic parameters
# 5. Assign a list of lists in the following format:
# [[f(x)], [support], ["Continuous", "XXX"]]
# where XXX is one of the following: PDF, CDF, IDF, SF, HF, CHF
# 6. Return the list of lists
#
#print(`CONTINUOUS DISTRIBUTIONS:`):
# `DoublyNoncentralFRV()`, `DoublyNoncentralTRV()`,
# `NoncentralChiSquareRV()`, `NoncentralFRV()`, `NoncentralTRV()`,
#print(`ArcSinRV()`, `ArcTanRV(alpha, phi)`, `BetaRV(alpha, beta)`,
print(`ArcSinRV()`, `ArcTanRV(alpha, phi)`, `BetaRV(alpha, beta)`,
`CauchyRV(a, alpha)`, `ChiRV(n)`, `ChiSquareRV(n)`,
`ErlangRV(lambda, n)`, `ErrorRV(mu, alpha, d)`,
`ExponentialRV(lambda)`, `ExponentialPowerRV(lambda, kappa)`,
`ExtremeValueRV(alpha, beta)`, `FRV(n1, n2)`,
`GammaRV(lambda, kappa)`,
`GeneralizedParetoRV(gamma, delta, kappa)`,
`GompertzRV(delta, kappa)`,
`HyperbolicSecantRV()`, `HyperExponentialRV(p, l)`,
`HypoExponentialRV(l)`, `IDBRV(gamma, delta, kappa)`,
`InverseGaussianRV(lambda, mu)`, `InvertedGammaRV(alpha, beta)`,
`KSRV(n)`, `LaPlaceRV(omega, theta)`, `LogGammaRV(alpha, beta)`,
`LogisticRV(kappa, lambda)`, `LogLogisticRV(lambda, kappa)`,
`LogNormalRV(mu, sigma)`, `LomaxRV(kappa, lambda)`,
`MakehamRV(gamma, delta, kappa)`, `MuthRV(kappa)`,
`NormalRV(mu, sigma)`, `ParetoRV(lambda, kappa)`,
`RayleighRV(lambda)`, `StandardCauchyRV()`, `StandardNormalRV()`,
`StandardTriangularRV(m)`, `StandardUniformRV()`, `TRV(n)`,
`TriangularRV(a, m, b)`, `UniformRV(a, b)`,
`WeibullRV(lambda, kappa)`):
print(``):
#
# ArcSin distribution (special case of beta with both parameters 1 / 2)
#
ArcSinRV := proc()
local ListOfLists, x:
if (nargs <> 0) then
print(`ERROR(ArcSinRV): This procedure requires no arguments`):
RETURN():
fi:
ListOfLists := [[unapply(1 / (Pi * sqrt(x * (1 - x))), x)], [0, 1],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# ArcTan distribution
#
ArcTanRV := proc(alpha :: {positive, symbol}, phi :: {numeric,
symbol})
local ListOfLists, x:
global alpha1, phi1:
alpha1 := alpha:
phi1 := phi:
if (nargs <> 2) then
print(`ERROR(ArcTanRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (type(alpha1, infinity) or type(phi1, infinity)) then
print(`ERROR(ArcTanRV): Both parameters must be finite`):
RETURN():
fi:
if type(alpha1, symbol) then
assume(alpha1, positive):
about(alpha1):
fi:
if type(phi1, symbol) then
assume(phi1, numeric):
fi:
ListOfLists := [[unapply(alpha1 / ((arctan(alpha1 * phi1) + Pi / 2) *
(1 + alpha1 ^ 2 * (x - phi1) ^ 2)), x)],
[0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Beta distribution
#
BetaRV := proc(alpha :: {positive, symbol}, beta :: {positive, symbol})
local ListOfLists, x:
global alpha1, beta1:
alpha1 := alpha:
beta1 := beta:
if (nargs <> 2) then
print(`ERROR(BetaRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (type(alpha1, infinity) or type(beta1, infinity)) then
print(`ERROR(BetaRV): Both parameters must be finite`):
RETURN():
fi:
if type(alpha1, symbol) then
assume(alpha1, positive):
about(alpha1):
fi:
if type(beta1, symbol) then
assume(beta1, positive):
about(beta1):
fi:
ListOfLists := [[unapply(GAMMA(alpha1 + beta1) * x ^ (alpha1 - 1) *
(1 - x) ^ (beta1 - 1)/ (GAMMA(alpha1) * GAMMA(beta1)), x)],
[0, 1], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Cauchy distribution
#
CauchyRV := proc(a :: {numeric, symbol}, alpha :: {positive, symbol})
local ListOfLists, x:
global a1, alpha1:
a1 := a:
alpha1 := alpha:
if (nargs <> 2) then
print(`ERROR(CauchyRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (type(alpha1, infinity) or type(a1, infinity)) then
print(`ERROR(CauchyRV): Both parameters must be finite`):
RETURN():
fi:
if type(a1, symbol) then
assume(a1, numeric):
fi:
if type(alpha1, symbol) then
assume(alpha1, positive):
about(alpha1):
fi:
ListOfLists := [[unapply(1 / (alpha1 * Pi * (1 + ((x - a1) / alpha1) ^
2)), x)], [-infinity , infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Chi distribution
#
ChiRV := proc(n :: {posint, symbol})
local ListOfLists, x:
global n1:
n1 := n:
if (nargs <> 1) then
print(`ERROR(ChiRV): This procedure requires 1 argument`):
RETURN():
fi:
if type(n1, infinity) then
print(`ERROR(ChiRV): The shape parameter must be finite`):
RETURN():
fi:
if type(n1, symbol) then
assume(n1, posint):
about(n1):
fi:
ListOfLists := [[unapply(x ^ (n1 - 1) * exp(-x ^ 2 / 2) /
(2 ^ (n1 / 2 - 1) * GAMMA(n1 / 2)), x)],
[0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# ChiSquare distribution (special case of gamma)
#
ChiSquareRV := proc(n :: {posint, symbol})
local ListOfLists, x:
global n1:
n1 := n:
if (nargs <> 1) then
print(`ERROR(ChiSquareRV): This procedure requires 1 argument`):
RETURN():
fi:
if type(n1, infinity) then
print(`ERROR(ChiSquareRV): The shape parameter must be finite`):
RETURN():
fi:
if type(n1, symbol) then
assume(n1, posint):
about(n1):
fi:
ListOfLists := [[unapply(x ^ (n1 / 2 - 1) * exp(-x / 2) /
(2 ^ (n1 / 2) * GAMMA(n1 / 2)), x)],
[0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# DoublyNoncentralF
#
# NOTE: reference in Johnson, Kotz, Vol. 2, pg. 499:
#
# DoublyNoncentralFRV := proc()
# local ListOfLists, x:
# ListOfLists := [[unapply( , x)],
# [0, 1], ["Continuous", "PDF"]]:
#
#
# DoublyNoncentralT
#
# NOTE: reference in Johnson, Kotz, Vol. 2, pg. 533
#
# DoublyNoncentralTRV := proc()
# local ListOfLists, x:
# ListOfLists := [[unapply( , x)],
# [0, 1], ["Continuous", "PDF"]]:
#
#
# Erlang distribution
#
ErlangRV := proc(lambda :: {positive, symbol}, n :: {posint, symbol})
local ListOfLists, x:
global lambda1, n1:
lambda1 := lambda:
n1 := n:
if (nargs <> 2) then
print(`ERROR(ErlangRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (type(lambda1, infinity) or type(n1, infinity)) then
print(`ERROR(ErlangRV): Both parameters must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
if type(n1, symbol) then
assume(n1, posint):
about(n1):
fi:
ListOfLists := [[unapply(lambda1 * (lambda1 * x) ^ (n1 - 1) *
exp(-lambda1 * x) / (n1 - 1)!, x)], [0, infinity], ["Continuous",
"PDF"]]:
RETURN(ListOfLists):
end:
#
# Error distribution (exponential power, general error)
#
ErrorRV := proc(mu :: {positive, symbol}, alpha, d :: {numeric, symbol})
local ListOfLists, x:
global mu1, alpha1, d1:
mu1 := mu:
alpha1 := alpha:
d1 := d:
if (nargs <> 3) then
print(`ERROR(ErrorRV): This procedure requires 3 arguments`):
RETURN():
fi:
if is(alpha1 < 1) then
print(`ERROR(ErrorRV): The parameter alpha must be >= 1`):
RETURN():
fi:
if (type(mu1, infinity) or type(alpha1, infinity) or type(d1, infinity))
then
print(`ERROR(ErrorRV): Each parameter must be finite`):
RETURN():
fi:
if type(mu1, symbol) then
assume(mu1, positive):
about(mu1):
fi:
if type(alpha1, symbol) then
assume(alpha1, RealRange(1, infinity)):
about(alpha1):
fi:
if type(d1, symbol) then
assume(d1, numeric):
about(d1):
fi:
ListOfLists := [[unapply(mu1 * exp(-abs(mu1 * (x - d1)) ^ alpha1) /
(2 * GAMMA(1 + 1 / alpha1)), x)],
[-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# ErrorII distribution (exponential power, general error)
#
ErrorIIRV := proc(a, b :: {nonneg, symbol}, c :: {nonneg, symbol})
local ListOfLists, x:
global a1, b1, c1:
a1 := a:
b1 := b:
c1 := c:
if (nargs <> 3) then
print(`ERROR(ErrorIIRV): This procedure requires 3 arguments`):
RETURN():
fi:
if (type(a1, infinity) or type(b1, infinity) or type(c1, infinity)) then
print(`ERROR(ErorIIRV): Each parameter must be finite`):
RETURN():
fi:
if type(b1, symbol) then
assume(b1, nonneg):
about(b1):
fi:
if type(c1, symbol) then
assume(c1, nonneg):
about(c1):
fi:
ListOfLists := [[unapply(exp(-((abs(x - a1)) ^ (2 / c1))/(2 * b1)) /
((b1 ^ (c1 / 2))* 2 ^ (c1 / 2 + 1) * GAMMA(c1 / 2 + 1)), x)],
[-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Exponential distribution
#
ExponentialRV := proc(lambda)
local ListOfLists, x:
global lambda1:
lambda1 := lambda:
if (nargs <> 1) then
print(`ERROR(ExponentialRV): This procedure requires 1 argument`):
RETURN():
fi:
if (is(lambda <= 0)) then
print(`ERROR(ExponentialRV): Lambda must be positive`):
RETURN():
fi:
if type(lambda1, infinity) then
print(`ERROR(ExponentialRV): The scale parameter must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
ListOfLists := [[unapply(lambda1 * exp(-lambda1 * x), x)], [0, infinity],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Exponential power distribution
#
ExponentialPowerRV := proc(lambda :: {positive, symbol}, kappa ::
{positive, symbol})
local x, ListOfLists:
global lambda1, kappa1:
lambda1 := lambda:
kappa1 := kappa:
if (nargs <> 2) then
print(`ERROR(ExponentialPowerRV): This procedure requires 2`):
print(`arguments`):
RETURN():
fi:
if (type(lambda1, infinity) or type(kappa1, infinity)) then
print(`ERROR(ExponentialPowerRV): Both parameters must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
if type(kappa, symbol) then
assume(kappa1, positive):
about(kappa1):
fi:
ListOfLists := [[unapply(exp(1 - exp(lambda1 * x ^ kappa1)) * exp(lambda1
* x ^ kappa1) * lambda1 * kappa1 * x ^ (kappa1 - 1) , x)],
[0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# ExtremeValue distribution (Gumbel)
#
ExtremeValueRV := proc(alpha :: {positive, symbol}, beta :: {positive, symbol})
local ListOfLists, x:
global alpha1, beta1:
alpha1:=alpha:
beta1:=beta:
if (nargs <> 2) then
print(`ERROR(ExtremeValueRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (type(alpha1, infinity) or type(beta1, infinity)) then
print(`ERROR(ExtremeValueRV): Both parameters must be finite`):
RETURN():
fi:
if type(alpha1, symbol) then
assume(alpha1, positive):
fi:
if type(beta1, symbol) then
assume(beta1, positive):
fi:
ListOfLists := [[unapply(beta1 * exp(x * beta1 - exp(x * beta1) / alpha1) /alpha1, x)],
[-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# F (variance ratio, Fisher-Snedecor):
#
FRV := proc(n1 :: {posint, symbol}, n2 :: {posint, symbol})
local ListOfLists, x:
global n, m:
n := n1:
m := n2:
if (nargs <> 2) then
print(`ERROR(FRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (type(n, infinity) or type(m, infinity)) then
print(`ERROR(FRV): The shape parameters must be finite`):
RETURN():
fi:
if type(n, symbol) then
assume(n, posint):
about(n):
fi:
if type(m, symbol) then
assume(m, posint):
about(m):
fi:
ListOfLists := [[unapply((GAMMA((n + m) / 2) * (n / m) ^ (n / 2) *
x ^ ( n / 2 - 1))/ (GAMMA(n / 2 ) * GAMMA(m / 2) * ((n / m) * x + 1)
^ ((n + m) / 2) ), x)], [0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Gamma distribution
#
GammaRV := proc(lambda :: {positive, symbol}, kappa :: {positive,
symbol})
local x, ListOfLists:
global lambda1, kappa1:
lambda1 := lambda:
kappa1 := kappa:
if (nargs <> 2) then
print(`ERROR(GammaRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (type(lambda1, infinity) or type(kappa1, infinity)) then
print(`ERROR(GammaRV): Both parameters must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
if type(kappa1, symbol) then
assume(kappa1, positive):
about(kappa1):
fi:
ListOfLists := [[unapply(lambda1 * (lambda1 * x) ^ (kappa1 - 1) *
exp(-lambda1 * x) /GAMMA(kappa1), x)], [0, infinity], ["Continuous",
"PDF"]]:
RETURN(ListOfLists):
end:
#
# Generalized Pareto distribution
#
GeneralizedParetoRV := proc(gamma :: {positive, symbol}, delta ::
{positive, symbol}, kappa)
local x, ListOfLists:
global gamma1, delta1, kappa1:
gamma1 := gamma:
delta1 := delta:
kappa1 := kappa:
if (nargs <> 3) then
print(`ERROR(GeneralizedParetoRV): This procedure requires 3`):
print(`arguments`):
RETURN():
fi:
if is(kappa1 < -delta1 * gamma1) then
print(`ERROR(GeneralizedParetoRV): Parameter space violation`):
print(`Need kappa >= -delta * gamma`):
RETURN():
fi:
if (type(gamma1, infinity) or type(delta1, infinity) or type(kappa1,
infinity)) then
print(`ERROR(GeneralizedParetoRV): Each parameter must be finite`):
RETURN():
fi:
if type(delta1, symbol) then
assume(delta1, positive):
about(delta1):
fi:
if type(gamma1, symbol) then
assume(gamma1, positive):
about(gamma1):
fi:
ListOfLists := [[unapply((gamma1 + kappa1 / (x + delta1)) * (1 + x /
delta1) ^ (-kappa1) * exp(-gamma1 * x), x)], [0, infinity],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Gompertz distribution
#
GompertzRV := proc(delta :: {positive, symbol}, kappa)
local x, ListOfLists:
global delta1, kappa1:
delta1 := delta:
kappa1 := kappa:
if (nargs <> 2) then
print(`ERROR(GompertzRV): This procedure requires 2 arguments`):
RETURN():
fi:
if is(kappa1 <= 1) then
print(`ERROR(GompertzRV): The parameter kappa must be > 1`):
RETURN():
fi:
if (type(delta1, infinity) or type(kappa1, infinity)) then
print(`ERROR(GompertzRV): Each paramter must be finite`):
RETURN():
fi:
if type(delta1, symbol) then
assume(delta1, positive):
about(delta1):
fi:
if type(kappa1, symbol) then
assume(kappa1, RealRange(Open(1), infinity)):
fi:
ListOfLists := [[unapply(delta1 * kappa1 ^ x * exp(-delta1 * (kappa1 ^
x - 1) / log(kappa1)), x)], [0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# HyperbolicSecant
#
HyperbolicSecantRV := proc()
local ListOfLists, x:
if (nargs <> 0) then
print(`ERROR(HyperbolicSecantRV): This procedure requires no`):
print(`arguments`):
RETURN():
fi:
ListOfLists := [[unapply(sech(Pi * x) , x)], [-infinity, infinity],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# HyperExponential (n parameter distribution related to the
# exponential: it is a mixture of n Exponential RV's)
#
# The parameter p is a finite list of probablities (or mixture
# "weights")
# p := [p1, p2, ... , pn]:
# The parameter l is a finite list of values for lambda1, lambda2, ...
# l := [lambda1, lambda2, ... , lambdan]:
#
HyperExponentialRV := proc(p :: {list}, l :: {list})
local ListOfLists, x, lengthp, lengthl, count, SumOfListp,
RationalSumOfListp, PDF:
lengthp := nops(p):
lengthl := nops(l):
if (nargs <> 2) then
print(`ERROR(HyperExponentialRV): This procedure requires 2 list`):
print(`arguments`):
RETURN():
fi:
if (lengthp <> lengthl) then
print(`ERROR(HyperExponentialRV): Size of lists p and l must be the`):
print(`same`):
RETURN():
fi:
if (evalf(lengthp) = infinity or evalf(lengthl) = infinity) then
print(`ERROR(HyperExponentialRV): There must be a finite number of`):
print(`elements in lists p and l`):
RETURN():
fi:
for count from 1 to lengthp do
if (is(p[count] <= 0)) then
print(`ERROR(HyperExponentialRV): Each parameter in the list p`):
print(`must be positive`):
RETURN():
fi:
od:
for count from 1 to lengthp do
if (is(p[count] >= 1)) then
print(`ERROR(HyperExponentialRV): Each parameter in list p must be`):
print(`less than or equal to 1`):
RETURN():
fi:
od:
SumOfListp := sum(p[j], j = 1 .. lengthp):
RationalSumOfListp := convert(SumOfListp, rational):
if (RationalSumOfListp <> 1) then
print(`ERROR(HyperExponentialRV): The parameters in list p must`):
print(`sum to 1`):
RETURN():
fi:
for count from 1 to lengthl do
if (is(l[count] <= 0)) then
print(`ERROR(HyperExponentialRV): Each parameter in the list l`):
print(`must be positive`):
RETURN():
fi:
od:
for count from 1 to lengthl do
if (evalf(l[count]) = infinity or evalf(l[count]) = -infinity or
evalf(p[count]) = infinity or evalf(p[count]) = -infinity) then
print(`ERROR(HyperExponentialRV): Each parameter in lists l and p`):
print(`must be finite`):
RETURN():
fi:
od:
for count from 1 to lengthp do
if type(p[count], symbol) then
assume(p[count] >= 0):
assume(p[count] <= 1):
fi:
od:
for count from 1 to lengthl do
if type(l[count], symbol) then
assume(l[count] > 0):
fi:
od:
PDF := sum(p[j] * l[j] * exp(-l[j] * x), j = 1 .. lengthp):
ListOfLists := [[unapply(PDF, x)],[0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# HypoExponential (n parameter distribution related to the exponential)
#
# The parameter l is a finite list of values:
# l := [lambda1, lambda2, ... , lambdan]:
# NOTE TO LARRY: I'm using Convolution and ExponentialRV for now
#
HypoExponentialRV := proc(l)
local ListOfLists, x, lengthl, j, i, fsum:
lengthl := nops(l):
if (nargs <> 1) then
print(`ERROR(HypoExponentialRV): This procedure requires 1 list`):
print(`argument`):
RETURN():
fi:
if (evalf(lengthl) = infinity) then
print(`ERROR(HypoExponentialRV): There must be a finite number of`):
print(`elements in list l`):
RETURN():
fi:
for j from 1 to lengthl do
if (is(l[j] <= 0)) then
print(`ERROR(HypoExponentialRV): Each parameter in the list l must`):
print(`be positive`):
RETURN():
fi:
od:
for j from 1 to lengthl do
if (evalf(l[j]) = infinity or evalf(l[j]) = -infinity) then
print(`ERROR(HypoExponentialRV): Each parameter in list l must be`):
print(`finite`):
RETURN():
fi:
od:
for j from 1 to lengthl do
if type(l[j], symbol) then
assume(l[j] > 0):
fi:
od:
if (is(lengthl = 1)) then
ListOfLists := [[unapply(l[1] * exp(-l[1] * x) , x)],
[0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
fi:
if (is(lengthl >= 2)) then
fsum := Convolution(ExponentialRV(l[1]),ExponentialRV(l[2])):
if (is(lengthl > 2)) then
for i from 3 to lengthl do
fsum := Convolution(ExponentialRV(l[i]), fsum):
od:
fi:
RETURN(fsum):
fi:
end:
#
# IDB distribution
#
IDBRV := proc(gamma :: {nonneg, symbol}, delta :: {nonneg, symbol},
kappa :: {nonneg, symbol})
local x, ListOfLists:
global gamma1, delta1, kappa1:
gamma1 := gamma:
delta1 := delta:
kappa1 := kappa:
if (nargs <> 3) then
print(`ERROR(IDBRV): This procedure requires 3 arguments`):
RETURN():
fi:
if (type(gamma1, infinity) or type(delta1, infinity) or type(kappa1,
infinity)) then
print(`ERROR(IDBRV): Each parameter must be finite`):
RETURN():
fi:
if type(gamma1, symbol) then
assume(gamma1, nonneg):
about(gamma1):
fi:
if type(delta1, symbol) then
assume(delta1, nonneg):
about(delta1):
fi:
if type(kappa1, symbol) then
assume(kappa1, nonneg):
about(kappa1):
fi:
ListOfLists := [[unapply(1 - (1 + kappa1 * x) ^ (-gamma1 / kappa1) *
exp(-delta1 * x ^ 2 / 2), x)], [0, infinity], ["Continuous", "CDF"]]:
#
# The following code was deleted because there was difficulty
# integrating the PDF (7/25/00 -- might be worth trying again with Maple
# 6)
#
# ListOfLists := [[unapply(((1 + kappa * x) * delta * x + gamma) /
# ((1 + kappa * x) ^ (gamma / kappa + 1)) * exp(- delta * x ^ 2 /
# 2), x)],
# [0, infinity], ["Continuous", "PDF"]]:
#
RETURN(ListOfLists):
end:
#
# Inverse Gaussian distribution
#
InverseGaussianRV := proc(lambda :: {positive, symbol}, mu :: {positive,
symbol})
local x, ListOfLists:
global lambda1, mu1:
lambda1 := lambda:
mu1 := mu:
if (nargs <> 2) then
print(`ERROR(InverseGaussianRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(lambda1 <= 0) or is(mu1 <= 0)) then
print(`ERROR(InverseGaussianRV): Both parameters must be positive`):
RETURN():
fi:
if (type(lambda1, infinity) or type(mu1, infinity)) then
print(`ERROR(InverseGaussianRV): Both parameters must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
if type(mu1, symbol) then
assume(mu1, positive):
about(mu1):
fi:
ListOfLists := [[unapply(sqrt(lambda1 / (2 * Pi * x ^ 3)) *
exp(-lambda1 *(x - mu1) ^ 2 / (2 * mu1 ^ 2 * x)), x)],
[0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# InvertedGamma distribution
#
InvertedGammaRV := proc(alpha :: {positive, symbol}, beta :: {positive,
symbol})
local ListOfLists, x:
global alpha1, beta1:
alpha1 := alpha:
beta1 := beta:
if (nargs <> 2) then
print(`ERROR(InvertedGammaRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(alpha1 <= 0) or is(beta1 <= 0)) then
print(`ERROR(InvertedGammaRV): Both parameters must be positive`):
RETURN():
fi:
if (type(alpha1, infinity) or type(beta1, infinity)) then
print(`ERROR(InvertedGammaRV): Both parameters must be finite`):
RETURN():
fi:
if type(alpha1, symbol) then
assume(alpha1 , positive):
about(alpha1):
fi:
if type(beta1, symbol) then
assume(beta1 , positive):
about(beta1):
fi:
ListOfLists := [[unapply(x ^ (-alpha1 - 1) * exp(-1 / (beta1 * x)) /
(GAMMA(alpha1) * beta1 ^ alpha1) , x)], [0, infinity],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# KS
#
# NOTE TO DIANE: this distribution is already a routine ... perhaps this
# doesn't need to be here at all ... just placed in the commented list of
# distributions
#
# KSRV := proc();
# local ListOfLists, x;
# ListOfLists := [[unapply( , x)],[0, 1], ["Continuous", "PDF"]];
#
#
# LaPlace (double exponential)
#
LaPlaceRV := proc(omega :: {positive, symbol}, theta :: {numeric,
symbol})
local ListOfLists, x:
global omega1, theta1:
omega1 := omega:
theta1 := theta:
if (nargs <> 2) then
print(`ERROR(LaPlaceRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(omega1 <= 0)) then
print(`ERROR(LaPlaceRV): The parameter omega must be positive`):
RETURN():
fi:
if (type(omega1, infinity) or type(theta1, infinity)) then
print(`ERROR(LaPlaceRV): Both parameters must be finite`):
RETURN():
fi:
if type(omega1, symbol) then
assume(omega1, positive):
about(omega1):
fi:
if type(theta1, symbol) then
assume(theta1, numeric):
fi:
ListOfLists := [[unapply(exp(-abs(x - theta1) / omega1) / (2 * omega1),
x)], [-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# LogGamma distribution
#
LogGammaRV := proc(alpha :: {positive, symbol}, beta :: {positive,
symbol})
local ListOfLists, x:
global alpha1, beta1:
alpha1 := alpha:
beta1 := beta:
if (nargs <> 2) then
print(`ERROR(LogGammaRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(alpha1 <= 0)) then
print(`ERROR(LogGammaRV): The parameter alpha must be positive`):
RETURN():
fi:
if (is(beta1 <= 0)) then
print(`ERROR(LogGammaRV): The parameter beta must be a positive`):
RETURN():
fi:
if (type(alpha1, infinity) or type(beta1, infinity)) then
print(`ERROR(LogGammaRV): Both parameters must be finite`):
RETURN():
fi:
if type(alpha1, symbol) then
assume(alpha1, positive):
about(alpha1):
fi:
if type(beta1, symbol) then
assume(beta1, positive):
about(beta1):
fi:
ListOfLists := [[unapply(exp(beta1 * x) * exp(-exp(x) / alpha1) /
(alpha1 ^ beta1 * GAMMA(beta1)), x)], [-infinity, infinity],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Logistic distribution
#
LogisticRV := proc(kappa :: {positive, symbol}, lambda :: {positive,
symbol})
local ListOfLists, x:
global kappa1, lambda1:
kappa1 := kappa:
lambda1 := lambda:
if (nargs <> 2) then
print(`ERROR(LogisticRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(kappa1 <= 0) or is(lambda1 <= 0)) then
print(`ERROR(LogisticRV): Both parameters must be positive`):
RETURN():
fi:
if (type(kappa1, infinity) or type(lambda1, infinity)) then
print(`ERROR(LogisticRV): Both parameters must be finite`):
RETURN():
fi:
if type(kappa1, symbol) then
assume(kappa1, positive):
about(kappa1):
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
ListOfLists := [[unapply((lambda1 ^ kappa1 * kappa1 * exp(kappa1 * x)) /
((1 + (lambda1 * exp(x)) ^ kappa1) ^ 2), x)],
[-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Log logistic distribution
#
LogLogisticRV := proc(lambda :: {positive, symbol}, kappa :: {positive,
symbol})
local x, ListOfLists:
global lambda1, kappa1:
lambda1 := lambda:
kappa1 := kappa:
if (nargs <> 2) then
print(`ERROR(LogLogisticRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(lambda1 <= 0) or is(kappa1 <= 0)) then
print(`ERROR(LogLogisticRV): Both parameters must be positive`):
RETURN():
fi:
if (type(lambda1, infinity) or type(kappa1, infinity)) then
print(`ERROR(LogLogisticRV): Both parameters must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
if type(kappa1, symbol) then
assume(kappa1, positive):
about(kappa1):
fi:
ListOfLists := [[unapply(lambda1 * kappa1 * (lambda1 * x) ^ (kappa1 - 1)
/ ((1 + (lambda1 * x) ^ kappa1) ^ 2), x)], [0, infinity],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Log normal distribution
#
LogNormalRV := proc(mu :: {numeric, symbol}, sigma :: {positive, symbol})
local x, ListOfLists:
global mu1, sigma1:
mu1 := mu:
sigma1 := sigma:
if (nargs <> 2) then
print(`ERROR(LogNormalRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(sigma1 <= 0)) then
print(`ERROR(LogNormalRV): Sigma must be positive`):
RETURN():
fi:
if (type(mu1, infinity) or type(sigma1, infinity)) then
print(`ERROR(LogNormalRV): Both parameters must be finite`):
RETURN():
fi:
if type(sigma1, symbol) then
assume(sigma1, positive):
about(sigma1):
fi:
if type(mu1, symbol) then
assume(mu1, numeric):
fi:
ListOfLists := [[unapply(1 / (sqrt(2 * Pi) * x * sigma1) * exp(-(log(x) -
mu1) ^ 2 / (2 * sigma1 ^ 2)), x)], [0, infinity], ["Continuous",
"PDF"]]:
RETURN(ListOfLists):
end:
#
# Lomax (Pareto Type II)
#
LomaxRV := proc(kappa :: {positive, symbol}, lambda :: {positive,
symbol})
local ListOfLists, x:
global kappa1, lambda1:
kappa1:=kappa:
lambda1:=lambda:
if (nargs <> 2) then
print(`ERROR(LomaxRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(kappa1 <= 0)) then
print(`ERROR(LomaxRV): Kappa must be positive`):
RETURN():
fi:
if (is(lambda1 <= 0)) then
print(`ERROR(LomaxRV): Lambda must be positive`):
RETURN():
fi:
if (type(kappa1, infinity) or type(lambda1, infinity)) then
print(`ERROR(LomaxRV): Both parameters must be finite`):
RETURN():
fi:
if type(kappa1, symbol) then
assume(kappa1, positive):
about(kappa1):
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
ListOfLists := [[unapply(lambda1 * kappa1 * (1 + lambda1 * x) ^ (-kappa1
- 1) , x)], [0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Makeham distribution
#
MakehamRV := proc(gamma :: {positive, symbol}, delta :: {positive,
symbol}, kappa :: {numeric, symbol})
local x, ListOfLists:
global gamma1, delta1, kappa1:
gamma1:=gamma:
delta1:=delta:
kappa1:=kappa:
if (nargs <> 3) then
print(`ERROR(MakehamRV): This procedure requires 3 arguments`):
RETURN():
fi:
if (is(gamma1 <= 0) or is(delta1 <= 0) or is(kappa1 <= 1)) then
print(`ERROR(MakehamRV): Parameter space violation`):
RETURN():
fi:
if (type(gamma1, infinity) or type(delta1, infinity) or type(kappa1,
infinity)) then
print(`ERROR(MakehamRV): Each parameter must be finite`):
RETURN():
fi:
if type(delta1, symbol) then
assume(delta1, positive):
about(delta1):
fi:
if type(kappa1, symbol) then
assume(kappa1 > 1):
about(kappa1):
fi:
if type(gamma1, symbol) then
assume(gamma1, positive):
about(gamma1):
fi:
ListOfLists := [[unapply((gamma1 + delta1 * kappa1 ^ x) * exp(-gamma1 * x
- delta1 * (kappa1 ^ x - 1) / log(kappa1)), x)], [0, infinity],
["Continuous","PDF"]]:
RETURN(ListOfLists):
end:
#
# Muth distribution
#
MuthRV := proc(kappa :: {positive, symbol})
local x, ListOfLists:
global kappa1:
kappa1 := kappa:
if (nargs <> 1) then
print(`ERROR(MuthRV): This procedure requires 1 argument`):
RETURN():
fi:
if (is(kappa1 <= 0) or is(kappa1 > 1)) then
print(`ERROR(MuthRV): Parameter space violation`):
RETURN():
fi:
if type(kappa1, infinity) then
print(`ERROR(MuthRV): The shape parameter must be finite`):
RETURN():
fi:
if type(kappa1, symbol) then
assume(kappa1, positive):
additionally(kappa1 <= 1):
about(kappa1):
fi:
ListOfLists := [[unapply((exp(kappa1 * x) - kappa) * exp(-exp(kappa1 * x)
/ kappa1 + kappa1 * x + 1 / kappa1), x)], [0, infinity],
["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# NoncentralChiSquare
#
# NOTE TO DIANE: see comments at top of file
# REFERENCE NOTE: Hogg and Craig (5ed), pages 458-460
# REFERENCE NOTE: Larsen and Marx (2ed), page 508
# NoncentralChiSquareRV := proc():
# local ListOfLists, x:
# ListOfLists := [[unapply(, x)],[0, 1], ["Continuous", "PDF"]]:
#
#
# NoncentralF
#
# NOTE TO DIANE: see comments at top of file
# REFERENCE NOTE: Hogg and Craig (5ed), page 460-461
# REFERENCE NOTE: Larsen and Marx (2ed), page 509
# NoncentralFRV := proc():
# local ListOfLists, x:
# ListOfLists := [[unapply(, x)], [0, 1], ["Continuous", "PDF"]]:
#
#
# NoncentralT
#
# NOTE TO DIANE: see comments at top of file
# REFERENCE NOTE: Hogg and Craig (5ed), page 420
# REFERENCE NOTE: Larsen and Marx (2ed), page 353
# NoncentralTRV := proc():
# local ListOfLists, x:
# ListOfLists := [[unapply(, x)], [0, 1], ["Continuous", "PDF"]]:
#
#
# Normal distribution
#
NormalRV := proc(mu :: {numeric, symbol}, sigma)
local x, ListOfLists:
global mu1, sigma1:
mu1 := mu:
sigma1 := sigma:
if (nargs <> 2) then
print(`ERROR(NormalRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(sigma1 <= 0)) then
print(`ERROR(NormalRV): Sigma must be positive`):
RETURN():
fi:
if (type(mu1, infinity) or type(sigma1, infinity)) then
print(`ERROR(NormalRV): Both parameters must be finite`):
RETURN():
fi:
if type(sigma1, symbol) then
assume(sigma1, positive):
about(sigma1):
fi:
if type(mu1, symbol) then
assume(mu1, numeric):
fi:
ListOfLists := [[unapply(exp(-((x - mu1) / sigma1) ^ 2 / 2) / sqrt(2 *
Pi * sigma1 ^ 2), x)], [-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Pareto distribution
#
ParetoRV := proc(lambda :: {positive, symbol}, kappa :: {positive,
symbol})
local x, ListOfLists:
global lambda1, kappa1:
lambda1 := lambda:
kappa1 := kappa:
if (nargs <> 2) then
print(`ERROR(ParetoRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(lambda1 <= 0) or is(kappa1 <= 0)) then
print(`ERROR(ParetoRV): Both parameters must be positive`):
RETURN():
fi:
if (type(lambda1, infinity) or type(kappa1, infinity)) then
print(`ERROR(ParetoRV): Both parameters must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
if type(kappa1, symbol) then
assume(kappa1, positive):
about(kappa1):
fi:
ListOfLists := [[unapply(kappa1 * lambda1 ^ kappa1 / (x ^ (kappa1 + 1)),
x)], [lambda, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Rayleigh (special case of Weibull with kappa = 2)
#
RayleighRV := proc(lambda :: {positive, symbol})
local ListOfLists, x:
global lambda1:
lambda1 := lambda:
if (nargs <> 1) then
print(`ERROR(RayleighRV): This procedure requires 1 argument`):
RETURN():
fi:
if (is(lambda1 <= 0)) then
print(`ERROR(RayleighRV): The scale parameter must be positive`):
RETURN():
fi:
if type(lambda1, infinity) then
print(`ERROR(RayleighRV): The scale parameter must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
ListOfLists := [[unapply(2 * lambda1 ^ 2 * x * exp(-(lambda1 * x) ^ 2),
x)], [0, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# StandardCauchy (special case of T with 1 df or of Cauchy)
#
StandardCauchyRV := proc()
local ListOfLists, x:
if (nargs <> 0) then
print(`ERROR(StandardCauchyRV): This procedure requires no arguments`):
RETURN():
fi:
ListOfLists := [[unapply(1 / (Pi * (1 + x ^ 2)), x)], [-infinity,
infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# StandardNormal (special case of Normal)
#
StandardNormalRV := proc()
local ListOfLists, x:
if (nargs <> 0) then
print(`ERROR(StandardNormalRV): This procedure requires no arguments`):
RETURN():
fi:
ListOfLists := [[unapply(exp(- x ^ 2 / 2) / sqrt(2 * Pi), x)],
[-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# StandardTriangular (special case of Triangular)
#
StandardTriangularRV := proc(m :: {positive, symbol})
local ListOfLists, x:
global m1:
m1 := m:
if (nargs <> 1) then
print(`ERROR(StandardTriangularRV): This procedure requires 1`):
print(`argument`):
RETURN():
fi:
if (is(m1 <= 0) or is(m1 >= 1)) then
print(`ERROR: The parameter m must be strictly between 0 and 1`):
RETURN():
fi:
if type(m1, infinity) then
print(`ERROR(StandardTriangularRV): The parameter m must be finite`):
RETURN():
fi:
if type(m1, symbol) then
assume(m1, positive):
additionally(m1 < 1):
about(m1):
fi:
ListOfLists := [[unapply(2 * x / m1, x), unapply(2 * (1 - x) / (1 - m1),
x)], [0, m, 1], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# StandardUniform (special case of Uniform)
#
StandardUniformRV := proc()
local ListOfLists, x:
if (nargs <> 0) then
print(`ERROR(StandardUniformRV): This procedure requires no`):
print(`arguments`):
RETURN():
fi:
ListOfLists := [[unapply(1, x)], [0, 1], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# T distribution
#
TRV := proc(n :: {posint, symbol})
local ListOfLists, x:
global n1:
n1 := n:
if (nargs <> 1) then
print(`ERROR(TRV): This procedure requires 1 argument`):
RETURN():
#fi:
#elif not(type(n1, posint)) then
# print(`ERROR(TRV): The shape parameter must be a positive integer`):
# #RETURN():
#fi:
#elif type(n1, infinity) then
# print(`ERROR: The shape parameter must be finite`):
# RETURN():
#fi:
elif type(n1, symbol) then
assume(n1, posint):
about(n1):
fi:
ListOfLists := [[unapply(GAMMA((n1 + 1) / 2) * (1 + x ^ 2 / n1) ^
(- (n1 + 1) / 2) / (sqrt(n1 * Pi) * GAMMA(n1 / 2)),x)],
[-infinity, infinity], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Triangular distribution
#
TriangularRV := proc(a, m, b)
local x, ListOfLists:
global a1, m1, b1:
a1 := a:
m1 := m:
b1 := b:
if (nargs <> 3) then
print(`ERROR(TriangularRV): This procedure requires 3 arguments`):
RETURN():
fi:
if (is(m1 <= a1)) then
print(`ERROR(TriangularRV): First parameter must be less than the`):
print(`second parameter`):
RETURN():
fi:
if (is(b1 <= m1)) then
print(`ERROR(TriangularRV): Second parameter must be less than the`):
print(`third parameter`):
RETURN():
fi:
if (type(a1, infinity) or type(b1, infinity) or type(m1, infinity)) then
print(`ERROR(TriangularRV): Each parameter must be finite`):
RETURN():
fi:
if (type(a1, symbol) and type(m1, symbol)) then
assume(a1 < m1):
additionally(a1, numeric):
additionally(m1, numeric):
fi:
if (type(m1, symbol) and type(b1, symbol)) then
assume(m1 < b1):
additionally(m1, numeric):
additionally(b1, numeric):
fi:
ListOfLists := [[unapply(2 * (x - a1) / ((b1 - a1) * (m1 - a1)), x),
unapply(2 * (b1 - x) / ((b1 - a1) * (b1 - m1)), x)],
[a, m, b], ["Continuous", "PDF"]]:
RETURN(ListOfLists):
end:
#
# Uniform distribution
#
UniformRV := proc(a, b)
local x, ListOfLists:
global a1, b1:
a1 := a:
b1 := b:
if (nargs <> 2) then
print(`ERROR(UniformRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(b <= a)) then
print(`ERROR(UniformRV): First parameter must be less than second`):
print(`parameter`):
RETURN():
fi:
if (type(a1, infinity) or type(b1, infinity)) then
print(`ERROR(UniformRV): Both parameters must be finite`):
RETURN():
fi:
if type(a1, symbol) and type(b1, symbol) then
assume(a1 < b1):
additionally(a1, numeric):
additionally(b1, numeric):
about(a1):
about(b1):
fi:
ListOfLists := [[unapply(1 /(b1 - a1), x)], [a, b], ["Continuous",
"PDF"]]:
RETURN(ListOfLists):
end:
#
# Version identifier
#
VersionRV := proc()
print(`APPL version 2, 25 June 2002, (c) Andrew Glen, Larry Leemis, Diane Evans`);
end:
#
# Weibull distribution
#
WeibullRV := proc(lambda, kappa)
local x, ListOfLists:
global lambda1, kappa1:
lambda1 := lambda:
kappa1 := kappa:
if (nargs <> 2) then
print(`ERROR(WeibullRV): This procedure requires 2 arguments`):
RETURN():
fi:
if (is(lambda1 <= 0) or is(kappa1 <= 0)) then
print(`ERROR(WeibullRV): Both parameters must be positive`):
RETURN():
fi:
if (type(lambda1, infinity) or type(kappa1, infinity)) then
print(`ERROR(WeibullRV): The parameters must be finite`):
RETURN():
fi:
if type(lambda1, symbol) then
assume(lambda1, positive):
about(lambda1):
fi:
if type(kappa1, symbol) then
assume(kappa1, positive):
about(kappa1):
fi:
ListOfLists := [[unapply(kappa1 * lambda1 ^ kappa1 * x ^ (kappa1 - 1)
* exp(-(lambda1 * x) ^ kappa1), x)], [0, infinity], ["Continuous",
"PDF"]]:
RETURN(ListOfLists):
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: convert4.map
#
# NOTES:
# Discrete Cases:
# (I) dot cases
# (a) incremented by 1
# (b) transformed by g(x)
# (i) incremented by k
# (ii) incremented by 1
# (c) incremented by k
# (II) no dot cases
# (a) arrow case
# (b) no arrow case
#
# standard "dot" support format:
# [value .. value, incremented by k, transformed by g(x)]
#
# standard "no dot" pdf and support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
# Example: [0.1, 0.3, 0.2, 0.4], [1, 4, 11, 34/3]
#
# Procedure name: Convert(X)
#
# Other APPL Procedures Called: PDF, Convert, ConvertNoDot
#
# Date: February 12, 2000
#
# Purpose: (1) Converts discrete RVs with a "dot" support type to
# the standard APPL "dot" support format:
# [value .. value, incremented by k, transformed by g(x)]
#
# (2) Converts discrete RV's with a "no dot" support type
# to the standard "no dot" pdf and support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
#
# Arguments: A discrete random variable X in the list-of-lists format:
# [[f(x)], [support], ["Discrete", "XXX"]], where XXX is
# PDF, CDF, IDF, SF, HF, or CHF
# REPLACE #5 with something about range
# Algorithm
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 lists format
# 3. Check that the given RV X is discrete
# 4. Convert X to PDF form if not already in that form
# 5. Check to see whether the RV X is in the discrete "dot" case.
# In startup.map, "dot" is a defined structure type for discrete
# RVs. The structure `type/dot is defined to be:
# `type/dot` := {constant .. constant, symbol .. constant,
# constant .. symbol, symbol .. symbol}:
# 6. If X is in the "dot" case with support incremented by 1,
# [value .. value], then convert its support list to:
# [value .. value, 1, x -> x]
# 7. If X is in the "dot" case with support incremented by 1 and
# transformed by g(x): [value .. value, transformed by
# g(x)], then convert its support list to:
# [value .. value, 1, g(x)]
# 8. If X is in the "dot" case with support incremented by k,
# [value .. value, incremented by k], then convert its support
# list to:
# [value .. value, k, x -> x]
# 9. If the discrete RV X is not in the "dot" case, it is in the
# "no dot" case, which has a support list that looks like:
# [1, 2, 5], or [15], or [2, 8, 13, 43, 100]
# 10. If X is in the "no dot" case, then determine if the PDF
# sublist contains a Maple procedure. If so, then X is in the
# "arrow" (->) case and needs to be converted to the standard
# "no dot" form, which is:
# [[fraction1, fraction2, fraction3, ... , fractionN],
# [a1, a2, a3, ... , aN], ["Discrete", "PDF"]]
# 11. Check that symbols or infinity are not support values in the
# "no dot" cases
# 12. Convert X to the standard "no dot" form
# 13. Return the converted discrete random variable to the user in
# its new form
#
Convert := proc(X :: list(list))
local NumLists, fX, SubList2, n, NoDotList, SubList1, IllSupp, NewList1, i,
NewMemb:
#
# Check for the appropriate number of arguments
#
# print(`in convert`):
if (nargs <> 1) then
print(`ERROR(Convert): This procedure requires 1 argument:`):
print(`A discrete random variable`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(Convert):The RV X must be in a list of 3 lists format`):
return:
fi:
#
# Check to see that the random variable X is discrete
#
if not(X[3][1] = "Discrete") then
print(`ERROR(Convert): This procedure requires a discrete RV`):
return:
fi:
fX := X:
SubList1 := fX[1]:
SubList2 := fX[2]:
# print(SubList1):
# print(SubList2):
#
# The RV X must be in PDF, CDF, SF, HF, CHF, or IDF form
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(Convert): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# Conversions for random variables having PDF, CDF, SF, HF, or CHF
# formats
#
if member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
#
# Check to see whether the random variable X is in the discrete "dot"
# case
#
if type(SubList2[1], range) then
# print(`dot form`):
#
# In the "dot" case with support incremented by 1, [value .. value].
# Convert X's support to: [value .. value, 1, x -> x]
#
if type(SubList2[-1], range) then
# print(`example: binomial`):
SubList2 := [SubList2[1], 1, x -> x]:
#
# In the "dot" case with support incremented by 1 and transformed by
# g(x), [value .. value, transformed by g(x)].
# Convert X's support to: [value .. value, 1, g(x)]
#
elif (type(SubList2[-1], procedure) and not(type(SubList2[-2],
integer))) then
SubList2 := [SubList2[1], 1, SubList2[-1]]:
#
# In the "dot" case with support incremented by k, [value .. value,
# incremented by k].
# Convert X's support to: [value .. value, k, x -> x]
#
elif type(SubList2[-1], integer) then
SubList2 := [SubList2[1], SubList2[2], x -> x]:
fi:
#
# Check to see whether the random variable X is in the discrete "no
# dot" case
#
else
n := nops(SubList2):
IllSupp := false:
#
# Check for a procedure (x -> ) in the first SubList
#
if type(SubList1[1], procedure) then
#
# Check that symbols or infinity are not support values
#
for i from 1 to n do
if (type(SubList2[i], symbol) or type(SubList2[i], infinity))
then
IllSupp := true:
break:
fi:
od:
#
# Convert the Maple procedure in the PDF SubList to a list of the
# form: [fraction1, fraction2, fraction3, ..., fractionN]
#
NewList1 := []:
if not(IllSupp) then
for i from 1 to n do
NewMemb := op(subs(x = SubList2[i], SubList1(x))):
NewList1 := [op(NewList1), NewMemb]:
od:
fX[1] := NewList1:
else
print(`ERROR(Convert): This RV requires numeric support values`):
return(false):
fi:
#
# If a Maple procedure is NOT in the PDF sublist, check that symbols
# or infinity are not support values
#
else
for i from 1 to n do
if (type(SubList2[i], symbol) or type(SubList2[i], infinity))
then
IllSupp := true:
break:
fi:
od:
if (IllSupp) then
print(`ERROR(Convert): RV requires numeric support values`):
return(false):
fi:
fi:
fi:
elif X[3][2] = "IDF" then
# print(`just returning X as is for now`):
fi:
#
# Return the converted discrete random variable sublists to the user
# in its new form
#
return([fX[1], SubList2, fX[3]]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: converttonodot1.map
#
# standard "dot" support format:
# [value .. value, incremented by k, transformed by g(x)]
#
# standard "nodot" pdf and support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
# Example: [0.1, 0.3, 0.2, 0.4], [1, 4, 11, 34/3]
#
# Procedure name: ConvertToNoDot(X)
#
# Other APPL Procedures Called: PDF
#
# Date: February 13, 2000
#
# Purpose: Converts discrete RVs with a standard APPL "dot" support
# format to the standard APPL "no dot" support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
#
# Arguments: A discrete random variable X in the list-of-lists format:
# [[f(x)], [support], ["Discrete", "XXX"]], where XXX is
# PDF, CDF, IDF, SF, HF, or CHF
#
# Algorithm
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 lists format
# 3. Check that the given RV X is discrete
# 4. Convert X to PDF form if not already in that form
# 5. Check to see that the RV X has the standard APPL "dot" format.
# In startup.map, "dot" is a defined structure type for discrete
# RVs. The structure `type/dot is defined to be:
# `type/dot` := {constant .. constant, symbol .. constant,
# constant .. symbol, symbol .. symbol}:
# The standard APPL "dot" support format is:
# [value .. value, incremented by k, transformed by g(x)]
# 6. Convert to the PDF and support of X to the standard APPL "no
# dot" formats.
# 7. Return the converted discrete random variable to the user in
# its new form
#
ConvertToNoDot := proc(X :: list(list))
local NumLists, List2, fX, gX, List1, Supp, Lo, Hi, Incr, PopSize,
Finite, NewList1, NewList2, i:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(ConvertToNoDot): This procedure requires 1 argument:`):
print(`A discrete random variable`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(ConvertToNoDot): X must be a list of 3 lists`):
return:
fi:
#
# Check to see that the random variable X is discrete
#
if not(X[3][1] = "Discrete") then
print(`ERROR(ConvertToNoDot): Procedure requires a discrete RV`):
return:
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif member(X[3][2], {"CDF", "SF", "HF", "CHF", "IDF"}) then
fX := PDF(X):
else
print(`ERROR(ConvertToNoDot): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# Convert fX to its standard APPL discrete list-of-sublists format
#
fX := Convert(fX):
if (fX = false) then
print(`ERROR(Transform): Discrete RV X is NOT in legal APPL form`):
return:
fi:
List2 := fX[2]:
#
# Check to see that the random variable X is in the standard discrete
# "dot" case. If it is not, return an error message to the user.
#
if type(List2, range) then
if not(type(List2[-1], procedure) and type(List2[-2], numeric)) then
print(`ERROR(ConvertToNoDot): Procedure requires a discrete RV`):
print(`in standard "dot" support format`):
print(`error type 1`):
return:
fi:
fi:
# else
# print(`ERROR(ConvertToNoDot): Procedure requires a discrete RV`):
# print(`in standard "dot" support format`):
# return:
# fi:
#
# If the random variable X has a "dot" support format with g(x) as an
# expression other than x -> x, transform the PDF f(x) by g(x). See
# (*) in the introductory comments for the meaning of g(x).
#
# print(`fX is now`):
# print(fX):
gX := unapply(fX[2][-1](x))(x):
# print(`gX is`, gX):
if not((ispoly(gX, linear, x, 'a0', 'a1')) and
(a0 = 0) and (a1 = 1)) then
fX[1] := subs(x = gX, unapply(fX[1](x))(x)):
fi:
# print(`fX is now`):
# print(fX):
List1 := fX[1]:
Supp := List2[1]:
Lo := lhs(Supp):
Hi := rhs(Supp):
Incr := List2[-2]:
#
# Check to see if the discrete RV has finite or infinite support. If
# it has finite support, then assign the size of the RV's support to
# PopSize. If the RV's support is infinite, then just return a message
# about infinite support for now ...
#
if not(type(Hi, symbol)) then
PopSize := (Hi - Lo)/Incr + 1:
Finite := true:
elif type(Hi, symbol) then
print(`ERROR(ConvertToNoDot): Conversion cannot take place, since`):
print(`the random variable X has infinite support`):
return(false):
fi:
#
# Rewrite the discrete PDF in List1 as numerical values separated by
# commas, instead of a procedure. Also, rewrite List2.
# EXAMPLE: List1 := [x -> x / 15], List2 := [1 .. 5, 1, x -> x]
# becomes List1 := [1/15, 2/15, 3/15, 4/15, 5/15]
# List2 := [1, 2, 3, 4, 5]
#
NewList1 := []:
NewList2 := []:
for i from Lo by Incr to Hi do
NewList1 := [op(NewList1), simplify(subs(x = i, op(unapply
(List1(x))(x))))]:
NewList2 := [op(NewList2), simplify(subs(x = i, gX))]:
od:
List1 := NewList1:
List2 := NewList2:
#
# Return the ConvertToNoDot discrete random variable sublists to the
# user in its new form
#
return([List1, List2, fX[3]]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: convolution7.map
# corresponds to my paper
#
# Procedure Name: Convolution(X, Y)
#
# Other APPL Procedures Called: PDF, Transform, Product, Convert,
#
# Date: September 4, 2000
#
# Purpose:
#
# Arguments: X, Y
#
# Algorithm:
Convolution := proc(X :: list(list), Y :: list(list), Z :: list(list))
global fX, fY:
local fXc, fYc, Sum1, Sum2, NumLists, i, x1, x2, gln, ge, temp1, temp2, temp3, fV,
Lo, Hi, DotX, DotY, n, m, NewXY, XYSum, XYSumProbs, NewXYSumProbs,
j, NewXYSum, k, FinalPDF, NextProbValue, FinalSupport, count, mgfx,
mgfy, mgfprod, Temp, s, Probs, NumZeros, FirstTerm, SecondTerm,
fZ:
#
# 6/22/2007: ADDED these next three lines for an example in the APPL
# Monongraph in which we wanted to add 3 different random variables
# with the Convolution procedure
#
if (nargs = 3) then
Sum1 := Convolution(X, Y):
Sum2 := Convolution(Sum1, Z):
return(Sum2):
fi:
#
# Check for the number of arguments
#
if (nargs <> 2) then
print(`ERROR(Convolution): This procedure requires 2 arguments:`):
print(`A random variable X, and a random variable Y`):
return:
fi:
#
# Check that the first RV is a list of 3 sublists
#
for i from 1 to nargs do
NumLists := nops(args[i]):
if (NumLists <> 3) then
print(`ERROR(Convolution): The RV must be a list of 3 lists`):
return:
fi:
od:
#
# Convert the RV to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fXc := X:
elif member(X[3][2], {"CDF", "SF", "HF", "CHF", "IDF"}) then
fXc := PDF(X):
else
print(`ERROR(Convolution): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
# print(`fXc is`, fXc):
#
# Convert Y to PDF form if not already in that form
#
if (Y[3][2] = "PDF") then
fYc := Y:
elif member(Y[3][2], {"CDF", "SF", "HF", "CHF", "IDF"}) then
fYc := PDF(Y):
else
print(`ERROR(Convolution): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
# print(`fYc is`, fYc):
if (X[3][1] = "Continuous") then
#assume(x1 > 0):
#assume(x2, real):
gln := [[x1 -> ln(x1)], [0, infinity]]:
ge := [[x2 -> exp(x2),x2 -> exp(x2)], [-infinity,0, infinity]]:
temp1 := Transform(fXc, ge):
# print(`temp1 is`, temp1):
temp2 := Transform(fYc, ge):
# print(`temp2 is`, temp2):
temp3 := Product(temp1, temp2):
# print(`temp3 is`, temp3):
fZ := Transform(temp3, gln):
# print(`fZ is`, fZ):
elif (X[3][1] = "Discrete") then
fX := PDF(X):
fX := Convert(fX):
if (fX = false) then
print(`ERROR(Convolution): Discrete random variable X is NOT`):
print(`in legal APPL form`):
return:
fi:
fY := PDF(Y):
fY := Convert(fY):
if (fY = false) then
print(`ERROR(Convolution): Discrete random variable Y is NOT`):
print(`in legal APPL form`):
return:
fi:
#
# Determine if the random variable X has a "dot" support format or a
# "nodot" support format. Return an error message for a symbolic PDF
# in the "dot" format with symbolic support, such as:
# X := [[x -> x / 6], [1 .. n], ["Discrete", "PDF"]];
#
if type(fX[2][1], range) then
Lo := lhs(fX[2][1]):
Hi := rhs(fX[2][1]):
if type(Hi, symbol) and not(evalb(Hi = infinity)) then
print(`ERROR(Convolution): RV's support must be numeric`):
return:
elif type(Lo, symbol) or evalb(Lo = -infinity) then
print(`ERROR(Convolution): RV's lower support must be`):
print(`a finite numerical value`):
return:
#
# Convert finite "dot" formats to "nodot" formats. For example, if
# X := [[x -> x / 6], [1 .. 3], ["Discrete", "PDF"]], convert X to
# X := [[1 / 6, 2 / 6, 3 / 6], [1, 2, 3], ["Discrete", "PDF]];
#
elif type(Lo, numeric) and type(Hi, numeric) then
fX := ConvertToNoDot(fX):
n := nops(fX[2]):
DotX := false:
else
DotX := true:
fi:
#
# The RV X has a "nodot" support format
#
else
n := nops(fX[2]):
DotX := false:
fi:
#
# Determine if the random variable Y has a "dot" support format or a
# "nodot" support format. Return an error message for a symbolic PDF
# in the "dot" format with symbolic support
#
if type(fY[2][1], range) then
Lo := lhs(fY[2][1]):
Hi := rhs(fY[2][1]):
if type(Hi, symbol) and not(evalb(Hi = infinity)) then
print(`ERROR(Convolution): RV's support must be numeric`):
return:
elif type(Lo, symbol) or evalb(Lo = -infinity) then
print(`ERROR(Convolution): RV's lower support must be`):
print(`a finite numerical value`):
return:
#
# Convert finite "dot" formats to "nodot" formats.
#
elif type(Lo, numeric) and type(Hi, numeric) then
fY := ConvertToNoDot(fY):
m := nops(fY[2]):
DotY := false:
else
DotY := true:
fi:
else
m := nops(fY[2]):
DotY := false:
fi:
#
# RV has a "nodot" support format
# Example: X := [[1/6, 1/3, 1/2], [1, 2, 3], ["Discrete", "PDF"]];
# DISCRETE, NODOT (FINITE)
#
if not(DotX) and not(DotY) then
if (n * m <= 100) then
Temp := BruteForceConvolutionMethod():
else
Temp := MovingHeapConvolutionMethod():
fi:
s := Temp[1]:
Probs := Temp[2]:
if Probs[1] = 1 then
return([Probs, s, ["Discrete", "PDF"]]):
fi:
#
# Remove redundancies from probability list
#
FinalSupport := array(sparse, 1 .. n * m, []):
#
# Since first element will be unique, place the first 2 sum elements
# in the final support
#
FinalSupport[1] := s[1]:
FinalSupport[2] := s[2]:
FinalPDF := array(sparse, 1 .. n * m, []):
FinalPDF[1] := Probs[1]:
k := 2:
j := 2:
while (k < n * m) do
FinalPDF[j] := FinalPDF[j] + Probs[k]:
if evalf(s[k]) <> evalf(s[k + 1]) then
j := j + 1:
FinalSupport[j] := s[k + 1]:
fi:
k := k + 1:
od:
FinalPDF[j] := FinalPDF[j] + Probs[k]:
#
# Remove extraneous zeros from FinalPDF and FinalSupport. We know the
# zeros (if any) at the end of the FinalPDF array are not probability
# values. They exist because of the redundant values in s. Use
# FinalPDF to determine how many extraneous zeros exist, and
# reconstruct FinalPDF and FinalSupport so the extra zeros are not
# included as part of the arrays.
#
NumZeros := 0:
for i from (n * m) by -1 to 1 while FinalPDF[i] = 0 do
NumZeros := NumZeros + 1:
od:
FinalSupport := array(1 .. n * m - NumZeros, [seq(FinalSupport[i],
i = 1 .. n * m - NumZeros)]):
FinalPDF := array(1 .. n * m - NumZeros, [seq(FinalPDF[i],
i = 1 .. n * m - NumZeros)]):
FinalSupport := convert(FinalSupport, list):
FinalPDF := convert(FinalPDF, list):
fZ := [FinalPDF, eval(FinalSupport), ["Discrete", "PDF"]]:
# FinalPDF := convert(FinalPDF, list):
# SizeBefore := nops(FinalPDF):
# FinalPDF := remove(`=`, FinalPDF, 0):
# SizeAfter := nops(FinalPDF):
# ExtraZeros := SizeBefore - SizeAfter:
# FinalSupport := array(1 .. n * m - ExtraZeros, [seq(FinalSupport[i],
# i = 1 .. n * m - ExtraZeros)]):
#
# Either X or Y has a "dot" (infinite) support format. For example,
# X := [[x -> (1 / 2) ^ x], [1 .. infinity], ["Discrete", "PDF"]];
# DISCRETE, DOT (INFINITE)
#
#
# One RV has infinite support, while the other has finite support. Best
# we can do is return the product of the MGFs.
#
else
if not(DotX and DotY) then
mgfx := MGF(fX):
mgfy := MGF(fY):
mgfprod := combine(expand(mgfx * mgfy), exp):
print(`The moment generating function of X is`, mgfx):
print(`The moment generating function of Y is`, mgfy):
print(`The moment generating function of their product is`):
print(mgfprod):
return:
#
# Both X and Y have infinite support. Determine the convolution
# of the two PDFs by the discrete convolution formula if they are
# both defined on the same support, their supports are incremented by 1,
# and their transformations are x -> x.
#
else
# print(lhs(fX[2][1]), lhs(fY[2][1]), fX[2][-2], fY[2][-2]):
if (lhs(fX[2][1]) <> lhs(fY[2][1])) or (fX[2][-2] <> fY[2][-2]) or
(fX[2][2] <> 1) or (evalb(unapply(fX[2][-1](x))(x) <> x)) or
(evalb(unapply(fX[2][-1](x))(x) <> unapply(fX[2][-1](x))(x)))
then
mgfx := MGF(fX):
mgfy := MGF(fY):
mgfprod := combine(expand(mgfx * mgfy), exp):
print(`The moment generating function of X is`, mgfx):
print(`The moment generating function of Y is`, mgfy):
print(`The moment generating function of their product is`):
print(mgfprod):
return:
else
# print(op(unapply(fX[1](x))(x))):
# print(op(unapply(fY[1](x))(x))):
FirstTerm := subs(x = k, op(unapply(fX[1](x))(x))):
SecondTerm := subs(x = x - k, op(unapply(fY[1](x))(x))):
# print(Sum(FirstTerm * SecondTerm, k = 0 .. x )):
FinalPDF := simplify(sum(FirstTerm * SecondTerm, k = 0 .. x )):
# print(denom(FinalPDF)):
# MIGHT WANT TO ADD LINES FOR WHEN MAPLE IS UNABLE
# TO DETERMINE THE DISCRETE CONV FORMULA SUM
if has(denom(FinalPDF), GAMMA(x + 1)) then
FinalPDF := convert(FinalPDF, factorial):
fi:
FinalSupport := [lhs(fX[2][1]) + lhs(fY[2][1]) .. infinity]:
fZ := [[FinalPDF], FinalSupport, ["Discrete", "PDF"]]:
fi:
fi:
fi:
else
print(`ERROR(Convolution): This procedure requires a`):
print(`Continuous or Discrete random variable`):
return:
fi:
return(fZ):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: convolutioniid1.map
#
# Procedure Name: ConvolutionIID(X, n)
#
# Other APPL Procedures Called: PDF, Convolution
#
# Date: September 10, 1999
#
# Purpose:
#
# Arguments: X: Continuous random variable
#
# Algorithm:
#
ConvolutionIID := proc(X, n)
local fX, fsum, i:
if (n < 2) then
print(`ERROR(ConvolutionIID): n must be > 1`):
RETURN():
fi:
print(`Please be patient, this may take several minutes`):
# fX := PDF(X):
# print(`fX is`, fX):
fsum := Convolution(X, X):
# print(`fsum is`, fsum):
for i from 3 to n do
fsum := Convolution(X, fsum):
od:
RETURN(fsum):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: createheap4.map
#
# Procedure Name: CreateHeap(A, B)
#
# Other APPL Procedures Called:
#
# Date: September 8, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
CreateHeap := proc(A :: list, B :: list)
global H, Probs:
local n, i:
#
# Create a left complete tree H containing the sums to be sorted and
# create a left complete tree Probs that corresponds to each sum in H
#
n := nops(A) + 1:
H := array(1 .. n, [-1 * 10 ^ 6, op(A)]):
Probs := array(1 .. n, [0, op(B)]):
#
# In the following for loop, do until i = 2, since i = 2 is the root
# of the tree
#
for i from ceil(n / 2) by -1 to 2 do
PercolateDown(H, Probs, i, n):
od:
return(H, Probs):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: createminheap2.map
#
# Procedure Name: CreateMinHeap(A)
#
# Other APPL Procedures Called:
#
# Date: September 16, 2000
#
# Purpose: Create minimum heap for just 2 elements
#
# Arguments:
#
# Algorithm:
CreateMinHeap := proc(A :: array)
global H, Mimic:
#
# Create a left complete tree H for two elements
#
H := array(1 .. 3, [-1 * 10 ^ 6, A[1, 2], A[2, 1]]):
Mimic := array(1 .. 3, [-1 * 10 ^ 6, [1, 2], [2, 1]]):
# print(`H is`, eval(H)):
# print(`Mimic is`, eval(Mimic)):
PercolateDownHeap(2, 3):
return(eval(H), eval(Mimic)):
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888888888#
# Filename: crit1.map
#
# Procedure name: CriticalPoint(X, st)
#
# Other APPL Procedures Called: CDF
#
# Date: May 30, 1999
#
# Purpose: CriticalPoint is a procedure that returns the critical point of a List
# of Lists specificed pdf
#
# Arguments:
#
# Algorithm:
#
CriticalPoint := proc(fX, lower)
local i, nsegments, newlower, critpt, j, pt, X, x;
if (whatttype(evalf(lower)) = string) then
assume(lower < 1);
assume(lower > 0);
fi;
# print(`In procedure CriticalPoint`):
X := CDF(fX);
# print(X):
nsegments := nops(X[1]);
# print(nsegments):
if (nsegments = 1) then
# 6/28/2007, threw in an evalf() around lower and set to newlower
newlower := evalf(lower):
# print(newlower):
critpt := fsolve(X[1][1](pt) = newlower, pt = X[2][1] .. X[2][2]);
# critpt2 := solve(X[1][1](pt) = lower, pt);
# print(critpt2);
# 6/23/2007: Trying to prevent CriticalPoint from passing
# back just the expression fsolve() because it can't solve
# redirect fsolve() to try again and give it a region to
# look in
# SEARCH
if whattype(critpt) = function then
# print(`try something else`);
j := 0:
while (whattype(critpt) = function and j < 100) do
critpt := fsolve(X[1][1](pt) = lower, pt = 5 * j .. X[2][2]);
j := j + 1:
od:
fi:
else
for i from 1 to nsegments do
# print(i);
if (lower >= evalf(limit(X[1][i](x), x= X[2][i])) and lower <= evalf(limit(X[1][i](x), x = X[2][i + 1])) ) then
critpt := fsolve(X[1][i](pt) = lower, pt = X[2][i] .. X[2][i + 1]);
# critpt := solve(X[1][i](pt) = lower, pt);
break;
fi;
od;
fi;
RETURN(critpt);
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: datasets1.map
#
DataSets := proc()
global BallBearing, HorseKickFatalities, Hurricane, MP6, MP6Censor, RatControl, RatTreatment, USSHalfBeak:
local i:
# Leemis, Reliability text
BallBearing :=[17.88, 28.92, 33.00, 41.52, 42.12, 45.60, 48.48, 51.84, 51.96, 54.12, 55.56, 67.80, 68.64, 68.64, 68.88, 84.12, 93.12, 98.64, 105.12, 105.84, 127.92, 128.04, 173.40]:
# Larsen & Marx, 2nd Edition, page 201
HorseKickFatalities := [seq(0, i = 1 .. 109), seq(1, i = 1 .. 65), seq(2, i = 1 .. 22), seq(3, i = 1 .. 3), 4]:
# Larsen & Marx
Hurricane :=[31.00, 2.82, 3.98, 4.02, 9.50, 4.50, 11.40, 10.71, 6.31, 4.95, 5.64, 5.51, 13.40, 9.72, 6.47, 10.16, 4.21, 11.60, 4.75, 6.85, 6.25, 3.42, 11.80, 0.80, 3.69, 3.10, 22.22, 7.43, 5.00, 4.58, 4.46, 8.00, 3.73, 3.50, 6.20, 0.67]:
# Leemis, Reliability text
MP6 := [6, 6, 6, 6, 7, 9, 10, 10, 11, 13, 16, 17, 19, 20, 22, 23, 25, 32, 32, 34, 35]:
MP6Censor := [1, 1, 1, 0, 1, 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0]:
# A reliability book Larry loaned me -- it's on my bookshelf
USSHalfBeak := [1382, 2990, 4124, 6827, 7472, 7567, 8845, 9450, 9453, 9794, 10848, 11528, 11993, 11993, 12300, 15058, 15413, 16497, 17315, 17352, 17632, 18122, 19067, 19172, 19299, 19360, 19686, 19940, 19944, 20121, 20132, 20431, 20525, 21057, 21061, 21309, 21310, 21378, 21391, 21456, 21461, 21603, 21658, 21688, 21750, 21815, 21820, 21822, 21888, 21930, 21943, 21946, 22181, 22311, 22634, 22635, 22669, 22691, 22846, 22947, 23149, 23305, 23491, 23526, 23774, 23791, 23822, 24006, 24006, 24286, 25000, 25000, 25010, 25048, 25268, 25400, 25500, 25518]:
# Efron & Tibshirani, page 11
RatControl := [10, 27, 30, 40, 46, 51, 52, 104, 146]:
RatTreatment := [16, 23, 38, 94, 99, 141, 197]:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: deletemaxheap1.map
#
# Procedure Name: DeleteMaxHeap(H, i, n)
#
# Other APPL Procedures Called:
#
# Date: September 8, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
DeleteMaxHeap := proc(H :: array, Probs :: array, n)
local Temp:
Temp := H[2]:
# print(`Temp is`, Temp):
H[2] := H[n]:
# print(`New elt 2 is`, NewH[2]):
H[n] := Temp:
# print(`New last elt is`, NewH[n]):
# print(`n is`, n):
Temp := Probs[2]:
Probs[2] := Probs[n]:
Probs[n] := Temp:
# print(`NewH is`, NewH):
PercolateDown(H, Probs, 2, n - 1):
return(H, Probs):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: determinant1.map
#
# Procedure Name: Determinant(Matrix)
#
# Other APPL Procedures Called: Product, Convolution
#
# Date: April 13, 2000
#
# Purpose: Returns the distribution of the determinant of a 2x2 matrix # with random variables as elements
#
# Arguments: Matrix: A 2x2 array of random variables
#
# Algorithm:
# 1. Check to see if the matrix is a 2x2 square matrix
# 2. Compute the distribution of the determinant
# to contain all 1's to indicate the data values are uncensored
#
Determinant := proc(Matrix)
local i, j, NumSubLists, Term1, Term2, Deter, g:
#
# Check for the appropriate number of arguments: 1
#
if (nargs <> 1) then
print(`ERROR(Determinant): This procedure requires one argument:`):
print(`a matrix of random variables`):
RETURN():
fi:
#
# Check that the matrix is a 2x2 matrix
#
#
# Check that the RV X is given in a list of 3 lists format
#
for i from 1 to 2 do
for j from 1 to 2 do
NumSubLists := nops(Matrix[i, j]):
if (NumSubLists <> 3) then
print(`ERROR(Determinant):`):
print(`The RV X must be in a list of 3 lists format`):
RETURN():
fi:
od:
od:
Term1 := Product(Matrix[1, 1], Matrix[1, 2]):
# print(`******************************************`):
# print(`Term1 is:`):
# print(Term1):
# print(`******************************************`):
Term2 := Product(Matrix[2, 1], Matrix[1, 2]):
g := [[x -> -x], [-infinity, infinity]]:
Term2 := Transform(Term2, g):
# print(`******************************************`):
# print(`Term2 is:`):
# print(Term2):
# print(`******************************************`):
Deter := Convolution(Term1, Term2):
RETURN(Deter):
end:#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: difference1.map
#
# Procedure Name: Difference(X, Y)
#
# Other APPL Procedures Called: PDF
#
# Date: February 7, 2001
#
# Purpose:
#
# Arguments: X: Random variable
# Y: Random variable
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 lists format
# 3. Convert X to PDF form if not already in that form
# 4. Check whether the RV X is Continuous or Discrete
# 5. If the RV X is continuous, then compute its expected value
# 6. If the RV X is discrete, then determine if the support of X is
# in the "dot" or "no dot" form
# 7. If the random variable X is in the discrete "dot" case, first
# call procedure Convert(X) to convert its support to the
# *standard dot* support format:
# [anything .. anything, incremented by k, transformed by h(x)]
# 8. Transform the discrete dot pdf f(x) by h(x)
# 9. Find the expected value of the transformed pdf
# 10. Similarly, if the random variable X is in the discrete "no dot"
# case, first call procedure Convert(X) to convert its support to
# the *standard no dot* pdf/support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
#
Difference := proc(X :: list(list), Y :: list(list))
local NumListsX, NumListsY, fX, fY, NegY, DiffRV:
#
# Check for the appropriate number of arguments
#
if (nargs <> 2) then
print(`ERROR(Difference): This procedure requires 2 arguments`):
print(`A random variable X and a random variable Y`):
RETURN():
fi:
#
# Check that the RV X is in the list of 3 lists format
#
NumListsX := nops(X):
NumListsY := nops(Y):
if (NumListsX <> 3) or (NumListsY <> 3) then
print(`ERROR(Difference): X and Y must be in a list of 3`):
print(`sublists format`):
RETURN():
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
else
if ((X[3][2] = "CDF") or
(X[3][2] = "CHF") or
(X[3][2] = "HF") or
(X[3][2] = "IDF") or
(X[3][2] = "SF")) then
fX := PDF(X):
else
print(`ERROR(Difference): The RV X must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
fi:
if (Y[3][2] = "PDF") then
fY := Y:
else
if ((Y[3][2] = "CDF") or
(Y[3][2] = "CHF") or
(Y[3][2] = "HF") or
(Y[3][2] = "IDF") or
(Y[3][2] = "SF")) then
fY := PDF(Y):
else
print(`ERROR(Difference): The RV Y must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
fi:
NegY := Transform(Y, [[x -> -x], [-infinity, infinity]]):
# print(NegY):
DiffRV := Convolution(X, NegY):
RETURN(DiffRV):
end:#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: discdist1.map
#
# Procedure names: BenfordRV
# BernoulliRV
# BingoCoverRV
# BinomialRV
# BirthdayRV
# GeometricRV
# NegativeBinomialRV
# PoissonRV
# UniformDiscreteRV
#
# Other APPL Procedures Called: None
#
# Date: September 12, 2000
#
# Purpose: Define the common parametric discrete univariate
# probability distributions shown below:
#
# NOTE: For each distribution, x is an integer.
#
# Distribution Support Parameters Parameter Space
# ------------ ------- ---------- ---------------
# Benford x=1,2,...,9 none none
# Bernoulli
# BingoCover x=24,25,...,75 none none
# Binomial 0<=x<=n n, p n: pos int; 0 < p < 1
# Birthday x=1,2,...,365 none none
# Geometric x >= 1 p 0 < p < 1
# Hypergeometric
# NegativeBinomial
# Poisson x >= 0 lambda lambda > 0
# UniformDiscrete
#
# Arguments: The parameters of the distribution of the random
# variable
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check parameter space when parameters are numeric
# 3. Check to see that the parameters are finite
# 4. Make assumptions about any symbolic parameters
# 5. Assign a list of lists in the following format:
# [[f(x)], [support], ["Discrete", "XXX"]]
# where XXX is one of the following: PDF, CDF, IDF, SF, HF, CHF
# 6. Return the list of lists
#
# Note: Could define a type in startup about p being between 0 and 1
#
#
# Benford distribution
#
BenfordRV := proc()
local ListOfLists, x:
if (nargs <> 0) then
print(`ERROR(BenfordRV): This procedure requires no arguments`):
return:
fi:
readlib(log10):
ListOfLists := [[unapply(log[10](1 + 1 / x), x)], [1 .. 9],
["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Bernoulli distribution
#
BernoulliRV := proc(p)
local ListOfLists, x:
if (nargs <> 1) then
print(`ERROR(BernoulliRV): This procedure requires 1 argument`):
return:
fi:
if (is(p <= 0) or is(p >= 1)) then
print(`ERROR(BernoulliRV): The parameter p must be between 0 and 1`):
return:
fi:
if type(p, infinity) then
print(`ERROR(BernoulliRV): p must be finite`):
return:
fi:
if type(p, symbol) then
assume(p, RealRange(Open(0), Open(1))):
fi:
ListOfLists := [[1 - p, p], [0, 1], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# BingoCover distribution
#
BingoCoverRV := proc(numrows, numballs)
local ListOfLists, j, k, x:
#
# Set j = numrows and k = numballs. If no parameters are given, then
# set j = 5 and k = 75 as in a standard bingo card
#
if (nargs = 0) then
j := 5:
k := 75:
#
# If two arguments are given, make sure j is an odd integer >= 3, k is a
# positive integer, and 0 = k mod j
#
elif (nargs = 2) then
j := numrows:
k := numballs:
if type(j, symbol) then
assume(j, posint):
additionally(j >= 3):
additionally(j, odd):
fi:
if not(is(j, posint)) then
print(`ERROR(BingoCoverRV): j must be a positive integer`):
return:
fi:
if not(is(j, odd) and is(j >= 3)) then
print(`ERROR(BingoCoverRV): j must be an odd integer >= 3`):
return:
fi:
if type(k, symbol) then
assume(k, posint):
additionally(k >= j ^ 2):
additionally(k mod j = 0):
fi:
if not(is(k, posint)) then
print(`ERROR(BingoCoverRV): k must be a positive integer`):
return:
fi:
if not(is(k >= j ^ 2)) then
print(`ERROR(BingoCoverRV): This procedure requires k >= j^2`):
return:
fi:
if not(is(k mod j = 0)) then
print(`ERROR(BingoCoverRV): k mod j must be 0`):
return:
fi:
else
print(`ERROR(BingoCoverRV): This procedure requires no arguments or`):
print(`or 2 arguments`):
return:
fi:
with(combinat, binomial):
ListOfLists := [[unapply((binomial(j ^ 2 - 1, j ^ 2 - 2) *
binomial(k - (j ^ 2 - 1), x - (j ^ 2 - 1)) / binomial(k, x - 1)) *
1 / (k - (x - 1)), x)], [j ^ 2 - 1 .. k], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Binomial distribution
#
BinomialRV := proc(n, p :: {constant, symbol})
local ListOfLists, x:
# NOTE: binomial(*, *) is only guaranteed to work if both *'s are
# NUMERIC
if (nargs <> 2) then
print(`ERROR(BinomialRV): This procedure requires 2 arguments`):
return:
fi:
# try something with RealRange here
if (is(p <= 0) or is(p >= 1)) then
print(`ERROR(BinomialRV): The parameter p must be between 0 and 1`):
return:
fi:
if (type(p, infinity) or type(n, infinity)) then
print(`ERROR(BinomialRV): Both parameters must be finite`):
return:
fi:
if type(p, symbol) then
assume(p, RealRange(Open(0), Open(1))):
fi:
if type(n, symbol) then
assume(n, posint):
fi:
ListOfLists := [[unapply(n! / ((n - x)! * x!) * p^x * (1 - p) ^ (n - x),
x)], [0 .. n], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Birthday distribution: Let Y := BirthdayRV(); Then Y = the number of
# the first student whose birthday matches one of the previous students
#
BirthdayRV := proc()
local ListOfLists, x:
if (nargs <> 0) then
print(`ERROR(BirthdayRV): This procedure requires no arguments`):
return:
fi:
ListOfLists := [[unapply(x * 364! / ((365 ^ x) * (365 - x)!), x)],
[1 .. 365], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Geometric distribution
#
GeometricRV := proc(p)
local ListOfLists, x:
if (nargs <> 1) then
print(`ERROR(GeometricRV): This procedure requires 1 argument`):
return:
fi:
if (is(p <= 0) or is(p >= 1)) then
print(`ERROR(GeometricRV): The parameter p must be between 0 and 1`):
return:
fi:
if type(p, infinity) then
print(`ERROR(GeometricRV): The parameter p must be finite`):
return:
fi:
if type(p, symbol) then
assume(p, RealRange(Open(0), Open(1))):
fi:
ListOfLists := [[unapply(p * (1 - p)^(x - 1), x)], [1 .. infinity],
["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Hypergeometric distribution
#
HypergeometricRV := proc(M, r, n)
local ListOfLists, x, lo, hi:
# NOTE: binomial(*, *) only "works" if both *'s are numeric
#
# M used as parameter instead of N since N is an assigned name and
# can't make assumptions about it later
#
if (nargs <> 3) then
print(`ERROR(HypergeometricRV): This procedure requires 3`):
print(`arguments`):
return:
fi:
if type(M, symbol) then
assume(M, posint):
fi:
if type(r, symbol) then
assume(r, posint):
fi:
if type(n, symbol) then
assume(n, posint):
fi:
lo := max(0, n - M + r):
# print(`lo is`, lo):
hi := min(r, n):
# print(`hi is`, hi):
ListOfLists := [[unapply(((r! / ((r - x)! * x!)) * ((M - r)! /
((M - r - n + x)! * (n - x)!))) / (M! / ((M - n)! * n!)), x)],
[lo .. hi], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Negative Binomial distribution
#
NegativeBinomialRV := proc(r, p)
local ListOfLists, x:
if (nargs <> 2) then
print(`ERROR(NegativeBinomialRV): This procedure requires 1`):
print(`argument`):
return:
fi:
if (is(p <= 0) or is(p >= 1)) then
print(`ERROR(NegativeBinomialRV): The parameter p must be between`):
print(`0 and 1`):
return:
fi:
if type(p, infinity) then
print(`ERROR(NegativeBinomialRV): The parameter p must be finite`):
return:
fi:
if type(p, symbol) then
assume(p, RealRange(Open(0), Open(1))):
fi:
ListOfLists := [[unapply(((x - 1)! / ((r - 1)! * (x - r)!)) * p ^ r *
(1 - p) ^ (x - r), x)], [r .. infinity], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Poisson distribution
#
PoissonRV := proc(lambda)
local ListOfLists, x:
if (nargs <> 1) then
print(`ERROR(PoissonRV): This procedure requires 1 argument`):
return:
fi:
if type(lambda, infinity) then
print(`ERROR(PoissonRV): The parameter lambda must be finite`):
return:
fi:
if type(lambda, symbol) then
assume(lambda, positive):
fi:
ListOfLists := [[unapply(lambda ^ x * exp(-lambda) / x!, x)],
[0 .. infinity], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Uniform Discrete distribution
#
UniformDiscreteRV := proc(a, b, k)
local ListOfLists, incr, n, i:
if (nargs <> 2 and nargs <> 3) then
print(`ERROR(UniformDiscreteRV): This procedure requires either`):
print(`2 or 3 arguments`):
return:
fi:
if is(b - a <= 0) then
print(`ERROR(UniformDiscreteRV): "b" must be greater than "a"`):
return:
fi:
if not(type(a, numeric)) or not(type(b, numeric)) then
print(`ERROR(UniformDiscreteRV): "a" and "b" must be numeric`):
return:
fi:
if (nargs = 3) then
incr := k:
else
incr := 1:
fi:
if not(type(incr, numeric)) then
print(`ERROR(UniformDiscreteRV): "k" must be numeric`):
return:
fi:
n := (b - a) / incr:
if not(type(n, posint)) then
print(`ERROR(UniformDiscreteRV): "(b - a)" must be divisible by "k"`):
return:
fi:
ListOfLists := [[seq( 1 / (n + 1), i = 1 .. n + 1)], [seq(a + i * incr,
i = 0 .. n)], ["Discrete", "PDF"]]:
return(ListOfLists):
end:
#
# Zipf distribution
#
ZipfRV := proc(alpha)
local ListOfLists, denom, k, c:
if (nargs <> 1) then
print(`ERROR(ZipfRV): This procedure requires 1 argument`):
return:
fi:
if not(type(alpha, numeric)) then
print(`ERROR(ZipfRV): "alpha" must be numeric`):
return:
fi:
if is(alpha <= 0) then
print(`ERROR(ZipfRV): "alpha" must be positive`):
return:
fi:
denom := sum(((1 / k) ^ (alpha + 1)), k = 1 .. infinity):
c := 1 / denom:
ListOfLists := [[unapply(c / x ^ (alpha + 1), x)], [1 .. infinity],
["Discrete", "PDF"]]:
return(ListOfLists):
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888888888#
# Filename: display1.map
#
# Procedure Name: Display(X)
#
# Other APPL Procedures Called: None
#
# Date: June 1, 1999
#
# Purpose: Prints the List of List random variable X in a more readable format
# given a List of Lists specificed PDF
#
# Arguments: X: A continuous random variable
#
# Algorithm:
#
Display := proc(X)
local i, bb, nsegments, fnseq;
nsegments := nops(X[1]);
print(`This random variable is currently represented as follows:`);
if(X[3][2] = "PDF") then
bb:= ` PDF`;
print(X[3][1], bb);
if(X[2][1] <> -infinity) then
fnseq := x < X[2][1], 0;
else
fnseq := NULL;
fi;
for i from 1 to nsegments do
fnseq := fnseq, x < X[2][i + 1], X[1][i](x)
od;
# print(`the fn seq`, fnseq);
convert(If(fnseq), piecewise);
elif(X[3][2] = "CDF") then
bb := ` CDF`;
print(X[3][1], bb);
if(X[2][1] <> -infinity) then
fnseq := x < X[2][1], 0;
else
fnseq := NULL;
fi;
for i from 1 to nsegments do
fnseq := fnseq, x < X[2][i + 1], X[1][i](x)
od;
if(X[2][nsegments + 1] <> infinity) then
fnseq := fnseq, x > X[2][nsegments + 1], 1;
fi;
# print(`the fn seq`, fnseq);
convert(If(fnseq), piecewise);
elif(X[3][2] = "SF") then
bb:= ` SF`;
print(X[3][1], bb);
if(X[2][1] <> -infinity) then
fnseq := x < X[2][1], 1;
else
fnseq := NULL;
fi;
for i from 1 to nsegments do
fnseq := fnseq, x < X[2][i + 1], X[1][i](x)
od;
if(X[2][nsegments + 1] <> infinity) then
fnseq := fnseq, x > X[2][nsegments + 1], 0;
fi;
# print(`the fn seq`, fnseq);
convert(If(fnseq), piecewise);
elif(X[3][2] = "HF") then
bb:= ` HF`;
print(X[3][1], bb);
if(X[2][1] <> -infinity) then
fnseq := x < X[2][1], 0;
else
fnseq := NULL;
fi;
for i from 1 to nsegments do
fnseq := fnseq, x < X[2][i + 1], X[1][i](x)
od;
# print(`the fn seq`, fnseq);
convert(If(fnseq), piecewise);
elif(X[3][2] = "CHF") then
bb:= ` CHF`;
print(X[3][1], bb);
if(X[2][1] <> -infinity) then
fnseq := x < X[2][1], 0;
else
fnseq := NULL;
fi;
for i from 1 to nsegments do
fnseq := fnseq, x < X[2][i + 1], X[1][i](x)
od;
if(X[2][nsegments + 1] <> infinity) then
fnseq := fnseq, x > X[2][nsegments + 1], 1;
fi;
# print(`the fn seq`, fnseq);
convert(If(fnseq), piecewise);
elif( X[3][2] = "IDF") then
bb:= ` IDF`;
print(X[3][1], bb);
if(X[2][1] <> -infinity) then
fnseq := x < X[2][1], 0;
else
fnseq := NULL;
fi;
for i from 1 to nsegments do
fnseq := fnseq, x < X[2][i + 1], X[1][i](x)
od;
if(X[2][nsegments + 1] <> infinity) then
fnseq := fnseq, x > X[2][nsegments + 1], 1;
fi;
# print(`the fn seq`, fnseq);
convert(If(fnseq), piecewise);
else
print(`error, a non-list of list specified`);
fi;
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888888888#
# Filename: dn1.map
#
# Procedure Names: D1, D2, D3, ... , D10
#
# Other APPL Procedures Called: None
#
# Date: June 7, 1999
#
# Purpose:
#
# Arguments: None
#
# Algorithm:
#
D1 := [[proc (x) options operator, arrow; 2*x-1 end], [1/2, 1], ["Continuous", "CDF"]]:
D2 := [[proc (x) options operator, arrow; 1/2*(4*x-1)^2 end, proc (x) options operator, arrow; -1+4*x-2*x^2 end], [1/4, 1/2, 1], ["Continuous", "CDF"]]:
D3 := [[proc (x) options operator, arrow; 2/9*(6*x-1)^3 end, proc (x) options operator, arrow; -8/3*x+14*x^2-12*x^3 end, proc (x) options operator, arrow; -1+10/3*x-4*x^3+2*x^2 end, proc (x) options operator, arrow; -1+6*x-6*x^2+2*x^3 end], [1/6, 1/3, 1/2, 2/3, 1], ["Continuous", "CDF"]]:
D4 := [[proc (x) options operator, arrow; 3/32*(8*x-1)^4 end, proc (x) options operator, arrow; 3/8-9/2*x+21/2*x^2-48*x^4+24*x^3 end, proc (x) options operator, arrow; 3/8-63/8*x+75/2*x^2-48*x^3+16*x^4 end, proc (x) options operator, arrow; -1+37/8*x+3/2*x^2-10*x^3+6*x^4 end, proc (x) options operator, arrow; -12*x^2+8*x-1+8*x^3-2*x^4 end], [1/8, 1/4, 3/8, 1/2, 3/4, 1], ["Continuous", "CDF"]]:
D5 := [[proc (x) options operator, arrow; 24/625*(10*x-1)^5 end, proc (x) options operator, arrow; -96/625+672/125*x-1464/25*x^2+240*x^3-288*x^4 end, proc (x) options operator, arrow; 424/5*x^3+12*x^2-168/25*x+336/625-240*x^4+160*x^5 end, proc (x) options operator, arrow; -728/125*x+224/5*x^2-456/5*x^3+74*x^4-20*x^5 end, proc (x) options operator, arrow; -1+522/125*x+24/5*x^2-56/5*x^3+12*x^5-6*x^4 end, proc (x) options operator, arrow; -92/5*x^3+12/25*x^2+738/125*x-1+22*x^4-8*x^5 end, proc (x) options operator, arrow; 20*x^3-20*x^2+10*x-1-10*x^4+2*x^5 end], [1/10, 1/5, 3/10, 2/5, 1/2, 3/5, 4/5, 1], ["Continuous", "CDF"]]:
D6 := [[proc (x) options operator, arrow; 5/324*(12*x-1)^6 end, proc (x) options operator, arrow; 10/27*x+235/9*x^2-1280/3*x^3+2360*x^4-4800*x^5+2880*x^6-5/81 end, proc (x) options operator, arrow; 145/27*x-35/1296-785/9*x^2+4240/9*x^3-2600/3*x^4+320*x^5+320*x^6 end, proc (x) options operator, arrow; 5/16-565/81*x+1525/54*x^2+515/9*x^3-1115/3*x^4+560*x^5-280*x^6 end, proc (x) options operator, arrow; 5/16-7645/648*x+775/9*x^2-1985/9*x^3+295*x^4-240*x^5+104*x^6 end, proc (x) options operator, arrow; -1+3371/648*x+175/36*x^2-185/9*x^3+32*x^5-20*x^6 end, proc (x) options operator, arrow; -1+4651/648*x-115/108*x^2-265/9*x^3+160/3*x^4-38*x^5+10*x^6 end, proc (x) options operator, arrow; -1+12*x-30*x^2+40*x^3-30*x^4+12*x^5-2*x^6 end], [1/12, 1/6, 1/4, 1/3, 5/12, 1/2, 2/3, 5/6, 1], ["Continuous", "CDF"]]:
D7 := [[proc (x) options operator, arrow; 720/117649*(14*x-1)^7 end, proc (x) options operator, arrow; -2880/7*x^4-128160/343*x^3-8640/2401*x+40320*x^7-43200*x^6+92160/7*x^5+8640/117649+20880/343*x^2 end, proc (x) options operator, arrow; 99840/49*x^4+15600/343*x^3+140400/16807*x-4480*x^7+11200*x^6-57600/7*x^5-31860/117649-176760/2401*x^2 end, proc (x) options operator, arrow; -15950/49*x^4+45040/343*x^3-120240/16807*x-1680*x^7+2120*x^6-3540/7*x^5+54540/117649+36240/2401*x^2 end, proc (x) options operator, arrow; -51950/49*x^4+60040/343*x^3-157740/16807*x+1008*x^7-2296*x^6+15660/7*x^5+54540/117649+73740/2401*x^2 end, proc (x) options operator, arrow; 3770/7*x^4-103000/343*x^3-153852/16807*x-168*x^7+468*x^6-4380/7*x^5+31512/343*x^2 end, proc (x) options operator, arrow; -150/7*x^4-6960/343*x^3+81446/16807*x-40*x^7+20*x^6-1+324/7*x^5+2700/343*x^2 end, proc (x) options operator, arrow; 710/49*x^4-11120/343*x^3+104486/16807*x+30*x^7-80*x^6-1+414/7*x^5+11220/2401*x^2 end,
proc (x ) options operator, arrow; 5210/49*x^4-14870/343*x^3+141986/16807*x-12*x^7+58*x^6-1-786/7*x^5-7530/2401*x^2 end, proc (x) options operator, arrow; -70*x^4+70*x^3+14*x+2*x^7-14*x^6-1+42*x^5-42*x^2 end], [1/14, 1/7, 3/14, 2/7, 5/14, 3/7, 1/2, 4/7, 5/7, 6/7, 1], ["Continuous", "CDF"]]:
D8 := [[proc (x) options operator, arrow; 315/131072*(16*x-1)^8 end, proc (x) options operator, arrow; 6615/4096*x-138915/2048*x^2+49140*x^5-184275/16*x^4+80325/64*x^3+322560*x^8-161280*x^7-55440*x^6-315/32768 end, proc (x) options operator, arrow; -38745/16384*x+919485/8192*x^2-19215/524288-22785*x^5+300195/32*x^4-402465/256*x^3-35840*x^8+35840*x^7+10360*x^6 end, proc (x) options operator, arrow; 25795/4096*x-559265/4096*x^2-3115/524288+6020*x^5-105595/32*x^4+523005/512*x^3-11200*x^8+14560*x^7-9485*x^6 end, proc (x) options operator, arrow; -571655/65536*x+217315/16384*x^2+584395/1048576-5901/4*x^5-75705/128*x^4+475895/2048*x^3+6720*x^8-12096*x^7+7931*x^6 end, proc (x) options operator, arrow; -1240267/131072*x+35/128+430241/8192*x^2+60235/16*x^5-39795/32*x^4+102277/1024*x^3-1792*x^8+4928*x^7-11725/2*x^6 end, proc (x) options operator, arrow; -1031905/65536*x+35/128+156723/1024*x^2-35805/16*x^5+2765/2*x^4-603617/1024*x^3+256*x^8-1344*x^7+4739/2*x^6 end, proc (x) options
operator, arrow; 375071/65536*x-1+8435/1024*x^2+1547/16*x^5-35/2*x^4-32865/1024*x^3+70*x^8-110*x^7-35/2*x^6 end, proc (x) options operator, arrow; 947017/131072*x-1+69335/16384*x^2+2919/32*x^5+10395/256*x^4-96355/2048*x^3-42*x^8+156*x^7-833/4*x^6 end, proc (x) options operator, arrow; 1273609/131072*x-1-93961/16384*x^2-8421/32*x^5+48195/256*x^4-123571/2048*x^3+14*x^8-82*x^7+805/4*x^6 end, proc (x) options operator, arrow; 16*x-1-56*x^2+112*x^5-140*x^4+112*x^3-2*x^8+16*x^7-56*x^6 end], [1/16, 1/8, 3/16, 1/4, 5/16, 3/8, 7/16, 1/2, 5/8, 3/4, 7/8, 1], ["Continuous", "CDF"]]:
D9 := [[proc (x) options operator, arrow; 4480/4782969*(18*x-1)^9 end, proc (x) options operator, arrow; 555520/531441*x-703360/59049*x^2+3207680/243*x^4-89600/4782969-2535680/6561*x^3+9067520/9*x^6-4444160/27*x^5-2938880*x^7+3225600*x^8 end, proc (x) options operator, arrow; -3365600/531441*x+7269920/59049*x^2-9699200/2187*x^4-4827200/6561*x^3-30365440/81*x^6+18914560/243*x^5+806400*x^7-752640*x^8+215040*x^9+500080/4782969 end, proc (x) options operator, arrow; 46340000/4782969*x-9682960/43046721-62515040/531441*x^2+27233360/6561*x^4+4669280/19683*x^3+804160/9*x^6-7171360/243*x^5-1420160/9*x^7+179200*x^8-107520*x^9 end, proc (x) options operator, arrow; 1120000/177147*x+3267040/43046721-92895040/531441*x^2-37843540/6561*x^4+29533280/19683*x^3-2242912/81*x^6+3270904/243*x^5+56000*x^7-76608*x^8+45696*x^9 end, proc (x) options operator, arrow; -1643264/177147*x+17812480/43046721+16411472/531441*x^2-7209524/6561*x^4+13801760/59049*x^3+849296/81*x^6-174776/729*x^5-244384/9*x^7+
30464*x^8-13440*x^9 end, proc (x) options operator, arrow; -57544816/4782969*x+17812480/43046721+9862720/177147*x^2-19041652/6561*x^4+17566528/59049*x^3-565712/27*x^6+2502808/243*x^5+232288/9*x^7-17664*x^8+4992*x^9 end, proc (x) options operator, arrow; -60169328/4782969*x+9157696/59049*x^2+1434944/729*x^4-41500928/59049*x^3+16408/3*x^6-2859920/729*x^5-43232/9*x^7+2234*x^8-372*x^9 end, proc (x) options operator, arrow; 25924114/4782969*x-1+654640/59049*x^2-34720/729*x^4-1820000/59049*x^3+280/3*x^6+79408/729*x^5-1760/9*x^7-70*x^8+140*x^9 end, proc (x) options operator, arrow; 10508038/1594323*x-1+4491760/531441*x^2-42980/6561*x^4-910000/19683*x^3-9632/81*x^6+13412/81*x^5-568/3*x^7+294*x^8-112*x^9 end, proc (x) options operator, arrow; 13120774/1594323*x-1+1879024/531441*x^2+537628/6561*x^4-1272880/19683*x^3-35840/81*x^6+10052/81*x^5+1504/3*x^7-266*x^8+56*x^9 end, proc (x) options operator, arrow; 52539010/4782969*x-1-4709320/531441*x^2+2016644/6561*x^4-4759832/59049*x^3+43736/
81*x^6-389732/729*x^5-2936/9*x^7+110*x^8-16*x^9 end, proc (x) options operator, arrow; 18*x-1-72*x^2-252*x^4+168*x^3-168*x^6+252*x^5+72*x^7-18*x^8+2*x^9 end], [1/18, 1/9, 1/6, 2/9, 5/18, 1/3, 7/18, 4/9, 1/2, 5/9, 2/3, 7/9, 8/9, 1], ["Continuous", "CDF"]]:
D10:= [[proc (x) options operator, arrow; 3715891200*(x-1/20)^10 end, proc (x) options operator, arrow; -17577/100000000+14742/125*(x-1/20)^4+1701/500000*x-2658096/125*(x-1/20)^5-20979/50000*(x-1/20)^2+63866880*(x-1/20)^9+10206/625*(x-1/20)^3+9815904/25*(x-1/20)^6-14079744*(x-1/20)^8-3773952/5*(x-1/20)^7-58060800*(x-1/20)^10 end, proc (x) options operator, arrow; -347634/625*(x-1/20)^4-87003/500000*x+176043/20000000+6988464/125*(x-1/20)^5+3094497/250000*(x-1/20)^2-7526400*(x-1/20)^9-766962/3125*(x-1/20)^3-9963072/25*(x-1/20)^6+1983744*(x-1/20)^8+3354624/5*(x-1/20)^7+6451200*(x-1/20)^10 end, proc (x) options operator, arrow; 576009/125*(x-1/20)^4+11425113/10000000*x-25022487/400000000-4827816/125*(x-1/20)^5-13149297/400000*(x-1/20)^2+698880*(x-1/20)^9+279909/3125*(x-1/20)^3-806400*(x-1/20)^10+2954448/25*(x-1/20)^6-189504*(x-1/20)^8-576576/5*(x-1/20)^7 end, proc (x) options operator, arrow; -895671/625*(x-1/20)^4-7321923/50000000*x+586360257/10000000000-37343376/3125*(x-1/20)^
5-97325109/2000000*(x-1/20)^2-591360*(x-1/20)^9+10861641/15625*(x-1/20)^3+419328*(x-1/20)^10+9939636/125*(x-1/20)^6+2205504/5*(x-1/20)^8-1157184/5*(x-1/20)^7 end, proc (x) options operator, arrow; -53315913/50000*(x-1/20)^4-2264889459/400000000*x+32391039681/80000000000+1011969/3125*(x-1/20)^5+76585131/1600000*(x-1/20)^2+95424*(x-1/20)^9+26202267/250000*(x-1/20)^3-77952*(x-1/20)^10+1224657/125*(x-1/20)^6-114408/5*(x-1/20)^8-446208/25*(x-1/20)^7 end, proc (x) options operator, arrow; -14030709/10000*(x-1/20)^4-2408216691/400000000*x+29524495041/80000000000+10083969/3125*(x-1/20)^5+2434189491/40000000*(x-1/20)^2-107328*(x-1/20)^9+13387419/250000*(x-1/20)^3+44928*(x-1/20)^10+724689/125*(x-1/20)^6+503064/5*(x-1/20)^8-223488/5*(x-1/20)^7 end, proc (x) options operator, arrow; -545825343/800000*(x-1/20)^4-4693484517/1280000000*x+54707994171/1280000000000+578833353/100000*(x-1/20)^5+47753233407/640000000*(x-1/20)^2+30876*(x-1/20)^9-148612383/800000*(x-1/20)^3-8712*(x-1/20)^10-
38285793/2000*(x-1/20)^6-457983/10*(x-1/20)^8+945621/25*(x-1/20)^7 end, proc (x) options operator, arrow; 1744264641/800000*(x-1/20)^4-21319938937/6400000000*x-138565534149/1280000000000-577221687/100000*(x-1/20)^5+67080586239/640000000*(x-1/20)^2-5476*(x-1/20)^9-2454337947/4000000*(x-1/20)^3+1528*(x-1/20)^10+22269471/2000*(x-1/20)^6+113409/10*(x-1/20)^8-356907/25*(x-1/20)^7 end, proc (x) options operator, arrow; 3868053/1600000*(x-1/20)^4+17949962129/2560000000*x-2604380589873/2560000000000+37915731/200000*(x-1/20)^5+1152305973/256000000*(x-1/20)^2+266*(x-1/20)^9-392222733/8000000*(x-1/20)^3-252*(x-1/20)^10-372939/4000*(x-1/20)^6+5481/20*(x-1/20)^8-717/2*(x-1/20)^7 end, proc (x) options operator, arrow; 51596601/800000*(x-1/20)^4+50216886467/6400000000*x-1287808038009/1280000000000+15172353/100000*(x-1/20)^5-277935651/640000000*(x-1/20)^2-532*(x-1/20)^9-218737701/4000000*(x-1/20)^3+168*(x-1/20)^10-706839/2000*(x-1/20)^6+5229/10*(x-1/20)^8+687/25*(x-1/20)^7 end, proc (x) options
operator, arrow; 123478047/800000*(x-1/20)^4+57109569719/6400000000*x-1264494550539/1280000000000-3779307/100000*(x-1/20)^5-5109942753/640000000*(x-1/20)^2+380*(x-1/20)^9-220108629/4000000*(x-1/20)^3-72*(x-1/20)^10-902853/2000*(x-1/20)^6-8253/10*(x-1/20)^8+4539/5*(x-1/20)^7 end, proc (x) options operator, arrow; 860690313/3200000*(x-1/20)^4+266881638251/25600000000*x-4865761405281/5120000000000-264951603/400000*(x-1/20)^5-56832817887/2560000000*(x-1/20)^2-133*(x-1/20)^9-504543891/16000000*(x-1/20)^3+18*(x-1/20)^10+7374213/8000*(x-1/20)^6+17253/40*(x-1/20)^8-15999/20*(x-1/20)^7 end, proc (x) options operator, arrow; -987963501/3200000*(x-1/20)^4-4237943235591/5120000000000+322687697779/25600000000*x+155994237/400000*(x-1/20)^5-152852067369/2560000000*(x-1/20)^2+19*(x-1/20)^9+2681615217/16000000*(x-1/20)^3-2*(x-1/20)^10-2736741/8000*(x-1/20)^6-3249/40*(x-1/20)^8+20577/100*(x-1/20)^7 end], [1/20, 1/10, 3/20, 1/5, 1/4, 3/10, 7/20, 2/5, 9/20, 1/2, 3/5, 7/10, 4/5, 9/10, 1],
["Continuous", "CDF"]]:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: expect4.map
#
# Procedure Name: ExpectedValue(X, [g])
#
# Other APPL Procedures Called: PDF
#
# Date: August 27, 2000
#
# Purpose: Returns the expected value of g(X)
# Ex: Suppose X ~ ExponentialRV(lambda); then E(X^2) would be
# entered as ExpectedValue(X, g), where g is the procedure
# g := x -> x^2
#
# Arguments: X: Random variable
# g: A procedure
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 lists format
# 3. Convert X to PDF form if not already in that form
# 4. Check whether the RV X is Continuous or Discrete
# 5. If the RV X is continuous, then compute its expected value
# 6. If the RV X is discrete, then determine if the support of X is
# in the "dot" or "no dot" form
# 7. If the random variable X is in the discrete "dot" case, first
# call procedure Convert(X) to convert its support to the
# *standard dot* support format:
# [anything .. anything, incremented by k, transformed by h(x)]
# 8. Transform the discrete dot pdf f(x) by h(x)
# 9. Find the expected value of the transformed pdf
# 10. Similarly, if the random variable X is in the discrete "no dot"
# case, first call procedure Convert(X) to convert its support to
# the *standard no dot* pdf/support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
# 11. Find the expected value of the pdf
# 12. Return the expected value of g(X)
#
ExpectedValue := proc(X :: list(list), g :: procedure)
local NumLists, fX, nsegments, Expect, gnew, i, SubList1, SubList2,
Support, Lo, Hi, IncrBy, Transformation, TransfPDF, NextValue, n:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 2)) then
print(`ERROR(ExpectedValue): This procedure requires`):
print(`1 or 2 arguments:`):
print(`A random variable X and an optional function g, such as`):
print(`g := x -> x^2. If g is not provided, it is assumed to be`):
print(`g := x -> x`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(ExpectedValue): X must be in a list of 3 lists format`):
return:
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif member(X[3][2], {"CDF", "SF", "HF", "CHF", "IDF"}) then
fX := PDF(X):
else
print(`ERROR(ExpectedValue): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
if (nargs = 1) then
gnew := x -> x:
else
gnew := g:
fi:
nsegments := nops(fX[1]):
Expect := 0:
#
# If the RV X is continuous, compute its expected value
#
if (fX[3][1] = "Continuous") then
for i from 1 to nsegments do
Expect := Expect + int(gnew(x) * fX[1][i](x), x = fX[2][i] .. fX[2][i + 1]):
# print(Expect):
Expect := simplify(combine(Expect)):
# print(Expect):
# Expect := simplify(combine(Expect)):
# print(Expect):
od:
#
# If the RV X is discrete, then determine if the support of X is in
# the "dot" or "no dot" form
#
elif (fX[3][1] = "Discrete") then
fX := Convert(fX):
if (fX = false) then
print(`ERROR(ExpectedValue): Discrete random variable X is`):
print(`NOT in legal APPL form`):
return(false):
fi:
SubList1 := fX[1]:
SubList2 := fX[2]:
#
# If the random variable X is in the discrete "dot" case, first call
# procedure Convert(X) to convert its support to the *standard dot*
# support format:
# [anything .. anything, incremented by k, transformed by h(x)]
#
if type(SubList2[1], range) then
Support := SubList2[1]:
Lo := lhs(Support):
Hi := rhs(Support):
IncrBy := SubList2[-2]:
#
# Transform the pdf f(x) by h(x)
#
Transformation := unapply(SubList2[-1](x))(x):
TransfPDF := subs(x = Transformation, unapply(SubList1(x))(x)):
# print(`transfpdf is`, TransfPDF):
#
# Find the expected value of the transformed pdf
# Deal w/ support [a .. b, 1, x -> x] as a special case
#
if ((IncrBy = 1) and (ispoly(Transformation, linear, x, 'a0',
'a1')) and (a0 = 0) and (a1 = 1)) then
Expect := simplify(eval(sum(op(SubList1(x)) * gnew(x),
x = Lo .. Hi))):
elif ((IncrBy = 1) and (ispoly(Transformation, linear, x, 'a0',
'a1'))) then
# print(`Lo is`, Lo): print(`hi is`, Hi):
Expect := simplify(eval(sum(op(TransfPDF)* gnew(x),
x = Lo .. Hi))):
else
for i from Lo by IncrBy to Hi do
NextValue := subs(x = i, op(TransfPDF)) * subs(x = subs(x = i,
Transformation), unapply(gnew(x))(x)):
Expect := simplify(Expect + NextValue):
od:
fi:
#
# If the random variable X is in the discrete "no dot" case, call
# procedure Convert(X) to convert its support to the *standard no dot*
# pdf/support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
#
else
n := nops(SubList1):
# added this for convolution mgf
SubList1 := convert(SubList1, rational):
#
# Find the expected value of the pdf f(x)
#
for i from 1 to n do
NextValue := subs(x = SubList2[i], unapply(gnew(x))(x)) *
SubList1[i]:
Expect := simplify(Expect + NextValue):
od:
fi:
else
print(`ERROR(ExpectedValue): The RV X must be either`):
print(`Continuous or Discrete`):
return:
fi:
return(simplify(Expect)):
end:
#
# ExponentialKS distribution
#
ExponentialKSRV := proc(n :: posint)
local x, ListOfLists:
if (nargs <> 1) then
print(`ERROR(ExponentialKSRV): This procedure requires 1 argument`):
RETURN():
fi:
if (is(n > 2)) then
print(`ERROR(ExponentialKSRV): Cannot determine this distribution`):
print(`for n larger than 2`):
RETURN():
fi:
if n = 1 then
print(`PDF for D_1 is degenerate`):
return([[1], [1 - 1 / exp(1)], ["Discrete", "PDF"]]):
elif n = 2 then
ListOfLists := [[unapply(-(4 * x - 3) / ((2 * x - 1) * (x - 1)), x),
unapply(-3 / ((2 * x + 1) * (x - 1)), x),
unapply(-1 / (x - 1), x)],
[abs(-1 + exp(2 * (2 + ln(-1 / 4 + 1 / 4 * sqrt(1 + 16 *
exp(-2)))) / (ln(-1 / 4 + 1 / 4 * sqrt(1 + 16 * exp(-2))) * (-(2 +
ln(-1 / 4 + 1 / 4 * sqrt(1 + 16 * exp(-2)))) / ln(-1 / 4 + 1 / 4 *
sqrt(1 + 16 * exp(-2))) + 1)))),
abs(exp(2 * (2 + ln(1 / 2 - 1 / 2 * sqrt(1 - 4 * exp(-2)))) /
(ln(1 / 2 - 1 / 2 * sqrt(1 - 4 * exp(-2))) * (-(2 + ln(1 / 2 - 1 /
2 * sqrt(1 - 4 * exp(-2)))) / ln(1 / 2 - 1 / 2 * sqrt(1 - 4 *
exp(-2))) + 1))) - 1 / 2),
1 / 2, 1 - 1 / exp(1)],
["Continuous", "PDF"]]:
return(ListOfLists):
fi:
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: exponentialvariate1.map
#
# Procedure Name: ExponentialVariate(lambda)
#
# Other APPL Procedures Called: None
#
# Date: June 1, 1999
#
# Purpose:
#
# Arguments:
#
# Algorithm:
#
ExponentialVariate := proc(lambda)
local variate:
variate := -1 / lambda * ln(rand() / 1000000000000):
return(evalf(variate)):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: geometricosmean1.map
#
# Procedure Name: GeometricOSMean(p)
#
# Other APPL Procedures Called: OrderStat, Mean
#
# Date: April 16, 2000
#
# Purpose: Reproduce appendix from Margolin, Winokur, "Exact Moments
# of the Order Statistics of the Geometric Distribution and their
# Relation to Inverse Sampling and Reliability of Redundant Systems"
# in the American Statistical Association Journal, 1967
#
# Arguments: p: A probability, 0 < p < 1
#
# Algorithm:
# 1.
#
GeometricOSMean := proc(p)
local Index1, Index2, X, Rows, i, n, r:
global MeanMatrix:
#
# Check for the appropriate number of arguments: 1
#
if (nargs <> 1) then
print(`ERROR(GeometricOSMean): This procedure requires 1 argument:`):
print(`a probability value p`):
RETURN():
fi:
Index1 := 1:
Index2 := 1:
X := GeometricRV(p):
Rows := [seq(0, i = 1 .. 8)]:
MeanMatrix := array(1 .. 5, 1 .. 8, [Rows, Rows, Rows, Rows, Rows]):
MeanMatrix[Index1, Index2] := Mean(OrderStat(X, 1, 1)):
for n from 5 by 5 to 20 do
Index1 := Index1 + 1:
for r from 1 to 5 do
MeanMatrix[Index1, Index2] := Mean(OrderStat(X, n, r)):
Index2 := Index2 + 1:
od:
for r from 10 by 5 to 20 while (r <= n) do
MeanMatrix[Index1, Index2] := Mean(OrderStat(X, n, r)):
Index2 := Index2 + 1:
od:
Index2 := 1:
od:
RETURN(print(MeanMatrix)):
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: geometricosvariance1.map
#
# Procedure Name: GeometricOSVariance(p)
#
# Other APPL Procedures Called: OrderStat, Variance
#
# Date: April 16, 2000
#
# Purpose: Reproduce appendix from Margolin, Winokur, "Exact Moments
# of the Order Statistics of the Geometric Distribution and their
# Relation to Inverse Sampling and Reliability of Redundant Systems"
# in the American Statistical Association Journal, 1967
#
# Arguments: p: A probability, 0 < p < 1
#
# Algorithm:
# 1.
#
GeometricOSVariance := proc(p)
local Index1, Index2, X, Rows, i, n, r:
global VarMatrix:
#
# Check for the appropriate number of arguments: 1
#
if (nargs <> 1) then
print(`ERROR(GeometricOSVariance): This procedure requires one`):
print(`argument: a probability value p`):
RETURN():
fi:
Index1 := 1:
Index2 := 1:
X := GeometricRV(p):
Rows := [seq(0, i = 1 .. 8)]:
VarMatrix := array(1 .. 5, 1 .. 8, [Rows, Rows, Rows, Rows, Rows]):
VarMatrix[Index1, Index2] := Variance(OrderStat(X, 1, 1)):
for n from 5 by 5 to 20 do
Index1 := Index1 + 1:
for r from 1 to 5 do
VarMatrix[Index1, Index2] := Variance(OrderStat(X, n, r)):
Index2 := Index2 + 1:
od:
for r from 10 by 5 to 20 while (r <= n) do
VarMatrix[Index1, Index2] := Variance(OrderStat(X, n, r)):
Index2 := Index2 + 1:
od:
Index2 := 1:
od:
RETURN(print(VarMatrix)):
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: heapsort3.map
#
# Procedure Name: HeapSort(A, B)
#
# Other APPL Procedures Called:
#
# Date: September 8, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
HeapSort := proc(A :: list, B :: list)
global H, Probs:
local n, i, SortedArray, SortedProbs:
CreateHeap(A, B):
# print(`H is`, eval(H)):
# print(`Probs is`, eval(Probs)):
n := nops(convert(H, list)):
# print(`n is`, n):
for i from n by -1 to 2 do
DeleteMaxHeap(H, Probs, i):
# print(eval(H)):
# print(evalf(Probs)):
od:
SortedArray := array([seq(H[i], i = 2 .. n)]):
SortedArray := convert(evalf(SortedArray), list):
# print(`whattype(SortedArray)`, whattype(SortedArray)):
SortedProbs := array([seq(Probs[i], i = 2 .. n)]):
SortedProbs := convert(evalf(SortedProbs), list):
# print(`whattype(SortedProbs)`, whattype(SortedProbs)):
# return(eval(SortedArray), evalf(SortedProbs)):
return(SortedArray, SortedProbs):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: hf6.map
#
# Procedure Name: HF(X, [x])
#
# Other APPL Procedures Called: SF, PDF, Convert
#
# Date: March 20, 2001
#
# Purpose: HF is a procedure that:
# (1) Returns the hazard function of a random variable X in the
# APPL list of 3 sublists form if given only the one
# argument X, or
# (2) Returns the value Pr(X = x) / Pr(X >= x) if it is given
# the optional argument x in addition to the RV X
#
# Arguments: X: A continuous or discrete random variable;
# x (optional argument): A numeric value entered when
# trying to determine Pr(X = x) / Pr(X >= x)
#
# Algorithm: 1. Perform error checking on user entered arguments
# 2. The HF of X is determined by sending it to its
# appropriate category, which is based on whether:
# A. X is continuous or discrete
# B. X is entered in its PDF, CDF, SF, HF, CHF, or IDF
# format
# 3. If only 1 argument (the random variable X) is entered
# by the user, return the hazard function of X in the
# APPL list of 3 lists format
# 4. If 2 arguments are provided, return the value
# Pr(X = x) / Pr(X >= x)
#
HF := proc(X :: list(list), st)
local numlists, nsegments, supp, fX, SX, hX, i, HHX, prob, Y, Range, lo,
hi, incr, transf, pdf, sf, hf, idf, pieces, numops, noceil,
ceilpiece, solns, nsolns, cdf, val, invfound, j, idfval, losupp,
hisupp, sublist1, n, hcum, notfound, count, k:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 2)) then
print(`ERROR(HF): This procedure requires 1 or 2 arguments:`):
print(`A random variable X and an optional argument x for`):
print(`computing Pr(X = x) / Pr(X >= x)`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
numlists := nops(X):
if (numlists <> 3) then
print(`ERROR(HF): The RV X must be a list of 3 lists`):
return:
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(HF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the RV X is continuous, find and return the HF of X
#
if (X[3][1] = "Continuous") then
nsegments := nops(X[1]):
supp := X[2]:
if (X[3][2] = "PDF") then
fX := X:
SX := SF(X):
elif (X[3][2] = "SF") then
fX := PDF(X):
SX := X:
elif (X[3][2] = "HF") then
hX := X[1]:
elif (X[3][2] = "CHF") then
hX:=[]:
for i from 1 to nsegments do
HHX := unapply(simplify(diff(X[1][i](x), x)), x):
hX := [op(hX), op([unapply(simplify(HHX(x)), x)])]:
od:
else
fX := PDF(X):
# print(`fX is`, fX):
SX := SF(X):
# print(`SX is`, SX):
# IDF's support will change from X[2] to fX[2]
supp := fX[2]:
fi:
if not((X[3][2] = "HF") or (X[3][2] = "CHF")) then
hX := []:
for i from 1 to nsegments do
HHX := unapply(simplify(fX[1][i](x) / SX[1][i](x)), x):
hX := [op(hX), op([unapply(simplify(HHX(x)), x)])]:
od:
fi:
if (nargs = 1) then
return([hX, supp, ["Continuous", "HF"]]):
elif (nargs = 2) then
if not(type(evalf(st), {numeric, infinity})) then
if nsegments = 1 then
prob := hX[1](st):
return(prob):
else
print(`ERROR(HF): Symbolic second arguments with a piecewise`):
print(`HF is not allowable in APPL at this time`):
return:
fi:
fi:
for i from 1 to nsegments do
if ((evalf(st) >= evalf(supp[i])) and (evalf(st) <
evalf(supp[i + 1]))) then
break:
fi:
od:
prob := hX[i](st):
return(prob):
fi:
#
# The RV X is a discrete random variable
#
elif (X[3][1] = "Discrete") then
#
# If the RV X is discrete, then call the procedure Convert(X) to
# convert the discrete random variable's support to a standard APPL
# discrete RV support format. Assign the converted random variable
# to the Maple variable Y.
#
Y := Convert(X):
hX[1] := Y[1]:
hX[2] := Y[2]:
#
# X has dot support
#
if type(Y[2][1], range) then
Range := Y[2][1]:
lo := lhs(Range):
hi := rhs(Range):
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
incr := Y[2][2]:
transf := Y[2][3]:
#
# Report the support of X back to the user in its simplest form
#
if (incr = 1 and unapply(transf(x))(x) = x) then
hX[2] := [Range]:
#
# APPL is not programmed to convert to a PDF format when the increment
# is not 1 and/or the transformation is not x -> x
#
elif not(incr = 1 or unapply(transf(x))(x) = x) then
print(`ERROR(HF): APPL is currently unable to evaluate`):
print(`this RV`):
return:
fi:
fi:
#
# X is given in its PDF form
#
if (Y[3][2] = "PDF") then
pdf := unapply(op(Y[1])(x))(x):
SX := SF(Y):
sf := unapply(op(SX[1])(x))(x):
hf := simplify(pdf / sf):
hX[1] := [unapply(hf, x)]:
#
# X is given in its CDF or CHF form
#
elif member(Y[3][2], {"CDF", "CHF"}) then
fX := PDF(Y):
pdf := unapply(op(fX[1])(x))(x):
SX := SF(Y):
sf := unapply(op(SX[1])(x))(x):
hf := simplify(pdf / sf):
hX[1] := [unapply(hf, x)]:
#
# X is given in its SF form
#
elif (Y[3][2] = "SF") then
fX := PDF(Y):
pdf := unapply(op(fX[1])(x))(x):
sf := unapply(op(Y[1])(x))(x):
hf := simplify(pdf / sf):
hX[1] := [unapply(hf, x)]:
#
# If X is given in its HF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "HF") then
#
# X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
# need to look for a ceil function here!
idf := unapply(op(Y[1])(y))(y):
# print(`idf is`, idf):
# print(`[op(idf)] is`, [op(idf)]):
pieces := [op(idf)]:
numops := nops(pieces):
# print(numops):
noceil := true:
for i from 1 to numops while noceil do
if has(pieces, ceil) then
# print(`has ceil`):
noceil := false:
ceilpiece := i:
fi:
od:
if not(noceil) then
# print(pieces[ceilpiece]):
pieces[ceilpiece] := op(pieces[ceilpiece]):
idf := sum(pieces[k], k = 1 .. numops):
fi:
solns := [solve(idf = x, y)]:
# print(solns):
nsolns := nops(solns):
# Find the correct inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to cdf.
cdf := solns[1]:
else
if lo = -infinity then
if hi = infinity then
val := 0:
else
val := hi:
fi:
else
val := lo:
fi:
# print(`val is`, val):
invfound := false:
for j from 1 to nsolns do
# Evaluate each inverse of the IDF at the value "val" assigned
# above. If CDF(IDF(val)) = val, then assign idf equal to that
# inverse.
idfval := subs(x = val, idf):
if evalf(subs(x = idfval, solns[j])) = evalf(val) then
cdf := solns[j]:
invfound := true:
break:
fi:
od:
if not(invfound) then
print(`ERROR(HF): Could not find the appropriate inverse`):
fi:
fi:
pdf := simplify(subs(x = w, cdf) - subs(x = w - 1, cdf)):
sf := 1 - sum(pdf, w = lo .. x - 1):
pdf := subs(w = x, pdf):
hX[1] := [unapply(simplify(pdf / sf), x)]:
# CAUTION: losupp is incorrect in some cases -- currently don't know
# how to fix this, need to be able to retrieve the first cdf value and
# sub it into idf as lo
losupp := evalf(subs(y = lo, idf)):
hisupp := evalf(subs(y = hi, idf)):
hX[2] := [losupp .. hisupp]:
fi:
#
# X has no dot support
#
else
sublist1 := hX[1]:
n := nops(sublist1):
#
# X is given in its PDF, CDF, or SF form
#
if member(Y[3][2], {"PDF", "CDF", "SF"}) then
fX := PDF(Y):
SX := SF(Y):
for i from 1 to n do
hX[1][i] := fX[1][i] / SX[1][i]:
od:
#
# If X is given in its HF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "HF") then
#
# X is given in its CHF form
#
elif (Y[3][2] = "CHF") then
hX[1][n] := 1:
hX[1][1] := 1 - exp(-sublist1[2]):
hcum := hX[1][1]:
for i from 2 to n - 1 do
hX[1][i] := 1 - exp(-sublist1[i + 1]) / hcum:
hcum := hcum + hX[1][i]:
od:
#
# X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
fX := PDF(Y):
SX := SF(Y):
for i from 1 to n do
hX[1][i] := fX[1][i] / SX[1][i]:
od:
hX[2] := SX[2]:
fi:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([hX[1], hX[2], ["Discrete", "HF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if type(Y[2][1], range) then
#
# Determine (if possible) if 'st' is in the support of fX; if not,
# Pr(X = st) = 0.
#
if not(type(lo, infinity) or type(hi, infinity)) then
#
# CAUTION: Maple does not consider 1.0 a member of the set {1, 2, 3};
# Problem if user chooses 'st' to be a float and the set contains
# integers or vice versa
#
if not(member(st, {$lo .. hi})) then
prob := 0:
return(prob):
fi:
fi:
prob := op(hX[1](st)):
else
prob := 0:
notfound := true:
count := 1:
for k from 1 to n while notfound do
if evalf(hX[2][k]) = evalf(st) then
notfound := false:
prob := hX[1][count]:
fi:
count := count + 1:
od:
fi:
return(prob):
fi:
#
# X is neither continuous nor discrete
else
print(`ERROR(HF): The random variable X must be continuous or`):
print(`discrete`):
fi:
end: #1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: idf8.map
#
# Procedure Name: IDF(X, [x])
#
# Other APPL Procedures Called: CDF, IDFDiscrete
#
# Date: March 20, 2001
#
# Purpose: IDF is a procedure that:
# (1) returns the inverse distribution function of a
# random variable X in the APPL list of sublists format if
# the only argument given is X, or
# (2) Given the optional value x, returns the value alpha,
# where that F(x) = alpha.
#
# Arguments: X: A continuous or discrete random variable;
# x (optional argument): A numeric value entered when
# alpha, where alpha = Pr(X <= x)
#
# Algorithm: 1. Perform error checking on user entered arguments
# 2. The IDF of X is determined by sending it to its
# appropriate category, which is based on whether:
# A. X is continuous or discrete
# B. X is entered in its PDF, CDF, SF, HF, CHF, or IDF
# format
# 3. If only 1 argument (the random variable X) is entered
# by the user, return the inverse distribution function
# of X in the APPL list of 3 lists format
# 4. If 2 arguments are provided, return the value alpha,
# where alpha = Pr(X <= x)
#
IDF := proc(X :: list(list), st)
local numlists, nsegments, i, prob, cp, FX, IDX, solnlist, nsolns,
c, begin, END, itp, supp, j, s, a, t, ii:
#
# Check for the appropriate number of arguments
#
# print(`in IDF`):
if ((nargs <> 1) and (nargs <> 2)) then
print(`ERROR(IDF): This procedure requires 1 or 2 arguments:`):
print(`A random variable X and an optional argument x for`):
print(`computing alpha, where alpha = Pr(X <= x)`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
numlists := nops(X):
if (numlists <> 3) then
print(`ERROR(IDF): The RV X must be a list of 3 lists`):
return:
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(IDF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the RV X is continuous, find and return the IDF of X
#
if (X[3][1] = "Continuous") then
nsegments := nops(X[1]):
if (X[3][2]= "IDF") then
if (nargs = 1) then
return(X):
elif (nargs = 2) then
for i from 1 to nsegments do
if ((evalf(st) >= evalf(X[2][i])) and (evalf(st) <=
evalf(X[2][i + 1]))) then
break:
fi:
od:
prob := limit(X[1][i](a), a = st):
return(prob):
fi:
else
if (nargs = 2) then
# 6/22/2007: FIX -- looks like CriticalPoint is doing
# what we'd like IDF to do when given 2 args ... so
# why not just have IDF call CriticalPoint to do what
# it is not able to do
# SEARCH IDF
# print(`going to CriticalPoint`);
# print(X); print(st);
cp := CriticalPoint(X, st):
return(cp):
fi:
FX := CDF(X):
IDX := []:
for i from 1 to nsegments do
solnlist := [solve(FX[1][i](x) = s, x)]:
nsolns := nops(solnlist):
solnlist := [seq(unapply(simplify(solnlist[j]), s), j = 1 ..
nsolns)]:
# Find right inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to ginv.
IDX := [op(IDX), solnlist[1]]:
else
# If there is more than one inverse, find the appropriate one.
# Find midpoints of each segment
c := array(1 .. nsegments):
if (FX[2][1] = -infinity and FX[2][2] = infinity) then
c[1] := 0:
else
begin := 1:
END := nsegments:
if (FX[2][1] = -infinity) then
c[1] := FX[2][2] - 1:
begin := 2:
fi:
if (FX[2][nsegments + 1] = infinity) then
c[nsegments] := FX[2][nsegments] + 1:
END := nsegments - 1:
fi:
for ii from begin to END do
c[ii] := (FX[2][ii] + FX[2][ii + 1]) / 2:
od:
fi:
# print(cis, c):
for t from 1 to nsolns do
# Evaluate each inverse of the CDF at the midpoint of the
# subinterval. Set IDX[1][i] to that inverse for which gtemp
#(g(x)) = x.
itp := solnlist[t](FX[1][i](c[i])):
# print(itpis, itp):
# whattype(itp):
# print(herrrrrr):
if(whattype(evalf(FX[1][i](c[i]))) <> float) then
# print(notafloat, simplify(itp), c[i]):
else
# print(isafloat, itp, c[i]):
fi:
if (((whattype(evalf(FX[1][i](c[i]))) <> float) and
(itp = c[i]) ) or
((whattype(evalf(FX[1][i](c[i]))) = float) and
(evalf(itp) >= evalf(FX[2][i]) and
(evalf(itp) <= evalf(FX[2][i + 1]))))) then
IDX := [op(IDX), solnlist[t]]:
# print(hereiam):
break:
else
print(`ERROR(IDF): Could not find the appropriate inverse`):
fi:
# print(evermakeithere):
od:
fi:
od:
supp := [0]:
for i from 1 to nsegments - 1 do
supp := [op(supp), CDF(FX, FX[2][i + 1])]:
# print(`supp is`, supp):
od:
supp := [op(supp), 1]:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([IDX, supp, ["Continuous", "IDF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if not(type(evalf(st), {numeric, infinity})) then
if nsegments = 1 then
prob := IDX[1](st):
return(prob):
else
print(`ERROR(IDF): Symbolic second arguments with a piecewise`):
print(`IDF are not allowable in APPL at this time`):
return:
fi:
fi:
# print(`nsegments is`, nsegments):
for i from 1 to nsegments do
if ((evalf(st) >= evalf(supp[i])) and (evalf(st) <
evalf(supp[i + 1]))) then
break:
fi:
od:
# print(IDX[i]):
prob := IDX[i](st):
# print(`prob is`, prob):
return(prob):
fi:
elif (X[3][1] = "Discrete") then
if nargs = 1 then
IDFDiscrete(X):
else
#
# 6/23/2007, trying to fix IDF for discrete RV's
# IDF should return something
#
cp := IDFDiscrete(X, st):
return(cp):
fi:
else
print(`ERROR(IDF): The random variable X must be continuous or`):
print(`discrete`):
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: idfdiscrete5.map
#
# Procedure Name: IDFDiscrete(X, [x])
#
# Other APPL Procedures Called: Convert, CDF
#
# Date: March 20, 2001
#
# Defn: For a distribution F, mapping a quantile x into a probability
# alpha, the inverse distribution function G performs the
# corresponding inverse mapping from alpha into x. Thus, if
# Pr(X <= x) = F(x) = alpha, then G(alpha) = x.
#
# Purpose: IDF is a procedure that:
# (1) returns the inverse distribution function of a
# random variable X in the APPL list of sublists format if
# the only argument given is X, or
# (2) Given the optional value x, returns the value alpha,
# where that F(x) = alpha.
#
# Arguments: X: A discrete random variable;
# x (optional argument): A numeric value entered when
# trying to determine alpha, where alpha = Pr(X <= x)
#
# Algorithm: 1. Perform error checking on user entered arguments
# 2. The IDF of X is determined by sending it to its
# appropriate category, which is based on whether:
# A. X is entered in its PDF, CDF, SF, HF, CHF, or IDF
# format
# 3. If only 1 argument (the random variable X) is entered
# by the user, return the inverse distribution function
# of X in the APPL list of 3 lists format
# 4. If 2 arguments are provided, return the value alpha,
# where alpha = Pr(X <= x)
#
# CAUTION: Made x local to find the inverse of the CDF
#
IDFDiscrete := proc(X :: list(list), st)
local Y, IDX, Range, lo, hi, incr, transf, FX, cdf, x, inveq, solns,
nsolns, idf, val, invfound, j, losupp, cdfval, n, i, Lo, prob:
#
# Call the procedure Convert(X) to convert the discrete random
# variable's support to a standard APPL discrete RV support format.
#
Y := Convert(X):
IDX[1] := Y[1]:
IDX[2] := Y[2]:
#
# 6/23/2007, IDF can't work with Binomial because it can't convert
# it to a nice closed form CDF; but IDF should still be able
# to report a critical value, so changing Binomial-type supports
# to NoDot format
#
if type(Y[2][1], range) then
Range := Y[2][1]:
lo := lhs(Range):
hi := rhs(Range):
if not(type(hi, symbol)) then
Y := ConvertToNoDot(X):
fi:
fi:
#
# X has dot support
#
# print(Y):
if type(Y[2][1], range) then
Range := Y[2][1]:
lo := lhs(Range):
hi := rhs(Range):
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
incr := Y[2][2]:
transf := Y[2][3]:
#
# Report the support of new random variable back to the user in its
# simplest form
#
if (incr = 1 and unapply(transf(x))(x) = x) then
IDX[2] := [Range]:
#
# APPL is not programmed to convert to a PDF format when the increment
# is not 1 and/or the transformation is not x -> x
#
elif not(incr = 1 or unapply(transf(x))(x) = x) then
print(`ERROR(IDF): APPL is currently unable to evaluate`):
print(`this RV`):
return:
fi:
fi:
#
# X is given in its PDF, CDF, SF, HF, or CHF form
#
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
FX := CDF(X):
# print(FX):
cdf := op(unapply(FX[1](x))(x)):
inveq := subs(x = y, cdf):
# print(`inveq is`, inveq):
# print(`number of ops in inveq`, nops(inveq)):
# if finding an inverse symbolically is probably not possible --
# making this determination if 4 or more terms make up inveq
# find the IDF value by "brute force" ... better than nothing
if nops(inveq) >= 4 and nargs = 2 then
Lo := lhs(FX[2][1]):
# print(`Lo is`, Lo):
if ((evalf(st, Digits + 2) > 0) and
(evalf(st, Digits + 2) <=
evalf(subs(x = Lo, op(unapply(FX[1](x))(x))), Digits + 2)))
then
# print(`in here`):
return(Lo):
fi:
# Setting the upper limit to Lo + 100
# print(FX[1]):
for i from Lo to (Lo + 100) do
# print(i):
if ((evalf(st, Digits + 2) >
evalf(subs(x = i, op(unapply(FX[1](x))(x))), Digits + 2))
and (evalf(st, Digits + 2) <= evalf(subs(x = i + 1,
op(unapply(FX[1](x))(x))), Digits + 2))) then
return(i + 1):
fi:
od:
print(`ERROR(IDF): Unable to determine requested value`):
return:
fi:
solns := [solve(inveq = x, y)]:
# print(`solns are`, solns):
nsolns := nops(solns):
# print(nsolns):
# Find the correct inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to idf
idf := solns[1]:
else
if lo = -infinity then
if hi = infinity then
val := 0:
else
val := hi:
fi:
else
val := lo:
fi:
# print(`val is`, val):
invfound := false:
for j from 1 to nsolns do
# Evaluate each inverse of the CDF at the value "val" assigned
# above. If IDF(CDF(val)) = val, then assign idf equal to that
# inverse.
cdfval := subs(x = val, cdf):
# print(cdfval):
if evalf(subs(x = cdfval, solns[j])) = evalf(val) then
idf := solns[j]:
invfound := true:
break:
fi:
od:
if invfound = false then
print(`ERROR(IDF): Could not find the appropriate inverse`):
fi:
fi:
# print(`idf is`, idf):
# "floor" causes problems with a GeometricRV; see IDFDiscreteDotCase
IDX[1] := [unapply(ceil(idf), x)]:
# Should really have the range as [0, 1] (as in continuous)? Either
# way, doesn't fully make sense, but we still want to treat the RV
# as if it is in the dot case. [0 .. 1] means from 0 to 1 here.
# NEW (5/20/01): IDF range: CDF at x = lo to 1
losupp := subs(x = lo, cdf):
IDX[2] := [losupp .. 1]:
#
# If X is given in its IDF form, then nothing needs to be done to X.
#
elif (X[3][2] = "IDF") then
fi:
#
# X has no dot support
#
else
#
# X is given in its PDF, CDF, SF, HF, or CHF form
#
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
FX := CDF(Y):
# print(`FX is`, FX):
IDX[2] := FX[1]:
IDX[1] := FX[2]:
#
# If X is given in its IDF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "IDF") then
fi:
fi:
#
# Only 1 argument given
#
if (nargs = 1) then
return([IDX[1], IDX[2], ["Discrete", "IDF"]]):
else
if (evalf(st, Digits + 2) <= 0) then
print(`ERROR(IDF): x must be greater than 0`):
return:
fi:
if (evalf(st, Digits + 2) > 1) then
print(`ERROR(IDF): x must be less than or equal to 1`):
return:
fi:
#
# No dot support format (Example: [1, 3, 7].)
#
if not(type(IDX[1][1], range)) and not(type(IDX[2][1], range)) then
n := nops(IDX[2]):
# print(n):
# print(IDX[2][1]):
if ((evalf(st, Digits + 2) > 0) and
(evalf(st, Digits + 2) <= evalf(IDX[2][1], Digits + 2))) then
return(IDX[1][1]):
fi:
for i from 1 to (n - 1) do
if ((evalf(st, Digits + 2) > evalf(IDX[2][i], Digits + 2)) and
(evalf(st, Digits + 2) <= evalf(IDX[2][i + 1], Digits + 2)))
then
return(IDX[1][i + 1]):
fi:
od:
return(IDX[1][n]):
#
# Dot support format (Example: [1 .. infinity].)
#
elif type(IDX[2][1], range) then
prob := subs(x = st, idf):
return(prob):
fi:
fi:
end: #11111111112222222222333333333344444444445555555555666666666677777777778888888888#
# Filename: incompletebeta1.map
#
# Procedure Name: IncompleteBeta(p, a, b)
#
# Other APPL Procedures Called:
#
# Updated: June 14, 1999
#
# Purpose: Computes the Incomplete Beta Function
#
# Arguments:
#
# Algorithm:
#
IncompleteBeta := proc(p, a, b)
local Expression, x:
if (nargs <> 3) then
print(`ERROR(IncompleteBeta): This procedure requires 3 arguments`):
RETURN():
fi:
if (type(p, infinity) or type(a, infinity) or type(b, infinity)) then
print(`ERROR(IncompleteBeta): Each parameter must be finite`):
RETURN():
fi:
if type(a, symbol) then
assume(a, positive):
fi:
if type(b, symbol) then
assume(b, positive):
fi:
Expression := GAMMA(a + b) / (GAMMA(a) * GAMMA(b)) * int(x ^ (a - 1) * (1 - x) ^ (b - 1),
x = 0 .. p):
RETURN(Expression):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: insertheapconvolution1.map
# making fX and fY global variables
#
# Procedure Name: InsertHeapConvolution()
#
# Other APPL Procedures Called:
#
# Date: September 17, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
InsertHeapConvolution := proc(position)
global H, Mimic, fX, fY:
local size, xval, xprob, yval, yprob, place, Parent, ParentValue,
ParentValueProb, ParentValuePosition:
size := nops(convert(H, list)):
place := size + 1:
H := array(1 .. place, [seq(H[i], i = 1 .. size), 0]):
# print(`H is`, H):
xval := fX[2][position[1]]:
xprob := fX[1][position[1]]:
# print(`xval is`, xval):
yval := fY[2][position[2]]:
yprob := fY[1][position[2]]:
# print(`yval is`, yval):
#
# Insert the new item at the bottom of the tree
#
H[place] := [xval + yval, xprob * yprob]:
# print(`H is`, H):
Mimic := array(1 .. place,
[seq(Mimic[i], i = 1 .. size), position]):
# print(`Mimic is`, Mimic):
#
# Inserted item will trickle up to its proper place in the tree
#
Parent := ceil(place / 2):
while ((Parent >= 2) and (H[place][1] < H[Parent][1])) do
ParentValue := H[Parent][1]:
ParentValueProb := H[Parent][2]:
ParentValuePosition := Mimic[Parent]:
# print(`H is`, eval(H)):
# print(`Parent is`, Parent):
# print(`place is`, place):
H[Parent] := H[place]:
Mimic[Parent] := Mimic[place]:
H[place][1] := ParentValue:
H[place][2] := ParentValueProb:
Mimic[place] := ParentValuePosition:
place := Parent:
Parent := ceil(place / 2):
od:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: insertheapproduct1.map
# making fX and fY global variables
#
# Procedure Name: InsertHeapProduct()
#
# Other APPL Procedures Called:
#
# Date: September 17, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
InsertHeapProduct := proc(position)
global H, Mimic, fX, fY:
local size, xval, xprob, yval, yprob, place, Parent, ParentValue,
ParentValueProb, ParentValuePosition:
size := nops(convert(H, list)):
place := size + 1:
H := array(1 .. place, [seq(H[i], i = 1 .. size), 0]):
# print(`H is`, H):
xval := fX[2][position[1]]:
xprob := fX[1][position[1]]:
# print(`xval is`, xval):
yval := fY[2][position[2]]:
yprob := fY[1][position[2]]:
# print(`yval is`, yval):
#
# Insert the new item at the bottom of the tree
#
H[place] := [xval * yval, xprob * yprob]:
# print(`H is`, H):
Mimic := array(1 .. place,
[seq(Mimic[i], i = 1 .. size), position]):
# print(`Mimic is`, Mimic):
#
# Inserted item will trickle up to its proper place in the tree
#
Parent := ceil(place / 2):
while ((Parent >= 2) and (H[place][1] < H[Parent][1])) do
ParentValue := H[Parent][1]:
ParentValueProb := H[Parent][2]:
ParentValuePosition := Mimic[Parent]:
# print(`H is`, eval(H)):
# print(`Parent is`, Parent):
# print(`place is`, place):
H[Parent] := H[place]:
Mimic[Parent] := Mimic[place]:
H[place][1] := ParentValue:
H[place][2] := ParentValueProb:
Mimic[place] := ParentValuePosition:
place := Parent:
Parent := ceil(place / 2):
od:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: insertheapproductq11.map
#
# Procedure Name: InsertHeapProductQ1()
#
# Other APPL Procedures Called:
#
# Date: January 11, 2001
#
# Purpose:
#
# Arguments:
#
# Algorithm:
InsertHeapProductQ1 := proc(position)
global Q1H, Q1Mimic, fXPos, fYPos:
local size, xval, xprob, yval, yprob, place, Parent, ParentValue,
ParentValueProb, ParentValuePosition:
size := nops(convert(Q1H, list)):
place := size + 1:
Q1H := array(1 .. place, [seq(Q1H[i], i = 1 .. size), 0]):
# print(`Q1H is`, Q1H):
xval := fXPos[2][position[1]]:
xprob := fXPos[1][position[1]]:
# print(`xval is`, xval):
yval := fYPos[2][position[2]]:
yprob := fYPos[1][position[2]]:
# print(`yval is`, yval):
#
# Insert the new item at the bottom of the tree
#
Q1H[place] := [xval * yval, xprob * yprob]:
# print(`Q1H is`, Q1H):
Q1Mimic := array(1 .. place,
[seq(Q1Mimic[i], i = 1 .. size), position]):
# print(`Q1Mimic is`, Q1Mimic):
#
# Inserted item will trickle up to its proper place in the tree
#
Parent := ceil(place / 2):
while ((Parent >= 2) and (Q1H[place][1] < Q1H[Parent][1])) do
ParentValue := Q1H[Parent][1]:
ParentValueProb := Q1H[Parent][2]:
ParentValuePosition := Q1Mimic[Parent]:
# print(`Q1H is`, eval(Q1H)):
# print(`Parent is`, Parent):
# print(`place is`, place):
Q1H[Parent] := Q1H[place]:
Q1Mimic[Parent] := Q1Mimic[place]:
Q1H[place][1] := ParentValue:
Q1H[place][2] := ParentValueProb:
Q1Mimic[place] := ParentValuePosition:
place := Parent:
Parent := ceil(place / 2):
od:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: insertheapproductq21.map
# making fX and fY global variables
#
# Procedure Name: InsertHeapProductQ2()
#
# Other APPL Procedures Called:
#
# Date: September 17, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
InsertHeapProductQ2 := proc(position)
global Q2H, Q2Mimic, fXNeg, fYPos:
local size, xval, xprob, yval, yprob, place, Parent, ParentValue,
ParentValueProb, ParentValuePosition:
size := nops(convert(Q2H, list)):
place := size + 1:
Q2H := array(1 .. place, [seq(Q2H[i], i = 1 .. size), 0]):
# print(`Q2H is`, Q2H):
xval := fXNeg[2][position[1]]:
xprob := fXNeg[1][position[1]]:
# print(`xval is`, xval):
yval := fYPos[2][position[2]]:
yprob := fYPos[1][position[2]]:
# print(`yval is`, yval):
#
# Insert the new item at the bottom of the tree
#
Q2H[place] := [xval * yval, xprob * yprob]:
# print(`Q2H is`, Q2H):
Q2Mimic := array(1 .. place,
[seq(Q2Mimic[i], i = 1 .. size), position]):
# print(`Q2Mimic is`, Q2Mimic):
#
# Inserted item will trickle up to its proper place in the tree
#
Parent := ceil(place / 2):
while ((Parent >= 2) and (Q2H[place][1] < Q2H[Parent][1])) do
ParentValue := Q2H[Parent][1]:
ParentValueProb := Q2H[Parent][2]:
ParentValuePosition := Q2Mimic[Parent]:
# print(`Q2H is`, eval(Q2H)):
# print(`Parent is`, Parent):
# print(`place is`, place):
Q2H[Parent] := Q2H[place]:
Q2Mimic[Parent] := Q2Mimic[place]:
Q2H[place][1] := ParentValue:
Q2H[place][2] := ParentValueProb:
Q2Mimic[place] := ParentValuePosition:
place := Parent:
Parent := ceil(place / 2):
od:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: insertheapproductq31.map
#
# Procedure Name: InsertHeapProductQ3()
#
# Other APPL Procedures Called:
#
# Date: January 11, 2001
#
# Purpose:
#
# Arguments:
#
# Algorithm:
InsertHeapProductQ3 := proc(position)
global Q3H, Q3Mimic, fXNeg, fYNeg:
local size, xval, xprob, yval, yprob, place, Parent, ParentValue,
ParentValueProb, ParentValuePosition:
size := nops(convert(Q3H, list)):
place := size + 1:
Q3H := array(1 .. place, [seq(Q3H[i], i = 1 .. size), 0]):
# print(`Q3H is`, Q3H):
xval := fXNeg[2][position[1]]:
xprob := fXNeg[1][position[1]]:
# print(`xval is`, xval):
yval := fYNeg[2][position[2]]:
yprob := fYNeg[1][position[2]]:
# print(`yval is`, yval):
#
# Insert the new item at the bottom of the tree
#
Q3H[place] := [xval * yval, xprob * yprob]:
# print(`Q3H is`, Q3H):
Q3Mimic := array(1 .. place,
[seq(Q3Mimic[i], i = 1 .. size), position]):
# print(`Q3Mimic is`, Q3Mimic):
#
# Inserted item will trickle up to its proper place in the tree
#
Parent := ceil(place / 2):
while ((Parent >= 2) and (Q3H[place][1] < Q3H[Parent][1])) do
ParentValue := Q3H[Parent][1]:
ParentValueProb := Q3H[Parent][2]:
ParentValuePosition := Q3Mimic[Parent]:
# print(`Q3H is`, eval(Q3H)):
# print(`Parent is`, Parent):
# print(`place is`, place):
Q3H[Parent] := Q3H[place]:
Q3Mimic[Parent] := Q3Mimic[place]:
Q3H[place][1] := ParentValue:
Q3H[place][2] := ParentValueProb:
Q3Mimic[place] := ParentValuePosition:
place := Parent:
Parent := ceil(place / 2):
od:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: insertheapproductq41.map
#
# Procedure Name: InsertHeapProductQ4()
#
# Other APPL Procedures Called:
#
# Date: January 11, 2001
#
# Purpose:
#
# Arguments:
#
# Algorithm:
InsertHeapProductQ4 := proc(position)
global Q4H, Q4Mimic, fXPos, fYNeg:
local size, xval, xprob, yval, yprob, place, Parent, ParentValue,
ParentValueProb, ParentValuePosition:
size := nops(convert(Q4H, list)):
place := size + 1:
Q4H := array(1 .. place, [seq(Q4H[i], i = 1 .. size), 0]):
# print(`Q4H is`, Q4H):
xval := fXPos[2][position[1]]:
xprob := fXPos[1][position[1]]:
# print(`xval is`, xval):
yval := fYNeg[2][position[2]]:
yprob := fYNeg[1][position[2]]:
# print(`yval is`, yval):
#
# Insert the new item at the bottom of the tree
#
Q4H[place] := [xval * yval, xprob * yprob]:
# print(`Q4H is`, Q4H):
Q4Mimic := array(1 .. place,
[seq(Q4Mimic[i], i = 1 .. size), position]):
# print(`Q4Mimic is`, Q4Mimic):
#
# Inserted item will trickle up to its proper place in the tree
#
Parent := ceil(place / 2):
while ((Parent >= 2) and (Q4H[place][1] < Q4H[Parent][1])) do
ParentValue := Q4H[Parent][1]:
ParentValueProb := Q4H[Parent][2]:
ParentValuePosition := Q4Mimic[Parent]:
# print(`Q4H is`, eval(Q4H)):
# print(`Parent is`, Parent):
# print(`place is`, place):
Q4H[Parent] := Q4H[place]:
Q4Mimic[Parent] := Q4Mimic[place]:
Q4H[place][1] := ParentValue:
Q4H[place][2] := ParentValueProb:
Q4Mimic[place] := ParentValuePosition:
place := Parent:
Parent := ceil(place / 2):
od:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: insertionsort1.map
# for convolution for discrete rvs, rangestat6.map
#
# Procedure Name: InsertionSort(A, B)
#
# Other APPL Procedures Called:
#
# Date: September 8, 2000
#
# Purpose: Returns two sorted lists; the procedure sorts list A and
# uses list A to sort list B accordingly
#
# Arguments:
#
# Algorithm:
InsertionSort := proc(A :: list, B :: list)
local n, NewA, NewB, i, TempA, TempB, j, SortedA, SortedB:
NewA := Array([-1 * 10 ^ 6, op(A)]):
# NewA := [-1 * 10 ^ 6, op(A)]:
NewB := Array([0, op(B)]):
n := ArrayNumElems(NewA):
# print(NewA):
# print(NewB):
for i from 3 to n do
# print(NewA):
TempA := NewA[i]:
TempB := NewB[i]:
for j from i by -1 to 2 while evalf(TempA) < evalf(NewA[j - 1]) do
NewA[j] := NewA[j - 1]:
NewB[j] := NewB[j - 1]:
od:
NewA[j] := TempA:
NewB[j] := TempB:
od:
# SortedA := Array([seq(NewA[i], i = 2 .. n)]):
SortedA := [seq(NewA[i], i = 2 .. n)]:
# SortedB := Array([seq(NewB[i], i = 2 .. n)]):
SortedB := [seq(NewB[i], i = 2 .. n)]:
# print(SortedA): print(SortedB):
RETURN(SortedA, SortedB):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: ks2.map: removed unused variables, commented out print
# statements, removed [op(*)] when * was already a list, no tampering
# with the logic, ordered variables by when they appear in code
#
# Procedure Name: KSRV(n)
#
# Other APPL Procedures Called: None
#
# Date: July 27, 2000
#
# Purpose: KS returns the PDF of the KS statistic for sample size n
#
# Arguments:
#
# Algorithm:
#
KSRV := proc(n)
local N, m, v, vv, g, mm, i, j, k, c, x, A, z, l, P, F, V, u, S, KSCDF, KSspt:
# Phase 1
N := n:
m := floor(3 * N / 2) + (N mod 2) - 1:
# print(`m is`, m):
vv := array(0 .. m):
vv[0] := 0:
g := 1 / (2 * N):
mm := 0:
for i from 1 to (N - 1) do
mm := mm + 1:
vv[mm] := i * g:
od:
for j from 2 * floor(N / 2) + 1 to (2 * N - 1) by 2 do
mm := mm + 1:
vv[mm] := j * g:
od:
if not(mm = m) then
print(`ERROR(KSRV): In calculating m`):
fi:
# print(`v is`, seq(vv[i], i = 0 .. m)):
# Phase 2
for k from 1 to m do
c[k] := (vv[k - 1] + vv[k]) / 2:
od:
for k from 1 to N do
x[k] := (2 * k - 1) * g:
od:
# print(`c is`, seq(c[i], i = 1 .. m)):
# print(`x is`, seq(x[i], i = 1 .. N)):
A := array(1 .. N, 1 .. N):
for i from 2 to N do
for j from 1 to i - 1 do
A[i, j] := 0:
od:
od:
for k from 1 to m do
for i from 1 to N do
for j from i to N do
A[i, j] := 0
od:
od:
z := max(floor(N * c[k] - 1/2), 0):
l := min(ceil(2 * N * c[k]), N):
for i from 1 to N do
for j from max(i, z + 1) to min(N, i + l - 1) do
A[i, j] := 1:
od:
od:
# print(`For k =`, k, `the A matrix is`, A):
od:
P := array(1 .. m):
F := array(1 .. N, 1 .. N):
V := array(1 .. N, 1 .. N):
u := array(1 .. N):
# set up the variables u_i
for i from 1 to N do
u[i] := cat(u, i):
od:
P[1] := N! * (2 * v) ^ N:
for k from 2 to m do
z := max(floor(N * c[k] - 1/2), 0):
l := min(ceil(2 * N * c[k]), N ):
# print(`at k = `, k,` l and z calculated John's way are `, l, z):
F[N, N] := int(1, u[N] = x[N] - v .. 1):
V[N, N] := int(1, u[N] = u[N - 1] .. 1):
for i from N - 1 to 2 by -1 do
# print(`k and i are`, k, i):
if (i + l > N) then
S := 0:
else
S := F[i + 1, i + l]:
fi:
# if (k = 7) then print(`K IS SEVEN: S at first =`, S): fi:
if (i + l > N + 1) then
F[i, N] := int(V[i + 1, N], u[i] = x[N] - v .. floor(x[i] + c[k])
+ (x[i] + v) * (1 - floor(x[i] + c[k]))):
V[i, N] := int(V[i + 1, N], u[i] = u[i - 1] .. floor(x[i] + c[k])
+ (x[i] + v) * (1 - floor(x[i] + c[k]))):
fi:
if (i + l = N + 1) then
F[i, N] := int(V[i + 1, N], u[i] = x[N] - v .. x[i] + v):
fi:
if (i + l < N + 1) then
F[i, i + l - 1] := int(V[i + 1, i + l - 1] + S, u[i] =
x[i + l - 1] - v .. x[i] + v):
fi:
# if (k = 7) then print(`K IS SEVEN: F and V at step one are`):
# print(F, V): fi:
S := S + F[i + 1, min(i + l - 1, N)]:
# if (k = 7) then print(`K IS SEVEN: S second =`, S): fi:
for j from (min(N - 1, i + l - 2)) to (max(i + 1, z + 2)) by -1 do
F[i, j] := int(V[i + 1, j] + S, u[i] = x[j] - v .. x[j + 1] - v ):
V[i, j] := int(V[i + 1, j] + S, u[i] = u[i - 1] .. x[j + 1] - v ):
S := S + F[i + 1, j]:
# if (k = 7) then print(`K IS SEVEN: In J loop: j, F, V, are`,):
# print(j, F, V): fi:
od:
# print(`here i am1, j, k, l, i, z`, j, k, l, i, z):
# print(F,V):
if (z + 1 <= i) then
V[i, i] := int(S, u[i] = u[i - 1] .. x[i + 1] - v):
fi:
if (z + 1 > i) then
V[i, z + 1] := int(V[i + 1, z + 1] + S , u[i] = u[i - 1] ..
x[z + 2] - v):
fi:
if (z + 1 < i) then
F[i, i] := int(S, u[i] = x[i] - v .. x[i + 1] - v):
fi:
# if (k=7) then print(`K IS SEVEN: after z + 1 check: F and V`):
#print(`are`,F, V): fi;
# print(`here i am2, j, k, l, i, z`, j, k, l, i, z):
od:
# print(`Now computing case of i = 1, k is currently`, k):
# print(`l is`, l):
if (l = N) then
S := 0:
F[1, N] := int(V[2, N], u[1] = x[N] - v .. x[1] + v):
else
S := F[2, l + 1]:
fi:
# if (k=7) then print(`K IS SEVEN: outer loop, F and S are`,F,S): fi:
# print(`k and S are`, k, S):
if (l < N) then
F[1, l] := int( V[2, l] + S, u[1] = x[l] - v .. x[1] + v):
fi:
S := S + F[2, l]:
for j from min(N - 1, l - 1) to max(2, z + 1) by -1 do
F[1, j] := int(V[2, j] + S, u[1] = (x[j] - v) * ceil(x[j] - c[k]) ..
x[j + 1] - v):
S := S + F[2, j]:
# if (k=7) then print(`K IS SEVEN: second j loop, j, F, and S`):
# print(`are`, j, F, S): fi:
od:
if (z = 0) then
F[1, 1] := int(S, u[1] = 0 .. x[2] - v):
# if (k=7) then print(`K IS SEVEN: z = 0, F is`,F): fi:
fi:
# if (k = 3) then print(`end of loop and F is`, F):
# print(`end of loop and V is`, V): fi:
P[k] := 0:
for j from z + 1 to l do
P[k] := P[k] + F[1, j]:
# print(`just added`, expand(F[1, j])):
# if (k = 7) then print(`K IS SEVEN: final j loop, j and F[1,j]`):
# print(`are`, j, F[1,j]): fi:
od:
P[k] := N! * P[k]:
# print(`here i am2, j, k, l, i, z`, j, k, l, i, z):
od:
# print(`Before conversion of P, P and m are`, P,m):
#KSCDF
KSspt := []:
KSCDF := []:
for i from 0 to m do
# print(`i and vvi are`, i, vv[i]):
KSspt := [op(KSspt), vv[i] + 1 / (2 * N)]:
od:
for i from 1 to m do
KSCDF := [op(KSCDF), unapply(simplify(subs(v = (w - 1 / (2 * N)), P[i])) , w)]:
od:
#print(herrrrrr, KS1);
# [op(KSCDF2)],
RETURN([KSCDF, KSspt, ["Continuous", "CDF"]]):
end:
#111111111122222222223333333333444444444455555555556666666666777777777788888
# Filename: kstest1.map
#
# Procedure name: KSTest(X, Sample, Parameters)
#
# Other APPL Procedures Called:
#
# Date: January 12, 2000
#
# Purpose: Calculates the Kolmogorov-Smirnoff test statistic for the
# empirical CDF of the sample data versus the CDF of a fitted
# distribution with random variable X
#
# Arguments: X: Random variable,
# Sample: List of sample data points,
# Parameters: List of parameters set equal to their estimated
# values to be substituted into the CDF of X
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in a list-of-lists format
# 3. Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
KSTest := proc(X :: list(list), Sample :: list, Parameters :: list)
local NumLists, n, SortedSample, EmpCDF, i, NoRepeatSample, EmpCDFValues, m,
FX, SubList1, newSubList1, FittedCDFValues, KS, Dpos, Dneg:
#
# Check for the appropriate number of arguments
#
if (nargs <> 3) then
print(`ERROR(KSTest): This procedure 3 arguments`):
RETURN():
fi:
#
# Check that the RV X is in a list-of-lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(KSTest): The RV X must be in a`):
print(`list of 3 lists format`):
RETURN():
fi:
#
# Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
if not((X[3][2] = "PDF") or
(X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
print(`ERROR(KSTest): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
n := nops(Sample):
SortedSample := sort(Sample):
EmpCDF := [[], [], ["Discrete", "CDF"]]:
for i from 1 to n - 1 do
if SortedSample[i] < SortedSample[i + 1] then
EmpCDF[1] := [op(EmpCDF[1]), i / n]:
fi:
od:
EmpCDF[1] := [op(EmpCDF[1]), 1]:
NoRepeatSample := [op({op(SortedSample)})]:
EmpCDF[2] := sort(NoRepeatSample):
EmpCDFValues := [0, op(EmpCDF[1])]:
# print(EmpCDFValues):
m := nops(EmpCDF[2]):
FX := CDF(X):
SubList1 := FX[1]:
newSubList1 := [subs({op(Parameters)}, op(SubList1(x)))]:
FX[1] := newSubList1:
# print(`FX[1] is`, FX[1]):
FittedCDFValues := []:
#
# CDF still contains an integral; can only estimate integral values with
# evalf
#
if hasfun(op(FX[1]), int) then
for i from 1 to m do
FittedCDFValues := [op(FittedCDFValues), evalf(subs(x = EmpCDF[2][i],
op(FX[1])))]:
# print(`hard cdf`, FittedCDFValues):
od:
#
# "Nice" CDF
#
else
for i from 1 to m do
FittedCDFValues := [op(FittedCDFValues), subs(x = EmpCDF[2][i],
op(FX[1]))]:
# print(`nice cdf`, FittedCDFValues):
od:
fi:
KS := 0:
for i from 1 to m - 1 do
Dpos := evalf(abs(EmpCDFValues[i + 1] - FittedCDFValues[i])):
Dneg := evalf(abs(FittedCDFValues[i] - EmpCDFValues[i])):
KS := max(KS, Dpos, Dneg):
# print(`KS is`, KS):
od:
KS := max(KS, evalf(abs(FittedCDFValues[m] - 1))):
print(`The KS test statistic is`, KS):
RETURN(KS):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: kurtosis2.map
#
# Procedure Name: Kurtosis(X)
#
# Other APPL Procedures Called:
#
# Updated: June 3, 2001
#
# Purpose: Returns the kurtosis
#
# Arguments: X: Random Variable
#
# Algorithm:
Kurtosis := proc(X :: list(list))
local mu, sigma, Term1, Term2, Term3, Term4, kurt:
mu := ExpectedValue(X):
sigma := sqrt(Variance(X)):
Term1 := ExpectedValue(X, x -> x ^ 4):
Term2 := 4 * mu * ExpectedValue(X, x -> x ^ 3):
Term3 := 6 * mu ^ 2 * ExpectedValue(X, x -> x ^ 2):
Term4 := 3 * mu ^ 4:
# Change on 6/7/2007: Put "simplify" in the kurt expression
kurt := simplify((Term1 - Term2 + Term3 - Term4) / sigma ^ 4):
# previously defined (in kurtosis1.map) as
# kurt := ExpectedValue(X, x -> x ^ 4):
return(kurt):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: max3.map: adding discrete capabilities -> MaximumDiscrete
# Problem occured in max1.map when receiving an RV with constants
# for range limits
#
# Procedure Name: Maximum(X, Y)
#
# Other APPL Procedures Called: PDF, Transform, Minimum
#
# Date: June 21, 2000
#
# Purpose: Maximum is a procedure that returns the PDF of the maximum
# of two independent RVs
#
# Arguments: X, Y: Independent continuous random variables
#
# Algorithm:
#
Maximum := proc(X, Y)
local lowerX, upperX, fX, nsegsx, lowerY, upperY, fY, nsegsy, fnegX,
fnegY, fmax:
if (X[3][1] = "Discrete") then
return(MaximumDiscrete(X, Y)):
fi:
lowerX := -infinity:
upperX := infinity:
fX := PDF(X):
# print(`fX is`, fX):
nsegsx := nops(fX[2]):
if not(fX[2][1] = -infinity) then
lowerX := fX[2][1]:
# print(lowerX):
if hastype(lowerX, symbol) and not(type(lowerX, constant)) then
assume(lowerX > -infinity):
fi:
fi:
if not(fX[2][nsegs] = infinity) then
upperX := fX[2][nsegsx]:
# print(upperX):
if hastype(upperX, symbol) and not(type(upperX, constant)) then
assume(upperX < infinity):
fi:
fi:
lowerY := -infinity:
upperY := infinity:
fY := PDF(Y):
nsegsy := nops(fY[2]):
if not(fY[2][1] = -infinity) then
lowerY := fY[2][1]:
if hastype(lowerY, symbol) and not(type(lowerY, constant)) then
assume(lowerY > -infinity):
fi:
fi:
if not(fY[2][nsegs] = infinity) then
upperY := fY[2][nsegsy]:
if hastype(upperY, symbol) and not(type(upperY, constant)) then
assume(upperY < infinity):
fi:
fi:
fnegX := Transform(fX, [[x -> -x], [lowerX, upperX]]):
# print(`fnegX is`, fnegX):
fnegY := Transform(fY, [[x -> -x], [lowerY, upperY]]):
# print(`fnegY is`, fnegY):
fmax := Minimum(fnegX, fnegY):
fmax := Transform(fmax, [[x -> -x], [-infinity, infinity]]):
RETURN(fmax):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: maxdiscrete2.map
# maxdiscrete2.map looking at cases (if possible), X finite, Y
# infinite, vice versa
#
# Procedure Name: MaximumDiscrete(X, Y)
#
# Other APPL Procedures Called:
#
# Date: June 12, 2001
#
# Purpose: MaximumDiscrete is a procedure that returns the PDF of the
# maximum of two independent discrete RVs
#
# Arguments: X, Y: Independent discrete random variables
#
# Algorithm:
#
MaximumDiscrete := proc(X, Y)
local fX, fY, xformulaic, xlo, xhi, xN, XSet, yformulaic, ylo, yhi, yN,
YSet, MaxSet, i, MaxList, mn, MaxProb, j, MaxPDF, FX, cdfx, FY,
cdfy, maxcdf, maxcdf1, pdfx, cdfval, m, lastpdfval, maxpdf1,
maxpdf2:
# Convert X and Y to their PDF representations (just to get each random
# variable in the same representation form)
fX := PDF(X):
fY := PDF(Y):
# Convert fX to its standard APPL discrete list-of-sublists format. If
# X has a $Dot$ format and finite support, then convert X to its
# $NoDot$ format
fX := Convert(fX):
if (fX = false) then
print(`ERROR(Maximum): Discrete RV X is NOT in legal APPL form`):
return:
fi:
if type(fX[2][1], range) and not(type(rhs(fX[2][1]), infinity)) then
fX := ConvertToNoDot(fX):
fi:
# print(`fX is`, fX):
# Convert fY to its standard APPL discrete list-of-sublists format. If
# Y has a $Dot$ format and finite support, then convert Y to its
# $NoDot$ format
fY := Convert(fY):
if (fY = false) then
print(`ERROR(Maximum): Discrete RV Y is NOT in legal APPL form`):
return:
fi:
if type(fY[2][1], range) and not(type(rhs(fY[2][1]), infinity)) then
fY := ConvertToNoDot(fY):
fi:
# print(`fY is`, fY):
# fX has a standard discrete $Dot$ format with infinite support. Assume
# for now that xincr is 1 and xtransf is x -> x
if type(fX[2][1], range) then
xformulaic := true:
xlo := lhs(fX[2][1]):
xhi := rhs(fX[2][1]):
# XSet := {xlo, xhi}:
# xincr := fX[2][2]:
# xtransf := fX[2][3]:
# if type(xhi, symbol) then
if not(type(xhi, infinity)) then
print(`ERROR(Maximum): X's support must be numeric`):
return:
fi:
if type(xlo, symbol) or evalb(xlo = -infinity) then
print(`ERROR(Maximum): X's lower support must be`):
print(`a finite numerical value.`):
return:
fi:
else
# print(`NoDot format for X`):
xN := nops(fX[2]):
xlo := fX[2][1]:
xhi := fX[2][xN]:
XSet := {op(fX[2])}:
xformulaic := false:
fi:
# fY has a standard discrete Dot format with infinite support. Assume
# for now that yincr is 1 and ytransf is x -> x
if type(fY[2][1], range) then
yformulaic := true:
ylo := lhs(fY[2][1]):
yhi := rhs(fY[2][1]):
# YSet := {ylo, yhi}:
# yincr := fY[2][2]:
# ytransf := fY[2][3]:
if not(evalb(yhi = infinity)) then
print(`ERROR(Maximum): Y's support must be numeric`):
return:
fi:
if type(ylo, symbol) or evalb(ylo = -infinity) then
print(`ERROR(Maximum): Y's lower support must be`):
print(`a finite numerical value.`):
return:
fi:
else
# print(`NoDot format for Y`):
yN := nops(fY[2]):
ylo := fY[2][1]:
yhi := fY[2][yN]:
YSet := {op(fY[2])}:
yformulaic := false:
fi:
# Building MaxSet so that it will contain all possible maximum values.
# Don't need to put values from the support of X or Y into the support
# of the maximum if they can never be the maximum
# EX. Omega_X = {1, 3, 7, 9}, Omega_Y = {5, 6, 7}
# The X support values 1 and 3 will never be the maximum
if not(xformulaic) and not(yformulaic) then
# print(`fX is`, fX):
# print(`fY is`, fY):
if xlo = ylo then
MaxSet := XSet union YSet:
elif xlo > ylo then
for i from 2 to yN while (fY[2][i] <= xlo) do
od:
if i = yN then
MaxSet := XSet:
else
MaxSet := XSet union YSet[i .. yN]:
fi:
else
for i from 2 to xN while (fX[2][i] <= ylo) do
od:
if i = xN then
MaxSet := YSet:
else
MaxSet := YSet union XSet[i .. xN]:
fi:
fi:
# print(`MaxSet is`, MaxSet):
MaxList := sort([op(MaxSet)], (x, y) -> evalb(evalf(x) < evalf(y))):
MaxList := ReduceList(MaxList):
mn := nops(MaxList):
# print(`MaxList is`, MaxList):
MaxProb := []:
for j from 1 to mn do
MaxProb := [op(MaxProb), CDF(X, MaxList[j]) * CDF(Y, MaxList[j])]:
od:
# print(MaxProb, MaxList):
MaxPDF := PDF([MaxProb, MaxList, ["Discrete", "CDF"]]):
elif xformulaic or yformulaic then
if xformulaic and yformulaic then
FX := CDF(X):
cdfx := op(unapply(FX[1](x))(x)):
FY := CDF(Y):
cdfy := op(unapply(FY[1](x))(x)):
if xlo = ylo then
maxcdf := simplify(cdfx * cdfy):
MaxPDF := PDF([[unapply(maxcdf, x)], FX[2], ["Discrete", "CDF"]]):
elif xlo > ylo then
maxcdf := simplify(cdfx * cdfy):
MaxPDF := PDF([[unapply(maxcdf, x)], FX[2], ["Discrete", "CDF"]]):
else
maxcdf := simplify(cdfx * cdfy):
MaxPDF := PDF([[unapply(maxcdf, x)], FY[2], ["Discrete", "CDF"]]):
fi:
# X infinite, Y finite
elif xformulaic and not(yformulaic) then
FX := CDF(X):
cdfx := op(unapply(FX[1](x))(x)):
maxcdf1 := []:
if xlo = ylo then
# Explain in chapter why going from ...
pdfx := op(unapply(fX[1](x))(x)):
for i from ylo to yhi do
cdfval := subs(x = i, cdfx) * CDF(Y, i):
# print(`cdf value is`):
# print(cdfval):
maxcdf1 := [op(maxcdf1), cdfval]:
od:
# print(`maxcdf1 is`):
# print(maxcdf1):
m := nops(maxcdf1):
lastpdfval := 1 - sum(maxcdf1[k], k = 1 .. m):
maxpdf1 := PDF([[op(maxcdf1), 1], [$ylo .. yhi, yhi + 1],
["Discrete", "CDF"]]):
# print(`maxpdf1 is`, maxpdf1):
maxpdf2 := pdfx:
MaxPDF := [[op(maxpdf1[1][1 .. m]), unapply(maxpdf2, x)],
[$ylo .. yhi, yhi + 1 .. infinity], ["Discrete", "PDF"]]:
elif xlo > ylo then
if xlo >= yhi then
MaxPDF := X:
else
pdfx := op(unapply(fX[1](x))(x)):
for i from xlo to yhi do
cdfval := subs(x = i, cdfx) * CDF(Y, i):
# print(cdfval):
maxcdf1 := [op(maxcdf1), cdfval]:
od:
m := nops(maxcdf1):
lastpdfval := 1 - sum(maxcdf1[k], k = 1 .. m):
maxpdf1 := PDF([[op(maxcdf1), 1], [$xlo .. yhi, yhi + 1],
["Discrete", "CDF"]]):
# print(`maxpdf1 is`, maxpdf1):
maxpdf2 := pdfx:
MaxPDF := [[op(maxpdf1[1][1 .. m]), unapply(maxpdf2, x)],
[$xlo .. yhi, yhi + 1 .. infinity], ["Discrete", "PDF"]]:
fi:
else
pdfx := op(unapply(fX[1](x))(x)):
for i from ylo to yhi do
cdfval := subs(x = i, cdfx) * CDF(Y, i):
# print(cdfval):
maxcdf1 := [op(maxcdf1), cdfval]:
od:
m := nops(maxcdf1):
lastpdfval := 1 - sum(maxcdf1[k], k = 1 .. m):
maxpdf1 := PDF([[op(maxcdf1), 1], [$ylo .. yhi, yhi + 1],
["Discrete", "CDF"]]):
# print(`maxpdf1 is`, maxpdf1):
maxpdf2 := pdfx:
MaxPDF := [[op(maxpdf1[1][1 .. m]), unapply(maxpdf2, x)],
[$ylo .. yhi, yhi + 1 .. infinity], ["Discrete", "PDF"]]:
fi:
# X finite, Y infinite ... just flip-flop the code above for
# X infinite, Y finite
elif not(xformulaic) and yformulaic then
print(`not currently written for X finite, Y infinite`):
print(`just reverse X and Y variables and redo`):
fi:
fi:
return(MaxPDF):
end:#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: maximumiid1.map
#
# Procedure Name: MaximumIID(X, n)
#
# Other APPL Procedures Called:
#
# Date: June 12, 2001
#
# Purpose: MaximumIID is a procedure that returns the PDF of the
# maximum of n iid random variables
#
# Arguments: X: Discrete random variable, n: positive integer
#
# Algorithm:
#
MaximumIID := proc(X, n)
local fX:
fX := OrderStat(X, n, n):
return(fX):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: mean9.map
#
# Procedure Name: Mean(X)
#
# Other APPL Procedures Called: PDF, Convert
#
# Updated: August 3, 2000
#
# Purpose: Returns the mean of a distribution.
#
# Arguments: X: Random Variable
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 lists format
# 3. Convert X to PDF form if not already in that form
# 4. Call the procedure ExpectedValue with the RV X and g := x -> x
# 5. Return the mean of the RV X
#
Mean := proc(X :: list(list))
local NumLists, fX, nsegments, mean, i, SubList1, SubList2, Support, Lo,
Hi, IncrBy, Transformation, TransfPDF, NextValue, n:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(Mean): This procedure requires 1 argument:`):
print(`A random variable`):
RETURN(false):
fi:
#
# Check that the RV X is in a list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(Mean): The RV X must be in a list of 3 lists format`):
RETURN(false):
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(Mean): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
mean := ExpectedValue(X, x -> x):
# print(mean):
if type(false, BooleanOpt(mean)) then
return:
else
return(simplify(mean)):
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: menu1.map
#
# Procedure name: Menu(Item), where Item is either All, Continuous, Discrete, or
# Procedures
#
# Other APPL Procedures Called: None
#
# Date Revised: June 7, 1999
#
# Purpose: APPL Menu
#
# Arguments: (optional)
# Menu or Menu(All): Returns the list of continuous and discrete
# distributions and the list of APPL procedures
# Menu(Continuous): Returns the list of continuous distributions only
# Menu(Discrete): Returns the list of discrete distributions only
# Menu(Procedures): Returns the list of APPL procedures only
#
Menu := proc(Item)
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(Menu): Procedure requires 1 of the following as an argument:`):
print(`All, Continuous, Discrete, or Procedures`):
RETURN():
fi:
if (Item = `All`) then
print(`CONTINUOUS DISTRIBUTIONS:`):
print(`ArcSinRV()`, `ArcTanRV(alpha, phi)`, `BetaRV(beta, gamma)`,
`CauchyRV(a, alpha)`, `ChiRV(n)`, `ChiSquareRV(n)`, `DoublyNoncentralFRV()`,
`DoublyNoncentralTRV()`, `ErlangRV(lambda, n)`, `ErrorRV(mu, alpha, d)`,
`ExponentialRV(lambda)`, `ExponentialPowerRV(lambda, kappa)`,
`ExtremeValueRV(alpha, beta)`, `FRV(n1, n2)`, `GammaRV(lambda, kappa)`,
`GeneralizedParetoRV(gamma, delta, kappa)`, `GompertzRV(delta, kappa)`,
`HyperbolicSecantRV()`, `HyperExponentialRV(p,l)`, `HypoExponentialRV(l)`,
`IDBRV(gamma, delta, kappa)`, `InverseGaussianRV(lambda, mu)`,
`InvertedGammaRV(alpha, beta)`, `KSRV(n)`, `LaPlaceRV(omega, theta)`,
`LogGammaRV(alpha, beta)`, `LogisticRV(kappa, lambda)`,
`LogLogisticRV(lambda, kappa)`,
`LogNormalRV(mu, sigma)`, `LomaxRV(kappa, lambda)`,
`MakehamRV(gamma, delta, kappa)`, `MuthRV(kappa)`, `NoncentralChiSquareRV()`,
`NoncentralFRV()`, `NoncentralTRV()`, `NormalRV(mu, sigma)`,
`ParetoRV(lambda, kappa)`, `RayleighRV(lambda)`, `StandardCauchyRV()`,
`StandardNormalRV()`, `StandardTriangularRV(m)`, `StandardUniformRV()`,
`TRV(n)`, `TriangularRV(a, m, b)`, `UniformRV(a, b)`,
`WeibullRV(lambda, kappa)`):
print(``):
print(`DISCRETE DISTRIBUTIONS:`):
print(`BenfordRV()`, `BinomialRV(n, p)`, `GeometricRV(p)`, `PoissonRV(lambda)`):
print(``):
print(`PROCEDURES:`):
print(`X and Y are random variables; n and r are positive integers, n >= r`):
print(`g is a function`):
print(`Brackets [] denote optional parameters`):
print(`A capitalized parameter, such as Sample, indicates that it must be`):
print(`entered as a list --> ex. Sample := [1, 12.4, 34, 52.45, 63]`):
print(`Benford(X)`, `CDF:CHF:HF:IDF:PDF:SF(X, [x]))`, `CriticalPoint(X, prob)`,
`Display(X)`, `ExpectedValue(X, g)`, `Maximum(X, Y)`, `Mean(X)`,
`Minimum(X, Y)`, `Mixture(MixParameters, MixRVs)`,
`MLE(X, Sample, Parameters, [Rightcensor])`, `MOM(X, Sample, Parameters)`,
`OrderStat(X, n, r)`, `PlotDist(X, low, high)`, `Product(X, Y)`,
`ProductIID(X, n)`, `Sum(X, Y)`, `SumIID(X, n)`, `Transform(X, g)`,
`Truncate(X, low, high)`, `Variance(X)`, `VerifyPDF(X)`):
print(``):
elif (Item = `Continuous`) then
print(`CONTINUOUS DISTRIBUTIONS:`):
print(`ArcSinRV()`, `ArcTanRV(alpha, phi)`, `BetaRV(beta, gamma)`,
`CauchyRV(a, alpha)`, `ChiRV(n)`, `ChiSquareRV(n)`, `DoublyNoncentralFRV()`,
`DoublyNoncentralTRV()`, `ErlangRV(lambda, n)`, `ErrorRV(mu, alpha, d)`,
`ExponentialRV(lambda)`, `ExponentialPowerRV(lambda, kappa)`,
`ExtremeValueRV(alpha, beta)`, `FRV(n1, n2)`, `GammaRV(lambda, kappa)`,
`GeneralizedParetoRV(gamma, delta, kappa)`, `GompertzRV(delta, kappa)`,
`HyperbolicSecantRV()`, `HyperExponentialRV(p,l)`, `HypoExponentialRV(l)`,
`IDBRV(gamma, delta, kappa)`, `InverseGaussianRV(lambda, mu)`,
`InvertedGammaRV(alpha, beta)`, `KSRV(n)`, `LaPlaceRV(omega, theta)`,
`LogGammaRV(alpha, beta)`, `LogisticRV(kappa, lambda)`,
`LogLogisticRV(lambda, kappa)`,
`LogNormalRV(mu, sigma)`, `LomaxRV(kappa, lambda)`,
`MakehamRV(gamma, delta, kappa)`, `MuthRV(kappa)`, `NoncentralChiSquareRV()`,
`NoncentralFRV()`, `NoncentralTRV()`, `NormalRV(mu, sigma)`,
`ParetoRV(lambda, kappa)`, `RayleighRV(lambda)`, `StandardCauchyRV()`,
`StandardNormalRV()`, `StandardTriangularRV(m)`, `StandardUniformRV()`,
`TRV(n)`, `TriangularRV(a, m, b)`, `UniformRV(a, b)`,
`WeibullRV(lambda, kappa)`):
print(``):
elif (Item = `Discrete`) then
print(`DISCRETE DISTRIBUTIONS:`):
print(`BenfordRV()`, `BinomialRV(n, p)`, `GeometricRV(p)`, `PoissonRV(lambda)`):
print(``):
elif (Item = `Procedures`) then
print(`PROCEDURES:`):
print(`X and Y are random variables; n and r are positive integers, n >= r`):
print(`g is a function`):
print(`Brackets [] denote optional parameters`):
print(`A capitalized parameter, such as Sample, indicates that it must be`):
print(`entered as a list --> ex. Sample := [1, 12.4, 34, 52.45, 63]`):
print(`Benford(X)`, `CDF:CHF:HF:IDF:PDF:SF(X, [x]))`, `CriticalPoint(X, prob)`,
`Display(X)`, `ExpectedValue(X, g)`, `Maximum(X, Y)`, `Mean(X)`,
`Minimum(X, Y)`, `Mixture(MixParameters, MixRVs)`,
`MLE(X, Sample, Parameters, [Rightcensor])`, `MOM(X, Sample, Parameters)`,
`OrderStat(X, n, r)`, `PlotDist(X, low, high)`, `Product(X, Y)`,
`ProductIID(X, n)`, `Sum(X, Y)`, `SumIID(X, n)`, `Transform(X, g)`,
`Truncate(X, low, high)`, `Variance(X)`, `VerifyPDF(X)`):
print(``):
else
print(`ERROR(Menu): The menu argument must be one of the following:`):
print(`All, Continuous, Discrete, or Procedures`):
fi:
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: mgf2.map
# ADDING DISCRETE CAPABILITIES
#
# Procedure Name: MGF(X)
#
# Other APPL Procedures Called: ExpectedValue
#
# Updated: August 8, 2000
#
# Purpose: Returns the moment-generating function of a distribution.
#
# Arguments: X: Random Variable
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 lists format
# 3. Check that X is given as a PDF, CDF, SF, HF, CHF, or IDF
# 4. Call the procedure ExpectedValue with the RV X and
# g := x -> exp(t * x)
# 5. Return the MGF of the RV X
#
MGF := proc(X :: list(list))
local NumLists, mgf:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(MGF): This procedure requires 1 argument:`):
print(`A random variable`):
RETURN(false):
fi:
#
# Check that the RV X is in a list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(MGF): The RV X must be in a list of 3 lists format`):
RETURN(false):
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(MGF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
mgf := ExpectedValue(X, x -> exp(t * x)):
RETURN(mgf):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: min3.map
#
# Procedure Name: Minimum(X, Y)
#
# Other APPL Procedures Called: PDF, ReduceList, CDF
#
# Date: June 21, 2000
#
# Purpose: Minimum is a procedure that returns the PDF of the minimum
# of two independent RVs
#
# Arguments: X, Y: Independent continuous random variables
#
# Algorithm:
#
Minimum := proc(X, Y)
local fX, fY, fmin, i, j, nsegments,FX, FY, Fmin, ffmin, x, currFX,
currFY, highest, highesti, stoppoint, Xindex, Yindex:
if (X[3][1] = "Discrete") then
return(MinimumDiscrete(X, Y)):
fi:
fX := PDF(X):
fY := PDF(Y):
# print(max(op(fX[2]))):
# print(max(op(fY[2]))):
# print(min(max(op(fX[2])), max(op(fY[2])))):
fmin[2] := [op(fX[2]), op(fY[2])]:
# print(`fmin[2] is`, fmin[2]):
fmin[2] := sort([op(fmin[2])], (x, y) -> evalb(evalf(x) < evalf(y))):
fmin[2] := ReduceList(fmin[2]):
#
# Now delete any elements that are above the lower support max
#
highest := min(max(op(fX[2])), max(op(fY[2]))):
stoppoint := nops(fmin[2]):
#
# ID the max support of the new RV
#
for i from 1 to stoppoint do
if (fmin[2][i] = highest) then
highesti := i:
break:
fi:
od:
#
# Remove from support list all values too high
#
if (highesti <> fmin[2][stoppoint]) then
for j from (highesti + 1) to stoppoint do
fmin[2] := subsop((highesti + 1) = NULL, fmin[2]):
od:
fi:
FX := CDF(fX):
FY := CDF(fY):
nsegments := nops(fmin[2]) - 1:
Xindex := 1:
Yindex := 1:
fmin[1] := []:
for i from 1 to nsegments do
# print(FX,FY):
if (fmin[2][i] < fX[2][1]) then
currFX := x -> 0:
elif (fmin[2][i] = fX[2][Xindex]) then
currFX := FX[1][Xindex]:
Xindex := Xindex + 1:
fi:
if (fmin[2][i] < fY[2][1]) then
currFY := x -> 0:
elif (fmin[2][i] = fY[2][Yindex]) then
currFY := FY[1][Yindex]:
Yindex := Yindex + 1:
fi:
# print('currently',currFX, currFY):
Fmin := simplify(1 - (1 - currFX(x)) * (1 - currFY(x))):
Fmin := unapply(Fmin, x):
# print('Fminis',Fmin):
ffmin := diff(Fmin(x), x):
ffmin := simplify(ffmin):
# print('ffminis', ffmin):
fmin[1] := [op(fmin[1]), unapply(ffmin, x)]:
# print(fmin1is,fmin[1]):
od:
RETURN([fmin[1], fmin[2], ["Continuous", "PDF"]]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: mindiscrete2.map
#
# Procedure Name: MinimumDiscrete(X, Y)
#
# Other APPL Procedures Called:
#
# Date: June 12, 2001
#
# Purpose: MinimumDiscrete is a procedure that returns the PDF of the
# minimum of two independent discrete RVs
#
# Arguments: X, Y: Independent discrete random variables
#
# Algorithm:
#
MinimumDiscrete := proc(X, Y)
local fX, fY, xformulaic, xlo, xhi, xN, XSet, yformulaic, ylo, yhi, yN,
YSet, MinSet, i, MinList, mn, MinProb, j, MinPDF, FX, cdfx, FY,
cdfy, mincdf, minpdf1, minpdf2, mincdf2, mindpdf2, cdfval, END,
cdfsupp, prev, pdfx, pdfy:
# Convert X and Y to their PDF representations (just to get each random
# variable in the same representation form)
fX := PDF(X):
fY := PDF(Y):
# Convert fX to its standard APPL discrete list-of-sublists format. If
# X has a $Dot$ format and finite support, then convert X to its
# $NoDot$ format
fX := Convert(fX):
if (fX = false) then
print(`ERROR(Minimum): Discrete RV X is NOT in legal APPL form`):
return:
fi:
if type(fX[2][1], range) and not(type(rhs(fX[2][1]), infinity)) then
fX := ConvertToNoDot(fX):
fi:
# print(`fX is`, fX):
# Convert fY to its standard APPL discrete list-of-sublists format. If
# Y has a $Dot$ format and finite support, then convert Y to its
# $NoDot$ format
fY := Convert(fY):
if (fY = false) then
print(`ERROR(Minimum): Discrete RV Y is NOT in legal APPL form`):
return:
fi:
if type(fY[2][1], range) and not(type(rhs(fY[2][1]), infinity)) then
fY := ConvertToNoDot(fY):
fi:
# print(`fY is`, fY):
# fX has a standard discrete $Dot$ format with infinite support. Assume
# for now that xincr is 1 and xtransf is x -> x
if type(fX[2][1], range) then
xformulaic := true:
xlo := lhs(fX[2][1]):
xhi := rhs(fX[2][1]):
# XSet := {xlo, xhi}:
# xincr := fX[2][2]:
# xtransf := fX[2][3]:
# if type(xhi, symbol) then
if not(type(xhi, infinity)) then
print(`ERROR(Minimum): X's support must be numeric`):
return:
fi:
if type(xlo, symbol) or evalb(xlo = -infinity) then
print(`ERROR(Minimum): X's lower support must be`):
print(`a finite numerical value.`):
return:
fi:
else
# print(`NoDot format for X`):
xN := nops(fX[2]):
xlo := fX[2][1]:
xhi := fX[2][xN]:
XSet := {op(fX[2])}:
xformulaic := false:
fi:
# fY has a standard discrete Dot format with infinite support. Assume
# for now that yincr is 1 and ytransf is x -> x
if type(fY[2][1], range) then
yformulaic := true:
ylo := lhs(fY[2][1]):
yhi := rhs(fY[2][1]):
# YSet := {ylo, yhi}:
# yincr := fY[2][2]:
# ytransf := fY[2][3]:
if not(evalb(yhi = infinity)) then
print(`ERROR(Minimum): Y's support must be numeric`):
return:
fi:
if type(ylo, symbol) or evalb(ylo = -infinity) then
print(`ERROR(Minimum): Y's lower support must be`):
print(`a finite numerical value.`):
return:
fi:
else
# print(`NoDot format for Y`):
yN := nops(fY[2]):
ylo := fY[2][1]:
yhi := fY[2][yN]:
YSet := {op(fY[2])}:
yformulaic := false:
fi:
# Building MinSet so that it will contain all possible minimum values.
# Don't need to put values from the support of X or Y into the support
# of the minimum if they can never be the minimum
# EX. Omega_X = {1, 3, 7, 9}, Omega_Y = {5, 6, 7, 14, 18}
# The Y support values 14 and 18 will never be the minimum
if not(xformulaic) and not(yformulaic) then
# print(`fX is`, fX):
# print(`fY is`, fY):
# print(`xhi is`, xhi):
# print(`yhi is`, yhi):
if xhi = yhi then
MinSet := XSet union YSet:
elif xhi > yhi then
for i from xN - 1 by -1 to 1 while (fX[2][i] > yhi) do
od:
# print(`i is`, i):
if i = 1 then
MinSet := YSet:
else
# print(`i is`, i):
MinSet := YSet union XSet[1 .. i]:
fi:
else
for i from yN - 1 by -1 to 1 while (fY[2][i] > xhi) do
od:
if i = 1 then
MinSet := XSet:
else
MinSet := XSet union XSet[1 .. i]:
fi:
fi:
# print(`MinSet is`, MinSet):
MinList := sort([op(MinSet)], (x, y) -> evalb(evalf(x) < evalf(y))):
MinList := ReduceList(MinList):
mn := nops(MinList):
# print(`MinList is`, MinList):
MinProb := []:
for j from 1 to mn do
MinProb := [op(MinProb), 1 - (1 - CDF(X, MinList[j])) *
(1 - CDF(Y, MinList[j]))]:
od:
# print(`CDF is:`):
# print(MinProb, MinList):
MinPDF := PDF([MinProb, MinList, ["Discrete", "CDF"]]):
elif xformulaic or yformulaic then
if xformulaic and yformulaic then
FX := CDF(X):
cdfx := op(unapply(FX[1](x))(x)):
FY := CDF(Y):
cdfy := op(unapply(FY[1](x))(x)):
if xlo = ylo then
mincdf := simplify(1 - (1 - cdfx) * (1 - cdfy)):
MinPDF := PDF([[unapply(mincdf, x)], FX[2], ["Discrete", "CDF"]]):
elif xlo > ylo then
minpdf1 := op(unapply(fY[1](x))(x)):
mincdf2 := simplify(1 - (1 - cdfx) * (1 - cdfy)):
minpdf2 := simplify(subs(x = x, mincdf2) -
subs(x = x - 1, mincdf2)):
MinPDF := [[unapply(minpdf1, x), unapply(minpdf2, x)],
[ylo .. xlo - 1, xlo .. infinity], ["Discrete", "PDF"]]:
elif xlo < ylo then
minpdf1 := op(unapply(fX[1](x))(x)):
mincdf2 := simplify(1 - (1 - cdfx) * (1 - cdfy)):
minpdf2 := simplify(subs(x = x, mincdf2) -
subs(x = x - 1, mincdf2)):
MinPDF := [[unapply(minpdf1, x), unapply(minpdf2, x)],
[xlo .. ylo - 1, ylo .. infinity], ["Discrete", "PDF"]]:
fi:
# X infinite, Y finite
elif xformulaic and not(yformulaic) then
# print(`X infinite, Y finite`):
FX := CDF(X):
cdfx := op(unapply(FX[1](x))(x)):
mincdf := []:
if xlo = ylo then
# Explain in chapter why going from ylo to yhi
# Use example: X ~ Geometric, Y := [],[1, 3],[]
for i from ylo to yhi do
cdfval := 1 - (1 - subs(x = i, cdfx)) * (1 - CDF(Y, i)):
# print(cdfval):
mincdf := [op(mincdf), cdfval]:
od:
# print(mincdf):
MinPDF := PDF([mincdf, [$ylo .. yhi], ["Discrete", "CDF"]]):
elif xlo > ylo then
# print(`xlo is`, xlo):
# print(`ylo is`, ylo):
# print(yN):
for END from 1 to yN while fY[2][END] <= xlo do
# print(fY[2][END]):
od:
# print(`END is`, END):
cdfsupp := [seq(fY[2][j], j = 1 .. END - 1)]:
# print(`cdfsupp is`, cdfsupp):
prev := 0:
for j from 1 to END - 1 do
# print(`j is`, j):
# print(fY[1]):
# print(fY[1][j]):
mincdf := [op(mincdf), prev + fY[1][j]]:
prev := prev + fY[1][j]:
# print(`mincdf is`, mincdf):
od:
# print(`first part of cdf and mincdf are`):
# print(cdfsupp): # print(mincdf):
for i from xlo to yhi do
cdfval := 1 - (1 - subs(x = i, cdfx)) * (1 - CDF(Y, i)):
# print(cdfval):
mincdf := [op(mincdf), cdfval]:
od:
# print(mincdf):
MinPDF := PDF([mincdf, [op(cdfsupp), $xlo .. yhi],
["Discrete", "CDF"]]):
else
# print(`xlo is`, xlo):
# print(`ylo is`, ylo):
END := ylo - xlo:
# print(`END is`, END):
cdfsupp := [$xlo .. yhi]:
# print(`cdfsupp is`, cdfsupp):
pdfx := op(unapply(fX[1](x))(x)):
prev := 0:
for j from xlo to END do
# print(`j is`, j):
cdfval := subs(x = j, cdfx):
mincdf := [op(mincdf), cdfval]:
# print(`mincdf is`, mincdf):
od:
# print(`first part of cdf and mincdf are`):
# print(cdfsupp): # print(mincdf):
for i from END + 1 to yhi do
cdfval := 1 - (1 - subs(x = i, cdfx)) * (1 - CDF(Y, i)):
# print(cdfval):
mincdf := [op(mincdf), cdfval]:
od:
# print(mincdf):
MinPDF := PDF([mincdf, cdfsupp, ["Discrete", "CDF"]]):
fi:
# X finite, Y infinite
elif not(xformulaic) and yformulaic then
# print(`X finite, Y infinite`):
FY := CDF(Y):
cdfy := op(unapply(FY[1](x))(x)):
mincdf := []:
if ylo = xlo then
# Explain in chapter why going from ylo to yhi
# Use example: X ~ Geometric, Y := [],[1, 3],[]
for i from xlo to xhi do
cdfval := 1 - (1 - subs(x = i, cdfy)) * (1 - CDF(X, i)):
# print(cdfval):
mincdf := [op(mincdf), cdfval]:
od:
# print(mincdf):
MinPDF := PDF([mincdf, [$xlo .. xhi], ["Discrete", "CDF"]]):
elif ylo > xlo then
# print(`xlo is`, xlo):
# print(`ylo is`, ylo):
# print(xN):
for END from 1 to xN while fX[2][END] <= ylo do
# print(fX[2][END]):
od:
# print(`END is`, END):
cdfsupp := [seq(fX[2][j], j = 1 .. END - 1)]:
# print(`cdfsupp is`, cdfsupp):
prev := 0:
for j from 1 to END - 1 do
# print(`j is`, j):
# print(fX[1]):
# print(fX[1][j]):
mincdf := [op(mincdf), prev + fX[1][j]]:
prev := prev + fX[1][j]:
# print(`mincdf is`, mincdf):
od:
# print(`first part of cdf and mincdf are`):
# print(cdfsupp): # print(mincdf):
for i from END to xhi do
cdfval := 1 - (1 - subs(x = i, cdfy)) * (1 - CDF(X, i)):
# print(cdfval):
mincdf := [op(mincdf), cdfval]:
od:
# print(mincdf):
MinPDF := PDF([mincdf, [op(cdfsupp), $END .. xhi],
["Discrete", "CDF"]]):
else
# print(`xlo is`, xlo):
# print(`ylo is`, ylo):
END := xlo - ylo:
# print(`END is`, END):
cdfsupp := [$ylo .. xhi]:
# print(`cdfsupp is`, cdfsupp):
pdfy := op(unapply(fY[1](x))(x)):
prev := 0:
for j from ylo to END do
# print(`j is`, j):
cdfval := subs(x = j, cdfy):
mincdf := [op(mincdf), cdfval]:
# print(`mincdf is`, mincdf):
od:
# print(`first part of cdf and mincdf are`):
# print(cdfsupp): # print(mincdf):
for i from END + 1 to xhi do
cdfval := 1 - (1 - subs(x = i, cdfy)) * (1 - CDF(X, i)):
# print(cdfval):
mincdf := [op(mincdf), cdfval]:
od:
# print(mincdf):
MinPDF := PDF([mincdf, cdfsupp, ["Discrete", "CDF"]]):
fi:
fi:
fi:
return(MinPDF):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: minimumiid1.map
#
# Procedure Name: MinimumIID(X, n)
#
# Other APPL Procedures Called:
#
# Date: June 12, 2001
#
# Purpose: MinimumIID is a procedure that returns the PDF of the
# maximum of n iid random variables
#
# Arguments: X: Discrete random variable, n: positive integer
#
# Algorithm:
#
MinimumIID := proc(X, n)
local fX:
fX := OrderStat(X, n, 1):
return(fX):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: mixture10.map
#
# Procedure Name: Mixture(MixParameters, MixRVs)
#
# Other APPL Procedures Called: PDF
#
# Date: March 12, 1999
#
# Purpose: "Mixes" random variables X1, X2, ... Xn by taking weighted sums of the
# distributions
#
# Arguments: MixParameters: A list of probabilities p1, p2, ... pn, where p#
# determines what proportion of the mixture density comes from distribution X#,
# also p1 + p2 + ... + pn = 1;
# MixRVs: X1, X2, ... Xn are the random variables of the component distributions
# that make up the mixture distribution
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the first argument is a list
# 3. Check that the second argument is a list
# 4. Check that the length of MixParameters and MixRVs match
# 5. Check for symbolic mixture parameters
# 6. Check each element of MixParameters to make sure it is in [0, 1]
# 7. Check that the sum of the elements of the MixParameters argument is 1
# 8. Check that each element of MixRVs represents a continuous random variable
# 9. Convert MixRVs to PDF form if not already in that form
# 10. Compute the support of the mixture as the union of the supports of MixRVs
# 11. Compute and return the mixed PDF in the list-of-3-lists format
# (NOTE: A conditional expression was placed in the mixed PDF loop to
# check for PDF's that are NOT of the form [x -> !]; the Maple "op"
# command reads these PDF's differently since the operation x is not
# in the PDF's expression)
#
Mixture := proc(MixParameters :: list, MixRVs :: list)
local NumMixParams, NumMixRVs, i, n, SumOfMixParams, RatSumOfMixParams, MixfX,
MixSupp, MixSuppList, LengthMixSuppList, fXnew, newMixfX, j, m, k, buildfX:
#
# Check for the appropriate number of arguments
#
if (nargs <> 2) then
print(`ERROR(Mixture): This procedure requires 2 arguments:`):
print(`MixParameters and MixRVs`):
print(`Both arguments need to be in a list format`):
RETURN():
fi:
#
# Check that the second argument is a list
#
NumMixParams := nops(MixParameters):
NumMixRVs := nops(MixRVs):
if not(type(MixRVs, list(list(list)))) then
print(`ERROR(Mixture): The second argument, MixRVs, must be a list`):
for i from 1 to NumMixRVs do
if (not(type(MixRVs[i], list)) or nops(MixRVs[i]) != 3) then
print(`Each RV component must be in a list of 3 lists format`):
RETURN():
fi:
od:
RETURN():
fi:
#
# Check that the length of MixParameters and MixRVs match
#
if not(is(NumMixParams = NumMixRVs)) then
print(`ERROR(Mixture): The length of the two arguments must match`):
RETURN():
fi:
n := NumMixParams:
#
# Note: it is impossible at this time (Maple V, Release 5) to assume that
# the sum of MixParameters elements (if symbolic) is 1. Therefore, the procedure
# returns an error message if it encounters a symbolic element in the
# MixParameters argument
#
# Check for symbolic mixture parameters
#
for i from 1 to n do
if (whattype(evalf(MixParameters[i])) = symbol) then
print(`ERROR(Mixture): No symbolic mix parameter elements`):
RETURN():
fi:
od:
#
# Check each element of the MixParameters argument to see if it is in [0, 1]
#
for i from 1 to n do
if (is(MixParameters[i] < 0) or is(MixParameters[i] > 1)) then
print(`ERROR(Mixture): Each mix parameter p_i satisfies 0 <= p_i <= 1`):
RETURN():
fi:
od:
#
# Check that the sum of the elements of the MixParameters argument is 1
#
SumOfMixParams := sum(MixParameters[j], j = 1 .. n):
RatSumOfMixParams := convert(SumOfMixParams, rational):
if (RatSumOfMixParams <> 1) then
print(`ERROR(Mixture): The mix parameters (first argument) must sum to 1`):
RETURN():
fi:
#
# Check that each element of MixRVs represents a continuous random variable
#
for i from 1 to n do
if not(MixRVs[i][3][1] = "Continuous") then
print(`ERROR(Mixture): MixRVs elements (second arg) must be continuous`):
RETURN():
fi:
od:
#
# Convert MixRVs to PDF form if not already in that form
#
for i from 1 to n do
if (MixRVs[i][3][2] = "PDF") then
MixfX[i] := MixRVs[i]:
else
if ((MixRVs[i][3][2] = "CDF") or
(MixRVs[i][3][2] = "SF") or
(MixRVs[i][3][2] = "HF") or
(MixRVs[i][3][2] = "CHF") or
(MixRVs[i][3][2] = "IDF")) then
MixfX[i] := PDF(MixRVs[i]):
else
print(`ERROR(Mixture): MixRVs elements (second arg) must be`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
fi:
od:
#
# Compute the support of the mixture as the union of the supports of MixRVs
#
MixSupp := {op(MixfX[1][2])}:
for i from 2 to n do
MixSupp := MixSupp union {op(MixfX[i][2])}
od:
MixSuppList := sort([op(MixSupp)], (x, y) -> evalb(evalf(x) < evalf(y))):
LengthMixSuppList := nops(MixSuppList):
#
# Compute and return the mixed PDF in the list-of-3-lists format
#
fXnew := []:
for i from 1 to (LengthMixSuppList - 1) do
newMixfX := 0:
for j from 1 to n do
m := nops(MixfX[j][2]) - 1:
for k from 1 to m do
if (evalf(MixfX[j][2][k]) <= evalf(MixSuppList[i]) and
evalf(MixSuppList[i + 1]) <= evalf(MixfX[j][2][k + 1])) then
buildfX := unapply(simplify(MixfX[j][1][k](x) * MixParameters[j]), x):
newMixfX := unapply(simplify(newMixfX(x) + buildfX(x)), x):
fi:
od:
od:
if is(whattype(op(1, unapply(simplify(newMixfX(x) + buildfX(x)), x))) = symbol)
then
fXnew := [op(fXnew), op(newMixfX)]:
else
fXnew := [op(fXnew), newMixfX]:
fi:
od:
RETURN([[op(fXnew)], [op(MixSuppList)], ["Continuous", "PDF"]]):
end:#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: mle7.map (For number of arguments = 3 or 4)
# CHANGE: if only 3 args, use Andy's formula from mle1.map, sometimes
# likeloglihood function with CHF and HF has problems -- so
# don't use this formula unless there is censoring!
#
# Procedure Name: MLE(X, Sample, Parameters, [Rightcensor])
#
# Other APPL Procedures Called: CHF, HF
#
# Date: June 27, 2000
#
# Purpose: Returns the Maximum Likelihood Estimates (MLE) of a RV
# given a sample data set drawn from the RV's distribution.
# The optional argument, Rightcensor, allows for data values
# to be right-censored.
#
# Arguments: X: Random Variable
# Sample: List of sample data points
# Parameters: List of parameters to be estimated
# Rightcensor (optional): Right-censoring vector of 1's and
# 0's, where 1 indicates an observed value and 0 indicates
# a right-censored value
#
# Algorithm: Rewrite ALGORITHM (6/27/2000)
# 1. Check for the appropriate number of arguments: 3 or 4
# 4. Make sure there are no piecewise RV's
# 3. Check that the RV X is given in a list of 3 lists format
# 2. If number of arguments is equal to 3, use *standard* (?)
# loglikelihood function
# . If number of arguments is equal to 4 (which indicated right-
# censoring), use *censoring* (?) loglikelihood function
# 5. Compute HF and CHF forms of X
# 6. Split up the sample data into two lists, censored and
# uncensored
# 7. Compute and simplify the log likelihood function
# 8. Differentiate the log likelihood function wrt each parameter
# and equate to 0
# 9. Solve the system of log likehood equations from #8
# 10. Return the MLE's
#
MLE := proc(X :: list(list), Sample :: list, Parameters,
Rightcensor :: list(binary))
local nsegs, NumSubLists, n, npars, fX, LogLike, i, RcV, hX, chX,
EqualTo1, NumUNCens, NumCens, j, k, UnCensored, Censored, UnC, C,
Logh, Sumch, DiffLogLike, EqnSet, ParamSet, Solns, Estimate,
SolnList:
#
# Check for the appropriate number of arguments: 3 or 4
#
if (nargs <> 3 and nargs <> 4) then
print(`ERROR(MLE): This procedure requires either 3 or 4 arguments:`):
print(`Random Variable, sample data set, parameters`):
print(`to be estimated, right-censoring vector (optional)`):
RETURN():
fi:
#
# Make sure there are no piecewise RV's
#
nsegs := nops(X[1]):
if (nsegs > 1) then
print(`ERROR(MLE): No piecewise RV's allowed`):
RETURN():
fi:
#
# Check that the RV X is given in a list of 3 lists format
#
NumSubLists := nops(X):
if (NumSubLists <> 3) then
print(`ERROR(MLE): The RV X must be in a list of 3 lists format`):
RETURN():
fi:
#
# Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
if not((X[3][2] = "PDF") or
(X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
print(`ERROR(MLE): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
n := nops(Sample):
npars := nops(Parameters):
#
# If only 3 arguments are given, all the data values are uncensored.
# Use the *standard* (uncensored version) loglikelihood function
#
if (X[3][1] = "Continuous") then
#print(`i'm here`):
if (nargs = 3) then
fX := PDF(X):
LogLike := 0:
for i from 1 to n do
LogLike := ln(fX[1][1](Sample[i])) + LogLike:
od:
# print(LogLike):
elif (nargs = 4) then
# print(`i'm here`):
RcV := Rightcensor:
hX := HF(X):
# print(hX):
chX := CHF(X):
# print(chX):
#
# Split up the sample data into two lists, censored and uncensored
#
EqualTo1 := x -> is(x = 1):
NumUNCens := nops(select(EqualTo1, RcV)):
NumCens := n - NumUNCens:
j := 1:
k := 1:
for i from 1 to n do
if (is(RcV[i] = 1)) then
UnCensored[j] := Sample[i]:
j := j + 1:
else
Censored[k] := Sample[i]:
k := k + 1:
fi:
od:
UnC := [seq(UnCensored[i], i = 1 .. NumUNCens)]:
C := [seq(Censored[i], i = 1 .. NumCens)]:
#
# Compute and simplify the log likelihood function
#
Logh := 0:
Sumch := 0:
for i from 1 to NumUNCens do
Logh := (ln(hX[1][1](UnC[i])) + Logh):
od:
for i from 1 to n do
Sumch := chX[1][1](Sample[i]) + Sumch:
od:
LogLike := simplify(Logh - Sumch):
fi:
#print(`LogLike is`, LogLike):
#
# Differentiate the log likelihood function wrt each parameter and
# equate to 0
#
DiffLogLike := array(1 .. npars):
for i from 1 to npars do
DiffLogLike[i] := simplify(diff(LogLike, Parameters[i])):
# print(DiffLogLike[i]):
od:
EqnSet := {seq(DiffLogLike[i] = 0, i = 1 .. npars)}:
#print(EqnSet):
ParamSet := {seq(Parameters[i], i = 1 .. npars)}:
#print(ParamSet);
#
# Solve the system of log likehood equations
#
Solns := solve(EqnSet, ParamSet):
#print(`The solns are`, Solns):
#
# the following if series only applies to the Rayleigh dist
#
# if (rhs(op(Solns[1])) > 0) then
# Solns := Solns[1]:
# elif (rhs(op(Solns[2])) > 0) then
# Solns := Solns[2]:
# else
# Print(Solutionerror);
# fi:
#print(solnsisnow, Solns);
#
# end of Rayleigh
#
Estimate := false:
for i from 1 to npars do
# The command rhs causes a problem if there are two sets of solns; e.g.;
# {lambda = 1, kappa = 2}, {lambda = -1, kappa = 2}
if type(rhs(Solns[i]), RootOf) then
Estimate := true:
Solns := fsolve(EqnSet, ParamSet):
break:
fi:
od:
if not(Estimate) then
#print(`Solutions are`, Solns):
else
print(`Numerical method used to solve for parameter values`):
print(`The approximate solutions are`, Solns):
fi:
#
# Return the MLEs as a list
#
SolnList := []:
for j from 1 to npars do
SolnList := [op(SolnList), subs(op(Solns), Parameters[j])]:
od:
RETURN(SolnList):
else
if nargs = 3 then
return(MLEDiscrete(X, Sample, Parameters)):
else
return(MLEDiscrete(X, Sample, Parameters, Rightcensor)):
fi:
fi:
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888
# Filename: mlediscrete1.map (For number of arguments = 3 or 4)
# Just writing for geometric and Purple Passion example first
# Procedure Name: MLE(X, Sample, Parameters, [Censor])
# need to write PDF for discrete distributions
#
# Other APPL Procedures Called:
#
# Date: July 1, 2000
#
# Purpose: Returns the Maximum Likelihood Estimates (MLE) of a RV given a
#
# Algorithm:
#
MLEDiscrete := proc(X :: list(list), Sample :: list, Parameters,
Censor :: list(binary))
local n, EqualTo1, NumUNCens, NumCens, j, k, UnCensored, Censored, UnC, C,
fX, SX, Factor1, Factor2, LikeLi, LogLike, DiffLogLike, npars, EqnSet, ParamSet, i, Solns, NumSolns, SolnList:
if nargs = 4 then
#
# Split up the sample data into two lists, censored and uncensored
#
n := nops(Sample):
EqualTo1 := x -> is(x = 1):
NumUNCens := nops(select(EqualTo1, Censor)):
NumCens := n - NumUNCens:
j := 1:
k := 1:
for i from 1 to n do
if (is(Censor[i] = 1)) then
UnCensored[j] := Sample[i]:
j := j + 1:
else
Censored[k] := Sample[i]:
k := k + 1:
fi:
od:
UnC := [seq(UnCensored[i], i = 1 .. NumUNCens)]:
C := [seq(Censored[i], i = 1 .. NumCens)]:
# print(`The given sample is:`):
# print(Sample):
# print(`The uncensored data is:`):
# print(UnC):
# print(`The censored data is:`):
# print(C):
#
# Compute and simplify the log likelihood function
#
fX := X:
SX := SF(X):
Factor1 := 1:
Factor2 := 1:
for i from 1 to NumUNCens do
Factor1 := fX[1][1](UnC[i]) * Factor1:
od:
for i from 1 to NumCens do
Factor2 := SX[1][1](C[i]) * Factor2:
od:
# print(`Factor 1 is`, Factor1):
# print(`Factor 2 is`, Factor2):
LikeLi := Factor1 * Factor2:
LogLike := ln(LikeLi):
# print(`LogLike is`, LogLike):
#
# Differentiate the log likelihood function wrt each parameter and equate
# to 0
#
npars := nops(Parameters):
DiffLogLike := array(1 .. npars):
for i from 1 to npars do
DiffLogLike[i] := simplify(diff(LogLike, Parameters[i])):
od:
# print(`DiffLogLike is`, DiffLogLike):
EqnSet := {seq(DiffLogLike[i] = 0, i = 1 .. npars)}:
# print(`EqnSet is`, EqnSet):
ParamSet := {seq(Parameters[i], i = 1 .. npars)}:
# print(`ParamSet is`, ParamSet):
#
# Solve the system of log likehood equations from above
#
Solns := solve(EqnSet, ParamSet):
# print(Solns):
#
# Return the MLEs as a list
#
SolnList := []:
for j from 1 to npars do
SolnList := [op(SolnList), subs(op(Solns), Parameters[j])]:
od:
fi:
RETURN(SolnList):
end:
#
# Filename: mlenhpp1.map
#
# Procedure name: MLENHPP
#
# Date: July 1, 2000
#
# Purpose: Estimate the parameters for
# via maximum likelihood with arbitrary right censoring
#
# Arguments: 1.
# 2.
# 4. A list of the parameters to be estimated
#
# Algorithm:
#
# Warning:
#
MLENHPP := proc(X, Sample, Parameters, ObsTime)
local hX, n, c, Factor1, i, Factor2, LikeLi, LogLike, npars, DiffLogLike, EqnSet, ParamSet, Solns, SolnList, j, lambdahat, kappahat:
if X[3][1] = "Discrete" then
print(`Error`):
fi:
hX := HF(X):
n := nops(Sample):
c := ObsTime:
Factor1 := 1:
for i from 1 to n do
Factor1 := hX[1][1](Sample[i]) * Factor1:
od:
Factor2 := exp(-(int(hX[1][1](t), t = 0 .. c))):
# print(Factor2):
LikeLi := Factor1 * Factor2:
# print(LikeLi):
LogLike := ln(LikeLi):
# print(`LogLike is`):
# print(simplify(LogLike)):
npars := nops(Parameters):
DiffLogLike := array(1 .. npars):
for i from 1 to npars do
# print(simplify(diff(LogLike, Parameters[i]))):
DiffLogLike[i] := simplify(diff(LogLike, Parameters[i])):
od:
# print(`DiffLogLike is`, DiffLogLike):
EqnSet := {seq(DiffLogLike[i] = 0, i = 1 .. npars)}:
# print(`EqnSet is`, EqnSet):
ParamSet := {seq(Parameters[i], i = 1 .. npars)}:
# print(`ParamSet is`, ParamSet):
#
# Solve the system of log likehood equations from above
#
Solns := solve(EqnSet, ParamSet):
# print(Solns):
# print(`Solns are`):
# print(Solns):
# print(whattype(Solns)):
# print(`hey`):
#
# Return the MLEs as a list
#
#
# Trying to prevent MLENHPP from returning the Solns as an
# uncalculated fsolve expression
#
if hasfun(Solns, fsolve) then
print(`helping MLENHPP solve for lambdahat and kappahat`):
print(`for some data sets with a Weibull hazard function`):
kappahat := n / (n * ln(c) - sum(ln(Sample[k]), k = 1 .. n)):
print(kappahat):
lambdahat := (n ^ (1 / kappahat)) / c:
print(lambdahat):
Solns := {lambda = lambdahat, kappa = kappahat}:
print(Solns):
fi:
SolnList := []:
for j from 1 to npars do
SolnList := [op(SolnList), subs(op(Solns), Parameters[j])]:
od:
RETURN(SolnList):
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888
# Filename: mleweibull1.map
#
# Procedure name: MLEWeibull(Sample, Rightcensor)
#
# Other APPL Procedures Called: None
#
# Date: January 11, 2000
#
# Purpose: Estimate the parameters for a Weibull distribution
# via maximum likelihood with arbitrary right censoring
#
# Arguments: Sample: The failure/right censoring times in list form;
# Delta: An indicator list (1 observed, 0 right censored).
#
# Algorithm: From Braxton and Leemis (1998), "A fixed-point algorithm
# for computing Weibull MLEs for a right-censored data set."
#
MLEWeibull := proc(Sample :: list, Rightcensor :: list)
local n, Delta, epsilon, c, r, i, s1, s2, s3, q, counter, chat, bhat,
solnlist:
#
# Check for the appropriate number of arguments: 1 or 2. If the number of
# arguments is 1, assign the right censor list to contain all ones to
# indicate the data values are uncensored
#
n := nops(Sample):
if (nargs = 2) then
Delta := Rightcensor:
elif (nargs = 1) then
Delta := [seq(1, i = 1 .. n)]:
else
print(`ERROR(MLEWeibull): This procedure requires 1 or 2 arguments:`):
print(`Sample data set and right-censoring vector (optional)`):
RETURN():
fi:
#
# Set tolerance and initial estimate
#
epsilon := 0.000000001:
c := 1:
#
# Compute the number of observed failures
#
r := 0:
for i from 1 to n do
r := r + Delta[i]:
od:
#
# Calculate s1
#
s1 := 0:
for i from 1 to n do
if (Delta[i] = 1) then
s1 := combine(s1 + log(Sample[i])):
fi:
od:
#
# Calculate s2 (beginning of random censoring adjustment)
#
s2 := 0:
for i from 1 to n do
s2 := combine(s2 + Sample[i] ^ c):
od:
#
# Calculate s3
#
s3 := 0:
for i from 1 to n do
s3 := combine(s3 + Sample[i] ^ c * log(Sample[i])):
od:
#
# Loop to assure that c is to the right of the vertical asymptote
#
while (evalf(r * s3 - s1 * s2) <= 0) do
c := c * 1.1:
s2 := 0:
for i from 1 to n do
s2 := combine(s2 + Sample[i] ^ c):
od:
s3 := 0:
for i from 1 to n do
s3 := combine(s3 + Sample[i] ^ c * log(Sample[i])):
od:
od:
#
# Calculate s2 (beginning of first iteration of Repeat .. Until loop)
#
s2 := 0:
for i from 1 to n do
s2 := combine(s2 + Sample[i] ^ c):
od:
#
# Calculate s3
#
s3 := 0:
for i from 1 to n do
s3 := combine(s3 + Sample[i] ^ c * log(Sample[i])):
od:
#
# Calculate q and c
#
q := r * s2 / (r * s3 - s1 * s2):
c := (c + q) / 2:
counter := 0:
while (evalf(abs(c - q)) > epsilon) and (counter < 100) do
counter := counter + 1:
s2 := 0:
for i from 1 to n do
s2 := evalf(s2 + Sample[i] ^ c):
od:
s3 := 0:
for i from 1 to n do
s3 := evalf(s3 + Sample[i] ^ c * log(Sample[i])):
od:
q := evalf(r * s2 / (r * s3 - s1 * s2)):
# print(`q in the while loop is`, q):
c := evalf((c + q) / 2):
# print(`c in the while loop is`, c):
od:
#
# Calculate the MLEs
#
chat := c:
s2 := 0:
for i from 1 to n do
s2 := s2 + Sample[i] ^ c:
od:
bhat := (s2 / r) ^ (1 / c):
solnlist := [1 / bhat, chat]:
RETURN(solnlist):
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: mom6.map--doesn't work for piecewise, like triangular
# trying to fix this in mom8.map
#
# Procedure Name: MOM(X, Sample, Parameters)
#
# Other APPL Procedures Called: PDF, ExpectedValue
#
# Date: August 20, 1999
#
# Purpose: Returns the Method of Moments (MOM) Estimates for a complete
# sample data set
#
# Arguments: X: Random variable,
# Sample: List of sample data points, and
# Parameters: List of parameters to be estimated
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is given in a list of 3 lists format
# 3. Convert X to PDF form if not already in that form
# 4. Check that parameters to be estimated are the same parameters
# that have been assigned to the random variable X; that is, if
# X := GammaRV(a, b), then the parameters to be estimated must be
# [a, b]. Return an error message if this is not the case. Also,
# return an error message if a parameter variable name has been
# used in the current Maple session without being unassigned
# before defining the random variable X and running MOM
# 5. Convert the values in the list Sample to rational numbers so
# that Maple commands such as sum and solve will give exact
# solutions instead of floating point approximations
# 6. Compute and simplify the sample moments and distribution
# moments
# 7. Equate the distribution moments with their corresponding sample
# moments
# 8. Solve the system of equations; if Maple cannot determine the
# exact solution(s) with "solve," then use Maple's numeric
# solver, "fsolve"
# 9. Return the MOMs as a list
#
MOM := proc(X :: list(list), Sample :: list, Parameters :: list(symbol))
local NumSubLists, fX, n, k, count, ParamCheck, RatSample, SampleMOM,
DistMOM, j, EqnSet, ParamSet, Solns, NumSolns, Estimate, i,
SolnList:
description `Returns method of moment estimates`:
#
# Check for the appropriate number of arguments
#
if (nargs <> 3) then
print(`ERROR(MOM): This procedure requires 3 arguments:`):
print(`Random variable, data set, and`):
print(`list of parameters to be estimated`):
return:
fi:
#
# Check that the RV X is given in a list of 3 lists format
#
NumSubLists := nops(X):
if (NumSubLists <> 3) then
print(`ERROR(MOM): The RV X must be in a list of 3 lists format`):
return:
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif ((X[3][2] = "CDF") or
(X[3][2] = "CHF") or
(X[3][2] = "HF") or
(X[3][2] = "IDF") or
(X[3][2] = "SF")) then
fX := PDF(X):
else
print(`ERROR(MOM): RV must be given as`):
print(`CDF, CHF, HF, IDF, PDF, or SF`):
return:
fi:
#
# Check that parameters to be estimated are the same parameters that
# have been assigned to the random variable X; that is, if
# X := GammaRV(a, b), then the parameters to be estimated must be
# [a, b]. Return an error message if this is not the case. Also,
# return an error message if a parameter variable name has been used in
# the current Maple session without being unassigned before defining
# the random variable X and running MOM
#
n := nops(Sample):
k := nops(Parameters):
# ParamCheck := op(X[1](x)):
# for count from 1 to k do
# if not(has(ParamCheck, Parameters[count])) then
# print(`ERROR(MOM): One of the two problems below has been
# encountered:`):
# print(`(1) The parameters to be estimated are NOT the same as the`):
# print(`parameters assigned to the random variable X`):
# print(`If X := GammaRV(a, b), then the parameters to be estimated
# MUST`):
# print(`be given as the list [a, b]`):
# print(``):
# print(`OR`):
# print(``):
# print(`(2) You are re-using a parameter variable name without first`):
# print(`unassigning it. Unassign parameter variable names before
# defining`):
# print(`your random variable X and then rerun MOM`):
# print(`Example: Unassign variable name lambda with: > unassign
# ('lambda');`):
# return:
# fi:
# od:
#
# Convert the values in the list Sample to rational numbers so that
# Maple commands such as sum and solve will give exact solutions
# instead of floating point approximations
#
SampleMOM := array(1 .. k):
DistMOM := array(1 .. k):
RatSample := convert(Sample, rational):
#
# Compute and simplify the sample moments and distribution moments
#
for j from 1 to k do
SampleMOM[j] := simplify(sum(RatSample[i] ^ j, i = 1 .. n) / n):
DistMOM[j] := ExpectedValue(fX, x -> x ^ j):
od:
#
# Equate the distribution moments with their corresponding sample
# moments
#
EqnSet := {seq(SampleMOM[j] = DistMOM[j], j = 1 .. k)}:
# print(EqnSet):
ParamSet := {seq(Parameters[j], j = 1 .. k)}:
# print(ParamSet):
#
# Solve the system of equations from above; if Maple cannot determine
# the exact solution(s), then use the numerical solver "fsolve"
#
Solns := solve(EqnSet, ParamSet):
# print(`Solns are`):
# print(Solns):
NumSolns := nops(Solns):
Estimate := false:
for i from 1 to NumSolns do
if type(rhs(Solns[i]), RootOf) then
Estimate := true:
# Used for Ball Bearing Data Set
# Solns := allvalues(Solns):
Solns := fsolve(EqnSet, ParamSet, lambda = 0 .. 0.015):
# Solns := fsolve(EqnSet, ParamSet):
break:
fi:
od:
if not(Estimate) then
print(`Solutions are`, Solns):
else
print(`A numerical method was used to solve for the values`):
print(`of the parameters`):
print(`The approximate solutions are`, Solns):
fi:
#
# Return the MOMs as a list
#
SolnList := []:
for j from 1 to k do
SolnList := [op(SolnList), subs(op(Solns), Parameters[j])]:
od:
return(SolnList):
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: momerlang1.map
#
# Procedure name: MOMErlang(Sample)
#
# Other APPL Procedures Called: ErlangRV,
#
# Date: January 21, 2000
#
# Purpose: Estimate the parameters for a Erlang distribution via
# method of moments estimation
#
# Arguments: Sample: The data set in list form
#
# Algorithm: 1. Check for 1 argument
#
MOMErlang := proc(Sample :: list)
local m, RatSample, i, fX, SampleMOM, DistMOM, EqnSet, ParamSet, Soln,
Estimate, X, ksvalue:
#
# Check for 1 argument
#
if (nargs <> 1) then
print(`ERROR(MOMErlang): This procedure requires 1 argument:`):
print(`The sample data in a list`):
RETURN():
fi:
#
# Define fX as the PDF of an Erlang RV
#
m :=nops(Sample):
RatSample := convert(Sample, rational):
# print(RatSample):
for i from 1 to 20 do
unassign('lambda'):
fX := ErlangRV(lambda, i):
# print(fX):
#
# Compute and simplify the sample moments and distribution moments
# for the given integer value of the Erlang parameter n
#
SampleMOM := simplify(sum(RatSample[j], j = 1 .. m) / m):
#print(SampleMOM):
DistMOM := ExpectedValue(fX, x -> x):
#print(DistMOM):
#
# Equate the distribution moments with their corresponding sample
# moments
#
EqnSet := {SampleMOM = DistMOM}:
ParamSet := {lambda}:
#print(EqnSet):
#
# Solve the system of equations from above; if Maple cannot determine
# the exact solution for the parameter lambda, then use the Maple
# numerical solver "fsolve"
#
Soln := solve(EqnSet, ParamSet):
Estimate := false:
if type(rhs(op(Soln)), RootOf) then
Estimate := true:
Soln := fsolve(EqnSet, ParamSet):
break:
fi:
print(`********************************************`):
print(`the integer n is`, i):
if not(Estimate) then
print(`The exact value of the Erlang parameter lambda is`, Soln):
else
print(`A numerical method was used to solve for the Erlang`):
print(`parameter lambda, which is approximately`, Soln):
fi:
unassign('lambda'):
unassign('n'):
X := ErlangRV(lambda, n):
ksvalue := KSTest(X, RatSample, [lambda = rhs(op(Soln)), n = i]):
od:
#
# Return the parameter lambda as a list
#
# RETURN([op(Soln)]):
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: movingheapconvolutionmethod1.map
#
# Procedure Name: MovingHeapConvolutionMethod(X, Y)
#
# Other APPL Procedures Called:
#
# Date: October 4, 2000
#
# Purpose:
#
# Arguments: X, Y: Continuous random variables
#
# Algorithm:
MovingHeapConvolutionMethod := proc()
global H, Mimic, fX, fY:
local n, m, s, Probs, r, c, row1col2elt, row2col1elt, q, RootItem,
RootPosition, a, b, size, NewPosition:
n := nops(fX[1]):
m := nops(fY[1]):
s := array(1 .. n * m, []):
Probs := array(1 .. n * m, []):
s[1] := fX[2][1] + fY[2][1]:
Probs[1] := fX[1][1] * fY[1][1]:
r := array(sparse, 1 .. n + 1, []):
c := array(sparse, 1 .. m + 1, []):
#
# Place a 1 in row 1, column 2, row 2, and column 1 to indicate that
# there is an "active" item in these rows and columns. Place a 1 in
# row n + 1 and column m + 1 to indicate the end of the array in the
# row and column directions
#
row1col2elt := [fX[2][1] + fY[2][2], fX[1][1] * fY[1][2]]:
r[1] := 1:
c[2] := 1:
row2col1elt := [fX[2][2] + fY[2][1], fX[1][2] * fY[1][1]]:
r[2] := 1:
c[1] := 1:
r[n + 1] := 1:
c[m + 1] := 1:
#
# Create a left complete tree H for two elements and create a left
# complete tree Mimic which contains the ordered positions (in the
# fX and fY lists) of the elements placed in the heap H
#
H := array(1 .. 3, [-1 * 10 ^ 6, row1col2elt, row2col1elt]):
Mimic := array(1 .. 3, [-1 * 10 ^ 6, [1, 2], [2, 1]]):
#
# Convert the trees H and Mimic into heaps
#
PercolateDownHeap(2, 3):
#
# Remove the root from the heap and place it in the sum array s,
# unmark the row and column that had its element removed, rebuild the
# heap with the remaining elements, insert allowable elements in the
# heap, place a 1 in the row and column arrays indicating the added
# element's position, repeat the process ...
#
for q from 2 to n * m do
#
# Remove the minimum element (in the root) from the heap and place it
# in the sum array s. Mark the position of the removed element in the
# array A as [row a, column b].
#
RootItem := H[2]:
RootPosition := Mimic[2]:
s[q] := RootItem[1]:
Probs[q] := RootItem[2]:
a := RootPosition[1]:
b := RootPosition[2]:
#
# Place a 0 in the column and row from which the minimum element was
# removed
#
r[a] := 0:
c[b] := 0:
#
# Replace the root of the heap with the last element in the heap,
# decrease the size of the heap by one (eliminating the position of
# the last element which was moved into the root), and rebuild the
# heap from top down
#
size := nops(convert(H, list)):
H[2] := H[size]:
Mimic[2] := Mimic[size]:
H := array(1 .. size - 1, [seq(H[i], i = 1 .. size - 1)]):
Mimic := array(1 .. size - 1, [seq(Mimic[i], i = 1 .. size - 1)]):
RebuildHeap(2, size - 1):
#
# The element in array position [row a, column b] was removed from
# the heap. If row a and column b + 1 do not contain an active
# element, then insert a new sum value into array position
# [row a, column b + 1]. Place a 1 in row a and column b + 1 to
# indicate that there is an "active" item in this row and column
#
if r[a] = 0 and c[b + 1] = 0 then
r[a] := 1:
c[b + 1] := 1:
NewPosition := [a, b + 1]:
InsertHeapConvolution(NewPosition):
fi:
#
# The element in array position [row a, column b] was removed from
# the heap. If row a + 1 and column b do not contain an active
# element, then insert a new sum value into array position
# [row a + 1, column b]. Place a 1 in row a + 1 and column b to
# indicate that there is an "active" item in this row and column
#
if r[a + 1] = 0 and c[b] = 0 then
r[a + 1] := 1:
c[b] := 1:
NewPosition := [a + 1, b]:
InsertHeapConvolution(NewPosition):
fi:
od:
return(s, Probs):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: movingheapproductmethod1.map
#
# Procedure Name: MovingHeapProductMethod(X, Y)
#
# Other APPL Procedures Called:
#
# Date: October 4, 2000
#
# Purpose:
#
# Arguments: X, Y: Continuous random variables
#
# Algorithm:
MovingHeapProductMethod := proc()
global H, Mimic, fX, fY:
local n, m, prods, Probs, r, c, row1col2elt, row2col1elt, q, RootItem,
RootPosition, a, b, size, NewPosition:
n := nops(fX[1]):
m := nops(fY[1]):
prods := array(1 .. n * m, []):
Probs := array(1 .. n * m, []):
prods[1] := fX[2][1] * fY[2][1]:
Probs[1] := fX[1][1] * fY[1][1]:
r := array(sparse, 1 .. n + 1, []):
c := array(sparse, 1 .. m + 1, []):
#
# Place a 1 in row 1, column 2, row 2, and column 1 to indicate that
# there is an "active" item in these rows and columns. Place a 1 in
# row n + 1 and column m + 1 to indicate the end of the array in the
# row and column directions
#
# if (n > 1) then
row1col2elt := [fX[2][2] * fY[2][1], fX[1][2] * fY[1][1]]:
r[1] := 1:
c[2] := 1:
# fi:
# if (m > 1) then
row2col1elt := [fX[2][1] * fY[2][2], fX[1][1] * fY[1][2]]:
r[2] := 1:
c[1] := 1:
# fi:
r[n + 1] := 1:
c[m + 1] := 1:
#
# Create a left complete tree H for two elements and create a left
# complete tree Mimic which contains the ordered positions (in the
# fX and fY lists) of the elements placed in the heap H
#
H := array(1 .. 3, [-1 * 10 ^ 6, row1col2elt, row2col1elt]):
Mimic := array(1 .. 3, [-1 * 10 ^ 6, [2, 1], [1, 2]]):
#
# Convert the trees H and Mimic into heaps
#
PercolateDownHeap(2, 3):
#
# Remove the root from the heap and place it in the sum array prods,
# unmark the row and column that had its element removed, rebuild the
# heap with the remaining elements, insert allowable elements in the
# heap, place a 1 in the row and column arrays indicating the added
# element's position, repeat the process ...
#
for q from 2 to n * m do
#
# Remove the minimum element (in the root) from the heap and place it
# in the sum array prods. Mark the position of the removed element in
# the
# array A as [row a, column b].
#
RootItem := H[2]:
RootPosition := Mimic[2]:
prods[q] := RootItem[1]:
Probs[q] := RootItem[2]:
a := RootPosition[1]:
b := RootPosition[2]:
#
# Place a 0 in the column and row from which the minimum element was
# removed
#
r[a] := 0:
c[b] := 0:
#
# Replace the root of the heap with the last element in the heap,
# decrease the size of the heap by one (eliminating the position of
# the last element which was moved into the root), and rebuild the
# heap from top down
#
size := nops(convert(H, list)):
H[2] := H[size]:
Mimic[2] := Mimic[size]:
H := array(1 .. size - 1, [seq(H[i], i = 1 .. size - 1)]):
Mimic := array(1 .. size - 1, [seq(Mimic[i], i = 1 .. size - 1)]):
RebuildHeap(2, size - 1):
#
# The element in array position [row a, column b] was removed from
# the heap. If row a and column b + 1 do not contain an active
# element, then insert a new sum value into array position
# [row a, column b + 1]. Place a 1 in row a and column b + 1 to
# indicate that there is an "active" item in this row and column
#
if r[a] = 0 and c[b + 1] = 0 then
r[a] := 1:
c[b + 1] := 1:
NewPosition := [a, b + 1]:
InsertHeapProduct(NewPosition):
fi:
#
# The element in array position [row a, column b] was removed from
# the heap. If row a + 1 and column b do not contain an active
# element, then insert a new sum value into array position
# [row a + 1, column b]. Place a 1 in row a + 1 and column b to
# indicate that there is an "active" item in this row and column
#
if r[a + 1] = 0 and c[b] = 0 then
r[a + 1] := 1:
c[b] := 1:
NewPosition := [a + 1, b]:
InsertHeapProduct(NewPosition):
fi:
od:
return(prods, Probs):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: movingheapproductq1q31.map
#
# Procedure Name: MovingHeapProductQ1Q3(X, Y)
#
# Other APPL Procedures Called:
#
# Date: January 10, 2001
#
# Purpose:
#
# Arguments: X, Y: Discrete random variables
#
# Algorithm:
MovingHeapProductQ1Q3 := proc()
global H, Mimic, fXNeg, fXPos, fYNeg, fYPos, Q1H, Q1Mimic, Q3H,
Q3Mimic:
local xneg, xpos, yneg, ypos, Q1Q3Prod, Q1Q3Prob, Q1row1col1,
Q3row1col1, Q1r, Q1c, Q3r, Q3c, Q1row1col2, Q1row2col1, Q3row1col2,
Q3row2col1, i,a, b, size, NewPosition:
xneg := nops(fXNeg[1]):
xpos := nops(fXPos[1]):
yneg := nops(fYNeg[1]):
ypos := nops(fYPos[1]):
Q1Q3Prod := array(1 .. xpos * ypos + xneg * yneg):
Q1Q3Prob := array(1 .. xpos * ypos + xneg * yneg):
Q1row1col1 := [fXPos[2][1] * fYPos[2][1], fXPos[1][1] * fYPos[1][1]]:
Q3row1col1 := [fXNeg[2][1] * fYNeg[2][1], fXNeg[1][1] * fYNeg[1][1]]:
Q1r := array(sparse, 1 .. xpos + 1, []):
Q1c := array(sparse, 1 .. ypos + 1, []):
Q3r := array(sparse, 1 .. xneg + 1, []):
Q3c := array(sparse, 1 .. yneg + 1, []):
Q1r[xpos + 1] := 1:
Q1c[ypos + 1] := 1:
Q3r[xneg + 1] := 1:
Q3c[yneg + 1] := 1:
if Q1row1col1[1] <= Q3row1col1[1] then
Q1Q3Prod[1] := Q1row1col1[1]:
Q1Q3Prob[1] := Q1row1col1[2]:
Q1row1col2 := [fXPos[2][2] * fYPos[2][1], fXPos[1][2] * fYPos[1][1]]:
Q1r[1] := 1:
Q1c[2] := 1:
Q1row2col1 := [fXPos[2][1] * fYPos[2][2], fXPos[1][1] * fYPos[1][2]]:
Q1r[2] := 1:
Q1c[1] := 1:
Q1H := array(1 .. 3, [-1 * 10 ^ 6, Q1row1col2, Q1row2col1]):
Q1Mimic := array(1 .. 3, [-1 * 10 ^ 6, [2, 1], [1, 2]]):
Q3r[1] := 1:
Q3c[1] := 1:
PercolateDownHeapQ1(2, 3):
Q3H := array(1 .. 2, [-1 * 10 ^ 6, Q3row1col1]):
Q3Mimic := array(1 .. 2, [-1 * 10 ^ 6, [1, 1]]):
else
Q1Q3Prod[1] := Q3row1col1[1]:
Q1Q3Prob[1] := Q3row1col1[2]:
Q3row1col2 := [fXNeg[2][2] * fYNeg[2][1], fXNeg[1][2] * fYNeg[1][1]]:
Q3r[1] := 1:
Q3c[2] := 1:
Q3row2col1 := [fXNeg[2][1] * fYNeg[2][2], fXNeg[1][1] * fYNeg[1][2]]:
Q3r[2] := 1:
Q3c[1] := 1:
Q3H := array(1 .. 3, [-1 * 10 ^ 6, Q3row1col2, Q3row2col1]):
Q3Mimic := array(1 .. 3, [-1 * 10 ^ 6, [2, 1], [1, 2]]):
Q1r[1] := 1:
Q1c[1] := 1:
PercolateDownHeapQ3(2, 3):
Q1H := array(1 .. 2, [-1 * 10 ^ 6, Q1row1col1]):
Q1Mimic := array(1 .. 2, [-1 * 10 ^ 6, [1, 1]]):
fi:
# print(`Q1r, Q1c are`, Q1r, Q1c):
# print(`Q3r, Q3c are`, Q3r, Q3c):
# print(`Q1H is`, Q1H):
# print(`Q3H is`, Q3H):
# print(`Q1Q3 is`, Q1Q3Prod):
for i from 2 to (xpos * ypos + xneg * yneg) do
if Q1H[2][1] <= Q3H[2][1] then
Q1Q3Prod[i] := Q1H[2][1]:
Q1Q3Prob[i] := Q1H[2][2]:
a := Q1Mimic[2][1]:
b := Q1Mimic[2][2]:
Q1r[a] := 0:
Q1c[b] := 0:
size := nops(convert(Q1H, list)):
Q1H[2] := Q1H[size]:
Q1Mimic[2] := Q1Mimic[size]:
Q1H := array(1 .. size - 1, [seq(Q1H[i], i = 1 .. size - 1)]):
Q1Mimic := array(1 .. size - 1,
[seq(Q1Mimic[i], i = 1 .. size - 1)]):
RebuildHeapQ1(2, size - 1):
if Q1r[a] = 0 and Q1c[b + 1] = 0 then
Q1r[a] := 1:
Q1c[b + 1] := 1:
NewPosition := [a, b + 1]:
InsertHeapProductQ1(NewPosition):
fi:
if Q1r[a + 1] = 0 and Q1c[b] = 0 then
Q1r[a + 1] := 1:
Q1c[b] := 1:
NewPosition := [a + 1, b]:
InsertHeapProductQ1(NewPosition):
fi:
Q1H := convert(Q1H, list):
# print(`Q1H is`, Q1H):
# print(`Q1r is`, Q1r):
# print(`Q1c is`, Q1c):
if nops(Q1H) = 1 then
Q1H := array(1 .. 2, [Q1H[1], [1 * 10 ^ 10, 0]]):
fi:
else
Q1Q3Prod[i] := Q3H[2][1]:
Q1Q3Prob[i] := Q3H[2][2]:
a := Q3Mimic[2][1]:
b := Q3Mimic[2][2]:
Q3r[a] := 0:
Q3c[b] := 0:
size := nops(convert(Q3H, list)):
Q3H[2] := Q3H[size]:
Q3Mimic[2] := Q3Mimic[size]:
Q3H := array(1 .. size - 1, [seq(Q3H[i], i = 1 .. size - 1)]):
Q3Mimic := array(1 .. size - 1,
[seq(Q3Mimic[i], i = 1 .. size - 1)]):
RebuildHeapQ3(2, size - 1):
if Q3r[a] = 0 and Q3c[b + 1] = 0 then
Q3r[a] := 1:
Q3c[b + 1] := 1:
NewPosition := [a, b + 1]:
# print(`Q3H is`, Q3H):
InsertHeapProductQ3(NewPosition):
# print(`Q3H is`, Q3H):
fi:
if Q3r[a + 1] = 0 and Q3c[b] = 0 then
Q3r[a + 1] := 1:
Q3c[b] := 1:
NewPosition := [a + 1, b]:
# print(`Q3H is`, Q3H):
InsertHeapProductQ3(NewPosition):
# print(`Q3H is`, Q3H):
fi:
# print(`Q3H is`, Q3H):
# print(`Q1r, Q1c are`, Q1r, Q1c):
# print(`Q3r, Q3c are`, Q3r, Q3c):
Q3H := convert(Q3H, list):
if nops(Q3H) = 1 then
Q3H := array(1 .. 2, [Q3H[1], [1 * 10 ^ 10, 0]]):
fi:
fi:
# print(`Q1Q3 is`, Q1Q3Prod):
od:
return(Q1Q3Prod, Q1Q3Prob):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: movingheapproductq2q41.map
#
# Procedure Name: MovingHeapProductQ2Q4(X, Y)
#
# Other APPL Procedures Called:
#
# Date: January 10, 2001
#
# Purpose:
#
# Arguments: X, Y: Discrete random variables
#
# Algorithm:
MovingHeapProductQ2Q4 := proc()
global H, Mimic, fXNeg, fXPos, fYNeg, fYPos, Q2H, Q2Mimic, Q4H,
Q4Mimic:
local xneg, xpos, yneg, ypos, Q2Q4Prod, Q2Q4Prob, Q2row1col1,
Q4row1col1, Q2r, Q2c, Q4r, Q4c, Q2row1col2, Q2row2col1, Q4row1col2,
Q4row2col1, i, a, b, size, NewPosition:
xneg := nops(fXNeg[1]):
xpos := nops(fXPos[1]):
yneg := nops(fYNeg[1]):
ypos := nops(fYPos[1]):
Q2Q4Prod := array(1 .. xneg * ypos + xpos * yneg):
Q2Q4Prob := array(1 .. xneg * ypos + xpos * yneg):
Q2row1col1 := [fXNeg[2][1] * fYPos[2][1], fXNeg[1][1] * fYPos[1][1]]:
Q4row1col1 := [fXPos[2][1] * fYNeg[2][1], fXPos[1][1] * fYNeg[1][1]]:
Q2r := array(sparse, 1 .. xneg + 1, []):
Q2c := array(sparse, 1 .. ypos + 1, []):
Q4r := array(sparse, 1 .. xpos + 1, []):
Q4c := array(sparse, 1 .. yneg + 1, []):
#
# Place a 1 in the last row and column of Q2 and Q4 to indicate the
# end of the arrays in the row and column directions.
#
Q2r[xneg + 1] := 1:
Q2c[ypos + 1] := 1:
Q4r[xpos + 1] := 1:
Q4c[yneg + 1] := 1:
#
# Since ProductDiscrete is caling movingheapproductq2q4, then Q2 is at
# least a 2 x 2 array AND Q4 is at least a 2 x 2 array
#
# If the element in the (1, 1) cell of Q2 is smaller than the element
# in the (1, 1) cell of Q4, then place Q2row1col1 as the first item in
# the Q2Q4Prod array.
#
if Q2row1col1[1] <= Q4row1col1[1] then
Q2Q4Prod[1] := Q2row1col1[1]:
Q2Q4Prob[1] := Q2row1col1[2]:
#
# Incorporate the elements in cells (1, 2) and (2, 1) of Q2 as
# active elements. Place a 1 in row 1, column 2, row 2, and column 1
# to indicate this.
#
Q2row1col2 := [fXNeg[2][2] * fYPos[2][1], fXNeg[1][2] * fYPos[1][1]]:
Q2r[1] := 1:
Q2c[2] := 1:
Q2row2col1 := [fXNeg[2][1] * fYPos[2][2], fXNeg[1][1] * fYPos[1][2]]:
Q2r[2] := 1:
Q2c[1] := 1:
Q2H := array(1 .. 3, [-1 * 10 ^ 6, Q2row1col2, Q2row2col1]):
Q2Mimic := array(1 .. 3, [-1 * 10 ^ 6, [2, 1], [1, 2]]):
#
# Indicate that Q4 still has an active element in cell (1, 1).
#
Q4r[1] := 1:
Q4c[1] := 1:
#
# Convert the trees Q2H and Q2Mimic into heaps
#
PercolateDownHeapQ2(2, 3):
#
# Q4H and Q4Mimic are already heaps; PercoleteDownHeapQ4 is not needed
#
Q4H := array(1 .. 2, [-1 * 10 ^ 6, Q4row1col1]):
Q4Mimic := array(1 .. 2, [-1 * 10 ^ 6, [1, 1]]):
else
Q2Q4Prod[1] := Q4row1col1[1]:
Q2Q4Prob[1] := Q4row1col1[2]:
#
# Incorporate the elements in cells (1, 2) and (2, 1) of Q4 as
# active elements. Place a 1 in row 1, column 2, row 2, and column 1
# to indicate this.
#
Q4row1col2 := [fXPos[2][2] * fYNeg[2][1], fXPos[1][2] * fYNeg[1][1]]:
Q4r[1] := 1:
Q4c[2] := 1:
Q4row2col1 := [fXPos[2][1] * fYNeg[2][2], fXPos[1][1] * fYNeg[1][2]]:
Q4r[2] := 1:
Q4c[1] := 1:
Q4H := array(1 .. 3, [-1 * 10 ^ 6, Q4row1col2, Q4row2col1]):
Q4Mimic := array(1 .. 3, [-1 * 10 ^ 6, [2, 1], [1, 2]]):
#
# Indicate that Q2 still has an active element in cell (1, 1)
#
Q2r[1] := 1:
Q2c[1] := 1:
#
# Convert the trees Q4H and Q4Mimic into heaps
#
PercolateDownHeapQ4(2, 3):
#
# Q2H and Q2Mimic are already heaps; PercolateDownHeapQ4 is not needed
#
Q2H := array(1 .. 2, [-1 * 10 ^ 6, Q2row1col1]):
Q2Mimic := array(1 .. 2, [-1 * 10 ^ 6, [1, 1]]):
fi:
#
# Continue to extract roots from each heap, determine the minimum of
# the roots, and rebuild the heaps.
#
for i from 2 to (xneg * ypos + xpos * yneg) do
#
# Determine the minimum of the roots of heaps Q2H and Q4H.
#
if Q2H[2][1] <= Q4H[2][1] then
Q2Q4Prod[i] := Q2H[2][1]:
Q2Q4Prob[i] := Q2H[2][2]:
a := Q2Mimic[2][1]:
b := Q2Mimic[2][2]:
#
# Unmark the row and column of Q2 that had its element removed
#
Q2r[a] := 0:
Q2c[b] := 0:
#
# Replace the root of heap Q2H with the last element in the heap,
# decrease the size of the heap by one (eliminating the position of
# the last element which was moved into the root), and rebuild the
# heap from top down
#
size := nops(convert(Q2H, list)):
Q2H[2] := Q2H[size]:
Q2Mimic[2] := Q2Mimic[size]:
Q2H := array(1 .. size - 1, [seq(Q2H[i], i = 1 .. size - 1)]):
Q2Mimic := array(1 .. size - 1,
[seq(Q2Mimic[i], i = 1 .. size - 1)]):
RebuildHeapQ2(2, size - 1):
#
# The element in array position [row a, column b] was removed from
# the heap Q2H. If row a and column b + 1 do not contain an active
# element, then insert a new sum value into array position
# [row a, column b + 1]. Place a 1 in row a and column b + 1 to
# indicate that there is an "active" item in this row and column
#
if Q2r[a] = 0 and Q2c[b + 1] = 0 then
Q2r[a] := 1:
Q2c[b + 1] := 1:
NewPosition := [a, b + 1]:
InsertHeapProductQ2(NewPosition):
fi:
#
# The element in array position [row a, column b] was removed from
# the heap Q2H. If row a + 1 and column b do not contain an active
# element, then insert a new sum value into array position
# [row a + 1, column b]. Place a 1 in row a + 1 and column b to
# indicate that there is an "active" item in this row and column
#
if Q2r[a + 1] = 0 and Q2c[b] = 0 then
Q2r[a + 1] := 1:
Q2c[b] := 1:
NewPosition := [a + 1, b]:
InsertHeapProductQ2(NewPosition):
fi:
Q2H := convert(Q2H, list):
#
# If Q2 is empty, add a positive element in its second position so
# loop will pick up the rest of the elements from Q4
#
if nops(Q2H) = 1 then
Q2H := array(1 .. 2, [Q2H[1], [1, 0]]):
fi:
else
Q2Q4Prod[i] := Q4H[2][1]:
Q2Q4Prob[i] := Q4H[2][2]:
a := Q4Mimic[2][1]:
b := Q4Mimic[2][2]:
#
# Unmark the row and column of Q4 that had its element removed
#
Q4r[a] := 0:
Q4c[b] := 0:
#
# Replace the root of heap Q4H with the last element in the heap,
# decrease the size of the heap by one (eliminating the position of
# the last element which was moved into the root), and rebuild the
# heap from top down
#
size := nops(convert(Q4H, list)):
Q4H[2] := Q4H[size]:
Q4Mimic[2] := Q4Mimic[size]:
Q4H := array(1 .. size - 1, [seq(Q4H[i], i = 1 .. size - 1)]):
Q4Mimic := array(1 .. size - 1,
[seq(Q4Mimic[i], i = 1 .. size - 1)]):
if (size > 2) then
RebuildHeapQ4(2, size - 1):
fi:
#
# The element in array position [row a, column b] was removed from
# the heap Q4H. If row a and column b + 1 do not contain an active
# element, then insert a new sum value into array position
# [row a, column b + 1]. Place a 1 in row a and column b + 1 to
# indicate that there is an "active" item in this row and column
#
if Q4r[a] = 0 and Q4c[b + 1] = 0 then
Q4r[a] := 1:
Q4c[b + 1] := 1:
NewPosition := [a, b + 1]:
InsertHeapProductQ4(NewPosition):
fi:
#
# The element in array position [row a, column b] was removed from
# the heap Q4H. If row a + 1 and column b do not contain an active
# element, then insert a new sum value into array position
# [row a + 1, column b]. Place a 1 in row a + 1 and column b to
# indicate that there is an "active" item in this row and column
#
if Q4r[a + 1] = 0 and Q4c[b] = 0 then
Q4r[a + 1] := 1:
Q4c[b] := 1:
NewPosition := [a + 1, b]:
InsertHeapProductQ4(NewPosition):
fi:
Q4H := convert(Q4H, list):
#
# If Q4 is empty, add a positive element in its second position so
# loop will pick up the rest of the elements from Q2
#
if nops(Q4H) = 1 then
Q4H := array(1 .. 2, [Q4H[1], [1, 0]]):
fi:
fi:
od:
return(Q2Q4Prod, Q2Q4Prob):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: nextcombo2.map
#
# Procedure Name: NextCombination(Previous, N)
#
# Other APPL Procedures Called: None
#
# Date: May 11, 2000
#
# Purpose: The code generates the next lexicographical ("alphabetical
# order") combination of size n (the size of the previous
# combination) of the integers {1, 2, ..., N}. It was created
# for use in the OrderStat code.
#
# Arguments: Previous: A set of integers (written in a Maple list)
# which is the previous combination. WLOG the code assumes
# that the underlying set is {1, 2, ..., N}.
# N: The size of the underlying set of integers from which
# the combination is to be formed.
#
# Algorithm:
# 1. Error check for the correct number of arguments
# 2. If the final position in the combination is not the maximum
# value it can attain, N, then increment it by 1. For example, if
# the previous combination is [1, 2, 4, 6] and N = 10, then
# increment the final position by 1 and return the next
# combination as [1, 2, 4, 7].
# 3. If the final position in the combination list is already at its
# maximum value, N, then move left through the combination and
# find the next possible value that can be incremented. In other
# words, scan the previous combination from right to left to
# locate the rightmost element that has not yet attained its
# maximum value. If n is the size of the combination, then index
# position i's maximum attainable value is N + i - n. For
# example, if the previous combination is [1, 4, 9, 10] and
# N = 10, then increment position 2 by 1: [1, 5, 9, 10].
# 4. Upon incrementing the rightmost element in position i, reset
# each value in the jth position (j = 1, 2, ... , n - i) to the
# right of the ith position to 1 more than the value in the
# preceding position. In the example above from step 3, the
# values in positions 3 and 4 need to be reset. The next
# combination is [1, 5, 6, 7].
# 5. Return the next combination.
#
NextCombination := proc(Previous :: list, N :: posint)
local Next, n, MoveLeft, i, j:
if (nargs <> 2) then
print(`ERROR(NextCombination): This procedure requires 2 arguments`):
RETURN():
fi:
Next := Previous:
n := nops(Previous):
#
# If the value in the final position of the combination is not the
# maximum value it can attain, N, then increment it by 1.
#
if (Next[n] <> N) then
Next[n] := Next[n] + 1:
#
# If the final position in the combination is already at its maximum
# value, N, then move left through the combination and find the next
# possible value that can be incremented. Index position i's maximum
# attainable value is N + i - n.
#
else
MoveLeft := true:
for i from (n - 1) by -1 to 1 while (MoveLeft = true) do
if (Next[i] < N + i - n) then
Next[i] := Next[i] + 1:
#
# Upon incrementing the rightmost element in position i, reset each
# value in the jth position (j = 1, 2, ... , n - i) to the right of
# the ith position to 1 more than the value in the preceding position.
#
for j from 1 to (n - i) do
Next[i + j] := Next[(i + j) - 1] + 1:
od:
MoveLeft := false:
fi:
od:
fi:
RETURN(Next):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: nextperm3.map
#
# Procedure Name: NextPermutation(Previous)
#
# Other APPL Procedures Called: None
#
# Date: May 12, 2000
#
# Purpose: The code generates the next lexicographical ("alphabetical
# order") permutation. WLOG the code assumes the elements of
# the set to be permuted are {1, 2, ..., k}. This code was
# created for use in the OrderStat code.
#
# Arguments: Previous: A set of integers (written in a Maple list)
# which is the previous permutation.
#
# Algorithm:
# 1. Error check for the correct number of arguments.
# 2. Find the largest index value i for which Next[i] < Next[i + 1].
# 3. Find the smallest value Next[j] for which Next[i] < Next[j] and
# i < j.
# 4. Interchange the values Next[i] and Next[j].
# 5. Reverse the order of the values to the right of the leftmost
# swapped value, which is now Next[j].
# 6. Return the next permutation.
#
# Example: Let A := [1, 4, 3, 2]. Find NextPermutation(A).
# 1. Error check ok: 1 argument.
# 2. Assign Next := [1, 4, 3, 2]. The largest index value i in which
# Next[i] < Next[i + 1] is i = 1.
# 3. The smallest value Next[j] s.t. Next[i] < Next[j] is 2 =
# Next[4].
# 4. Swap the values in position i = 1 and j = 4. Next becomes
# [2, 4, 3, 1].
# 5. Reverse the order of the values to the right of 2. Next becomes
# [2, 1, 3, 4].
# 6. Return [2, 1, 3, 4] as the next permutation.
#
NextPermutation := proc(Previous :: list)
local Next, n, flag, i, OrigVal, SwapIndex, j, Temp1, k, Temp2, m:
if (nargs <> 1) then
print(`ERROR(NextPermutation): This procedure requires 1 argument`):
RETURN():
fi:
Next := Previous:
n := nops(Previous):
flag := false:
#
# Find the largest index value i for which Next[i] < Next[i + 1]
#
for i from n - 1 to 1 by -1 while not(flag) do
if (Next[i] < Next[i + 1]) then
flag := true:
OrigVal := Next[i]:
SwapIndex := i + 1:
#
# Find the smallest value Next[j] for which Next[i] < Next[j] and i < j
#
for j from n to SwapIndex by -1 do
if ((Next[j] < Next[SwapIndex]) and (Next[j] > OrigVal)) then
SwapIndex := j:
fi:
od:
Temp1 := Next[SwapIndex]:
Next[SwapIndex] := Next[i]:
Next[i] := Temp1:
#
# Reverse the order of the values to the right of the leftmost swapped
# value
#
for k from i + 1 to n do
Temp2[k] := Next[k]:
od:
for m from i + 1 to n do
Next[m] := Temp2[n + i + 1 - m]:
od:
fi:
od:
RETURN(Next):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: normalvariate1.map
#
# Procedure Name: NormalVariate(mu, sigma)
#
# Other APPL Procedures Called: None
#
# Date: June 1, 1999
#
# Purpose:
#
# Arguments:
#
# Algorithm:
#
NormalVariate := proc(mu, sigma)
local variate, rnd:
rnd := x -> rand() / 1000000000000:
variate := (-2 * ln(rnd())) ^ (1 / 2) * cos(2 * Pi * rnd()):
variate := variate * sigma + mu:
RETURN(evalf(variate)):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: orderstat30.map moved SX because now using it both in
# w\ and w\out replacement cases
# adding infinite, without replacement -- couple cases
# moved CDF to after PDF with SF -- nope, might need to move in future
#
# 9/5 -- ConvertToNumeric ... switch this in the future to
# ConvertToNoDot
#
#
# OrderStat Procedure:
# I. X is a continuous random variable
# II. X is a discrete random variable
# A. Items are sampled with replacement
# i. X has numeric PDF
# ii. X has symbolic PDF
# B. Items are sampled without replacement
# i. X has finite support
# a. PDF of X has equally likely probabilities
# b. PDF of X has non-equally likely probabilities
# ii. X has infinite support
#
# Procedure Name: OrderStat(X, n, r, ["wo"])
#
# Other APPL Procedures Called: PDF, CDF, Convert, SF,
# ConvertToNumeric
#
# Date: May 17, 2000
#
# Purpose: OrderStat is a procedure that returns the PDF of the rth
# order statistic of a random variable when ordering n
# observations from the population with PDF fX(x)
#
# Arguments: X: A random variable,
# n: The number of items drawn randomly from the population
# with PDF fX(x),
# r: The index of the desired order statistic,
# "wo" (optional): A variable that indicates if the items
# drawn from the population are done so without (wo)
# replacement (for discrete distributions only)
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the order statistic index, r, is not greater than
# the number of random items drawn from the population, n
# 3. Check that the RV X is a list of 3 sublists
# 4. Convert X to PDF form if not already in that form
# 5. If the RV X is continuous, find the PDF of the rth order
# statistic. The RV X must have a tractable CDF for this to be
# possible.
# 6. If the RV X is discrete, then call the procedure Convert(X) to
# convert the discrete random variable's support to a standard
# APPL discrete random variable support format:
# standard "dot" support format:
# [anything .. anything, incremented by k, transformed by g(x)]
# standard "no dot" support format:
# [a1, a2, a3, ... , aN]
# 7. Determine if the random variable X has a "dot" support format
# (which indicates a symbolic PDF) or a "nodot" support format
# (which indicates a numeric support format). Return an error
# message for symbolic support values in the "dot" format, such
# as X := [[x -> x/6], [1 .. n], ["Discrete", "PDF"]];
# 8. If only 3 arguments are given, by default items are sampled
# with replacement
# 9. If X has a numeric PDF, then calculate the PDF of the rth order
# statistic by looping through the formula given in the code for
# each value of x from min(support of X) to max(support of X)
# 10. If X has a symbolic PDF, then calculate the PDF of the rth order
# statistic by obtaining a general expression for the PDF with the
# same formula used in the numeric case. Since the first term of
# the PDF is calculated with FX = 1, calculate the first term
# separate from the other general terms of the PDF. If the general
# expression for the order stat PDF evaluated at x = min(support
# of X) is equal to the same value as the first term of the order
# stat PDF, then combine them as one expression. Otherwise, leave
# the order stat PDF as a piecewise function with 2 terms.
# 11. If 4 arguments are provided, check if the fourth argument is
# the string "wo." If it is, then items are drawn from the RV's
# population without replacement
# 12. Determine if the random variable X has a symbolic PDF. If it
# does and also has finite support, then call the procedure
# ConvertToNumeric to convert its PDF and support to the standard
# APPL numeric list format. The conversion is necessary in order
# to have list inputs for the procedures NextPermutation and
# NextCombination.
# 13. Check that the sample size n is not greater than the population
# size N. If it is, return an error message.
# 14. If X has fijite support, check to see if it has equally likely
# probabilities. If so, compute the PDF of the rth order statistic
# by a combinatorial formula given in the code.
# 15. If X has finite support, but not equally likely probabilities,
# the PDF of the rth order statistic is computed differently if
# n = 1, n = N, or n = 2, 3, ... N - 1. If n = 1, the PDF of the
# rth order statistic is the same as the population PDF. If n = N,
# the PDF of the rth order statistic 1 for x = r, and 0 otherwise.
# 16. If n = 2, 3, ... N - 1, create an "n by N" array, ProbStorage,
# to store the rth order statistic PDF values for r from 1 to n,
# and x from 1 to N. Initialize ProbStorage to contain all zeros.
# 17. Create the first lexicographical combination of n items.
# 18. Assign perm as the current combination. For each combination,
# the algorithm finds every possible permutation of that
# combination.
# 19. For each permutation, compute the probability of obtaining that
# given permutation.
# 20. Order each permutation and determine which value sits in the rth
# ordered position. Store the permutation's probability in the
# appropriate positions in the array ProbStorage.
# 21. Find the next lexicographical combination, and repeat steps 18 -
# 20.
# 22. If X has infinite support, then:
# (a) if n = 1, the PDF of the rth order statistic is the same
# as the population PDF,
# (b) if n = 2 and r = 1, a general formula for the PDF of the
# rth order statistic is computed,
# (c) at present, OrderStat is unable to handle infinite support
# without replacement cases for n > 2, r > 1. This is an
# open area for future work. Return a message to the user
# stating this.
# 23. If 4 arguments are provided and the fourth one is not the
# string "wo", then return an error message
# 24. If the RV X is neither continuous or discrete, return an error
# message
# 25. Return the rth order statistic in the list of sublists format
#
OrderStat := proc(X :: list(list), n :: {posint, symbol}, r :: {posint,
symbol}, indicator :: string)
local NumLists, fX, FX, nsegs, fXOS, i, ffX, N, Lo, Hi, Symbolic, SX, k,
fXOS1, fXOS2, RealValue, Finite, EqLike, index, ProbStorage, j,
combo, perm, PermProb, cumsum, m, orderedperm:
with(combinat, binomial):
with(combinat, multinomial):
#
# Check for the appropriate number of arguments
#
if ((nargs <> 3) and (nargs <> 4)) then
print(`ERROR(OrderStat): This procedure requires 3 or 4 arguments:`):
print(`A random variable X,`):
print(`the number of random items sampled from the population n,`):
print(`the index of the order statistic r, and`):
print(`an optional argument "wo", which indicates sampling *without*`):
print(`replacement for discrete random variables`):
RETURN():
fi:
#
# Check that the order statistic index, r, is not greater than the
# number of items drawn randomly from the population, n; i.e.
# check r <= n if r and n are integers (not symbolic parameters)
#
if (type(r, posint) and type(n, posint)) then
if (r > n) then
print(`ERROR(OrderStat): The order statistic index, r, cannot be`):
print(`greater than the size of the random sample drawn, n`):
RETURN():
fi:
fi:
#
# Check that the RV X is a list of 3 sublists
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(OrderStat): The RV X must be a list of 3 lists`):
RETURN():
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif ((X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
fX := PDF(X):
else
print(`ERROR(OrderStat): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
FX := CDF(fX):
#
# If the RV X is continuous and it CDF is tractable, find the PDF of
# the rth order statistic
#
if (fX[3][1] = "Continuous") then
nsegs := nops(fX[1]):
fXOS := []:
if(n=1) then
fXOS := fX[1];
else
# ??? DLE: (5/16) simplify should be inside the unapply to do any good
for i from 1 to nsegs do
ffX := simplify(unapply(n! / ((r - 1)! * (n - r)!) * (FX[1][i](x))
^ (r - 1) * (1 - FX[1][i](x)) ^ (n - r) * fX[1][i](x), x)):
fXOS := [op(fXOS), op(ffX)]:
od:
fi;
#
# If the RV X is discrete, then call the procedure Convert(X) to
# convert the discrete random variable's support to a standard APPL
# discrete RV support format. See the introductory comments (#6) for
# the structure of these support formats.
#
elif (fX[3][1] = "Discrete") then
fX := Convert(fX):
if (fX = false) then
print(`ERROR(OrderStat): Discrete RV X is NOT in legal APPL form`):
RETURN():
fi:
SX := SF(fX):
#
# Determine if the random variable X has a "dot" support format (which
# indicates a symbolic PDF) or a "nodot" support format (which
# indicates a numeric support format). Return an error message for
# symbolic support values in the "dot" format, such as:
# X := [[x -> x/6], [1 .. n], ["Discrete", "PDF"]];
#
if type(fX[2][1], dot) then
Lo := lhs(fX[2][1]):
Hi := rhs(fX[2][1]):
if type(Hi, symbol) and not(evalb(Hi = infinity)) then
print(`ERROR(OrderStat): RV's support must be numeric`):
RETURN():
elif type(Lo, symbol) or evalb(Lo = -infinity) then
print(`ERROR(OrderStat): RV's lower support must be`):
print(`a finite numerical value`):
RETURN():
else
Symbolic := true:
fi:
else
N := nops(fX[2]):
Symbolic := false:
fi:
#
# If only 3 arguments are given, by default items are sampled with
# replacement
#
if (nargs = 3) then
#
# RV has numeric PDF
# Example: X := [[1/6, 1/3, 1/2], [1, 2, 3], ["Discrete", "PDF"]];
#
# DISCRETE/WITH REPLACEMENT/NUMERIC PDF
#
if not(Symbolic) then
# print(`not symbolic`):
fXOS := [seq(0, i = 1 .. N)]:
for k from 1 to N do
if (N = 1) then
fXOS[1] := 1:
elif (k = 1 and k <> N) then
fXOS[1] := sum(binomial(n, w) *
1 * (fX[1][1] ^ (n - w)) * (SX[1][2] ^ w),
w = 0 .. (n - r)):
elif (k = N and k <> 1) then
fXOS[N] := sum(binomial(n, u) *
(FX[1][N - 1] ^ u) * (fX[1][N] ^ (n - u)) * 1,
u = 0 .. (r - 1)):
else
# Maple will only return multinomial expression in answer
# Changed code with defn of multinomial on 6/7/2007
fXOS[k] := sum(sum(n! / (u! * (n - u - w)! * w!) *
(FX[1][k - 1] ^ u) * (fX[1][k] ^ (n - u - w)) *
(SX[1][k + 1] ^ w), w = 0 .. (n - r)),
u = 0 .. r - 1):
# fXOS[k] := sum(sum(multinomial(n, u, n - u - w, w) *
# (FX[1][k - 1] ^ u) * (fX[1][k] ^ (n - u - w)) *
# (SX[1][k + 1] ^ w), w = 0 .. (n - r)),
# u = 0 .. r - 1):
# print(`multinomial from here`):
fi:
od:
#
# RV has symbolic PDF
# Example: X := [[x -> x/6], [1 .. 3], ["Discrete", "PDF"]];
#
# fXOS1 holds the (numeric) PDF value of the rth order statistic at Lo.
# fXOS2 holds the (symbolic) expression for the PDF of the rth order
# statistic at Lo + 1, Lo + 2, ...
#
# DISCRETE/WITH REPLACEMENT/SYMBOLIC PDF
#
else
# print(`symbolic`):
# Substitute Lo in fX, Lo + 1 in SX, and assign FX = 1
fXOS1 := sum(binomial(n, w) * 1 *
((subs(x = Lo, op(unapply(fX[1](x))(x)))) ^ (n - w))
* (subs(x = Lo + 1, op(unapply(SX[1](x))(x))) ^ w),
w = 0 .. (n - r)):
# print(fXOS1):
fXOS1 := simplify(fXOS1):
# Substitute k - 1 in FX, k in fX, and k + 1 in SX
fXOS2 := sum(sum(n! / (u! * (n - u - w)! * w!) *
(subs(x = k - 1, op(unapply(FX[1](x))(x))) ^ u) *
((subs(x = k, op(unapply(fX[1](x))(x)))) ^ (n - u - w)) *
(subs(x = k + 1, op(unapply(SX[1](x))(x))) ^ w),
w = 0 .. (n - r)), u = 0 .. r - 1):
# Maple will only return multinomial expression in answer for fXOS2
# Changed code with defn of multinomial on 6/22/2007
fXOS2 := simplify(fXOS2):
# Write the PDF in terms of x, instead of k
fXOS2 := subs(k = x, fXOS2):
# print(fXOS2):
# Special fix for Possion RV
# NOTE: PUT IN THE FOLLOWING 3 LINES 8/16/2000 -- fixed the
# discrepancy of getting GAMMA(x + 1) vs x * GAMMA(x) ... this subs
# does the job!
if has(denom(fXOS2), GAMMA(x + 1)) then
fXOS2 := subs(GAMMA(x + 1) = x * GAMMA(x), fXOS2):
fi:
if has(denom(fXOS2), GAMMA(x)) then
fXOS2 := convert(fXOS2, factorial):
fi:
RealValue := subs(x = Lo, fXOS2):
# print(RealValue):
#
# ACTUALLY, could just call CleanUp? (BELOW)
# Is it working for Discrete RVs?
# 5/26/01
#
# If fXOS1 is the same value as fXOS2 evaluated at x = Lo, then
# then combine fXOS1 and fXOS2 into one formula
#
if ((evalb(evalf(RealValue, Digits + 2) =
evalf(fXOS1, Digits + 2))) or
evalb(simplify(RealValue) = fXOS1)) then
fXOS := [unapply(fXOS2, x)]:
fX[2]:= [Lo .. Hi]:
else
# print(`why going here?`):
fXOS := [fXOS1, unapply(fXOS2, x)]:
fX[2] := [Lo, Lo + 1 .. Hi]:
fi:
fi:
#
# If 4 arguments are provided and the 4th argument is the string "wo",
# then items are sampled *without replacement*
#
elif ((nargs = 4) and is(indicator = "wo")) then
Finite := true:
#
# Determine if the random variable X has a symbolic PDF. If it does
# and also has finite support, then call the procedure ConvertToNumeric
# to convert its PDF and support to the standard APPL numeric list
# format. The conversion is necessary in order to have list inputs for
# the procedures NextPermutation and NextCombination.
#
if (Symbolic) then
if (is(Lo, infinity) or is(Hi, infinity))
then
Finite := false:
else
fX := ConvertToNoDot(fX):
print(`fX is`, fX):
N := nops(fX[2]):
fi:
fi:
#
# The random variable X has finite support
#
if (Finite) then
if type(r, posint) then
fXOS := [seq(0, i = r .. N - n + r)]:
fX[2] := fX[2][r .. N - n + r]:
fi:
#
# Check that the sample size n is not greater than the population
# size N. If it is, return an error message.
#
if (n > N) then
print(`ERROR(OrderStat): When sampling *without* replacement,`):
print(`n CANNOT be larger than the population size`, N):
RETURN():
fi:
#
# Determine if the PDF has equally likely probabilities
#
EqLike := true:
for i from 1 to N while EqLike do
if (fX[1][1] <> fX[1][i]) then
EqLike := false:
fi:
od:
#
# Find the PDF of the rth order statistic given that the support is
# finite and the discrete probabilities are equally likely
#
# DISCRETE/WITHOUT REPLACEMENT/FINITE SUPPORT/EQUALLY LIKELY PROBS
#
if (EqLike) then
if type(r, symbol) then
unapply('x'):
fXOS := [(binomial(x - 1, r - 1) * binomial(1, 1) *
binomial(N - x, n - r)) / binomial(N, n)]:
RETURN([fXOS, [x = r .. N - n + r], ["Discrete", "PDF"]]):
else
index := 1:
for i from r to (N - n + r) do
fXOS[index] := (binomial(i - 1, r - 1) * binomial(1, 1) *
binomial(N - i, n - r)) / binomial(N, n):
index := index + 1:
od:
fi:
#
# Find the PDF of the rth order statistic given that the support is
# finite, but the discrete probabilities are not equally likely. Treat
# n = 1 and n = N as special cases.
#
# DISCRETE/FINITE SUPPORT/WITHOUT REPLACEMENT/NON-EQUALLY LIKELY PROBS
#
elif not(EqLike) then
# n is 1
if is(n = 1) then
fXOS := fX[1]:
# n is N; fXOS is a list with only 1 element
elif is(n = N) then
fXOS[1] := 1:
#
# n is neither 1 nor N; i.e. n = 2, 3, ... N-1. Create an "n by N"
# array, ProbStorage, to store the rth order statistic PDF values for
# r from 1 to n, and x from 1 to N. Initialize ProbStorage to contain
# all zeros.
#
else
ProbStorage := array(1 .. n, 1 .. N):
for i from 1 to n do
for j from 1 to N do
ProbStorage[i, j] := 0:
od:
od:
# Create the first lexicographical combination of n items
combo := [seq(i, i = 1 .. n)]:
for i from 1 to binomial(N, n) do
# Assign perm as the current combo
perm := combo:
#
# Compute the probability of obtaining the given permutation, perm
#
for j from 1 to n! do
# print(`perm is`, perm):
PermProb := fX[1][perm[1]]:
cumsum := fX[1][perm[1]]:
for m from 2 to n do
PermProb := PermProb * fX[1][perm[m]] / (1 - cumsum):
# print(`PermProb is`, PermProb):
cumsum := cumsum + fX[1][perm[m]]:
od:
#
# Order each permutation and determine which value sits in the rth
# ordered position. Store the permutation's probability in the
# appropriate positions in the array ProbStorage.
#
orderedperm := sort(perm):
for m from 1 to n do
for k from 1 to N do
if (orderedperm[m] = k) then
ProbStorage[m, k] := PermProb + ProbStorage[m, k]:
#print(`m is`, m):
#print(`k is`, k):
#print(`ProbStorage[m, k] is`, ProbStorage[m, k]):
fi:
od:
od:
# Find the next lexicographical permutation
perm := NextPermutation(perm):
od:
# Find the next lexicographical combination
combo := NextCombination(combo, N):
od:
index := 1:
for m from r to N - n + r do
fXOS[index] := ProbStorage[r, m]:
index := index + 1:
od:
fi:
fi:
#
# If X has infinite support, then:
# (a) if n = 1, the PDF of the rth order statistic is the same as the
# population PDF,
# (b) if n = 2 and r = 1 or 2, a general formula for the PDF of the rth
# order statistic is computed,
# (c) at present, OrderStat is unable to handle infinite support/
# without replacement cases for n > 2, r > 2. Return a message to
# the user stating this.
#
# DISCRETE/INFINITE SUPPORT/WITHOUT REPLACEMENT
#
else
fX[2] := X[2]:
if (n = 1) then
fXOS := fX[1]:
elif (n = 2) and (r = 1) then
fXOS := [unapply(simplify(op(unapply(fX[1](x))(x)) *
subs(x = x + 1, op(unapply(SX[1](x))(x)))
/ (1 - op(unapply(fX[1](x))(x)))) +
op(unapply(fX[1](x))(x)) *
sum(subs(x = y, op(unapply(fX[1](x))(x))) /
subs(x = y, 1 - op(unapply(fX[1](x))(x))),
y = x + 1 .. infinity), x)]:
elif (n = 2) and (r = 2) then
fXOS := [unapply(simplify(op(unapply(fX[1](x))(x)) *
subs(x = x - 1, op(unapply(FX[1](x))(x)))
/ (1 - op(unapply(fX[1](x))(x)))) +
op(unapply(fX[1](x))(x)) *
sum(subs(x = y, op(unapply(fX[1](x))(x))) /
subs(x = y, 1 - op(unapply(fX[1](x))(x))),
y = 1 .. x - 1), x)]:
else
print(`ERROR(OrderStat): At present, OrderStat cannot handle`):
print(`this infinite support RV in the without replacement`):
print(`case`):
RETURN():
fi:
fi:
#
# If 4 arguments are provided and the fourth one is not the string
# "wo", then return an error message
#
else
print(`ERROR(OrderStat): The 4th argument must be the string`):
print(`"wo" to indicate items are drawn *without* replacement`):
RETURN():
fi:
#
# If the RV X is neither continuous or discrete, return an error
# message
#
else
print(`ERROR(OrderStat): The RV X must be continuous or discrete`):
RETURN():
fi:
#
# Return the PDF of the rth order statistic in the list of sublists
# format
#
RETURN([fXOS, fX[2], fX[3]]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: pdf6.map
#
# Procedure Name: PDF(X, [x])
#
# Other APPL Procedures Called: IDF, Convert, HF, SF, CDF
#
# Date: March 17, 2001
#
# Purpose: PDF is a procedure that:
# (1) Returns the probability density function (continuous)
# or the probability mass function (discrete) of a
# random variable X in the APPL list of 3 lists format if
# the only argument given is X, or
# (2) Returns the value Pr(X = x) if it is given the optional
# argument x in addition to the RV X
#
# Arguments: X: A continuous or discrete random variable;
# x (optional argument): A numeric value entered when
# trying to determine Pr(X = x)
#
# Algorithm: 1. Perform error checking on user entered arguments
# 2. The PDF of X is determined by sending it to its
# appropriate category, which is based on whether:
# A. X is continuous or discrete
# B. X is entered in its PDF, CDF, SF, HF, CHF, or IDF
# format
# 3. If only 1 argument (the random variable X) is entered
# by the user, return the probability density function of
# X in the APPL list of 3 lists format
# 4. If 2 arguments are provided, return the value Pr(X = x)
#
PDF := proc(X :: list(list), st)
local numlists, nsegments, fX,fXXX, supp, i, ffx, hX, FX, solns, nsolns, j,
c, ii, t, itp, a, prob, Y, Range, lo, hi, incr, transf, cdf, pdf,
sf, hf, hfprod, chf, idf, idforig, pieces, k, numops, noceil,
ceilpiece, val, invfound, idfval, losupp, hisupp, sublist1, n, SX,
notfound, count:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 2)) then
print(`ERROR(PDF): This procedure requires 1 or 2 arguments:`):
print(`A random variable X and an optional argument x for`):
print(`computing Pr(X = x)`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
numlists := nops(X):
if (numlists <> 3) then
print(`ERROR(PDF): The RV X must be a list of 3 lists`):
return:
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(PDF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the RV X is continuous, find and return the PDF of X
#
if (X[3][1] = "Continuous") then
nsegments := nops(X[1]):
fX := []:
supp := X[2]:
#
# The RV X is given in its PDF form. Nothing needs to be done to X.
#
if X[3][2] = "PDF" then
fX := X[1]:
#
# The RV X is given in its CDF form
#
elif (X[3][2] = "CDF") then
for i from 1 to nsegments do
ffx := unapply(diff(X[1][i](x), x), x):
fX := [op(fX), op([unapply(simplify(ffx(x)), x)])]:
od:
#
# The RV X is given in its SF form
#
elif (X[3][2] = "SF") then
for i from 1 to nsegments do
ffx := unapply(-diff(X[1][i](x), x), x):
fX := [op(fX), op([unapply(simplify(ffx(x)), x)])]:
od:
#
# The RV X is given in its HF form
#
elif (X[3][2] = "HF") then
# for i from 1 to nsegments do
# hX := X[1][i](t):
# hhX := subs(t = x, hX):
# print(`hhx`,hhX);
# ffx := hhX * exp(-int(hX, t = X[2][i] .. x)):
# print(`segment num`,i,`ffx `,ffx);
# fX := [op(fX), op([unapply(simplify(ffx), x)])]:
# od:
SX:=SF(X):
fXXX:=PDF(SX):
fX:=fXXX[1]:
#
# The RV X is given in its CHF form
#
elif (X[3][2] = "CHF") then
for i from 1 to nsegments do
ffx := unapply(diff(X[1][i](x))(x)) *
exp(-unapply(X[1][i](x))(x)):
fX := [op(fX), op([unapply(simplify(ffx), x)])]:
od:
#
# The RV X is given in its IDF form
#
elif (X[3][2] = "IDF") then
FX[1] := []:
for i from 1 to nsegments do
solns := [solve(X[1][i](x) = s, x)]:
nsolns := nops(solns):
solns := [seq(unapply(simplify(solns[j]), s),
j = 1 .. nsolns)]:
# Find right inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to ginv.
FX[1] := [op(FX[1]), solns[1]]:
else
# If there is more than one inverse, find the appropriate one.
# Find midpoints of each segment
c := array(1 .. nsegments):
for ii from 1 to nsegments do
c[ii] := (X[2][ii] + X[2][ii + 1]) / 2:
od:
for t from 1 to nsolns do
# Evaluate each inverse of the CDF at the midpoint of the
# subinterval. Set IDX[1][i] to that inverse for which
# gtemp(g(x)) = x.
itp := solns[t](X[1][i](c[i])):
if (whattype(evalf(X[1][i](c[i]))) <> float) then
# print(notafloat, simplify(itp), c[i]):
else
# print(isafloat, itp, c[i]):
fi:
if (((whattype(evalf(X[1][i](c[i]))) <> float) and
(itp = c[i])) or
((whattype(evalf(X[1][i](c[i]))) = float) and
(evalf(itp) >= evalf(X[2][i]) and
(evalf(itp) <= evalf(X[2][i + 1]))))) then
FX[1] := [op(FX[1]), solns[t]]:
break:
else
print(`ERROR(PDF): Could not find the appropriate inverse`):
fi:
od:
fi:
od:
supp := []:
for i from 1 to (nsegments + 1) do
supp := [op(supp), limit(a, a = IDF(X, X[2][i]))]:
od:
for i from 1 to nsegments do
ffx := unapply(diff(FX[1][i](x), x), x):
fX := [op(fX), op([unapply(simplify(ffx(x)), x)])]:
od:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([fX, supp, ["Continuous", "PDF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if not(type(evalf(st), {numeric, infinity})) then
if nsegments = 1 then
prob := fX[1](st):
return(prob):
else
print(`ERROR(PDF): Symbolic second arguments with a piecewise`):
print(`PDF are not allowable in APPL at this time`):
return:
fi:
fi:
if (evalf(st) = evalf(supp[nops(supp)])) then
prob := fX[nsegments](st):
return(prob):
else
for i from 1 to nsegments do
if ((evalf(st) >= evalf(supp[i])) and (evalf(st) < evalf(supp[i
+ 1]))) then
break:
fi:
od:
prob := fX[i](st):
return(prob):
fi:
fi:
#
# The RV X is a discrete random variable
#
elif (X[3][1] = "Discrete") then
#
# If the RV X is discrete, then call the procedure Convert(X) to
# convert the discrete random variable's support to a standard APPL
# discrete RV support format. Assign the converted random variable
# to the Maple variable Y.
#
Y := Convert(X):
fX[1] := Y[1]:
fX[2] := Y[2]:
#
# X has dot support
#
if type(Y[2][1], range) then
Range := Y[2][1]:
lo := lhs(Range):
hi := rhs(Range):
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
incr := Y[2][2]:
transf := Y[2][3]:
#
# Report the support of new random variable back to the user in its
# simplest form
#
if (incr = 1 and unapply(transf(x))(x) = x) then
fX[2] := [Range]:
elif (not(incr = 1) and unapply(transf(x))(x) = x) then
fX[2] := [Range, incr]:
elif ((incr = 1) and not(unapply(transf(x))(x) = x)) then
fX[2] := [Range, Y[2][3]]:
else
fX[2] := [Range, incr, Y[2][3]]:
fi:
fi:
#
# APPL is not programmed to convert to a PDF format when the increment
# is not 1 and/or the transformation is not x -> x
#
# elif not(incr = 1 and unapply(transf(x))(x) = x) then
# print(`ERROR(PDF): APPL is currently unable to evaluate`):
# print(`this RV`):
# return:
# fi:
# fi:
#
# If X is given in its PDF form, then nothing needs to be done to X.
#
if (Y[3][2] = "PDF") then
#
# The RV X is given in its CDF form
#
elif Y[3][2] = "CDF" then
cdf := unapply(op(Y[1])(x))(x):
pdf := simplify(subs(x = x, cdf) - subs(x = x - 1, cdf)):
fX[1] := [unapply(pdf, x)]:
#
# The RV X is given in its SF form
#
elif Y[3][2] = "SF" then
sf := unapply(op(Y[1])(x))(x):
pdf := simplify(subs(x = x, sf) - subs(x = x + 1, sf)):
fX[1] := [unapply(pdf, x)]:
#
# The RV X is given in its HF form
#
elif (Y[3][2] = "HF") then
hf := unapply(op(Y[1])(w))(w):
# sf := product(1 - hf, w = lo .. (x - 1)):
# pdf := simplify(subs(x = x, sf) - subs(x = x + 1, sf)):
# print(`old way`, pdf):
hfprod := product(1 - hf, w = lo .. (x - 1)):
pdf := simplify(subs(w = x, hf) * subs(w = x, hfprod)):
fX[1] := [unapply(pdf, x)]:
#
# If X is given in its CHF form
#
elif (Y[3][2] = "CHF") then
chf := unapply(op(Y[1])(x))(x):
sf := exp(-chf):
pdf := simplify(subs(x = x, sf) - subs(x = x + 1, sf)):
fX[1] := [unapply(pdf, x)]:
#
# If X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
# need to look for a ceil function here!
# Received help from MUG: James McCarron, Robert Israel
# > f := ceil(1 / 2 + 1 / 2 * sqrt(1 + 120 * x)) - 1;
# > eval(f, ceil = (x -> x));
idf := unapply(op(Y[1])(y))(y):
idforig := idf:
# print(`idf is`, idf):
# print(`[op(idf)] is`, [op(idf)]):
idf := eval(idf, ceil = (y -> y)):
# print(`idf is now`, %):
# pieces := [op(idf)]:
# numops := nops(pieces):
# print(numops):
# noceil := true:
# for i from 1 to numops while noceil do
# if has(pieces, ceil) then
# print(`has ceil`):
# noceil := false:
# ceilpiece := i:
# fi:
# od:
# if not(noceil) then
# print(pieces[ceilpiece]):
# pieces[ceilpiece] := op(pieces[ceilpiece]):
# idf := sum(pieces[k], k = 1 .. numops):
# fi:
# print(idf):
solns := [solve(idf = x, y)]:
# print(solns):
nsolns := nops(solns):
# Find the correct inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to cdf.
cdf := solns[1]:
else
if lo = -infinity then
if hi = infinity then
val := 1:
else
val := hi:
fi:
else
val := lo:
fi:
# print(`val is`, val):
invfound := false:
for j from 1 to nsolns do
# Evaluate each inverse of the IDF at the value "val" assigned
# above. If CDF(IDF(val)) = val, then assign idf equal to that
# inverse.
idfval := subs(x = val, idf):
if evalf(subs(x = idfval, solns[j])) = evalf(val) then
cdf := solns[j]:
invfound := true:
break:
fi:
od:
if not(invfound) then
print(`ERROR(PDF): Could not find the appropriate inverse`):
fi:
fi:
pdf := simplify(subs(x = x, cdf) - subs(x = x - 1, cdf)):
fX[1] := [unapply(pdf, x)]:
# CAUTION: losupp is incorrect in some cases -- currently don't know
# how to fix this, need to be able to retrieve the first cdf value and
# sub it into idf as lo
losupp := evalf(subs(y = lo, idforig)):
hisupp := evalf(subs(y = hi, idforig)):
fX[2] := [losupp .. hisupp]:
fi:
#
# X has no dot support
#
else
sublist1 := Y[1]:
n := nops(sublist1):
#
# If X is given in its PDF form, then nothing needs to be done to X.
#
if (Y[3][2] = "PDF") then
#
# If X is given in its CDF form
#
elif (Y[3][2] = "CDF") then
for i from n by -1 to 2 do
fX[1][i] := sublist1[i] - sublist1[i - 1]:
od:
fX[1][1] := sublist1[1]:
#
# If X is given in its SF form
#
elif (Y[3][2] = "SF") then
for i from 1 to n - 1 do
fX[1][i] := sublist1[i] - sublist1[i + 1]:
od:
fX[1][n] := sublist1[n]:
#
# If X is given in its HF or CHF form
#
elif member(Y[3][2], {"HF", "CHF"}) then
hX := HF(Y):
SX := SF(hX):
for i from 1 to n do
fX[1][i] := hX[1][i] * SX[1][i]:
od:
#
# If X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
FX := CDF(Y):
sublist1 := FX[1]:
for i from n by -1 to 2 do
fX[1][i] := sublist1[i] - sublist1[i - 1]:
od:
fX[1][1] := sublist1[1]:
fX[2] := FX[2]:
fi:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([fX[1], fX[2], ["Discrete", "PDF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if type(Y[2][1], range) then
#
# Determine (if possible) if 'st' is in the support of fX; if not,
# Pr(X = st) = 0.
#
if not(type(lo, infinity) or type(hi, infinity)) then
#
# CAUTION: Maple does not consider 1.0 a member of the set {1, 2, 3};
# Problem if user chooses 'st' to be a float and the set contains
# integers or vice versa
#
if not(member(st, {$lo .. hi})) then
prob := 0:
return(prob):
fi:
fi:
prob := op(fX[1](st)):
else
prob := 0:
notfound := true:
count := 1:
for k from 1 to n while notfound do
if evalf(fX[2][k]) = evalf(st) then
notfound := false:
prob := fX[1][count]:
fi:
count := count + 1:
od:
fi:
return(prob):
fi:
#
# X is neither continuous nor discrete
else
print(`ERROR(PDF): X must be continuous or discrete`):
fi:
end: #1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: percolatedown2.map
# for H and B
#
# Procedure Name: PercolateDown(H, B, i, n)
#
# Other APPL Procedures Called:
#
# Date: September 8, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
PercolateDown := proc(H :: array, Probs :: array, i :: integer, n ::
integer)
local ParentValue, HoldValue, Child:
ParentValue := H[i]:
HoldValue := Probs[i]:
# print(`i is`, i):
if i * 2 <= (n + 1) then
#
# Assign Child to the left child since there may not exist a right
# child in a left complete tree
#
Child := i * 2 - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> n) and (H[Child + 1] > H[Child])) then
Child := Child + 1:
fi:
# print(`ParentValue is`, ParentValue):
# print(`Child value is`, H[Child]):
if ParentValue < H[Child] then
H[i] := H[Child]:
H[Child] := ParentValue:
Probs[i] := Probs[Child]:
Probs[Child] := HoldValue:
# print(`H is`, H):
# print(`Child is`, Child):
# print(`n is`, n):
PercolateDown(H, Probs, Child, n):
# print(`H is`, H):
fi:
fi:
return(H, Probs):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: percolatedownheap1.map
# for CreateMinHeap
#
# Procedure Name: PercolateDownHeap(H, i, n)
#
# Other APPL Procedures Called:
#
# Date: September 16, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
PercolateDownHeap := proc(i :: integer, n :: integer)
global H, Mimic:
local ParentValue, ProbValue, MimicParentValue, Child:
ParentValue := H[i][1]:
ProbValue := H[i][2]:
MimicParentValue := Mimic[i]:
if i * 2 <= (n + 1) then
#
# Assign Child to the left child since there may not exist a right
# child in a left complete tree
#
Child := i * 2 - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> n) and (H[Child + 1][1] < H[Child][1])) then
Child := Child + 1:
fi:
if ParentValue > H[Child][1] then
H[i] := H[Child]:
Mimic[i] := Mimic[Child]:
H[Child][1] := ParentValue:
H[Child][2] := ProbValue:
Mimic[Child] := MimicParentValue:
PercolateDownHeap(Child, n):
fi:
fi:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: percolatedownheapq11.map
#
# Procedure Name: PercolateDownHeapQ1(H, i, n)
#
# Other APPL Procedures Called:
#
# Date: January 11, 2001
#
# Purpose:
#
# Arguments:
#
# Algorithm:
PercolateDownHeapQ1 := proc(i :: integer, n :: integer)
global Q1H, Q1Mimic:
local ParentValue, ProbValue, MimicParentValue, Child:
ParentValue := Q1H[i][1]:
ProbValue := Q1H[i][2]:
MimicParentValue := Q1Mimic[i]:
if i * 2 <= (n + 1) then
#
# Assign Child to the left child since there may not exist a right
# child in a left complete tree
#
Child := i * 2 - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> n) and (Q1H[Child + 1][1] < Q1H[Child][1])) then
Child := Child + 1:
fi:
if ParentValue > Q1H[Child][1] then
Q1H[i] := Q1H[Child]:
Q1Mimic[i] := Q1Mimic[Child]:
Q1H[Child][1] := ParentValue:
Q1H[Child][2] := ProbValue:
Q1Mimic[Child] := MimicParentValue:
PercolateDownHeapQ1(Child, n):
fi:
fi:
return:
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: percolatedownheapq21.map
# for CreateMinHeap
#
# Procedure Name: PercolateDownHeapQ2(H, i, n)
#
# Other APPL Procedures Called:
#
# Date: September 16, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
PercolateDownHeapQ2 := proc(i :: integer, n :: integer)
global Q2H, Q2Mimic:
local ParentValue, ProbValue, MimicParentValue, Child:
ParentValue := Q2H[i][1]:
ProbValue := Q2H[i][2]:
MimicParentValue := Q2Mimic[i]:
if i * 2 <= (n + 1) then
#
# Assign Child to the left child since there may not exist a right
# child in a left complete tree
#
Child := i * 2 - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> n) and (Q2H[Child + 1][1] < Q2H[Child][1])) then
Child := Child + 1:
fi:
if ParentValue > Q2H[Child][1] then
Q2H[i] := Q2H[Child]:
Q2Mimic[i] := Q2Mimic[Child]:
Q2H[Child][1] := ParentValue:
Q2H[Child][2] := ProbValue:
Q2Mimic[Child] := MimicParentValue:
PercolateDownHeapQ2(Child, n):
fi:
fi:
return:
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: percolatedownheapq31.map
#
# Procedure Name: PercolateDownHeapQ3(i, n)
#
# Other APPL Procedures Called:
#
# Date: January 11, 2001
#
# Purpose:
#
# Arguments:
#
# Algorithm:
PercolateDownHeapQ3 := proc(i :: integer, n :: integer)
global Q3H, Q3Mimic:
local ParentValue, ProbValue, MimicParentValue, Child:
ParentValue := Q3H[i][1]:
ProbValue := Q3H[i][2]:
MimicParentValue := Q3Mimic[i]:
if i * 2 <= (n + 1) then
#
# Assign Child to the left child since there may not exist a right
# child in a left complete tree
#
Child := i * 2 - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> n) and (Q3H[Child + 1][1] < Q3H[Child][1])) then
Child := Child + 1:
fi:
if ParentValue > Q3H[Child][1] then
Q3H[i] := Q3H[Child]:
Q3Mimic[i] := Q3Mimic[Child]:
Q3H[Child][1] := ParentValue:
Q3H[Child][2] := ProbValue:
Q3Mimic[Child] := MimicParentValue:
PercolateDownHeapQ3(Child, n):
fi:
fi:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: percolatedownheapq41.map
# for CreateMinHeap
#
# Procedure Name: PercolateDownHeapQ4(i, n)
#
# Other APPL Procedures Called:
#
# Date: September 16, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
PercolateDownHeapQ4 := proc(i :: integer, n :: integer)
global Q4H, Q4Mimic:
local ParentValue, ProbValue, MimicParentValue, Child:
ParentValue := Q4H[i][1]:
ProbValue := Q4H[i][2]:
MimicParentValue := Q4Mimic[i]:
if i * 2 <= (n + 1) then
#
# Assign Child to the left child since there may not exist a right
# child in a left complete tree
#
Child := i * 2 - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> n) and (Q4H[Child + 1][1] < Q4H[Child][1])) then
Child := Child + 1:
fi:
if ParentValue > Q4H[Child][1] then
Q4H[i] := Q4H[Child]:
Q4Mimic[i] := Q4Mimic[Child]:
Q4H[Child][1] := ParentValue:
Q4H[Child][2] := ProbValue:
Q4Mimic[Child] := MimicParentValue:
PercolateDownHeapQ4(Child, n):
fi:
fi:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: plotdist7.map
#
# NOTE (6/24/00): plotdist3.map having trouble with KSRV(n) when
# lo and hi are given -- see plotdist3.mws; Fixed in plotdist4
# Problem -- if range given by user, the new max range value for X does
# not automatically become that high value -- need to figure out what
# segment that high value falls in in a piecewise function ... same
# with low
#
# NOTE: plotdist6.map has discrete capabilities
#
# NOTE: plotdist7.map defines lo and hi for infinite support range
# as IDF(X, 0.025), IDF(X, 0.975)
#
# NOTE: plotdist.map only works for 1 argument in discrete case right
# now -- user cannot supply his own range ... APPL determines the best
# support range for graphing
#
# Procedure name: PlotDist(X, low, high)
#
# Date: May 16, 2001
#
# Purpose: For the random variable X, plot the function indicated in
# the random variable X's list-of-sublists (PDF, CDF, SF, HF, CHF,
# or IDF)
#
# Arguments: X: Random variable;
# low, high (optional values): values provided by the user
# to indicate over what range the function is to be plotted
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in a list-of-lists format
# 3. Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
PlotDist := proc(X :: list(list), low, high)
local NumLists, nsegs, Xsegs, i, Xrange, lo, hi, Y, incr, formulaic, N,
pdf, Cross, Circle, pdfplot, cdf, Open0, Open, Closed, CrossN,
ClosedN, cdfplot, sf, Cross0, Closed0, OpenN, sfplot, hf, hfplot,
chf, chfplot, idf, idfplot:
# print(`X is`, X):
# print(`Low is`, low):
# print(`High is`, high):
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 3)) then
print(`ERROR(PlotDist): This procedure requires either 1 or 3`):
print(`arguments`):
return:
fi:
#
# Check that the RV X is in a list-of-lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(PlotDist): X must be in a list-of-sublists format`):
return:
fi:
#
# Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
if not((X[3][2] = "PDF") or
(X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
print(`ERROR(PlotDist): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the user does not provide values for low and high, set
# the default values as the lower and upper range values in sublist 2
#
if (X[3][1] = "Continuous") then
nsegs := nops(X[1]):
# print(`nsegs is`, nsegs):
Xsegs := array(1 .. nsegs):
if (nargs = 1) then
for i from 1 to nsegs do
Xsegs[i] := plot(X[1][i](x), x = X[2][i] .. X[2][i + 1],
labels = [x, X[3][2]]):
od:
plots[display]({seq(Xsegs[j], j = 1 .. nsegs)},
scaling = unconstrained):
#
# The user has provided values for low and high
#
elif (nargs = 3) then
Xrange := X[2]:
lo := 1:
hi :=nsegs:
#
# Inform the user that the values for low and high have been reset if
# they are out of the random variable's support range
#
if (evalf(low) < evalf(X[2][1])) then
print(`WARNING(PlotDist): Low value provided by user`, low):
print(`is less than minimum support value of random variable`):
print(X[2][1]):
print(`Resetting low to RV's minimum support value`):
Xrange[1] := X[2][1]:
else
for i from nsegs to 1 by -1 do
if (evalf(X[2][i]) <= evalf(low)) then
lo := i:
break:
fi:
od:
Xrange[lo] := low:
fi:
if (evalf(high) > evalf(X[2][nsegs + 1])) then
print(`WARNING(PlotDist): High value provided by user`, high):
print(`is greater than maximum support value of the random`):
print(`variable`, X[2][nsegs + 1]):
print(`Resetting high to RV's maximum support value`):
Xrange[nsegs + 1] := X[2][nsegs + 1]:
else
for i from 1 to nsegs do
if (evalf(X[2][i]) >= evalf(high)) then
hi := i - 1:
break:
fi:
od:
Xrange[hi + 1] := high:
fi:
# print(`Xrange is`, Xrange):
# print(lo, hi):
for i from lo to hi do
# print(X[1][i]):
# print(X[2][i], X[2][i + 1]):
# Just using for the ps plot
Xsegs[i] := plot(X[1][i](x), x = Xrange[i] .. Xrange[i + 1],
labels = ["x", X[3][2]],
labeldirections = [horizontal, horizontal]):
od:
plots[display]({seq(Xsegs[j], j = lo .. hi)},
scaling = unconstrained):
fi:
else
Y := Convert(X):
if (Y = false) then
print(`ERROR(PlotDist): Discrete RV X is NOT in legal APPL form`):
return:
fi:
# print(Y[2]):
# for IDF: Convert procedure needs to return *dot* standard format
# for IDF -- convert4.map currently doesn't
if type(Y[2][1], range) then
formulaic := true:
lo := lhs(Y[2][1]):
hi := rhs(Y[2][1]):
incr := Y[2][2]:
if type(hi, symbol) then
if evalb(hi = infinity) then
hi := IDF(Y, 0.975):
# hi contains something like a "rootof" expression
if type(hi, function) then
hi := 4:
# print(`ERROR(PlotDist): Please try again, but provide`):
# print(`the procedure with low and high range values`):
# return:
fi:
# convert to a float value
hi := evalf(hi):
else
print(`ERROR(PlotDist): RV's support must be numeric`):
return:
fi:
elif type(lo, symbol) or evalb(lo = -infinity) then
print(`ERROR(PlotDist): RV's lower support must be`):
print(`a finite numerical value.`):
# print(`Please try again, but provide`):
# print(`the procedure with low and high range values`):
return:
fi:
else
N := nops(Y[2]):
lo := Y[2][1]:
hi := Y[2][N]:
formulaic := false:
fi:
if (Y[3][2] = "PDF") then
pdf := {}:
if not(formulaic) then
for i from 1 to N do
pdf := pdf union {[[Y[2][i], 0], [Y[2][i], Y[1][i]]]}:
Cross[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CROSS))):
Circle[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CIRCLE))):
od:
pdfplot := plot(pdf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "PDF"],
labeldirections = [horizontal, horizontal]):
plots[display]({pdfplot, seq(Cross[i], i = 1 .. N),
seq(Circle[i], i = 1 .. N)}):
# ONLY CONSIDERING CASE WITH x -> x TRANSFORMATION
else # formulaic pdf
for i from lo by incr to hi do
pdf := pdf union {[[i, 0], [i, op(Y[1](i))]]}:
Cross[i] := PLOT(POINTS([i, evalf(op(Y[1](i)))],
SYMBOL(CROSS))):
Circle[i] := PLOT(POINTS([i, evalf(op(Y[1](i)))],
SYMBOL(CIRCLE))):
# print(Cross[i]):
od:
# print(pdf):
pdfplot := plot(pdf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "PDF"],
labeldirections = [horizontal, horizontal], color = black,
linestyle = 1):
plots[display]({pdfplot, seq(Cross[i], i = lo .. hi),
seq(Circle[i], i = lo .. hi)}):
fi:
elif (Y[3][2] = "CDF") then
if not(formulaic) then
cdf := {[[0, 0], [Y[2][1], 0]]}:
Open0 := PLOT(POINTS([Y[2][1], 0], SYMBOL(CIRCLE))):
for i from 1 to N - 1 do
cdf := cdf union {[[Y[2][i], Y[1][i]], [Y[2][i + 1], Y[1][i]]]}:
Open[i] := PLOT(POINTS([Y[2][i + 1], Y[1][i]],
SYMBOL(CIRCLE))):
Cross[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CROSS))):
Closed[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CIRCLE))):
od:
cdf := cdf union {[[Y[2][N], 1], [Y[2][N] + hi, 1]]}:
CrossN := PLOT(POINTS([Y[2][N], 1], SYMBOL(CROSS))):
ClosedN := PLOT(POINTS([Y[2][N], 1], SYMBOL(CIRCLE))):
# print(cdf):
cdfplot := plot(cdf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "CDF"], color = black,
labeldirections = [horizontal, horizontal]):
plots[display]({cdfplot, Open0, seq(Open[i], i = 1 .. N - 1),
seq(Cross[i], i = 1 .. N - 1),
seq(Closed[i], i = 1 .. N - 1), CrossN, ClosedN}):
# ONLY CONSIDERING CASE WITH x -> x TRANSFORMATION
else # formulaic cdf
cdf := {[[0, 0], [lo, 0]]}:
Open0 := PLOT(POINTS([lo, 0], SYMBOL(CIRCLE))):
for i from lo by incr to hi do
cdf := cdf union {[[i, op(Y[1](i))], [i + 1, op(Y[1](i))]]}:
Open[i] := PLOT(POINTS([i + 1, op(Y[1](i))], SYMBOL(CIRCLE))):
Cross[i] := PLOT(POINTS([i, op(Y[1](i))], SYMBOL(CIRCLE))):
Closed[i] := PLOT(POINTS([i, op(Y[1](i))], SYMBOL(CROSS))):
# print(cdf):
od:
cdf := cdf union {[[hi, 1], [hi + hi, 1]]}:
ClosedN := PLOT(POINTS([hi, 1], SYMBOL(CROSS))):
# print(cdf):
cdfplot := plot(cdf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "CDF"], color = black,
labeldirections = [horizontal, horizontal]):
plots[display]({cdfplot, Open0, seq(Open[i], i = lo .. hi),
seq(Cross[i], i = lo .. hi),
seq(Closed[i], i = lo .. hi), ClosedN}):
fi:
elif (Y[3][2] = "SF") then
if not(formulaic) then
sf := {[[0, 1], [Y[2][1], 1]]}:
Cross0 := PLOT(POINTS([Y[2][1], 1], SYMBOL(CROSS))):
Closed0 := PLOT(POINTS([Y[2][1], 1], SYMBOL(CIRCLE))):
for i from 1 to N - 1 do
sf := sf union {[[Y[2][i], Y[1][i + 1]],
[Y[2][i + 1], Y[1][i + 1]]]}:
Cross[i] := PLOT(POINTS([Y[2][i + 1], Y[1][i + 1]],
SYMBOL(CROSS))):
Closed[i] := PLOT(POINTS([Y[2][i + 1], Y[1][i + 1]],
SYMBOL(CIRCLE))):
Open[i] := PLOT(POINTS([Y[2][i], Y[1][i + 1]], SYMBOL(CIRCLE))):
od:
sf := sf union {[[Y[2][N], 0], [Y[2][N] + hi, 0]]}:
OpenN := PLOT(POINTS([Y[2][N], 0], SYMBOL(CIRCLE))):
# print(sf):
sfplot := plot(sf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "SF"],
labeldirections = [horizontal, horizontal]):
plots[display]({sfplot, Cross0, Closed0,
seq(Cross[i], i = 1 .. N - 1), seq(Closed[i], i = 1 .. N - 1),
seq(Open[i], i = 1 .. N - 1), OpenN}):
# ONLY CONSIDERING CASE WITH x -> x TRANSFORMATION
else # formulaic sf
sf := {[[0, 1], [lo, 1]]}:
Cross0 := PLOT(POINTS([lo, 1], SYMBOL(CROSS))):
Closed0 := PLOT(POINTS([lo, 1], SYMBOL(CIRCLE))):
for i from lo by incr to hi do
sf := sf union {[[i, op(Y[1](i + 1))],
[i + 1, op(Y[1](i + 1))]]}:
Open[i] := PLOT(POINTS([i, op(Y[1](i + 1))], SYMBOL(CIRCLE))):
Cross[i] := PLOT(POINTS([i + 1, op(Y[1](i + 1))],
SYMBOL(CIRCLE))):
Closed[i] := PLOT(POINTS([i + 1, op(Y[1](i + 1))],
SYMBOL(CROSS))):
# print(sf):
od:
sf := sf union {[[hi, 0], [hi + hi, 0]]}:
OpenN := PLOT(POINTS([hi, 0], SYMBOL(CIRCLE))):
# print(cdf):
sfplot := plot(sf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "SF"],
labeldirections = [horizontal, horizontal]):
plots[display]({sfplot, Cross0, Closed0,
seq(Open[i], i = lo .. hi),
seq(Cross[i], i = lo .. hi),
seq(Closed[i], i = lo .. hi), OpenN}):
fi:
elif (Y[3][2] = "HF") then
hf := {}:
if not(formulaic) then
for i from 1 to N do
hf := hf union {[[Y[2][i], 0], [Y[2][i], Y[1][i]]]}:
Cross[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CROSS))):
Circle[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CIRCLE))):
od:
hfplot := plot(hf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "HF"],
labeldirections = [horizontal, horizontal]):
plots[display]({hfplot, seq(Cross[i], i = 1 .. N),
seq(Circle[i], i = 1 .. N)}):
# ONLY CONSIDERING CASE WITH x -> x TRANSFORMATION
else # formulaic hf
for i from lo by incr to hi do
hf := hf union {[[i, 0], [i, op(Y[1](i))]]}:
Cross[i] := PLOT(POINTS([i, op(Y[1](i))], SYMBOL(CROSS))):
Circle[i] := PLOT(POINTS([i, op(Y[1](i))], SYMBOL(CIRCLE))):
od:
# print(hf):
hfplot := plot(hf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "HF"],
labeldirections = [horizontal, horizontal]):
plots[display]({hfplot, seq(Cross[i], i = lo .. hi),
seq(Circle[i], i = lo .. hi)}):
fi:
elif (Y[3][2] = "CHF") then
if not(formulaic) then
chf := {[[0, 0], [Y[2][1], 0]]}:
Cross0 := PLOT(POINTS([Y[2][1], 0], SYMBOL(CROSS))):
Closed0 := PLOT(POINTS([Y[2][1], 0], SYMBOL(CIRCLE))):
for i from 1 to N - 1 do
chf := chf union {[[Y[2][i], Y[1][i + 1]],
[Y[2][i + 1], Y[1][i + 1]]]}:
Open[i] := PLOT(POINTS([Y[2][i], evalf(Y[1][i + 1])],
SYMBOL(CIRCLE))):
Cross[i] := PLOT(POINTS([Y[2][i + 1], evalf(Y[1][i + 1])],
SYMBOL(CROSS))):
Closed[i] := PLOT(POINTS([Y[2][i + 1], evalf(Y[1][i + 1])],
SYMBOL(CIRCLE))):
od:
# print(chf):
chfplot := plot(chf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "CHF"],
labeldirections = [horizontal, horizontal]):
plots[display]({chfplot, Cross0, Closed0,
seq(Open[i], i = 1 .. N - 1),
seq(Cross[i], i = 1 .. N - 1),
seq(Closed[i], i = 1 .. N - 1)}):
# ONLY CONSIDERING CASE WITH x -> x TRANSFORMATION
else # formulaic chf
chf := {[[0, 0], [lo, 0]]}:
Cross0 := PLOT(POINTS([lo, 0], SYMBOL(CROSS))):
Closed0 := PLOT(POINTS([lo, 0], SYMBOL(CIRCLE))):
for i from lo by incr to hi - 1 do
chf := chf union {[[i, op(Y[1](i + 1))],
[i + 1, op(Y[1](i + 1))]]}:
Open[i] := PLOT(POINTS([i, evalf(op(Y[1](i + 1)))],
SYMBOL(CIRCLE))):
Cross[i] := PLOT(POINTS([i + 1, evalf(op(Y[1](i + 1)))],
SYMBOL(CROSS))):
Closed[i] := PLOT(POINTS([i + 1, evalf(op(Y[1](i + 1)))],
SYMBOL(CIRCLE))):
# print(chf):
od:
chfplot := plot(chf, x = lo - 0.5 .. hi + 0.5,
labels = ["x", "CHF"],
labeldirections = [horizontal, horizontal]):
plots[display]({chfplot, Cross0, Closed0,
seq(Open[i], i = lo .. hi - 1),
seq(Cross[i], i = lo .. hi - 1),
seq(Closed[i], i = lo .. hi - 1)}):
fi:
elif (Y[3][2] = "IDF") then
if not(formulaic) then
idf := {[[0, Y[1][1]], [Y[2][1], Y[1][1]]]}:
Open0 := PLOT(POINTS([0, Y[1][1]], SYMBOL(CIRCLE))):
for i from 1 to N - 1 do
idf := idf union {[[Y[2][i], Y[1][i + 1]],
[Y[2][i + 1], Y[1][i + 1]]]}:
Open[i] := PLOT(POINTS([Y[2][i], Y[1][i + 1]],
SYMBOL(CIRCLE))):
Cross[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CROSS))):
Closed[i] := PLOT(POINTS([Y[2][i], Y[1][i]], SYMBOL(CIRCLE))):
od:
CrossN := PLOT(POINTS([Y[2][N], Y[1][N]], SYMBOL(CROSS))):
ClosedN := PLOT(POINTS([Y[2][N], Y[1][N]], SYMBOL(CIRCLE))):
# print(idf):
idfplot := plot(idf, x = 0 .. 1, labels = ["x", "IDF"],
labeldirections = [horizontal, horizontal]):
plots[display]({idfplot, Open0, seq(Open[i], i = 1 .. N - 1),
seq(Cross[i], i = 1 .. N - 1),
seq(Closed[i], i = 1 .. N - 1)}, CrossN, ClosedN):
# ONLY CONSIDERING CASE WITH x -> x TRANSFORMATION
else # formulaic idf
print(`idf plot for this case not completed yet`):
fi:
fi:
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: plotempcdf1.map
#
# Procedure name: PlotEmpCDF(Sample, [low], [high])
#
# Other APPL Procedures Called: PDF
#
# Date: January 7, 2000
#
# Purpose: Plot the empirical cumulative distribution function of a
# random sample
#
# Arguments: Sample: A random sample;
# low, high (optional values): Values provided by the user
# indicating the left and right end values of the plot
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Sort the sample list
# Example: Sample := [1, 10, 5, 10, 5, 7, 3, 2.5];
# SortedSample := [1, 2.5, 3, 5, 5, 7, 10, 10]
# 3. Construct the empirical CDF as a set of lists, where each list
# contains either:
# (a) The endpoints of a given "step" of the empirical CDF, or
# Example: [[1, 1/8], [2, 1/8]]
# (b) The points needed to connect the "steps" of the empirical CDF
# Example: [[1, 0], [1, 1/8]]
# The counter is used to determine the length of the line which
# connects the steps in (b)
# 4. The empirical CDF is plotted on the range low to high. If the
# values low and high are not provided by the user, the default
# value for low is the smallest sample point and the default value
# for high is the largest sample point
#
PlotEmpCDF := proc(Sample :: list, lo, hi)
local SortedSample, n, low, high, EmpCDF, counter, i:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 3)) then
print(`ERROR(PlotEmpCDF): This procedure requires 1 or 3 arguments`):
RETURN():
fi:
SortedSample := sort(Sample):
n := nops(Sample):
if (nargs = 1) then
low := SortedSample[1]:
high := SortedSample[n]:
elif (nargs = 3) then
low := lo:
high := hi:
fi:
counter := 0:
EmpCDF := {[[low, 0], [SortedSample[1], 0]]}:
for i from 1 to n - 1 do
counter := counter + 1:
if SortedSample[i] < SortedSample[i + 1] then
EmpCDF := EmpCDF union {[[SortedSample[i], i / n], [SortedSample[i + 1],
i / n]]} union {[[SortedSample[i], (i - counter) / n], [SortedSample
[i], i / n]]}:
counter := 0:
fi:
od:
# plot(EmpCDF, x = low .. high):
counter := counter + 1:
EmpCDF := EmpCDF union {[[SortedSample[n], 1], [high, 1]]} union
{[[SortedSample[n], (i - counter) / n], [SortedSample[n], 1]]}:
# print(EmpCDF):
plot(EmpCDF, x = low .. high, color = blue, labels = ["x", "CDF"], labeldirections =
[horizontal, horizontal]):
end:
#111111111122222222223333333333444444444455555555556666666666777777777788888
# Filename: plotempcif1.map
#
# Procedure name: PlotEmpCIF(Sample, lo, hi)
#
# Other APPL Procedures Called:
#
# Date: July 18
#
# NEED TO WORK ON COMMENTS AT A LATER TIME (7/18/2000)
#
# Purpose: Plot the empirical cumulative intensity function
#
# Arguments: Sample: A random sample;
# low, high (optional values): Values provided by the user
# indicating the left and right end values of the plot
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Sort the sample list
# Example: Sample := [1, 10, 5, 10, 5, 7, 3, 2.5];
# SortedSample := [1, 2.5, 3, 5, 5, 7, 10, 10]
# 3. Construct the empirical CDF as a set of lists, where each list
# contains either:
# (a) The endpoints of a given "step" of the empirical CDF, or
# Example: [[1, 1/8], [2, 1/8]]
# (b) The points needed to connect the "steps" of the empirical CDF
# Example: [[1, 0], [1, 1/8]]
# The counter is used to determine the length of the line which
# connects the steps in (b)
# 4. The empirical CDF is plotted on the range low to high. If the
# values low and high are not provided by the user, the default
# value for low is the smallest sample point and the default value
# for high is the largest sample point
#
PlotEmpCIF := proc(Sample :: list, lo, hi)
local n, SortedSample, low, high, EmpCIF, i:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1 and nargs <> 3) then
print(`ERROR(PlotEmpCIF): This procedure requires 1 or 3 argument`):
RETURN():
fi:
n := nops(Sample):
SortedSample := sort(Sample):
if (nargs = 1) then
low := SortedSample[1]:
high := SortedSample[n]:
elif (nargs = 3) then
low := lo:
high := hi:
fi:
EmpCIF := {[[low, 0], [SortedSample[1], 0]]} union {[[SortedSample[1], 0],
[SortedSample[1], 1]]}:
for i from 1 to n - 1 do
if SortedSample[i] < SortedSample[i + 1] then
EmpCIF := EmpCIF union {[[SortedSample[i], i], [SortedSample[i + 1],
i]]} union {[[SortedSample[i + 1], i], [SortedSample
[i + 1], i + 1]]}:
fi:
od:
EmpCIF := EmpCIF union {[[SortedSample[n], n], [high, n]]}:
# union {[[SortedSample[n], (i - counter) / n], [SortedSample[n], 1]]}:
# print(EmpCDF):
plot(EmpCIF, x = low .. high, color = blue, labels = ["x", "CIF"], labeldirections =
[horizontal, horizontal]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: plotempsf1.map
#
# Procedure name: PlotEmpSF(Sample, Censor)
#
# Other APPL Procedures Called:
#
# Date: June 28, 2000
#
# NEED TO WORK ON COMMENTS AT A LATER TIME (6/28/2000)
#
# Purpose: Plot the empirical survivor function of a random sample
#
# Arguments: Sample: A random sample;
# Censor: Right-censoring vector
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Sort the sample list
# Example: Sample := [1, 10, 5, 10, 5, 7, 3, 2.5];
# SortedSample := [1, 2.5, 3, 5, 5, 7, 10, 10]
# 3. Construct the empirical SF as a set of lists, where each list
# contains either:
# (a) The endpoints of a given "step" of the empirical CDF, or
# Example: [[1, 1/8], [2, 1/8]]
# (b) The points needed to connect the "steps" of the empirical
# CDF
# Example: [[1, 0], [1, 1/8]]
# The counter is used to determine the length of the line which
# connects the steps in (b)
# 4. The empirical SF is plotted on the range low to high. If the
# values low and high are not provided by the user, the default
# value for low is the smallest sample point and the default
# value
# for high is the largest sample point
#
PlotEmpSF := proc(Sample :: list, Censor :: list)
local m, y, d, n, RigCensor, counter, RigSample, NumItems, i, Size,
KMSurvFctn, Prev:
#
# Check for the appropriate number of arguments
#
if (nargs <> 2) then
print(`ERROR(PlotEmpSF): This procedure requires 2 arguments`):
RETURN():
fi:
m := nops(Sample):
y := []:
d := []:
n := [m]:
#
# Construct the list y
#
for i from 1 to m do
if (Censor[i] = 1) and not(member(Sample[i], y)) then
y := [op(y), Sample[i]]:
fi:
od:
#
# Construct the list d
#
RigCensor := [op(Censor), 0]:
RigSample := [op(Sample), Sample[m]]:
counter := 1:
for i from 1 to m do
if RigCensor[i] = 1 then
if RigSample[i] = RigSample[i + 1] and RigCensor[i + 1] = 1 then
counter := counter + 1:
elif RigSample[i] <> RigSample[i + 1] or RigCensor[i + 1] = 0 then
d := [op(d), counter]:
counter := 1:
fi:
fi:
od:
#
# Construct the list n
#
NumItems := m:
for i from 1 to m do
if RigSample[i] = RigSample[i + 1] or RigCensor[i + 1] = 0 then
NumItems := NumItems - 1:
else
NumItems := NumItems - 1:
n := [op(n), NumItems]:
fi:
od:
# print(`y is`, y):
# print(`d is`, d):
# print(`n is`, n):
Size := nops(y):
KMSurvFctn := {[[0, 1], [y[1], 1]]} union {[[y[1], 1 - (d[1] / n[1])],
[y[1], 1]]}:
Prev := 1:
for i from 1 to Size - 1 do
Prev := Prev * (1 - (d[i] / n[i])):
KMSurvFctn := KMSurvFctn union {[[y[i], Prev], [y[i + 1], Prev]]} union
{[[y[i + 1], Prev], [y[i + 1], Prev * (1 - (d[i + 1] / n[i + 1]))]]}:
od:
# print(KMSurvFctn):
plot(KMSurvFctn, 0 .. y[Size], 0 .. 1, color = blue, labels = ["t", "SF"]):
end:
#111111111122222222223333333333444444444455555555556666666666777777777788888
# Filename: plotempvsfittedcdf1.map
#
# Procedure name: PlotEmpVsFittedCDF(X, Sample, Parameters, [low], [high])
#
# Other APPL Procedures Called: CDF, PlotDist, PlotEmpCDF
#
# Date: January 9, 2000
#
# Purpose: Plot the random variable X's empirical CDF and fitted CDF
# together
#
# Arguments: X: Random variable;
# Sample: List of sample data points
# Parameters: List of parameters set equatl to their estimated
# values to be substituted into the CDF of X
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in a list-of-lists format
# 3. Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
# 4. Define EmpCDFPlot as the plot of the empirical CDF
# 5. Define FittedCDFPlot as the plot of the fitted CDF
# 6. Plot the empirical CDF and fitted CDF together
#
PlotEmpVsFittedCDF := proc(X :: list(list), Sample :: list, Parameters ::
list, low :: numeric, high :: numeric)
local NumLists, n, SortedSample, lo, hi, EmpCDFPlot, FX, SubList1,
SubList1Expr, NewSubList1, i, FittedCDFPlot:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 3) and (nargs <> 5)) then
print(`ERROR(PlotEmpVsFittedCDF): This procedure 3 or 5 arguments`):
RETURN():
fi:
#
# Check that the RV X is in a list-of-lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(PlotEmpVsFittedCDF): The RV X must be in a`):
print(`list of 3 lists format`):
RETURN():
fi:
#
# Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
if not((X[3][2] = "PDF") or
(X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
print(`ERROR(PlotEmpVsFittedCDF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
#
# Set the lower and upper plot range
#
n := nops(Sample):
SortedSample := sort(Sample):
if (nargs = 5) then
lo := low:
hi := high:
else
lo := SortedSample[1]:
hi := SortedSample[n]:
fi:
#
# Define EmpCDFPlot as the plot of the empirical CDF
#
# print(PlotEmpCDF(SortedSample, lo, hi)):
EmpCDFPlot := PlotEmpCDF(SortedSample, lo, hi):
#
# Define FittedCDFPlot as the plot of the fitted CDF
#
FX := CDF(X):
SubList1 := FX[1]:
SubList1Expr := unapply(SubList1(x))(x):
FX[1] := []:
# print(nops(SubList1)):
for i from 1 to nops(SubList1) do
FX[1] := [op(FX[1]), unapply(subs({op(Parameters)}, SubList1Expr[i]), x)]:
print(`FX[1] is`, FX[1]):
od:
#if hasfun(op(unapply(FX[1](x))(x)), int) then
# print(`ERROR(PlotEmpVsFittedCDF): CDF of X contains an integral that #can't`):
# print(`be simplified. Plot cannot be made`):
# RETURN():
#fi:
# print(PlotDist(FX, lo, hi)):
FittedCDFPlot := PlotDist(FX, lo, hi):
#
# Plot the empirical CDF and fitted CDF together, [] used so that
# labels from EmpCDFPlot used
#
plots[display]([EmpCDFPlot, FittedCDFPlot], scaling = unconstrained):
end:
#111111111122222222223333333333444444444455555555556666666666777777777788888
# Filename: plotempvsfittedcif1.map
#
# Procedure name: PlotEmpVsFittedCIF(X, Sample, Parameters, low, high)
#
# Other APPL Procedures Called:
#
# Date: July 18
#
# NEED TO WORK ON COMMENTS AT A LATER TIME (7/18/2000)
#
# Purpose: Plot the empirical cumulative distribution function of a random
# sample
#
# Arguments: Sample: A random sample;
# low, high (optional values): Values provided by the user
# indicating the left and right end values of the plot
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Sort the sample list
# Example: Sample := [1, 10, 5, 10, 5, 7, 3, 2.5];
# SortedSample := [1, 2.5, 3, 5, 5, 7, 10, 10]
# 3. Construct the empirical CDF as a set of lists, where each list
# contains either:
# (a) The endpoints of a given "step" of the empirical CDF, or
# Example: [[1, 1/8], [2, 1/8]]
# (b) The points needed to connect the "steps" of the empirical CDF
# Example: [[1, 0], [1, 1/8]]
# The counter is used to determine the length of the line which
# connects the steps in (b)
# 4. The empirical CDF is plotted on the range low to high. If the
# values low and high are not provided by the user, the default
# value for low is the smallest sample point and the default value
# for high is the largest sample point
#
PlotEmpVsFittedCIF := proc(X, Sample :: list, Parameters,
lo, hi)
local ChX, SubList1, SubList1Expr, i, FittedSFPlot, CIFPlot, FittedCHFPlot:
#
# Check for the appropriate number of arguments
#
if (nargs <> 5) then
print(`ERROR(PlotEmpVsFittedCIF): This procedure requires 5 args`):
RETURN():
fi:
#
# Define CIFPlot as the plot of the empirical cumulative intensity function
#
CIFPlot := PlotEmpCIF(Sample, lo, hi):
# print(PlotEmpCIF(Sample, lo, hi)):
#
# Define FittedCHFPlot as the plot of the fitted CHF
#
ChX := CHF(X):
SubList1 := ChX[1]:
SubList1Expr := unapply(SubList1(x))(x):
ChX[1] := []:
# print(nops(SubList1)):
for i from 1 to nops(SubList1) do
ChX[1] := [op(ChX[1]), unapply(subs({op(Parameters)}, SubList1Expr[i]), x)]:
# print(`ChX[1] is`, ChX[1]):
od:
# print(PlotDist(ChX, lo, hi)):
FittedCHFPlot := PlotDist(ChX, lo, hi):
#
# Plot the empirical SF and fitted SF together
#
plots[display]([CIFPlot, FittedCHFPlot], scaling = unconstrained):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: plotempvsfittedsf1.map
#
# Procedure name: PlotEmpVsFittedSF(X, Sample, Parameters, Censor)
#
# Other APPL Procedures Called:
#
# Date: June 28, 2000
#
# NEED TO WORK ON COMMENTS AT A LATER TIME (6/28/2000)
#
# Purpose: Plot the empirical survivor function of a random
# sample
#
# Arguments: Sample: A random sample;
# low, high (optional values): Values provided by the user
# indicating the left and right end values of the plot
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Sort the sample list
# Example: Sample := [1, 10, 5, 10, 5, 7, 3, 2.5];
# SortedSample := [1, 2.5, 3, 5, 5, 7, 10, 10]
# 3. Construct the empirical CDF as a set of lists, where each list
# contains either:
# (a) The endpoints of a given "step" of the empirical CDF, or
# Example: [[1, 1/8], [2, 1/8]]
# (b) The points needed to connect the "steps" of the empirical
# CDF
# Example: [[1, 0], [1, 1/8]]
# The counter is used to determine the length of the line which
# connects the steps in (b)
# 4. The empirical CDF is plotted on the range low to high. If the
# values low and high are not provided by the user, the default
# value for low is the smallest sample point and the default
# value
# for high is the largest sample point
#
PlotEmpVsFittedSF := proc(X, Sample :: list, Parameters,
Censor :: list, lo, hi)
local EmpSFPlot, SX, SubList1, SubList1Expr, i, FittedSFPlot:
#
# Check for the appropriate number of arguments
#
if (nargs <> 6) then
print(`ERROR(PlotKaplanMeierVsFittedSF): This procedure requires`):
print(`6 arguments`):
RETURN():
fi:
#
# Define KMFPlot as the plot of the Kaplan Meier SF
#
EmpSFPlot := PlotEmpSF(Sample, Censor):
#
# Define FittedSFPlot as the plot of the fitted SF
#
SX := SF(X):
SubList1 := SX[1]:
SubList1Expr := unapply(SubList1(x))(x):
SX[1] := []:
# print(nops(SubList1)):
for i from 1 to nops(SubList1) do
SX[1] := [op(SX[1]), unapply(subs({op(Parameters)},
SubList1Expr[i]), x)]:
# print(`SX[1] is`, SX[1]):
od:
FittedSFPlot := PlotDist(SX, lo, hi):
#
# Plot the empirical SF and fitted SF together
#
plots[display]([EmpSFPlot, FittedSFPlot], scaling = unconstrained):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: ppplot1.map
#
# Procedure name: PPPlot(X, Sample, Parameters)
#
# Other APPL Procedures Called:
#
# Date: June 26, 2000
#
# Purpose: Plots the model probability F^hat(X) versus the sample
# probability
#
# Arguments: X: Random variable
# Sample: List of sample data points
# Parameters
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in a list-of-lists format
# 3. Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
PPPlot := proc(X :: list(list), Sample :: list, Parameters)
local NumLists, n, p, SortedSample, FX, SubList1, SubList1Expr, Model,
FittedPoints, i, DataPoints:
#
# Check for the appropriate number of arguments
#
if (nargs <> 3) then
print(`ERROR(PPPlot): This procedure requires 3 arguments`):
RETURN():
fi:
#
# Check that the RV X is in a list-of-lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(PPPlot): The RV X must be in a`):
print(`list of 3 lists format`):
RETURN():
fi:
#
# Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
if not((X[3][2] = "PDF") or
(X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
print(`ERROR(PPPlot): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
with(plots):
n := nops(Sample):
p := [seq((i - (1 / 2)) / n, i = 1 .. n)]:
SortedSample := sort(Sample):
# print(`p is`, p):
FX := CDF(X):
SubList1 := FX[1]:
SubList1Expr := op(unapply(SubList1(x))(x)):
Model := subs({op(Parameters)}, SubList1Expr):
FittedPoints := []:
for i from 1 to n do
FittedPoints := [op(FittedPoints), subs(x = SortedSample[i], Model)]:
od:
# print(FittedPoints):
DataPoints := []:
for i from 1 to n do
DataPoints := [op(DataPoints), [p[i], FittedPoints[i]]]:
od:
# print(DataPoints):
pointplot(DataPoints, view = [0 .. 1, 0 .. 1], labels = ["sample",
" model"], scaling = constrained, title = "P-P Plot"):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: probs1.map
#
# Procedure names: BirthdayProb
# CrapsProb
# HatCheckGirlProb
# PointsProb
#
# Other APPL Procedures Called: None
#
# Date:
#
# Purpose:
#
# Arguments: The parameters of the distribution of the random
# variable
#
# Algorithm: (NEED TO REDO FOR PROBABILITIES)
# 1. Check for the appropriate number of arguments
# 2. Check parameter space when parameters are numeric
# 3. Check to see that the parameters are finite
# 4. Make assumptions about any symbolic parameters
# 6. Return the list of lists
#
# Note: Could define a type in startup about p being between 0 and 1
#
#
# Birthday Probability
#
BirthdayProb := proc(n)
print(`Sorry ... this procedure is not completed`):
return:
if (nargs <> 1) then
print(`ERROR(BirthdayProb): This procedure requires 1 argument`):
return:
fi:
end:
#
# Craps Probability
#
CrapsProb := proc()
print(`Sorry ... this procedure is not completed`):
return:
end:
#
# Hat Check Girl Probability
#
HatCheckGirlProb := proc(n, k)
print(`Sorry ... this procedure is not completed`):
return:
end:
#
# Points Probability
#
PointsProb := proc()
print(`Sorry ... this procedure is not completed`):
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: prodiid1.map
#
# Procedure Name: ProductIID(X, n)
#
# Other APPL Procedures Called: PDFRV, Product
#
# Date: June 1, 1999
#
# Purpose:
#
# Arguments: X: Continuous random variable
#
# Algorithm:
#
ProductIID := proc(X, n)
local i, fprod, fX:
if (n < 2) then
print(`ERROR(ProductIID): n must be > 1`):
RETURN():
fi:
fX := PDF(X):
fprod := Product(fX, fX):
for i from 3 to n do
# print(here1, i):
fprod := Product(fX, fprod):
# print(here2, i, fprod):
od:
RETURN(fprod):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: product9.map
# calls productcontinuous or product discrete
#
# Procedure Name: Product(X, Y)
#
# Other APPL Procedures Called: ProductContinuous, ProductDiscrete
#
# Date: January 7, 2001
#
# Purpose:
#
# Arguments: X, Y
#
# Algorithm:
Product := proc(X :: list(list), Y :: list(list), Z :: list(list))
local Prod1, Prod2, i, NumLists, fX, fY, fZ:
#
# 6/23/2007: ADDED these next three lines for an example in the APPL
# Monongraph in which we wanted to find the product of 3 different
# random variables with the Product procedure
#
if (nargs = 3) then
Prod1 := Product(X, Y):
Prod2 := Product(Prod1, Z):
return(Prod2):
fi:
#
# Check for the appropriate number of arguments
#
if (nargs <> 2) then
print(`ERROR(Product): This procedure requires 2 arguments:`):
print(`A random variable X, and a random variable Y`):
return:
fi:
#
# Check that the first RV is a list of 3 sublists
#
for i from 1 to nargs do
NumLists := nops(args[i]):
if (NumLists <> 3) then
print(`ERROR(Product): The RV must be a list of 3 lists`):
return:
fi:
od:
#
# Convert the RV to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif member(X[3][2], {"CDF", "SF", "HF", "CHF", "IDF"}) then
fX := PDF(X):
else
print(`ERROR(Product): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# Convert Y to PDF form if not already in that form
#
if (Y[3][2] = "PDF") then
fY := Y:
elif member(Y[3][2], {"CDF", "SF", "HF", "CHF", "IDF"}) then
fY := PDF(Y):
else
print(`ERROR(Product): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
if (X[3][1] = "Continuous") then
fZ := ProductContinuous(fX, fY):
elif (X[3][1] = "Discrete") then
fZ := ProductDiscrete(fX, fY):
else
print(`ERROR(Product): This procedure requires a`):
print(`Continuous or Discrete random variable`):
return:
fi:
return(fZ):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: productcontinuous1.map
#
# Procedure Name: ProductContinuous(X, Y)
#
# Other APPL Procedures Called: PDF, ReduceList, CleanUp
#
# Date: August 8, 2000
#
# Revised: March 11, 2008
#
# Purpose:
#
# Arguments: X, Y: Continuous random variables
#
# Algorithm:
#
ProductContinuous := proc(X, Y)
local fXc, fYc, f, XStar, n, g, YStar, m, VStarSet, VStar, Xtemp, ftemp,
temp1, temp2, i, i3, zeropsn, Ytemp, gtemp, j, nn, v, h, a, b, c, d, f1,
f2, f3, f4, ii, hh, fV, axc, axd, bxc, bxd, minVdist, floaterror, used:
fXc := X:
fYc := Y:
f := fXc[1]:
XStar := fXc[2]:
n := nops(XStar):
g := fYc[1]:
YStar := fYc[2]:
m := nops(YStar):
#
#see if we have positive X and Y
#
#if(fXc[2][1] >= 0 and fYc[2][1] >= 0) then
# assume(v > 0);
#elif(fXc[2][n] <= 0 and fYc[2][m] <= 0) then
# assume(v > 0);
#else
# assume(v, real);
#fi;
VStarSet := {}:
VStar := []:
#
# Insert 0 into XStar (if necessary)
#
Xtemp := []:
ftemp := []:
temp1 := XStar[1]:
temp2 := XStar[n]:
if (evalf(temp1) < 0 and evalf(temp2) > 0 and not(member(0, XStar)))
then
for i from 1 to n do
temp1 := XStar[i]:
temp2 := XStar[i + 1]:
if (evalf(temp1) < 0 and evalf(temp2) > 0) then
zeropsn := i + 1:
break:
fi:
od:
for i from 1 to (zeropsn - 1) do
Xtemp := [op(Xtemp), XStar[i]]:
ftemp := [op(ftemp), f[i]]:
od:
Xtemp := [op(Xtemp), 0]:
ftemp := [op(ftemp), f[zeropsn - 1]]:
for i from (zeropsn + 1) to (n + 1) do
Xtemp := [op(Xtemp), XStar[i - 1]]:
od:
for i from (zeropsn + 1) to (n) do
ftemp := [op(ftemp), f[i - 1]]:
od:
n := n + 1:
XStar := Xtemp:
f := ftemp:
fi:
# print(`XStar is`, XStar):
#
# Insert 0 into YStar (if necessary)
#
Ytemp := []:
gtemp := []:
temp1 := YStar[1]:
temp2 := YStar[m]:
if (evalf(temp1) < 0 and evalf(temp2) > 0 and not(member(0, YStar)))
then
for i from 1 to m do
temp1 := YStar[i]:
temp2 := YStar[i + 1]:
if (evalf(temp1) < 0 and evalf(temp2) > 0) then
zeropsn:= i + 1:
break:
fi:
od:
for i from 1 to (zeropsn - 1) do
Ytemp := [op(Ytemp), YStar[i]]:
gtemp := [op(gtemp), g[i]]:
od:
Ytemp := [op(Ytemp), 0]:
gtemp := [op(gtemp), g[zeropsn - 1]]:
for i from zeropsn + 1 to (m + 1) do
Ytemp := [op(Ytemp), YStar[i - 1]]:
od:
for i from zeropsn + 1 to (m) do
gtemp := [op(gtemp), g[i - 1]]:
od:
m := m + 1:
YStar := Ytemp:
g := gtemp:
fi:
# print(`YStar is`, YStar):
#
# Set up the support list VStar
#
for i from 1 to n do:
for j from 1 to m do:
VStarSet := VStarSet union {limit(limit(b, b = XStar[i]) * a, a =
YStar[j])}:
od:
od:
#
# Convert VStar from a set to a list. Then order VStar and remove
# redundancies
#
VStarSet := simplify(VStarSet);
VStar := sort([op(VStarSet)], (x, y) -> evalb(evalf(x) < evalf(y))):
VStar:= ReduceList(VStar):
nn := nops(VStar):
# print(`VStar is`, VStar,`VstarSet is`,VStarSet):
#
# Set up the proper assumption about v so that integration can be done
# properly
#
if(evalf(limit(x, x = VStar[1])) >= 0) then
# assume(v > 0):
elif(evalf(limit(x, x = VStar[nn])) <= 0) then
# assume(v < 0):
else
# assume(v, real):
fi:
# about(v):
#
# Find the min distance in Vstar to create and even smaller float point error
# adjustment term 'floaterror'
#
minVdist := abs(VStar[1] - VStar[2]);
for i3 from 2 to (nn - 1) do
if (evalf(abs(VStar[i3+1]-VStar[i3])) < evalf(minVdist)) then
minVdist := evalf(abs(VStar[i3 +1]-VStar[i3]));
fi;
od;
if(minVdist=0) then
floaterror := 1/1000000
elif(evalf(minVdist/100000) < infinity) then
floaterror := evalf(minVdist/100000);
else
floaterror := 1/1000000;
fi;
# print("minVdist and floaterror", evalf(minVdist), floaterror);
#
# Initialize every function in h to be zero
#
h := array(1 .. (nn - 1), [seq(0, i = 1 .. nn - 1)]):
#
# Integration for each segment of X times each segment of Y
#
for i from 1 to n - 1 do
for j from 1 to m - 1 do
a := XStar[i]:
b := XStar[i + 1]:
c := YStar[j]:
d := YStar[j + 1]:
axc := simplify(a * c);
axd := simplify(a * d);
bxc := simplify(b * c);
bxd := simplify(b * d);
#
# The two segments transform into the 1st Quadrant
#
if (evalf(a) + floaterror >= 0 and evalf(c) + floaterror >= 0) then
# print(`in first quadrant abcd`,a,b,c,d);
assume(vv > 0);
# print(f[i](x)):
# print(g[j](v / x)):
# print(f[i](x) * g[j](v / x) / x):
# print(f1): # print(evalf(a)): # print(evalf(b)):
# print(Int(f[i](x) * g[j](v / x) / x, x = a .. b)):
f1 := int(f[i](x) * g[j](vv / x) / x, x = a .. b):
f1 := unapply(f1, vv);
f1 := f1(v);
if (evalf(d) < infinity) then
# print(here1);
f2 := int(f[i](x) * g[j](vv / x) / x, x = (vv / d) .. b):
f2 := unapply(f2, vv);
f2 := f2(v);
fi:
if (evalf(c) > 0) then
# print(here2);
f3 := int(f[i](x) * g[j](vv / x) / x, x = a .. (vv / c)):
f3 := unapply(f3, vv);
f3 := f3(v);
fi:
if (evalf(c) > 0 and evalf(d) < infinity and
evalf(axd) < evalf(bxc)) then
# print(here3);
f4 := int(f[i](x) * g[j](vv / x) / x, x = (vv / d) .. (vv / c)):
f4 := unapply(f4, vv);
f4 := f4(v);
fi:
# print(f1, f2, f3, f4):
#
# 1st Quadrant, Scenario A
#
if (evalf(c) = 0 and is(d, infinity)) then
# print(ScenarioA):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= 0) then
h[ii] := h[ii] + f1:
fi:
od:
#
# 1st Quadrant, Scenario B
#
elif (evalf(c) = 0 and evalf(d) < infinity) then
# print(ScenarioB):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= 0 and evalf(temp2) <= floaterror + evalf(axd))
then
h[ii] := h[ii] + f1:
# print(usedf1);
fi:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f2:
# print(usedf2);
fi:
od:
#
# 1st Quadrant, Scenario C
#
elif (evalf(c) > 0 and is(d, infinity)) then
# print(ScenarioC):
for ii from 1 to (nn - 1) do:
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(bxc) and
evalf(temp2) <= infinity) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(axc) and
evalf(temp2) <= floaterror + evalf(bxc))
then
h[ii] := h[ii] + f3:
fi:
od:
#
# 1st Quadrant, Scenario D
#
elif (evalf(c) > 0 and evalf(d) < infinity) then
# print(ScenarioD, "print ad bc and evalfh of each",axd, bxc, evalf(axd), evalf(bxc)):
# Scenario D, Case 1
if (evalf(axd) < evalf(bxc)) then
# print(Case1):
for ii from 1 to (nn - 1) do
used:=0;
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f3: used:=1;
fi:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f4: used:=2;
fi:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f2: used:=3;
fi:
# print(wascase1used, used);
od:
# Scenario D, Case 2
elif (evalf(axd) = evalf(bxc)) then
# print(Case2,floaterror):
for ii from 1 to (nn - 1) do
used:=0;
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
# print("comparing case1 v1>=ac and v2<=ad", evalf(temp1)+floaterror, evalf(axc), evalf(temp2), evalf(axd)+floaterror);
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f3: used:=1;
fi:
# print("comparing case2 v1>=bc and v2<=bd", evalf(temp1),evalf(temp1+floaterror), evalf(bxc), evalf(temp2), evalf(bxd)+floaterror);
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f2: used:=2;
fi:
# print(wascase2used, used);
od:
# Scenario D, Case 3
elif (evalf(axd) > evalf(bxc)) then
# print(Case3):
for ii from 1 to (nn - 1) do
used:=0;
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
# print("temp1 2 and evalf",temp1, temp2, evalf(temp1), evalf(temp2));
# print("evalfac bc",evalf(axc),evalf(bxc));
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f3: used:=1;
fi:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f1: used:=2;
fi:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f2: used:=3;
fi:
# print(wascase3used, used);
od:
fi:
fi:
#
# The two segments transform into the 2nd Quadrant
#
elif (evalf(a) < 0 and evalf(c) < 0) then
assume(vv > 0);
# print(QuadTwo):
f1 := -int(f[i](x) * g[j](vv / x) /x, x = a .. b):
f1 := unapply(f1, vv);
f1 := f1(v);
if (evalf(d) < 0) then
f2 := -int(f[i](x) * g[j](vv / x) /x, x = (vv / d) .. b):
f2 := unapply(f2, vv);
f2 := f2(v);
fi:
if (evalf(c) > -infinity) then
f3 := - int(f[i](x) * g[j](vv / x) /x, x = a .. (vv / c)):
f3 := unapply(f3, vv);
f3 := f3(v);
fi:
if (evalf(c) > -infinity and evalf(d) < 0 and
evalf(axd) > evalf(bxc)) then
f4 := -int(f[i](x) * g[j](vv / x) /x, x = (vv / d) .. (vv / c)):
f4 := unapply(f4, vv);
f4 := f4(v);
fi:
#
# 2nd Quadrant, Scenario A
#
if (is(c, infinity) and evalf(d) = 0) then
# print(ScenarioA):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= 0) then
h[ii] := h[ii] + f1:
fi:
od:
#
# 2nd Quadrant, Scenario B
#
elif (is(c, infinity)and evalf(d) < 0) then
# print(ScenarioB):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
infinity) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f2:
fi:
od:
#
# 2nd Quadrant, Scenario C
#
elif (evalf(c) > -infinity and evalf(d) = 0) then
# print(ScenarioC):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= 0 and evalf(temp2) <= floaterror + evalf(bxc))
then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f3:
fi:
od:
#
# 2nd Quadrant, Scenario D
#
elif (evalf(c) > -infinity and evalf(d) < 0) then
# print(ScenarioD):
# Scenario D, Case 1
if (evalf(axd) > evalf(bxc)) then
# print(Case1):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f4:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f2:
fi:
od:
# Scenario D, Case 2
elif (evalf(axd) = evalf(bxc)) then
# print(Case2):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f2:
fi:
od:
# Scenario D, Case 3
elif (evalf(axd) < evalf(bxc)) then
# print(Case3):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f2:
fi:
od:
fi:
fi:
#
# The two segments transform into the 3rd Quadrant
#
elif (evalf(a) < 0 and evalf(c) + floaterror >= 0) then
assume(vv < 0);
# print(QuadThree):
f1 := -int(f[i](x) * g[j](vv / x) / x, x = a .. b):
f1 := unapply(f1, vv);
f1 := f1(v);
#print(hereisf1now,f1);
if (evalf(d) < infinity) then
f2 := -int(f[i](x) * g[j](vv / x) / x, x = a .. (vv / d)):
#print(hereisf2, f2);
f2 := unapply(f2, vv);
f2 := f2(v);
#print(hereisf2now,f2);
fi:
if (evalf(c) > 0) then
f3 := -int(f[i](x) * g[j](vv / x) / x, x = (vv / c) .. b):
f3 := unapply(f3, vv);
f3 := f3(v);
fi:
if (evalf(c) > 0 and evalf(d) < infinity and
evalf(bxd) > evalf(axc)) then
f4 := -int(f[i](x) * g[j](vv / x) / x, x = (vv / c) .. (vv / d)):
f4 := unapply(f4, vv);
f4 := f4(v);
fi:
#
# 3rd Quadrant, Scenario A
#
if (evalf(c) = 0 and is(d, infinity)) then
# print(ScenarioA):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp2) <= floaterror + 0) then
h[ii] := h[ii] + f1:
fi:
od:
#
# 3rd Quadrant, Scenario B
#
elif (evalf(c) = 0 and evalf(d) < infinity) then
# print(ScenarioB):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror + 0) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f2:
fi:
od:
#
# 3rd Quadrant, Scenario C
#
elif (evalf(c) > 0 and is(d, infinity))
then
# print(ScenarioC):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= -infinity and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(bxc))
then
h[ii] := h[ii] + f3:
fi:
od:
#
# 3rd Quadrant, Scenario D
#
elif (evalf(c) > 0 and evalf(d) < infinity)
then
# print(ScenarioD):
if (evalf(bxd) > evalf(axc)) then
# Scenario D, Case 1
# print(Case1):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f4:
fi:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f2:
fi:
od:
# Scenario D, Case 2
elif (evalf(axc) = evalf(bxd)) then
# print(Case2):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f2:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f3:
fi:
od:
# Scenario D, Case 3
elif (evalf(axc) > evalf(bxd)) then
# print(Case3):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(bxc)) then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(axd) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f2:
fi:
od:
fi:
fi:
#
# The two segments transform into the 4th Quadrant
#
elif (evalf(a) + floaterror >= 0 and evalf(c) < 0) then
assume(vv < 0);
# print(QuadFour):
f1 := int(f[i](x) * g[j](vv / x) / x, x = a .. b):
f1 := unapply(f1, vv);
f1 := f1(v);
if (evalf(d) < 0) then
f2 := int(f[i](x) * g[j](vv / x) / x, x = a .. (vv/d)):
f2 := unapply(f2, vv);
f2 := f2(v);
fi:
if (evalf(c) > -infinity) then
f3 := int(f[i](x) * g[j](vv / x) / x, x = (vv/c) .. b):
f3 := unapply(f3, vv);
f3 := f3(v);
fi:
if (evalf(c) > -infinity and evalf(d) < 0 and
evalf(axc) > evalf(bxd)) then
f4 := int(f[i](x) * g[j](vv / x) / x, x = (vv/c) .. (vv/d)):
f4 := unapply(f4, vv);
f4 := f4(v);
fi:
#
# 4th Quadrant, Scenario A
#
if (is(c, infinity) and evalf(d) = 0) then
# print(ScenarioA):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp2) <= floaterror + 0) then
h[ii] := h[ii] + f1:
fi:
od:
#
# 4th Quadrant, Scenario B
#
elif (is(c, infinity)and evalf(d) < 0) then
# print(ScenarioB):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= -infinity and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f2:
fi:
od:
#
# 4th Quadrant, Scenario C
#
elif (evalf(c) > -infinity and evalf(d) = 0) then
# print(ScenarioC):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror + 0)
then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f3:
fi:
od:
#
# 4th Quadant, Scenario D
#
# print(ScenarioD):
elif (evalf(c) > -infinity and evalf(d) < 0) then
# Scenario D, Case 1
if (evalf(axc) > evalf(bxd)) then
# print(Case1):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(bxd))
then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f4:
fi:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f2:
fi:
od:
# Scenario D, Case 2
elif (evalf(axd) = evalf(bxc)) then
# print(Case2):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f2:
fi:
od:
# Scenario D, Case 3
elif (evalf(axc) < evalf(bxd)) then
#print(Case3):
for ii from 1 to (nn - 1) do
temp1 := VStar[ii]:
temp2 := VStar[ii + 1]:
if (evalf(temp1) + floaterror >= evalf(bxc) and evalf(temp2) <= floaterror +
evalf(axc)) then
h[ii] := h[ii] + f3:
fi:
if (evalf(temp1) + floaterror >= evalf(axc) and evalf(temp2) <= floaterror +
evalf(bxd)) then
h[ii] := h[ii] + f1:
fi:
if (evalf(temp1) + floaterror >= evalf(bxd) and evalf(temp2) <= floaterror +
evalf(axd)) then
h[ii] := h[ii] + f2:
fi:
od:
fi:
fi:
fi:
od:
od:
#
# Make a new list of sublists for V
#
hh:= []:
for i from 1 to (nn - 1) do
hh := [op(hh), unapply(simplify(h[i]), v)]:
od:
#
# Reduce any unneeded duplication around zero in the piecewise PDF list
# of sublists
#
for i from 2 to (nn - 1) do
if ((hh[2][i] = 0)
and (limit(hh[1][i](pt), pt = 0) <> infinity)
and (limit(hh[1][i](pt), pt = 0) <> -infinity)
and (hh[1][i - 1](0) = hh[1][i](0))) then
hh[1] := subsop(i = NULL, hh[1]):
hh[2] := subsop(i = NULL, hh[2]):
# print(reducingsizeofhh):
break:
fi:
od:
fV := [hh, VStar, ["Continuous", "PDF"]]:
# print(fV):
#fV := CleanUp(fV):
RETURN(fV):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: productdiscrete4.map
#
# Procedure Name: ProductDiscrete(X, Y)
#
# Other APPL Procedures Called:
#
# Date: January 15, 2001
#
# Purpose:
#
# Arguments: X, Y
#
# Algorithm:
ProductDiscrete := proc(X :: list(list), Y :: list(list))
global fX, fY, fXNeg, fXPos, fYNeg, fYPos:
local Lo, Hi, n, DotX, m, DotY, Temp, leftbound, i, flagx, upperbound,
j, flagy, i1, j1, tempprod, tempprob, lengthposx, Temp1, Q4Prod,
Q4Prob, Temp2, Q3Prod, Q3Prob, fYTemp, Q2Prod, Q2Prob, Q1Prod,
Q1Prob, lengthposy, fXTemp, fXPosTemp, fYPosTemp, Q2Q4Prod,
Q2Q4Prob, Q1Q3Prod, Q1Q3Prob, Prods, Probs, FinalSupport, FinalPDF,
k, NumZeros, fZ:
fX := X:
fY := Y:
fX := Convert(fX):
if (fX = false) then
print(`ERROR(Product): Discrete random variable X is NOT`):
print(`in legal APPL form`):
return:
fi:
fY := Convert(fY):
if (fY = false) then
print(`ERROR(Product): Discrete random variable Y is NOT`):
print(`in legal APPL form`):
return:
fi:
#
# Determine if the random variable X has a "dot" support format or a
# "nodot" support format. Return an error message for a symbolic PDF
# in the "dot" format with symbolic support, such as:
# X := [[x -> x / 6], [1 .. n], ["Discrete", "PDF"]];
#
if type(fX[2][1], range) then
Lo := lhs(fX[2][1]):
Hi := rhs(fX[2][1]):
if type(Hi, symbol) and not(evalb(Hi = infinity)) then
print(`ERROR(Product): RV's support must be numeric`):
return:
elif type(Lo, symbol) or evalb(Lo = -infinity) then
print(`ERROR(Product): RV's lower support must be`):
print(`a finite numerical value`):
return:
#
# Convert finite "dot" formats to "nodot" formats. For example, if
# X := [[x -> x / 6], [1 .. 3], ["Discrete", "PDF"]], convert X to
# X := [[1 / 6, 2 / 6, 3 / 6], [1, 2, 3], ["Discrete", "PDF]];
#
elif type(Lo, numeric) and type(Hi, numeric) then
fX := ConvertToNoDot(fX):
n := nops(fX[2]):
DotX := false:
else
DotX := true:
fi:
#
# The RV X has a "nodot" support format
#
else
n := nops(fX[2]):
DotX := false:
fi:
#
# Determine if the random variable Y has a "dot" support format or a
# "nodot" support format. Return an error message for a symbolic PDF
# in the "dot" format with symbolic support
#
if type(fY[2][1], range) then
Lo := lhs(fY[2][1]):
Hi := rhs(fY[2][1]):
if type(Hi, symbol) and not(evalb(Hi = infinity)) then
print(`ERROR(Product): RV's support must be numeric`):
return:
elif type(Lo, symbol) or evalb(Lo = -infinity) then
print(`ERROR(Product): RV's lower support must be`):
print(`a finite numerical value`):
return:
#
# Convert finite "dot" formats to "nodot" formats.
#
elif type(Lo, numeric) and type(Hi, numeric) then
fY := ConvertToNoDot(fY):
m := nops(fY[2]):
DotY := false:
else
DotY := true:
fi:
else
m := nops(fY[2]):
DotY := false:
fi:
#
# RV has a "nodot" support format
# Example: X := [[1/6, 1/3, 1/2], [1, 2, 3], ["Discrete", "PDF"]];
# DISCRETE, NODOT (FINITE)
#
if not(DotX) and not(DotY) then
#
# Determine left boundardy of array A; this is where x's switch from
# negative to positive
#
if (n = 1) or (m = 1) then
Temp := BruteForceProductMethod():
return([Temp[2], Temp[1], ["Discrete", "PDF"]]):
fi:
if fX[2][1] >= 0 then
leftbound := 1:
elif fX[2][n] < 0 then
leftbound := n + 1:
else
leftbound := n:
i := 2:
flagx := 0:
while (i <= n and flagx = 0) do
if (fX[2][i] >= 0) then
leftbound := i:
flagx := 1:
fi:
i := i + 1:
od:
fi:
# print(`leftbound is`, leftbound):
#
# Determine upper boundary of array A; this is where y's switch from
# negative to positive
#
if fY[2][1] >= 0 then
upperbound := 1:
elif fY[2][m] < 0 then
upperbound := m + 1:
else
upperbound := m:
j := 2:
flagy := 0:
while (j <= m and flagy = 0) do
if (fY[2][j] >= 0) then
upperbound := j:
flagy := 1:
fi:
j := j + 1:
od:
fi:
# *****************************************
# 9 cases
# *****************************************
# Quadrant 1 Only
if (leftbound = 1 and upperbound = 1) then
# print(`Q1`):
Temp := MovingHeapProductMethod():
# Quadrant 3 Only
elif (leftbound = n + 1 and upperbound = m + 1) then
# Reverse X and Y lists
# print(`Q3`):
for i1 from 1 to ceil(n / 2) do
tempprod := fX[2][i1]:
tempprob := fX[1][i1]:
fX[2][i1] := fX[2][n - i1 + 1]:
fX[1][i1] := fX[1][n - i1 + 1]:
fX[2][n - i1 + 1] := tempprod:
fX[1][n - i1 + 1] := tempprob:
od:
for j1 from 1 to ceil(m / 2) do
tempprod := fY[2][j1]:
tempprob := fY[1][j1]:
fY[2][j1] := fY[2][m - j1 + 1]:
fY[1][j1] := fY[1][m - j1 + 1]:
fY[2][m - j1 + 1] := tempprod:
fY[1][m - j1 + 1] := tempprob:
od:
Temp := MovingHeapProductMethod():
# Quadrant 4 Only
elif (leftbound = 1 and upperbound = m + 1) then
# print(`Q4`):
for i1 from 1 to ceil(n / 2) do
tempprod := fX[2][i1]:
tempprob := fX[1][i1]:
fX[2][i1] := fX[2][n - i1 + 1]:
fX[1][i1] := fX[1][n - i1 + 1]:
fX[2][n - i1 + 1] := tempprod:
fX[1][n - i1 + 1] := tempprob:
od:
Temp := MovingHeapProductMethod():
# Quadrant 2 Only
elif (leftbound = n + 1 and upperbound = 1) then
# print(`Q2`):
for j1 from 1 to ceil(m / 2) do
tempprod := fY[2][j1]:
tempprob := fY[1][j1]:
fY[2][j1] := fY[2][m - j1 + 1]:
fY[1][j1] := fY[1][m - j1 + 1]:
fY[2][m - j1 + 1] := tempprod:
fY[1][m - j1 + 1] := tempprob:
od:
Temp := MovingHeapProductMethod():
# Quadrant 4 -> Quadrant 3
elif (upperbound = m + 1) then
# print(`Q4 -> Q3`):
fXNeg[2] := [seq(fX[2][k2], k2 = 1 .. leftbound - 1)]:
fXNeg[1] := [seq(fX[1][k2], k2 = 1 .. leftbound - 1)]:
fX[2] := [seq(fX[2][k1], k1 = leftbound .. n)]:
fX[1] := [seq(fX[1][k1], k1 = leftbound .. n)]:
lengthposx := n - leftbound + 1:
for i1 from 1 to ceil(lengthposx / 2) do
tempprod := fX[2][i1]:
tempprob := fX[1][i1]:
fX[2][i1] := fX[2][lengthposx - i1 + 1]:
fX[1][i1] := fX[1][lengthposx - i1 + 1]:
fX[2][lengthposx - i1 + 1] := tempprod:
fX[1][lengthposx - i1 + 1] := tempprob:
od:
if (lengthposx = 1 or m = 1) then
Temp1 := BruteForceProductMethod():
else
Temp1 := MovingHeapProductMethod():
fi:
Q4Prod := seq(Temp1[2][k], k = 1 .. lengthposx * m):
Q4Prob := seq(Temp1[1][k], k = 1 .. lengthposx * m):
fX[2] := fXNeg[2]:
fX[1] := fXNeg[1]:
for i1 from 1 to floor(leftbound / 2) do
tempprod := fX[2][i1]:
tempprob := fX[1][i1]:
fX[2][i1] := fX[2][leftbound - i1]:
fX[1][i1] := fX[1][leftbound - i1]:
fX[2][leftbound - i1] := tempprod:
fX[1][leftbound - i1] := tempprob:
od:
for j1 from 1 to ceil(m / 2) do
tempprod := fY[2][j1]:
tempprob := fY[1][j1]:
fY[2][j1] := fY[2][m - j1 + 1]:
fY[1][j1] := fY[1][m - j1 + 1]:
fY[2][m - j1 + 1] := tempprod:
fY[1][m - j1 + 1] := tempprob:
od:
if ((n - lengthposx) = 1 or m = 1) then
Temp2 := BruteForceProductMethod():
else
Temp2 := MovingHeapProductMethod():
fi:
Q3Prod := seq(Temp2[2][k], k = 1 .. (n - lengthposx) * m):
Q3Prob := seq(Temp2[1][k], k = 1 .. (n - lengthposx) * m):
Temp := [Q4Prob, Q3Prob], [Q4Prod, Q3Prod]:
# Quadrant 2 -> Quadrant 1
elif (upperbound = 1) then
# print(`Q2 -> Q1`):
fXPos[2] := [seq(fX[2][k1], k1 = leftbound .. n)]:
fXPos[1] := [seq(fX[1][k1], k1 = leftbound .. n)]:
fX[2] := [seq(fX[2][k2], k2 = 1 .. leftbound - 1)]:
fX[1] := [seq(fX[1][k2], k2 = 1 .. leftbound - 1)]:
lengthposx := n - leftbound + 1:
fYTemp := fY:
for j1 from 1 to ceil(m / 2) do
tempprod := fY[2][j1]:
tempprob := fY[1][j1]:
fY[2][j1] := fY[2][m - j1 + 1]:
fY[1][j1] := fY[1][m - j1 + 1]:
fY[2][m - j1 + 1] := tempprod:
fY[1][m - j1 + 1] := tempprob:
od:
if ((n - lengthposx) = 1 or m = 1) then
Temp1 := BruteForceProductMethod():
else
Temp1 := MovingHeapProductMethod():
fi:
Q2Prod := seq(Temp1[2][k], k = 1 .. (n - lengthposx) * m):
Q2Prob := seq(Temp1[1][k], k = 1 .. (n - lengthposx) * m):
fX[2] := fXPos[2]:
fX[1] := fXPos[1]:
fY := fYTemp:
if (lengthposx = 1 or m = 1) then
Temp2 := BruteForceProductMethod():
else
Temp2 := MovingHeapProductMethod():
fi:
Q1Prod := seq(Temp2[2][k], k = 1 .. lengthposx * m):
Q1Prob := seq(Temp2[1][k], k = 1 .. lengthposx * m):
Temp := [Q2Prob, Q1Prob], [Q2Prod, Q1Prod]:
# Quadrant 2 -> Quadrant 3
elif (leftbound = n + 1) then
# print(`Q2 -> Q3`):
fYNeg[2] := [seq(fY[2][k2], k2 = 1 .. upperbound - 1)]:
fYNeg[1] := [seq(fY[1][k2], k2 = 1 .. upperbound - 1)]:
fY[2] := [seq(fY[2][k1], k1 = upperbound .. m)]:
fY[1] := [seq(fY[1][k1], k1 = upperbound .. m)]:
lengthposy := m - upperbound + 1:
for j1 from 1 to ceil(lengthposy / 2) do
tempprod := fY[2][j1]:
tempprob := fY[1][j1]:
fY[2][j1] := fY[2][lengthposy - j1 + 1]:
fY[1][j1] := fY[1][lengthposy - j1 + 1]:
fY[2][lengthposy - j1 + 1] := tempprod:
fY[1][lengthposy - j1 + 1] := tempprob:
od:
if (n = 1 or lengthposy = 1) then
Temp1 := BruteForceProductMethod():
else
Temp1 := MovingHeapProductMethod():
fi:
Q2Prod := seq(Temp1[2][k], k = 1 .. n * lengthposy):
Q2Prob := seq(Temp1[1][k], k = 1 .. n * lengthposy):
fY[2] := fYNeg[2]:
fY[1] := fYNeg[1]:
for i1 from 1 to ceil(n / 2) do
tempprod := fX[2][i1]:
tempprob := fX[1][i1]:
fX[2][i1] := fX[2][n - i1 + 1]:
fX[1][i1] := fX[1][n - i1 + 1]:
fX[2][n - i1 + 1] := tempprod:
fX[1][n - i1 + 1] := tempprob:
od:
# print(`fXNeg is`, fX):
for j1 from 1 to floor(upperbound / 2) do
tempprod := fY[2][j1]:
tempprob := fY[1][j1]:
fY[2][j1] := fY[2][upperbound - j1]:
fY[1][j1] := fY[1][upperbound - j1]:
fY[2][upperbound - j1] := tempprod:
fY[1][upperbound - j1] := tempprob:
od:
# print(`fYneg is `, fY):
if (n = 1 or (m - lengthposy) = 1) then
Temp2 := BruteForceProductMethod():
else
Temp2 := MovingHeapProductMethod():
fi:
Q3Prod := seq(Temp2[2][k], k = 1 .. n * (m - lengthposy)):
Q3Prob := seq(Temp2[1][k], k = 1 .. n * (m - lengthposy)):
Temp := [Q2Prob, Q3Prob], [Q2Prod, Q3Prod]:
# Quadrant 4 -> Quadrant 1
elif (leftbound = 1) then
# print(`Q4 -> Q1`):
fYPos[2] := [seq(fY[2][k1], k1 = upperbound .. m)]:
fYPos[1] := [seq(fY[1][k1], k1 = upperbound .. m)]:
fY[2] := [seq(fY[2][k2], k2 = 1 .. upperbound - 1)]:
fY[1] := [seq(fY[1][k2], k2 = 1 .. upperbound - 1)]:
lengthposy := m - upperbound + 1:
fXTemp := fX:
for i1 from 1 to ceil(n / 2) do
tempprod := fX[2][i1]:
tempprob := fX[1][i1]:
fX[2][i1] := fX[2][n - i1 + 1]:
fX[1][i1] := fX[1][n - i1 + 1]:
fX[2][n - i1 + 1] := tempprod:
fX[1][n - i1 + 1] := tempprob:
od:
if (n = 1 or (m - lengthposy) = 1) then
Temp1 := BruteForceProductMethod():
else
Temp1 := MovingHeapProductMethod():
fi:
Q4Prod := seq(Temp1[2][k], k = 1 .. n * (m - lengthposy)):
Q4Prob := seq(Temp1[1][k], k = 1 .. n * (m - lengthposy)):
fY[2] := fYPos[2]:
fY[1] := fYPos[1]:
fX := fXTemp:
if (n = 1 or lengthposy = 1) then
Temp2 := BruteForceProductMethod():
else
Temp2 := MovingHeapProductMethod():
fi:
Q1Prod := seq(Temp2[2][k], k = 1 .. n * lengthposy):
Q1Prob := seq(Temp2[1][k], k = 1 .. n * lengthposy):
Temp := [Q4Prob, Q1Prob], [Q4Prod, Q1Prod]:
# Quadrant 4 -> Quadrant 1, Quadrant 2 -> Quadrant 3
else
# print(`Q2, Q4 -> Q1, Q3`):
fXNeg[2] := [seq(fX[2][k2], k2 = 1 .. leftbound - 1)]:
fXNeg[1] := [seq(fX[1][k2], k2 = 1 .. leftbound - 1)]:
fXPos[2] := [seq(fX[2][k1], k1 = leftbound .. n)]:
fXPos[1] := [seq(fX[1][k1], k1 = leftbound .. n)]:
fXPosTemp[2] := fXPos[2]:
fXPosTemp[1] := fXPos[1]:
fYNeg[2] := [seq(fY[2][k2], k2 = 1 .. upperbound - 1)]:
fYNeg[1] := [seq(fY[1][k2], k2 = 1 .. upperbound - 1)]:
fYPos[2] := [seq(fY[2][k1], k1 = upperbound .. m)]:
fYPos[1] := [seq(fY[1][k1], k1 = upperbound .. m)]:
fYPosTemp[2] := fYPos[2]:
fYPosTemp[1] := fYPos[1]:
# Reverse positive x's
lengthposx := n - leftbound + 1:
for i1 from 1 to ceil(lengthposx / 2) do
tempprod := fXPos[2][i1]:
tempprob := fXPos[1][i1]:
fXPos[2][i1] := fXPos[2][lengthposx - i1 + 1]:
fXPos[1][i1] := fXPos[1][lengthposx - i1 + 1]:
fXPos[2][lengthposx - i1 + 1] := tempprod:
fXPos[1][lengthposx - i1 + 1] := tempprob:
od:
# Reverse positive y's
lengthposy := m - upperbound + 1:
for j1 from 1 to ceil(lengthposy / 2) do
tempprod := fYPos[2][j1]:
tempprob := fYPos[1][j1]:
fYPos[2][j1] := fYPos[2][lengthposy - j1 + 1]:
fYPos[1][j1] := fYPos[1][lengthposy - j1 + 1]:
fYPos[2][lengthposy - j1 + 1] := tempprod:
fYPos[1][lengthposy - j1 + 1] := tempprob:
od:
# print(`fXNeg is`, fXNeg[2], fXNeg[1]):
# print(`fXPos is`, fXPos[2], fXPos[1]):
# print(`fYNeg is`, fYNeg[2], fYNeg[1]):
# print(`fYPos is`, fYPos[2], fYPos[1]):
if (lengthposx = 1 or (m - lengthposy) = 1) or
((n - lengthposx) = 1 or lengthposy = 1) then
Temp1 := BruteForceProductQ2Q4():
else
Temp1 := MovingHeapProductQ2Q4():
fi:
# print(`Temp1 is`, Temp1):
Q2Q4Prod := seq(Temp1[2][k], k = 1 .. (n - lengthposx) *
lengthposy + lengthposx * (m - lengthposy)):
Q2Q4Prob := seq(Temp1[1][k], k = 1 .. (n - lengthposx) *
lengthposy + lengthposx * (m - lengthposy)):
fXPos[2] := fXPosTemp[2]:
fXPos[1] := fXPosTemp[1]:
fYPos[2] := fYPosTemp[2]:
fYPos[1] := fYPosTemp[1]:
for i1 from 1 to floor(leftbound / 2) do
tempprod := fXNeg[2][i1]:
tempprob := fXNeg[1][i1]:
fXNeg[2][i1] := fXNeg[2][leftbound - i1]:
fXNeg[1][i1] := fXNeg[1][leftbound - i1]:
fXNeg[2][leftbound - i1] := tempprod:
fXNeg[1][leftbound - i1] := tempprob:
od:
for j1 from 1 to floor(upperbound / 2) do
tempprod := fYNeg[2][j1]:
tempprob := fYNeg[1][j1]:
fYNeg[2][j1] := fYNeg[2][upperbound - j1]:
fYNeg[1][j1] := fYNeg[1][upperbound - j1]:
fYNeg[2][upperbound - j1] := tempprod:
fYNeg[1][upperbound - j1] := tempprob:
od:
# print(`fXNeg is`, fXNeg[2], fXNeg[1]):
# print(`fXPos is`, fXPos[2], fXPos[1]):
# print(`fYNeg is`, fYNeg[2], fYNeg[1]):
# print(`fYPos is`, fYPos[2], fYPos[1]):
if (lengthposx = 1 or lengthposy = 1) or
((n - lengthposx) = 1 or (m - lengthposy) = 1) then
Temp2 := BruteForceProductQ1Q3():
else
# print(`MovingHeap`):
Temp2 := MovingHeapProductQ1Q3():
fi:
# print(`Temp2 is`, Temp2):
Q1Q3Prod := seq(Temp2[2][k], k = 1 .. ((n - lengthposx) * (m -
lengthposy)) + (lengthposx * lengthposy)):
Q1Q3Prob := seq(Temp2[1][k], k = 1 .. ((n - lengthposx) * (m -
lengthposy)) + (lengthposx * lengthposy)):
Temp := [Q2Q4Prob, Q1Q3Prob], [Q2Q4Prod, Q1Q3Prod]:
print(`Temp is`, Temp):
fi:
Prods := Temp[1]:
Probs := Temp[2]:
#
# Remove redundancies from probability list
#
FinalSupport := array(sparse, 1 .. n * m, []):
#
# Since first element is not unique (as in the convolution code) place
# only the first product element in the final support
#
FinalSupport[1] := Prods[1]:
FinalPDF := array(sparse, 1 .. n * m, []):
FinalPDF[1] := 0:
k := 1:
j := 1:
while (k < n * m) do
FinalPDF[j] := FinalPDF[j] + Probs[k]:
if evalf(Prods[k]) <> evalf(Prods[k + 1]) then
j := j + 1:
FinalSupport[j] := Prods[k + 1]:
fi:
k := k + 1:
od:
FinalPDF[j] := FinalPDF[j] + Probs[k]:
#
# Remove extraneous zeros from FinalPDF and FinalSupport. We know the
# zeros (if any) at the end of the FinalPDF array are not probability
# values. They exist because of the redundant values in Prods. Use
# FinalPDF to determine how many extraneous zeros exist, and
# reconstruct FinalPDF and FinalSupport so the extra zeros are not
# included as part of the arrays.
#
NumZeros := 0:
for i from (n * m) by -1 to 1 while FinalPDF[i] = 0 do
NumZeros := NumZeros + 1:
od:
FinalSupport := array(1 .. n * m - NumZeros, [seq(FinalSupport[i],
i = 1 .. n * m - NumZeros)]):
FinalPDF := array(1 .. n * m - NumZeros, [seq(FinalPDF[i],
i = 1 .. n * m - NumZeros)]):
FinalSupport := convert(FinalSupport, list):
FinalPDF := convert(FinalPDF, list):
fZ := [FinalPDF, eval(FinalSupport), ["Discrete", "PDF"]]:
#
# At least one RV has infinite support
#
else # if DotX or DotY
print(`Unable to compute the product of these random variables`):
return:
fi:
return(fZ):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: qqplot1.map
#
# Procedure name: QQPlot(X, Sample, Parameters)
#
# Other APPL Procedures Called: IDF
#
# Date: June 26, 2000
#
# Purpose: Plots the q_i quantile of a fitted distribution function X
# versus the q_i quantile of the Sample distribution
#
# Arguments: X: Random variable
# Sample: List of sample data points
# Parameters
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in a list-of-lists format
# 3. Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
QQPlot := proc(X :: list(list), Sample :: list, Parameters)
local NumLists, n, q, SortedSample, i, Fitted, ParFitted, DataPoints,
Hi:
#
# Check for the appropriate number of arguments
#
if (nargs <> 3) then
print(`ERROR(QQPlot): This procedure requires 3 arguments`):
RETURN():
fi:
#
# Check that the RV X is in a list-of-lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(QQPlot): The RV X must be in a`):
print(`list of 3 lists format`):
RETURN():
fi:
#
# Check that X is in its PDF, CDF, SF, HF, CHF, or IDF format
#
if not((X[3][2] = "PDF") or
(X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
print(`ERROR(QQPlot): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
with(plots):
n := nops(Sample):
q := [seq((i - (1 / 2)) / n, i = 1 .. n)]:
# print(`q is`, q):
SortedSample := sort(Sample):
Fitted := []:
for i from 1 to n do
Fitted := [op(Fitted), IDF(X, q[i])]:
od:
ParFitted := subs({op(Parameters)}, Fitted):
# print(`Parfitted is`, ParFitted):
DataPoints := []:
for i from 1 to n do
DataPoints := [op(DataPoints), [SortedSample[i], ParFitted[i]]]:
od:
# print(DataPoints):
# Lo := min(Parfitted[1], SortedSample[1]):
Hi := max(ParFitted[n], SortedSample[n]):
pointplot(DataPoints, view = [0 .. Hi + 10, 0 .. Hi + 10], labels = ["sample",
"model"], scaling = constrained, title = "Q-Q Plot"):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: rangestat7.map
# Assuming incremented by 1 in without replacement case
# Paul Stockmeyer formula for with replacement case
# rangestat7.map: adding continuous capability
#
# Procedure Name: RangeStat(X, n, ["wo"])
#
# Other APPL Procedures Called: Convert
#
# Date: May 10, 2001
#
# Purpose: RangeStat is a procedure that returns the PDF of the range
# X_(n) - X_(1), of a population when n items are sampled
#
# Arguments: X: A random variable,
# n: The number of items drawn randomly from the population
# with PDF fX(x),
# "wo" (optional): A variable that indicates if the items
# drawn from the population are done so without (wo)
# replacement (for discrete distributions only)
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is a list of 3 sublists
# 3. Check that n >= 2, if not return an error message stating that
# there is no range since only 1 item is sampled from the
# population
# 4. Convert X to PDF form if not already in that form
# 5. Call the procedure Convert(X) to convert the discrete random
# variable's support to a standard APPL discrete random variable
# support format:
# standard "dot" support format:
# [anything .. anything, incremented by k, transformed by g(x)]
# standard "no dot" support format:
# [x1, x2, x3, ... , xN]
# 6. Determine if the random variable X has a "dot" support format
# (which indicates a formulaic PDF) or a "nodot" support format
# (which indicates a numeric PDF). Return an error message for
# formulaic PDFs with non-numeric support values, such as:
# X := [[x -> x/6], [1 .. n], ["Discrete", "PDF"]];
# 7. Check that N >= 2, if not return an error message stating that
# the population consists of only 1 element and so thhere is no
# range
# 8. If only 2 arguments are given, by default items are sampled
# with replacement
# 9. If X has a numeric PDF, then calculate the PDF of the range by
# formula from Paul Stockmeyer.
# 10. If X has a formulaic PDF, then calculate the PDF of the range ..
# by obtaining a general expression for the PDF with the
# same formula used in the numeric case.
# 11. If 3 arguments are provided, check if the third argument is
# the string "wo." If it is, then items are drawn from the RV's
# population without replacement
# 12. Determine if the random variable X has a formulaic PDF. If it
# does and also has finite support, then call the procedure
# ConvertToNumeric to convert its PDF and support to the standard
# APPL numeric list format. The conversion is necessary in order
# to have list inputs for the procedures NextPermutation and
# NextCombination.
# 15. If X has finite support and if n = N, then the PDF of the range
# is 1 for x = n, and 0 otherwise.
# 16. If n = 2, 3, ... N - 1, create an array of size N - n to store
# the range values x from 1 to N - n + 1. Initialize the array to
# contain all zeros.
# 17. Create the first lexicographical combination of n items.
# 18. Assign perm as the current combination. For each combination,
# the algorithm finds every possible permutation of that
# combination.
# 19. For each permutation, compute the probability of obtaining that
# given permutation.
# 20. Find the maximum and minimum elements of the permutation and
# then determine their diference, the range. Store the
# permutation's probability in the appropriate position in the
# array.
# 21. Find the next lexicographical combination, and repeat steps 18
# - 20.
# 22. If X has infinite support, then at present, RangeStat is unable
# to compute the range for infinite support without replacement
# cases. This is an open area for future work.
# 23. If 3 arguments are provided and the third one is not the
# string "wo", then return an error message
# 24. Return the PDF of the range in the list of sublists format
#
RangeStat := proc(X :: list(list), n :: {posint, symbol}, indicator ::
string)
local NumLists, fX, FX, nsegs, fXRange, ffX, Lo, Hi, formulaic, N, s, p,
k, uppers, rs, rp,
i, j, sortedr, sortedrs, sortedrp, frs, frp, nz, Finite,
combo, perm, PermProb, cumsum, m, HiVal, LoVal, Range, flag,
fXRangeNoZeros, index:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 2) and (nargs <> 3)) then
print(`ERROR(RangeStat): This procedure requires 2 or 3 arguments:`):
print(`A random variable X,`):
print(`the number of random items sampled from the population n,`):
print(`an optional argument wo, which indicates sampling *without*`):
print(`replacement for discrete random variables`):
return:
fi:
#
# Check that the RV X is a list of 3 sublists
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(RangeStat): The RV X must be a list of 3 lists`):
return:
fi:
#
# Check that n >= 2, if not return a message stating that there is no
# range
#
if not(type(n, symbol)) and (n < 2) then
print(`ERROR(RangeStat): Only 1 item sampled from the population`):
print(`There is no range`):
return:
fi:
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif ((X[3][2] = "CDF") or
(X[3][2] = "SF") or
(X[3][2] = "HF") or
(X[3][2] = "CHF") or
(X[3][2] = "IDF")) then
fX := PDF(X):
else
print(`ERROR(RangeStat): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the RV X is continuous and it CDF is tractable, find the PDF of
# the range statistic
#
if (fX[3][1] = "Continuous") then
FX := CDF(X):
# print(FX):
nsegs := nops(fX[1]):
fXRange := []:
for i from 1 to nsegs do
ffX := unapply(int(n * (n - 1) *
(FX[1][i](z) - FX[1][i](z - x)) ^ (n - 2) * fX[1][i](z - x)
* fX[1][i](z), z = x .. fX[2][2]), x):
fXRange := [op(fXRange), op(ffX)]:
od:
#
# Call the procedure Convert(X) to convert the discrete random
# variable's support to a standard APPL discrete RV support format.
#
elif (fX[3][1] = "Discrete") then
fX := Convert(fX):
if (fX = false) then
print(`ERROR(RangeStat): Discrete RV X is NOT in legal APPL form`):
return:
fi:
FX := CDF(fX):
#
# Determine if the random variable X has a "dot" support format (which
# indicates a formulaic PDF) or a "nodot" support format (which
# indicates a numeric PDF). Return an error message for formulaic PDFs
# with non-numeric support values (in the "dot" format), such as:
# X := [[x -> x/6], [1 .. n], ["Discrete", "PDF"]];
#
if type(fX[2][1], range) then
Lo := lhs(fX[2][1]):
Hi := rhs(fX[2][1]):
if type(Hi, symbol) and not(evalb(Hi = infinity)) then
print(`ERROR(RangeStat): RV's support must be numeric`):
return:
elif type(Lo, symbol) and not(evalb(Lo = infinity)) then
print(`ERROR(RangeStat): RV's support must be numeric`):
return:
else
formulaic := true:
fi:
else
N := nops(fX[2]):
formulaic := false:
#
# Check that N >= 2, if not return a message stating that there is no
# range
#
if (N < 2) then
print(`ERROR(RangeStat): The population consists of 1 element`):
print(`There is no range`):
return:
fi:
fi:
#
# If only 3 arguments are given, by default items are sampled with
# replacement
#
if (nargs = 2) then
#
# RV has numeric PDF
# Example: X := [[1/6, 1/3, 1/2], [1, 2, 3], ["Discrete", "PDF"]];
#
# DISCRETE/WITH REPLACEMENT/NUMERIC PDF
#
#
if not(formulaic) then
# assign s as the support of the random variable X
# s[1], s[2], s[3], ..., s[N] are sorted distinct support values, i.e.,
# s[1] < s[2] < ... < s[N]
s := fX[2]:
# print(s):
# assign p as the probability mass function of the random variable X
# p[1], p[2], ..., p[N] are the probability mass values that correspond
# to the support values s[1], s[2], ..., s[N], respectively
p := fX[1]:
# print(p):
# k is a counter
k := 1:
# rs is an array that holds the range support values--initialize it to
# contain all 0's (sparse)
# rp is an array that holds the range probability mass values--
# initialize it to contain all 0's (sparse)
#
# LARRY: An array must be constructed before it can be used--that's why
# I'm building rs and rp now. There are only 1 + 2 + 3 + ... + N
# range support values possible if the support is of size N.
#
uppers := add(m, m = 1 .. N):
rs := array(1 .. uppers, sparse, []):
rp := array(1 .. uppers, sparse, []):
# print(rs):
# print(rp):
# print(N):
for i from 1 to N do
for j from i to N do
# print(s[j]):
# print(s[i]):
rs[k] := s[j] - s[i]:
# print(rs[k]):
# print(rs):
rp[k] := add(p[m], m = i .. j) ^ n -
add(p[m], m = i + 1 .. j) ^ n -
add(p[m], m = i .. j - 1) ^ n +
add(p[m], m = i + 1 .. j - 1) ^ n:
k := k + 1:
# print(add(p[m], m = i .. j) ^ n):
# print(add(p[m], m = i + 1 .. j) ^ n):
# print(add(p[m], m = i .. j - 1) ^ n):
# print(`lower add bd`, i + 1): print(`upper add bd`, j - 1):
# print(add(p[m], m = i + 1 .. j - 1) ^ n):
od:
od:
# print(rs):
# print(rp):
rs := convert(rs, list):
rp := convert(rp, list):
sortedr := InsertionSort(rs, rp):
# print(sortedr):
sortedrs := sortedr[1]:
sortedrp := sortedr[2]:
# print(sortedrs):
# print(sortedrp):
# Build final range support (frs) and final range probability values
# (frp)--initialize them to contain all zeroes
frs := array(sparse, 1 .. uppers, sparse, []):
frp := array(sparse, 1 .. uppers, sparse, []):
# Remove redundancies from support probability list
# Place the first range support and range probability values in the
# first position in the frs and frp arrays
frs[1] := sortedrs[1]:
frp[1] := sortedrp[1]:
k := 2:
j := 1:
while (k <= uppers) do
if evalf(sortedrs[k]) <> evalf(sortedrs[k - 1]) then
j := j + 1:
frs[j] := sortedrs[k]:
fi:
frp[j] := frp[j] + sortedrp[k]:
k := k + 1:
od:
# print(frs): # print(frp):
#
# Remove extraneous zeros from frs and frp. We know the zeros (if any)
# at the end of the frp array are not probability values. They exist
# because of the redundant values in s. Use frp to determine how many
# extraneous zeros exist, and reconstruct frp and frs so the extra zeros
# are not included as part of the arrays.
#
nz := 0:
for i from (uppers) by -1 to 1 while frp[i] = 0 do
nz := nz + 1:
od:
frs := array(1 .. uppers - nz, [seq(frs[i],
i = 1 .. uppers - nz)]):
frp := array(1 .. uppers - nz, [seq(frp[i],
i = 1 .. uppers - nz)]):
fX[2] := convert(frs, list):
fXRange := convert(frp, list):
# print(fX[2]): # print(fXRange):
#
# PREVIOUS CODE FOR RANGE STAT WITH SUPPORT 1, 2, 3, ..., N
# FinalPDF[j] := FinalPDF[j] + Probs[k]:
# fX[2] := [seq(supp, supp = 0 .. N - 1)]:
# fXRange := array(1 .. N):
# fXRange[1] := sum((fX[1][j]) ^ n, j = 1 .. N):
# for w from 2 to N do
# fXRange[w] := (FX[1][w]) ^ n -
# (FX[1][w] - FX[1][1]) ^ n -
# (FX[1][w - 1]) ^ n +
# (FX[1][w - 1] - FX[1][1]) ^ n +
# sum((FX[1][w + k] - FX[1][k]) ^ n -
# (FX[1][w + k] - FX[1][k + 1]) ^ n -
# (FX[1][w + k - 1] - FX[1][k]) ^ n +
# (FX[1][w + k - 1] - FX[1][k + 1]) ^ n,
# k = 1 .. N - w):
# od:
#
# RV has formulaic PDF
# Example: X := [[x -> x/6], [1 .. 3], ["Discrete", "PDF"]];
#
# DISCRETE/WITH REPLACEMENT/formulaic PDF
#
else
print(`Have not done range for w/ replacement, formulaic PDF`):
return:
# Substitute Lo in fX, Lo + 1 in SX, and assign FX = 1
# fXOS1 := sum(binomial(n, w) * 1 *
# ((subs(x = Lo, op(unapply(fX[1](x))(x)))) ^ (n - w))
# * (subs(x = Lo + 1, op(unapply(SX[1](x))(x))) ^ w),
# w = 0 .. (n - r)):
# fXOS1 := simplify(fXOS1):
# Substitute k - 1 in FX, k in fX, and k + 1 in SX
# fXOS2 := sum(sum(multinomial(n, u, n - u - w, w) *
# (subs(x = k - 1, op(unapply(FX[1](x))(x))) ^ u) *
# ((subs(x = k, op(unapply(fX[1](x))(x)))) ^ (n - u - w)) *
# (subs(x = k + 1, op(unapply(SX[1](x))(x))) ^ w),
# w = 0 .. (n - r)), u = 0 .. r - 1):
# fXOS2 := simplify(fXOS2):
# Write the PDF in terms of x, instead of k
# fXOS2 := subs(k = x, fXOS2):
# Special fix for Possion RV
# if has(denom(fXOS2), GAMMA(x)) then
# fXOS2 := convert(fXOS2, factorial):
# fi:
# RealValue := subs(x = Lo, fXOS2):
# If fXOS1 is the same value as fXOS2 evaluated at x = Lo, then
# then combine fXOS1 and fXOS2 into one formula
# if ((evalb(evalf(RealValue, Digits + 2) =
# evalf(fXOS1, Digits + 2))) or
# evalb(simplify(RealValue) = fXOS1)) then
# fXOS := [unapply(fXOS2, x)]:
# fX[2]:= [Lo .. Hi]:
# else
# fXOS := [fXOS1, unapply(fXOS2, x)]:
# fX[2] := [Lo, Lo + 1 .. Hi]:
# fi:
fi:
#
# If 3 arguments are provided and the 3rd argument is the string "wo",
# then items are sampled *without replacement*
#
elif ((nargs = 3) and is(indicator = "wo")) then
Finite := true:
#
# Determine if the random variable X has a formulaic PDF. If it does
# and also has finite support, then call the procedure ConvertToNumeric
# to convert its PDF and support to the standard APPL numeric list
# format. The conversion is necessary in order to have list inputs for
# the procedures NextPermutation and NextCombination.
#
if (formulaic) then
if (is(Lo, infinity) or is(Hi, infinity)) then
Finite := false:
else
fX := ConvertToNumeric(fX):
N := nops(fX[2]):
fi:
fi:
#
# The random variable X has finite support
#
if (Finite) then
fX[2] := [seq(supp, supp = n - 1 .. N - 1)]:
#
# Check that the sample size n is not greater than the population
# size N. If it is, return an error message.
#
if (n > N) then
print(`ERROR(RangeStat): If sampling *without* replacement,`):
print(`n CANNOT be larger than the population size`, N):
return:
fi:
#
# Check that N >= 2, if not return a message stating that there is no
# range
#
if (N < 2) then
print(`ERROR(RangeStat): Population consists of 1 element`):
print(`There is no range`):
return:
fi:
#
# Find the PDF of the range given that the support is finite and n = N
#
if is(n = N) then
fXRange := array(1 .. 1):
fXRange[1] := 1:
fX[2] := [N - 1]:
#
# If n = 2, 3, ... N - 1, create an array of size N - n to store the
# range values x from 1 to N - n + 1. Initialize the array to contain
# all zeros.
#
else
fXRange := array(1 .. N - 1):
for j from 1 to N - 1 do
fXRange[j] := 0:
od:
# Create the first lexicographical combination of n items
combo := [seq(i, i = 1 .. n)]:
for i from 1 to binomial(N, n) do
# Assign perm as the current combo
perm := combo:
#
# Compute the probability of obtaining the given permutation, perm
#
for j from 1 to n! do
PermProb := fX[1][perm[1]]:
cumsum := fX[1][perm[1]]:
for m from 2 to n do
PermProb := PermProb * fX[1][perm[m]] / (1 - cumsum):
cumsum := cumsum + fX[1][perm[m]]:
od:
#
# Find the maximum and minimum elements of the permutation and then
# determine their diference, the range. Store the permutation's
# probability in the appropriate position in the range array.
#
HiVal := max(op(perm)):
LoVal := min(op(perm)):
Range := HiVal - LoVal:
flag := true:
for k from 1 to N - 1 do
if (Range = k) then
fXRange[k] := PermProb + fXRange[k]:
fi:
od:
# Find the next lexicographical permutation
perm := NextPermutation(perm):
od:
# Find the next lexicographical combination
combo := NextCombination(combo, N):
od:
fXRangeNoZeros := array(1 .. N - n + 1):
index := 1:
for k from 1 to N - 1 do
if (fXRange[k] <> 0) then
fXRangeNoZeros[index] := fXRange[k]:
index := index + 1:
fi:
od:
fXRange := fXRangeNoZeros:
fi:
#
# If X has infinite support, then at present, RangeStat is unable to
# compute the range for infinite support without replacement cases.
#
# DISCRETE/INFINITE SUPPORT/WITHOUT REPLACEMENT
#
else
print(`ERROR(RangeStat): At present, RangeStat cannot`):
print(`compute the range for this infinite support RV`):
print(`in the without replacement case`):
return:
fi:
#
# If 3 arguments are provided and the third one is not the string
# "wo", then return an error message
#
else
print(`ERROR(RangeStat): The 3rd argument must be the string`):
print(`*wo* to indicate items are drawn *without* replacement`):
return:
fi:
fXRange := convert(fXRange, list):
fi:
#
# Return the PDF of the rth order statistic in the list of sublists
# format
#
return([fXRange, fX[2], fX[3]]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: rebuildheap1.map
#
# Procedure Name: RebuildHeap()
#
# Other APPL Procedures Called:
#
# Date: September 17, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
RebuildHeap := proc(Root, size)
global H, Mimic:
local RootValue, RootValueProb, RootValuePosition, Child:
# local size, RootItem:
# local NewH, Temp, NewArray, NewHeap:
#
# If there are no elements in the heap except the sentinel
# (-1 * 10 ^ 6), then return the heap H as is, since it doesn't need
# rebuilt
#
if (size = 1) then
return:
fi:
# print(`Root is`, Root):
# print(`H is`, H):
# size := nops(convert(H, list)):
# print(`size is`, size):
RootValue := H[Root][1]:
RootValueProb := H[Root][2]:
RootValuePosition := Mimic[Root]:
#
# Check that root is not a leaf
#
if (2 * Root - 1 > size) then
# print(`there are no children`):
return:
#
# Root must have a left child
#
else
Child := 2 * Root - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> size) and (H[Child + 1][1] < H[Child][1])) then
Child := Child + 1:
else
# print(`either no right child or right child not larger`):
fi:
if H[Child][1] < RootValue then
H[Root] := H[Child]:
Mimic[Root] := Mimic[Child]:
H[Child][1] := RootValue:
H[Child][2] := RootValueProb:
Mimic[Child] := RootValuePosition:
RebuildHeap(Child, size):
fi:
fi:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: rebuildheapq11.map
#
# Procedure Name: RebuildHeapQ1()
#
# Other APPL Procedures Called:
#
# Date: January 11, 2001
#
# Purpose:
#
# Arguments:
#
# Algorithm:
RebuildHeapQ1 := proc(Root, size)
global Q1H, Q1Mimic:
local RootValue, RootValueProb, RootValuePosition, Child:
#
# If there are no elements in the heap except the sentinel
# (-1 * 10 ^ 6), then return the heap Q1H as is, since it doesn't need
# rebuilt
#
if (size = 1) then
return:
fi:
RootValue := Q1H[Root][1]:
RootValueProb := Q1H[Root][2]:
RootValuePosition := Q1Mimic[Root]:
#
# Check that root is not a leaf
#
if (2 * Root - 1 > size) then
return:
#
# Root must have a left child
#
else
Child := 2 * Root - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> size) and (Q1H[Child + 1][1] < Q1H[Child][1])) then
Child := Child + 1:
else
# print(`either no right child or right child not larger`):
fi:
if Q1H[Child][1] < RootValue then
Q1H[Root] := Q1H[Child]:
Q1Mimic[Root] := Q1Mimic[Child]:
Q1H[Child][1] := RootValue:
Q1H[Child][2] := RootValueProb:
Q1Mimic[Child] := RootValuePosition:
RebuildHeapQ1(Child, size):
fi:
fi:
return:
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: rebuildheapq21.map
#
# Procedure Name: RebuildHeapQ2()
#
# Other APPL Procedures Called:
#
# Date: January 11, 2001
#
# Purpose:
#
# Arguments:
#
# Algorithm:
RebuildHeapQ2 := proc(Root, size)
global Q2H, Q2Mimic:
local RootValue, RootValueProb, RootValuePosition, Child:
#
# If there are no elements in the heap except the sentinel
# (-1 * 10 ^ 6), then return the heap Q2H as is, since it doesn't need
# rebuilt
#
if (size = 1) then
return:
fi:
RootValue := Q2H[Root][1]:
RootValueProb := Q2H[Root][2]:
RootValuePosition := Q2Mimic[Root]:
#
# Check that root is not a leaf
#
if (2 * Root - 1 > size) then
return:
#
# Root must have a left child
#
else
Child := 2 * Root - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> size) and (Q2H[Child + 1][1] < Q2H[Child][1])) then
Child := Child + 1:
else
# print(`either no right child or right child not larger`):
fi:
if Q2H[Child][1] < RootValue then
Q2H[Root] := Q2H[Child]:
Q2Mimic[Root] := Q2Mimic[Child]:
Q2H[Child][1] := RootValue:
Q2H[Child][2] := RootValueProb:
Q2Mimic[Child] := RootValuePosition:
RebuildHeapQ2(Child, size):
fi:
fi:
return:
end:#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: rebuildheapq31.map
#
# Procedure Name: RebuildHeapQ3()
#
# Other APPL Procedures Called:
#
# Date: September 17, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
RebuildHeapQ3 := proc(Root, size)
global Q3H, Q3Mimic:
local RootValue, RootValueProb, RootValuePosition, Child:
# local size, RootItem:
# local NewH, Temp, NewArray, NewHeap:
#
# If there are no elements in the heap except the sentinel
# (-1 * 10 ^ 6), then return the heap Q3H as is, since it doesn't need
# rebuilt
#
if (size = 1) then
return:
fi:
# print(`Root is`, Root):
# print(`Q3H is`, Q3H):
# size := nops(convert(Q3H, list)):
# print(`size is`, size):
RootValue := Q3H[Root][1]:
RootValueProb := Q3H[Root][2]:
RootValuePosition := Q3Mimic[Root]:
#
# Check that root is not a leaf
#
if (2 * Root - 1 > size) then
# print(`there are no children`):
return:
#
# Root must have a left child
#
else
Child := 2 * Root - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> size) and (Q3H[Child + 1][1] < Q3H[Child][1])) then
Child := Child + 1:
else
# print(`either no right child or right child not larger`):
fi:
if Q3H[Child][1] < RootValue then
Q3H[Root] := Q3H[Child]:
Q3Mimic[Root] := Q3Mimic[Child]:
Q3H[Child][1] := RootValue:
Q3H[Child][2] := RootValueProb:
Q3Mimic[Child] := RootValuePosition:
RebuildHeapQ3(Child, size):
fi:
fi:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: rebuildheapq41.map
#
# Procedure Name: RebuildHeapQ4()
#
# Other APPL Procedures Called:
#
# Date: September 17, 2000
#
# Purpose:
#
# Arguments:
#
# Algorithm:
RebuildHeapQ4 := proc(Root, size)
global Q4H, Q4Mimic:
local RootValue, RootValueProb, RootValuePosition, Child:
# local size, RootItem:
# local NewH, Temp, NewArray, NewHeap:
#
# If there are no elements in the heap except the sentinel
# (-1 * 10 ^ 6), then return the heap Q4H as is, since it doesn't need
# rebuilt
#
if (size = 1) then
return:
fi:
# print(`Root is`, Root):
# print(`Q4H is`, Q4H):
# size := nops(convert(Q4H, list)):
# print(`size is`, size):
RootValue := Q4H[Root][1]:
RootValueProb := Q4H[Root][2]:
RootValuePosition := Q4Mimic[Root]:
#
# Check that root is not a leaf
#
if (2 * Root - 1 > size) then
# print(`there are no children`):
return:
#
# Root must have a left child
#
else
Child := 2 * Root - 1:
#
# If there are 2 children and the right child's value is greater than
# the left child's value, then update Child to be the right child
#
if ((Child <> size) and (Q4H[Child + 1][1] < Q4H[Child][1])) then
Child := Child + 1:
else
# print(`either no right child or right child not larger`):
fi:
if Q4H[Child][1] < RootValue then
Q4H[Root] := Q4H[Child]:
Q4Mimic[Root] := Q4Mimic[Child]:
Q4H[Child][1] := RootValue:
Q4H[Child][2] := RootValueProb:
Q4Mimic[Child] := RootValuePosition:
RebuildHeapQ4(Child, size):
fi:
fi:
return:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
#
# ReduceList is a procedure that eliminates floating point redundancies
# (e.g., 3 vs. 3.0) from a sorted Maple list.
#
ReduceList := proc(LST :: list)
local i, size, delt, deltamin, ListIn:
deltamin := 0.0000001:
ListIn := LST:
size := nops(ListIn):
for i from (size - 1) by -1 to 1 do
if (ListIn[i] <> -infinity and ListIn[i + 1] <> infinity) then
delt := evalf(ListIn[i + 1]) - evalf(ListIn[i]):
if (delt < deltamin) then
if (whattype(ListIn[i]) <> float) then
ListIn := subsop((i + 1) = NULL, ListIn):
else
ListIn := subsop(i = NULL, ListIn):
fi:
fi:
fi:
od:
RETURN(ListIn):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: sf6.map
#
# Procedure Name: SF(X, [x])
#
# Other APPL Procedures Called: CDF, CHF, Convert, PDF, HF
#
# Date: March 20, 2001
#
# Purpose: SF is a procedure that:
# (1) Returns the survivor function of a random variable X in
# the APPL list of 3 lists format if the only argument
# given is X, or
# (2) Returns the value Pr(X > x) if it is given the optional
# argument x in addition to the RV X
#
# Arguments: X: A continuous or discrete random variable;
# x (optional argument): A numeric value entered when
# trying to determine Pr(X > x)
#
# Algorithm: 1. Perform error checking on user entered arguments
# 2. The SF of X is determined by sending it to its
# appropriate category, which is based on whether:
# A. X is continuous or discrete
# B. X is entered in its PDF, CDF, SF, HF, CHF, or IDF
# format
# 3. If only 1 argument (the random variable X) is entered
# by the user, return the survivor function of X in
# the APPL list of 3 lists format
# 4. If 2 arguments are provided, return the value Pr(X > x)
#
# CAUTION: Made "x" local because assumption made on x in the discrete
# dot HF case
#
SF := proc(X :: list(list), st)
local numlists, nsegments, SX, supp, FX, SSX, CHX, i, prob, Y, Range,
lo, hi, incr, transf, fX, x, hf, chf, sf, idf, pieces, numops,
noceil, ceilpiece, solns, nsolns, cdf, val, invfound, j, idfval,
pdf, losupp, hisupp, sublist1, n, hX, notfound, count, k:
#
# Check for the appropriate number of arguments
#
if ((nargs <> 1) and (nargs <> 2)) then
print(`ERROR(SF): This procedure requires 1 or 2 arguments:`):
print(`A random variable X and an optional argument x for`):
print(`computing Pr(X > x)`):
return:
fi:
#
# Check that the RV X is in the list of 3 lists format
#
numlists := nops(X):
if (numlists <> 3) then
print(`ERROR(SF): The RV X must be a list of 3 lists`):
return:
fi:
#
# Make sure X is given as a PDF, CDF, SF, HF, CHF, or IDF
#
if not(member(X[3][2], {"PDF", "CDF", "SF", "HF", "CHF", "IDF"})) then
print(`ERROR(SF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
return:
fi:
#
# If the RV X is continuous, find and return the SF of X
#
if (X[3][1] = "Continuous") then
nsegments := nops(X[1]):
SX := []:
supp := X[2]:
#
# The RV X is given in its PDF, CDF, or IDF form
#
if (X[3][2] = "PDF" or X[3][2] = "CDF" or X[3][2] = "IDF") then
if X[3][2] = "CDF" then
FX := X:
else
FX := CDF(X):
# IDF will change its support from X[2] to FX[2]
supp := FX[2]:
fi:
for i from nsegments by -1 to 1 do
SSX := unapply(1 - FX[1][i](x), x):
# SX := [op(SX), unapply(simplify(SSX(x)), x)]:
SX := [unapply(simplify(SSX(x)), x), op(SX)]:
od:
#
# The RV X is given in its SF form. Nothing needs to be done to X.
#
elif X[3][2] = "SF" then
SX := X[1]:
supp := X[2]:
#
# The RV X is given in its HF form
#
elif (X[3][2] = "HF" or X[3][2] = "CHF") then
if X[3][2] = "HF" then
CHX := CHF(X):
else
CHX := X:
fi:
for i from 1 to nsegments do
SSX := unapply(exp(-CHX[1][i](s)), s):
SX := [op(SX), unapply(simplify(SSX(x)), x)]:
od:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([SX, supp, ["Continuous", "SF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if not(type(evalf(st), {numeric, infinity})) then
if nsegments = 1 then
prob := SX[1](st):
return(prob):
else
print(`ERROR(SF): Symbolic second arguments with a piecewise`):
print(`SF are not allowable in APPL at this time`):
return:
fi:
fi:
if (st <= evalf(supp[1])) then return(1):
elif (st > evalf(supp[nsegments + 1])) then return(0): fi:
for i from 1 to nsegments do
if ((evalf(st) > evalf(supp[i])) and (evalf(st) <= evalf(supp[i +
1]))) then
break:
fi:
od:
prob := SX[i](st):
return(prob):
fi:
#
# If the RV X is discrete, find and return the SF of X
#
elif (X[3][1] = "Discrete") then
#
# If the RV X is discrete, then call the procedure Convert(X) to
# convert the discrete random variable's support to a standard APPL
# discrete RV support format. Assign the converted random variable
# to the Maple variable Y.
#
Y := Convert(X):
SX[1] := Y[1]:
SX[2] := Y[2]:
#
# X has dot support
#
if type(Y[2][1], range) then
Range := Y[2][1]:
lo := lhs(Y[2][1]):
hi := rhs(Y[2][1]):
if member(Y[3][2], {"PDF", "CDF", "SF", "HF", "CHF"}) then
incr := Y[2][2]:
transf := Y[2][3]:
#
# Report the support of new random variable back to the user in its
# simplest form
#
if (incr = 1 and unapply(transf(x))(x) = x) then
SX[2] := [Range]:
#
# APPL is not programmed to convert to a PDF format when the increment
# is not 1 and/or the transformation is not x -> x
#
elif not(incr = 1 or unapply(transf(x))(x) = x) then
print(`ERROR(SF): APPL is currently unable to evaluate`):
print(`this RV`):
return:
fi:
fi:
#
# If X is given in its PDF form
#
if (Y[3][2] = "PDF") then
# fX := PDF(X):
# SX[1] := [unapply(1 - sum(op(unapply(fX[1](w))(w)), w = lo ..
# x - 1), x)]:
# print(`old way`, SX[1]):
SX[1] := [unapply(sum(op(unapply(Y[1](w))(w)), w = x .. hi), x)]:
#
# If X is given in its CDF form
#
elif (Y[3][2] = "CDF") then
SX[1] := [unapply(1 - (op(unapply(Y[1](x))(x))), x)]:
#
# The RV X is given in its SF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "SF") then
#
# The RV X is given in its HF form
#
elif (Y[3][2] = "HF") then
hf := unapply(op(Y[1])(w))(w):
# The following assumption is made since the following product
# may return an expression containing the GAMMA function, and we
# want Maple to simplify the expression knowing the conditions
# on the support of the random variable
# SX[1] := [unapply(simplify(product(1 - hf,
# w = lo .. (x - 1))), x)]:
# print(`before assumption`):
# print(SX[1]):
# assume(x < hi):
SX[1] := [unapply(simplify(product(1 - hf,
w = lo .. (x - 1))), x)]:
#
# If X is given in its CHF form
#
elif (Y[3][2] = "CHF") then
chf := unapply(op(Y[1])(x))(x):
sf := exp(-chf):
SX[1] := [unapply(sf, x)]:
#
# If X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
# need to look for a ceil function here!
idf := unapply(op(Y[1])(y))(y):
# print(`idf is`, idf):
# print(`[op(idf)] is`, [op(idf)]):
pieces := [op(idf)]:
numops := nops(pieces):
# print(numops):
noceil := true:
for i from 1 to numops while noceil do
if has(pieces, ceil) then
# print(`has ceil`):
noceil := false:
ceilpiece := i:
fi:
od:
if not(noceil) then
# print(pieces[ceilpiece]):
pieces[ceilpiece] := op(pieces[ceilpiece]):
idf := sum(pieces[k], k = 1 .. numops):
fi:
solns := [solve(idf = x, y)]:
# print(solns):
nsolns := nops(solns):
# Find the correct inverse
if (nsolns = 1) then
# If there is only one inverse, assign it to cdf.
cdf := solns[1]:
else
if lo = -infinity then
if hi = infinity then
val := 0:
else
val := hi:
fi:
else
val := lo:
fi:
# print(`val is`, val):
invfound := false:
for j from 1 to nsolns do
# Evaluate each inverse of the IDF at the value "val" assigned
# above. If CDF(IDF(val)) = val, then assign idf equal to that
# inverse.
idfval := subs(x = val, idf):
if evalf(subs(x = idfval, solns[j])) = evalf(val) then
cdf := solns[j]:
invfound := true:
break:
fi:
od:
if not(invfound) then
print(`ERROR(SF): Could not find the appropriate inverse`):
fi:
fi:
pdf := simplify(subs(x = w, cdf) - subs(x = w - 1, cdf)):
SX[1] := [unapply(1 - sum(pdf, w = lo .. x - 1), x)]:
# CAUTION: losupp is incorrect in some cases -- currently don't know
# how to fix this, need to be able to retrieve the first cdf value and
# sub it into idf as lo
losupp := evalf(subs(y = lo, idf)):
hisupp := evalf(subs(y = hi, idf)):
SX[2] := [losupp .. hisupp]:
fi:
#
# X has no dot support
#
else
sublist1 := SX[1]:
n := nops(sublist1):
#
# If X is given in its PDF form,
#
if (Y[3][2] = "PDF") then
n := nops(SX[2]):
FX := CDF(Y):
SX[1][1] := 1:
for i from 2 to n do
SX[1][i] := 1 - FX[1][i - 1]:
od:
#
# If X is given in its CDF form,
#
elif (Y[3][2] = "CDF") then
SX[1][1] := 1:
for i from 2 to n do
SX[1][i] := 1 - sublist1[i - 1]:
od:
#
# If X is given in its SF form, then nothing needs to be done to X.
#
elif (Y[3][2] = "SF") then
#
# If X is given in its HF form
#
elif member(Y[3][2], {"HF", "CHF"}) then
SX[1][1] := 1:
hX := HF(Y):
for i from 2 to n do
SX[1][i] := SX[1][i - 1] * (1 - hX[1][i - 1]):
od:
#
# If X is given in its IDF form
#
elif (Y[3][2] = "IDF") then
FX := CDF(Y):
sublist1 := FX[1]:
SX[2] := FX[2]:
SX[1][1] := 1:
for i from 2 to n do
SX[1][i] := 1 - sublist1[i - 1]:
od:
fi:
fi:
#
# Only 1 argument, X, given for the procedure
#
if (nargs = 1) then
return([SX[1], SX[2], ["Discrete", "SF"]]):
#
# Two arguments, X and x, provided for the procedure
#
elif (nargs = 2) then
if type(Y[2][1], range) then
prob := op(SX[1](st)):
else
prob := 0:
notfound := true:
count := 1:
for k from 1 to n while notfound do
if evalf(SX[2][k]) = evalf(st) then
notfound := false:
prob := SX[1][count]:
fi:
count := count + 1:
od:
fi:
return(prob):
fi:
#
# X is neither continuous nor discrete
else
print(`ERROR(SF): The random variable X must be continuous or`):
print(`discrete`):
fi:
end:#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: skewness2.map
# Rewriting E[((X - mu) / sigma) ^ 3]
#
# Procedure Name: Skewness(X)
#
# Other APPL Procedures Called:
#
# Updated: June 30, 2000
#
# Purpose: Returns the skewness
#
# Arguments: X: Random Variable
#
# Algorithm:
Skewness := proc(X :: list(list))
local mu, sigma, Term1, Term2, Term3, skew:
mu := Mean(X):
sigma := sqrt(Variance(X)):
Term1 := ExpectedValue(X, x -> x ^ 3):
Term2 := 3 * mu * ExpectedValue(X, x -> x ^ 2):
Term3 := 2 * mu ^ 3:
skew := (Term1 - Term2 + Term3) / sigma ^ 3:
RETURN(skew):
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888888888#
# Filename: stealth1.map
#
# Procedure Name: Stealth
#
# Other APPL Procedures Called: ExpectedValue, NormalRV, UniformRV, Variance
#
# Date: June 7, 1999
#
# Purpose: Stealth for E(X, g), N(mu, sigma), U(a, b), V(X)
#
E := proc(X, g)
local mean:
mean := ExpectedValue(X, g):
RETURN(mean):
end:
N := proc(mu, sigma)
local ListOfLists:
ListOfLists := NormalRV(mu, sigma):
RETURN(ListOfLists):
end:
U := proc(a, b)
local ListOfLists:
ListOfLists := UniformRV(a, b):
RETURN(ListOfLists):
end:
V := proc(X)
local variance:
variance := Variance(X):
RETURN(variance):
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888888888#
# ReduceList is a procedure that eliminates floating point redundancies
# (e.g., 3 vs. 3.0) from a sorted Maple list.
#
ReduceList := proc(LST)
local i, size, delt, deltamin, ListIn:
deltamin := 0.0000001:
ListIn := LST:
size := nops(ListIn):
for i from (size - 1) by -1 to 1 do
if (ListIn[i] <> -infinity and ListIn[i + 1] <> infinity) then
delt := evalf(ListIn[i + 1]) - evalf(ListIn[i]):
if (delt < deltamin) then
if (whattype(ListIn[i]) <> float) then
ListIn := subsop((i + 1) = NULL, ListIn):
else
ListIn := subsop(i = NULL, ListIn):
fi:
fi:
fi:
od:
return(ListIn):
end:
#
#11111111112222222222333333333344444444445555555555666666666677777777778888888888#3:06 PM 3/11/2008
# Procedure Transform finds the pdf of Y = g(X), where X and Y are
# random variables. The arguments are f(x), the pdf of X, and g(X), the
# transformation. The arguments of Transform and the returned value are
# in the list-of-sublists format.
#
Transform := proc(X, gX)
local nx, XStarSet, ng, XStarList, n, FF, i, k, c, fXc, BEGIN, END, gndx, j, mn, Mx, a,
b, YStarSet, YStarList, m, ffY, y, h, ntmp, temp, gtemp, ii, t, itp, ginv, fY:
if (X[3][1] = "Discrete") then
return(TransformDiscrete(X, gX)):
else
assume(y, real):
fXc := PDF(X):
nx := nops(fXc[2]):
XStarSet := {op(fXc[2])}:
ng := nops(gX[2]):
for i from 1 to ng do
if (evalf(gX[2][i]) > evalf(fXc[2][1]) and evalf(gX[2][i]) < evalf(fXc[2][nx]))
then
XStarSet := XStarSet union {gX[2][i]}
fi:
od:
XStarList := sort([op(XStarSet)], (x, y) -> evalb(evalf(x) < evalf(y))):
XStarList := ReduceList(XStarList):
n := nops(XStarList) - 1:
#print(`XStartList is`, XStarList): #####
FF := array(1 .. n):
# Find the appropriate index k of fXc[1][k] for each x interval.
for i from 1 to n do
for k from 1 to nx do
if (evalf(XStarList[i]) >= evalf(fXc[2][k])) then
FF[i] := k:
fi:
od:
od:
#print(`FF is`, FF): ######
c := array(1 .. n):
if (XStarList[1] = -infinity and XStarList[2] = infinity) then
c[1] := 0
else
BEGIN := 1:
END := n:
if (XStarList[1] = -infinity) then
c[1] := XStarList[2] - 1:
BEGIN := 2:
fi:
if (XStarList[n + 1] = infinity) then
c[n] := XStarList[n] + 1:
END := n - 1:
fi:
for i from BEGIN to END do
c[i] := (XStarList[i] + XStarList[i + 1]) / 2:
od:
fi:
#print(`c is`, c): ####
ng := nops(gX[1]):
gndx := array(1 .. n):
# Find the appropriate index j of gX[1][j] for each x interval.
for i from 1 to n do
for j from 1 to ng do
if (evalf(XStarList[i]) >= evalf(gX[2][j]) and evalf(XStarList[i]) <
evalf(gX[2][j + 1])) then
gndx[i] := j:
break:
fi:
od:
od:
#print(`gndx is`, gndx): ####
mn := array(1 .. n):
Mx := array(1 .. n):
for i from 1 to n do
a := limit(gX[1][gndx[i]](x), x = XStarList[i], right):
b := limit(gX[1][gndx[i]](x), x = XStarList[i + 1], left):
mn[i] := min(a, b):
Mx[i] := max(a, b):
od:
#print(`mn is`, mn): ####
#print(`Mx is`, Mx): ####
YStarSet := {seq(mn[i], i = 1 .. n), seq(Mx[i], i = 1 .. n)}:
YStarList := sort([op(YStarSet)], (x, y) -> evalb(evalf(x) < evalf(y))):
YStarList := ReduceList(YStarList):
m := nops(YStarList) - 1:
#print(`YStarList is`, YStarList): ####
ffY := []:
for j from 1 to m do
h := 0:
for i from 1 to n do
# If working with a relevant transformation segment, adjust the pdf.
if (evalf(mn[i]) <= evalf(YStarList[j]) and evalf(YStarList[j + 1]) <=
evalf(Mx[i])) then
temp := [solve(gX[1][gndx[i]](t2) = y, t2)]:
#print(`temp is`, temp): #####
ntmp := nops(temp):
gtemp := array(1 .. ntmp):
#print(`gtemp is`, gtemp): #####
for ii from 1 to ntmp do
gtemp[ii] := unapply(temp[ii], y):
od:
#print(`numtemp is`, ntmp): #####
if (ntmp = 1) then
# If there is only one inverse, assign it to ginv.
ginv := gtemp[1](y):
else
# If there is more than one inverse, find the appropriate one.
for t from 1 to ntmp do
# Evaluate each inverse of the transformation at the midpoint of the
# subinterval. Set ginv to that inverse for which gtemp(g(x)) = x.
itp := evalf(gtemp[t](gX[1][gndx[i]](evalf(c[i])))):
if (itp > evalf(XStarList[i]) and itp < evalf(XStarList[i + 1])) then
ginv := gtemp[t](y):
break:
else
ginv := notfound:
fi:
od:
if (ginv = notfound) then
print(`ERROR, GINVERSE not found`):
fi:
fi:
# For the case of an increasing transformation segment, add the change.
if (evalf(limit(gX[1][gndx[i]](xx), xx = XStarList[i], right))
< evalf(limit(gX[1][gndx[i]](xx), xx = XStarList[i + 1], left))) then
# print(`increasing transformation segment`):
h := h + fXc[1][FF[i]](ginv) * diff(ginv, y):
# For the case of a decreasing transformation segment, subtract the change.
else
h := h - fXc[1][FF[i]](ginv) * diff(ginv, y):
# print(`decreasing transformation segment`):
fi:
# print(`h is`, h):
fi:
od:
ffY := [op(ffY), op([unapply(simplify(h), y)])]:
od:
RETURN([ffY, [op(YStarList)], ["Continuous", "PDF"]]):
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: transformdiscrete1.map
#
# Procedure Name: TransformDiscrete(X, gX)
#
# Other APPL Procedures Called:
#
# Date: June 7, 2001
#
# Purpose: TransformDiscrete finds the PDF of Y = g(X), where X and Y
# are discrete random variables. The arguments are X, a
# discrete random variable, and g(X), the transformation.
#
# Arguments: X, gX
#
# Algorithm:
#
TransformDiscrete := proc(X, gX)
local fX, formulaic, lo, hi, incr, transf, N, nx, XStarSet, ng, i,
XStarList, n, gndx, j, gx, pdfsupp, sortedf, fY, ysupp, k, nz, c,
BEGIN, END, mn, Mx, a, b, YStarSet, YStarList, m, h, temp, ntmp,
gtemp, t, ii, ginv, itp:
# Convert X to its PDF representation
fX := PDF(X):
# Convert fX to its standard APPL discrete list-of-sublists format
fX := Convert(fX):
if (fX = false) then
print(`ERROR(Transform): Discrete RV X is NOT in legal APPL form`):
return:
fi:
# fX has a standard discrete Dot format
if type(fX[2][1], range) then
formulaic := true:
lo := lhs(fX[2][1]):
hi := rhs(fX[2][1]):
XStarSet := {lo, hi}:
incr := fX[2][2]:
transf := fX[2][3]:
if type(hi, symbol) then
if not(evalb(hi = infinity)) then
print(`ERROR(Transform): RV's support must be numeric`):
return:
fi:
if type(lo, symbol) or evalb(lo = -infinity) then
print(`ERROR(Transform): RV's lower support must be`):
print(`a finite numerical value.`):
return:
fi:
fi:
else
# print(`NoDot format`):
N := nops(fX[2]):
lo := fX[2][1]:
hi := fX[2][N]:
XStarSet := {op(fX[2])}:
formulaic := false:
fi:
ng := nops(gX[2]):
# print(ng):
# print(`fX is`, fX):
# ASSUME (FOR NOW) THAT ALL DISCRETE PDFs ARE IN ONE PIECE
# FF := array(1 .. n):
# Find the appropriate index k of fX[1][k] for each x interval.
# for i from 1 to n do
# for k from 1 to nx do
# if (evalf(XStarList[i]) >= evalf(fX[2][k])) then
# FF[i] := k:
# fi:
# od:
# od:
# fX is in the standard discrete NoDot format
if not(formulaic) then
# print(`made it`):
for i from 1 to ng do
# print(`made it inside for loop -- what's happening`):
# print(gX[2][i]):
# print(fX[2][1]):
# print(fX[2][N]):
if (evalf(gX[2][i]) > evalf(fX[2][1]) and
evalf(gX[2][i]) < evalf(fX[2][N])) then
XStarSet := XStarSet union {gX[2][i]}:
fi:
od:
# print(`made it`):
XStarList := sort([op(XStarSet)], (x, y) -> evalb(evalf(x) <
evalf(y))):
# print(`where's the problem?`):
XStarList := ReduceList(XStarList):
n := nops(XStarList):
# print(`XStartList is`, XStarList):
ng := nops(gX[1]):
gndx := array(1 .. n):
# Find the appropriate transformation function for each support value
# of the PDF
for i from 1 to n do
for j from 1 to ng do
if (evalf(XStarList[i]) > evalf(gX[2][j]) and
evalf(XStarList[i]) <= evalf(gX[2][j + 1])) then
gndx[i] := j:
break:
fi:
od:
od:
# print(`gndx is`, gndx):
gx := []:
for i from 1 to ng do
gx := [op(gx), unapply(gX[1][i](x))(x)]:
od:
# print(`gx is`, gx):
# Substitute each support value into the correct transformation
# function (as determined above)
# print(`fX before transforming`, fX):
pdfsupp := array(1 .. N):
for i from 1 to N do
pdfsupp[i] := simplify(subs(x = fX[2][i], gx[gndx[i]])):
# fX[2][i] := simplify(subs(x = fX[2][i], gx[gndx[i]])):
od:
# print(`pdfsupp after transforming`, pdfsupp):
fX[2] := convert(pdfsupp, list):
sortedf := InsertionSort(fX[2], fX[1]):
# print(`sorted f is`, sortedf):
fX[2] := sortedf[1]:
fX[1] := sortedf[2]:
# print(`fx[1] is`, fX[1]):
# print(`fx[2] is`, fX[2]):
# Build final transform support (fY) and final transform probability
# values (ysupp)--initialize them to contain all zeroes
fY := array(sparse, 1 .. N, sparse, []):
ysupp := array(sparse, 1 .. N, sparse, []):
# Remove redundancies from transform support list. Place the first
# transform support and probability values in the first position in the
# fY and ysupp arrays
ysupp[1] := fX[2][1]:
fY[1] := fX[1][1]:
k := 2:
j := 1:
while (k <= N) do
if evalf(fX[2][k]) <> evalf(fX[2][k - 1]) then
j := j + 1:
ysupp[j] := fX[2][k]:
fi:
fY[j] := fY[j] + fX[1][k]:
k := k + 1:
od:
# print(ysupp): # print(fY):
#
# Remove extraneous zeros from fY and ysupp. We know the zeros (if any)
# at the end of the fY array are not probability values. They exist
# because of the identical values in fX[2]. Use fY to determine how
# many extraneous zeros exist, and reconstruct ysupp and fY so the extra
# zeros are not included as part of the arrays.
#
nz := 0:
for i from N by -1 to 1 while fY[i] = 0 do
nz := nz + 1:
od:
ysupp := array(1 .. N - nz, [seq(ysupp[i], i = 1 .. N - nz)]):
fY := array(1 .. N - nz, [seq(fY[i], i = 1 .. N - nz)]):
ysupp := convert(ysupp, list):
fY := convert(fY, list):
# print(ysupp): # print(fY):
# fX is in the standard discrete Dot format
else
# For $Dot$ case, c not
# needed for *every* subinterval
# ... check the endpoints -- think about this after
# finding g or ginv (?)
# print(`lo is`, lo):
# print(`hi is`, hi):
# print(`incr is`, incr):
# print(`transf is`, transf):
# APPL can only transform this discrete random variable if transf is
# x -> x and incr is 1
if is(unapply(transf(x))(x) = x) and is(incr = 1) then
fY := []:
for i from 1 to ng do
if (evalf(gX[2][i]) > evalf(lo) and
evalf(gX[2][i]) < evalf(hi)) then
XStarSet := XStarSet union {gX[2][i]}
fi:
od:
XStarList := sort([op(XStarSet)], (x, y) -> evalb(evalf(x) <
evalf(y))):
XStarList := ReduceList(XStarList):
n := nops(XStarList) - 1:
# print(`XStartList is`, XStarList):
# Determining c to use later to check for the appropriate inverse
c := array(1 .. n):
if (XStarList[1] = -infinity and XStarList[2] = infinity) then
c[1] := 0
else
BEGIN := 1:
END := n:
if (XStarList[1] = -infinity) then
c[1] := XStarList[2] - 1:
BEGIN := 2:
fi:
if (XStarList[n + 1] = infinity) then
c[n] := XStarList[n] + 1:
END := n - 1:
fi:
for i from BEGIN to END do
c[i] := (XStarList[i] + XStarList[i + 1]) / 2:
od:
fi:
# print(`c is`, c):
ng := nops(gX[1]):
gndx := array(1 .. n):
# Find the appropriate transformation function for each support
# value of the PDF
for i from 1 to n do
for j from 1 to ng do
if (evalf(XStarList[i]) >= evalf(gX[2][j]) and
evalf(XStarList[i]) < evalf(gX[2][j + 1])) then
gndx[i] := j:
break:
fi:
od:
od:
# print(`gndx is`, gndx):
gx := []:
for i from 1 to ng do
gx := [op(gx), unapply(gX[1][i](x))(x)]:
od:
# print(`gx is`, gx):
ysupp := []:
for i from 1 to n do
ysupp := [op(ysupp), XStarList[i] .. XStarList[i + 1],
unapply(gx[gndx[i]], x)]:
od:
mn := array(1 .. n):
Mx := array(1 .. n):
for i from 1 to n do
a := limit(gX[1][gndx[i]](x), x = XStarList[i], right):
b := limit(gX[1][gndx[i]](x), x = XStarList[i + 1], left):
mn[i] := min(a, b):
Mx[i] := max(a, b):
od:
# print(mn):
# print(Mx):
YStarSet := {seq(mn[i], i = 1 .. n), seq(Mx[i], i = 1 .. n)}:
YStarList := sort([op(YStarSet)], (x, y) -> evalb(evalf(x) <
evalf(y))):
YStarList := ReduceList(YStarList):
m := nops(YStarList) - 1:
# print(`Let's see if YStar list helps us`):
# print(`YStarList is`, YStarList):
# print(`m is`, m):
for j from 1 to m do
h := 0:
# assume(y, real):
# print(`n is`, n):
for i from 1 to n do
# If we are working with a relevant transformation segment,
# adjust the pdf -- WHAT DOES THIS MEAN?
if (evalf(mn[i]) <= evalf(YStarList[j]) and
evalf(YStarList[j + 1]) <= evalf(Mx[i])) then
# print(`i is`, i):
# print(`j is`, j):
temp := [solve(gX[1][gndx[i]](t2) = y, t2)]:
temp := subs(y = x, temp):
# print(`temp is`, temp):
ntmp := nops(temp):
# print(`ntmp is`, ntmp):
gtemp := array(1 .. ntmp):
# print(`gtemp is`, gtemp):
for ii from 1 to ntmp do
gtemp[ii] := unapply(temp[ii], x):
od:
# print(`gtemp is`, gtemp):
# If there is only one inverse, assign it to ginv.
if (ntmp = 1) then
ginv := gtemp[1](x):
# print(`only one inverse`):
# print(`ginv is`, ginv):
# If there is more than one inverse, find the appropriate
# one.
else
for t from 1 to ntmp do
# Evaluate each inverse of the transformation at the
# midpoint of the subinterval. Set ginv to that inverse
# for which gtemp(g(c)) = c.
itp := evalf(gtemp[t](gX[1][gndx[i]](evalf(c[i])))):
if (itp > evalf(XStarList[i]) and
itp < evalf(XStarList[i + 1])) then
ginv := gtemp[t](x):
break:
else
ginv := notfound:
fi:
od:
if (ginv = notfound) then
print(`ERROR, GINVERSE not found`):
fi:
fi:
# print(`ginv is`, ginv):
# print(fX[1](ginv)):
# ffY := unapply(op(fX[1](ginv)), y):
# print(ffY):
# For the case of an increasing transformation segment, add
# the change. (FREUND, page 245)
# if (evalf(limit(gX[1][gndx[i]](xx), xx = XStarList[i], right))
# < evalf(limit(gX[1][gndx[i]](xx), xx = XStarList[i + 1],
# left))) then
# print(`increasing transformation segment`):
# h := h + fX[1](ginv) * diff(ginv, y):
# For the case of a decreasing transformation segment,
# subtract the change. (FREUND, page 245)
# else
# print(`decreasing transformation segment`):
# h := h - fX[1](ginv) * diff(ginv, y):
# fi:
# print(`h is`, h):
fi:
fY := [op(fY), unapply(op(fX[1](ginv)), x)]:
od:
od:
# print(`fY is`, fY):
# If transf is not x -> x or incr is not 1, then APPL cannot do this
# type of problem at this time
else
print(`ERROR(Transform): APPL is unable to perform the`):
print(`transformation on this type of RV at this time`):
return:
fi:
fi:
return([fY, ysupp, ["Discrete", "PDF"]]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: truncate13.map
#
# Procedure Name: Truncate(X, a, b)
#
# Other APPL Procedures Called: PDF, CDF
#
# Date: March 16, 1999
#
# Purpose: Truncates a random variable X on the left by a and on the
# right by b.
#
# Arguments: X: Random Variable
# a, b: Truncation Points
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 lists format
# 3. Convert X to PDF form if not already in that form
# 4. Check that the truncation pts are numeric
# 5. Check that the RV supports are numeric
# 6. Check that lower truncation pt 'a' is less than upper
# truncation pt 'b'
# 7. Check that lower truncation pt 'a' is less than upper
# support of RV X
# 8. If 'a' is less than the min value of support, reset
# lower truncation pt 'a' to minimum value of support
# 9. If 'b' is greater than the max value of support, reset
# upper truncation pt 'b' to maximum value of support
# 10. Find out which segments of the PDF contain the
# truncation pts a and b
# 11. Compute CDF(b) - CDF(a)
# 12. Check for CDF(b) - CDF(a)= 0: if so, treat as a
# special case
# 13. Compute and return the truncated RV's support list
# 14. Compute and return the truncated PDF in the list of
# 3 lists format
#
Truncate := proc(X :: list(list), a :: {numeric, infinity},
b :: {numeric, infinity})
local NumLists, fX, nsegments, beginseg, Digittemp, endingseg,
i, low, high, FXlow, FXhigh, area, newnsegments, newsuppset,
newsupplist, piecefX, fXnew:
#
# Check for the appropriate number of arguments
#
if (nargs <> 3) then
print(`ERROR(Truncate): This procedure requires 3 arguments:`):
print(`A random variable, lower truncation pt, and upper truncation pt`):
RETURN():
fi:
#
# Check that the RV X is in a list-of-lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(Truncate): The RV X must be in a list of 3 lists format`):
RETURN():
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif ((X[3][2] = "CDF") or
(X[3][2] = "CHF") or
(X[3][2] = "HF") or
(X[3][2] = "IDF") or
(X[3][2] = "SF")) then
fX := PDF(X):
else
print(`ERROR(Truncate): RV must be given as`):
print(`CDF, CHF, HF, IDF, PDF, or SF`):
RETURN():
fi:
#
# Check that the truncation pts are numeric
#
if ((type(a, symbol) and not(type(a, infinity))) or
(type(b, symbol) and not(type(b, infinity)))) then
print(`ERROR(Truncate): Must specify numeric values for the truncation pts`):
RETURN():
fi:
#
# Check that the RV supports are numeric
#
nsegments := nops(fX[1]):
beginseg := 1:
endingseg := nsegments:
for i from beginseg to (endingseg + 1) do
if (type(evalf(fX[2][i]), symbol) and not(type(evalf(fX[2][i]), infinity))) then
print(`ERROR(Truncate): Must specify numeric values for supports of RV X`):
RETURN():
fi:
od:
#
# Check that lower truncation pt 'a' is less than upper truncation pt 'b'
#
if (evalf(b) <= evalf(a)) then
print(`ERROR(Truncate): Illegal truncation points`):
print(`Lower truncation pt a must be less than upper truncation pt b`):
RETURN():
fi:
#
# Check that lower truncation pt 'a' is less than upper support of RV X
#
if (evalf(a) >= evalf(fX[2][nsegments + 1])) then
print(`ERROR(Truncate): Illegal truncation points`):
print(`Lower truncation pt a must be less than upper support of RV X`):
RETURN():
fi:
#
# If 'a' is less than the min value of support, reset lower
# truncation pt 'a' to minimum value of support
#
low := a:
high := b:
if (evalf(low) < evalf(fX[2][1])) then
print(`WARNING(Truncate): Lower truncation pt less than lower support of RV`):
print(`Resetting lower truncation point to minimum value of support`):
low := fX[2][1]:
fi:
#
# If 'b' is greater than the max value of support, reset upper
# truncation pt 'b' to maximum value of support
#
if (evalf(high) > evalf(fX[2][nsegments + 1])) then
print(`WARNING(Truncate): Upper trunc pt greater than upper support of RV`):
print(`Resetting upper truncation point to maximum value of support`):
high := fX[2][nsegments + 1]:
fi:
#
# Find out which segments of the PDF contain the truncation pts a and b
#
for i from 1 to nsegments do
if ((evalf(low) >= evalf(fX[2][i])) and (evalf(low) < evalf(fX[2][i + 1]))) then
beginseg := i:
break:
fi:
od:
for i from 1 to nsegments do
if ((evalf(high) > evalf(fX[2][i])) and (evalf(high) <= evalf(fX[2][i + 1])))
then
endingseg := i:
break:
fi:
od:
#
# Compute CDF(b) - CDF(a)
#
#print(`digits are currently`, Digits);
Digittemp:=Digits;
Digits:=40;
#print(`digits are changed to`,Digits);
FXlow := CDF(fX, low):
FXhigh := CDF(fX, high):
area := simplify(FXhigh - FXlow):
#
# Check for CDF(b) - CDF(a)= 0: if so, treat as a special case
#
if is(area = 0) then
if is(beginseg = endingseg) then
print(`ERROR(Truncate): The pdf on this truncated interval is 0`):
print(`Truncation points `, low, ` and `, high, ` do not work`):
RETURN():
else
area := FXlow:
fi:
fi:
Digits:=Digittemp;
#print(`Digits are now`, Digits);
#
# Compute the truncated RV's support list; newsuppset was added to truncate13.map
# because Maple "sort" command does NOT order a list with infinity in it properly
# Ex. > sort([-3, 2, -10, 1/2, infinity, 2.5])
# yields --> [infinity, -10, 2, -3, 2.5, 1/2];
# > sort([-3, 2, -10, 1/2, 2.5]) yields --> [-10, -3, 1/2, 2, 2.5]
# Also, "sort" works with lists, not sets; but "minus" works on sets
#
newnsegments := endingseg - beginseg + 1:
newsuppset := {low, high}:
for i from beginseg to (endingseg - 1) do
newsuppset := {op(newsuppset), fX[2][i + 1]}:
od:
if member(infinity, newsuppset) then
newsuppset := newsuppset minus {infinity}:
newsupplist := [op(sort([op(newsuppset)])), infinity]:
else
newsupplist := sort([op(newsuppset)]):
fi:
#
# Compute and return the truncated PDF in the list of 3 lists format
#
fXnew[1] := []:
for i from beginseg to endingseg do
piecefX := unapply(simplify(fX[1][i](x) / area), x):
fXnew[1] := [op(fXnew[1]), op([unapply(piecefX(x), x)])]:
od:
# fXnew[2] := [low, high]:
fXnew[3] := ["Continuous", "PDF"]:
RETURN([[op(fXnew[1])], newsupplist, fXnew[3]]):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: uniformvariate1.map
#
# Procedure name: UniformVariate()
#
# Other APPL Procedures Called: None
#
# Date Revised: August 29, 1999
#
# Purpose: UniformVariate generates a standard uniform variate
#
# Arguments: None
#
# Note: With no arguments, the call rand() returns a 12 digit non-negative random
# integer.
#
UniformVariate := proc()
local Variate:
Variate := evalf(rand()/10 ^ 12):
RETURN(Variate):
end:
#11111111112222222222333333333344444444445555555555666666666677777777778888888888#
# Filename: valid2.map
#
# NOTES:
# Discrete Cases:
# (I) dotdot cases
# (a) incremented by 1
# (b) transformed by g(x)
# (i) incremented by k
# (ii) incremented by 1
# (c) incremented by k
# (II) no dotdot cases
# (a) arrow case
# (b) no arrow case
#
# standard "dotdot" support format:
# [anything .. anything, incremented by k, transformed by g(x)]
#
# standard "no dotdot" pdf and support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
# Example: [0.1, 0.3, 0.2, 0.4], [1, 4, 11, 34/3]
#
# Procedure name: Valid(X)
# can strictly be used in calls by other procedures for valid pdf checks --
# just to send back true or false
#
# Date: June 8, 1999
#
# Purpose: This procedure is called by other APPL procedures to determine the
# "validity" of a given random variable and its APPL format. More
# specifically, it checks that the:
# (a) appropriate number of arguments is given
# (b) RV X is in the list of 3 lists format
# (c) pdf of X sums to 1 and pdf values are nonnegative for discrete RV's
# (d) discrete support values for the pdf of X are valid
# (e) area under the pdf of X is 1 for continuous RV's
#
# Argument: The random variable of interest X in the list-of-lists format:
# [[f(x)], [support], ["Continuous" or "Discrete", "XXX"]],
# where XXX is CDF, CHF, HF, IDF, PDF, or SF
#
# Algorithm
# 1. Check that the RV X is in the list of 3 lists format
# 2. Convert X to PDF form if not already in that form
# 3. Check to see whether the RV X is continuous or discrete
# 4. If the RV X is continuous, calculate the integral(f(x)dx) from 0 to +inf
# and the integral(abs(f(x))dx) from 0 to +inf. If int(f(x)) = 1 and
# int(abs(f(x))) = 1, then f(x) >= 0. Otherwise, f(x) is negative for some
# value x in its support and is NOT a valid pdf
# 5. If the RV X is discrete, determine if it is in the "dotdot" case. In
# probproc.map, dotdot is a defined structure type for discrete RV's:
# `type/dotdot` := {constant .. constant, symbol .. constant, constant ..
# symbol, symbol .. symbol}:
# 6. If X is in the "dotdot" case, then first convert the support of X to the
# standard "dotdot" form:
# [anything .. anything, incremented by k, transformed by g(x)]
# 7. Transform the pdf f(x) by g(x)
# 8. Check that transformed pdf is >= 0 for all x in its support
# 9. Check that the transformed pdf sums to 1 over its support
# 10. If X is in the "no dotdot" case, convert the support of X to the
# standard "no dotdot" form: [[fraction1, fraction2, fraction3, ... ,
# fractionN], [a1, a2, a3, ... , aN], ["Discrete", "PDF"]]
# 11. Check that f(x) >= 0 for all x in its support
# 12. Sum f(x) over all x in its support
# 13. If X is continuous and the area under its pdf is is 1, then report to the
# user that X is a valid RV. Similarly, if X is discrete and its pdf is
# nonnegative for all values in its support and sums to 1 over its support,
# then also report to the user that X is a valid RV.
#
Valid := proc(X :: list(list))
local NumLists, fX, area, AbsArea, fXsum, nsegments, i, SubList1, SubList2, IllPDF,
Support, Lo, Hi, ExtendedSubList2, m, IncrBy, Transformation,
TransfPDF, PDFValues, n, IllSupp:
#
# Check that the RV X is in the list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR: The RV X must be in a list of 3 lists format`):
RETURN(false):
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif ((X[3][2] = "CDF") or
(X[3][2] = "CHF") or
(X[3][2] = "HF") or
(X[3][2] = "IDF") or
(X[3][2] = "SF")) then
fX := PDF(X):
else
print(`ERROR: RV must be given as`):
print(`CDF, CHF, HF, IDF, PDF, or SF`):
RETURN():
fi:
#
# Check to see whether the random variable X is continuous; if it is, find the
# area under the pdf f(x) and abs(f(x)) over its support
#
area := 0:
AbsArea := 0:
fXsum := 0:
if (fX[3][1] = "Continuous") then
nsegments := nops(X[1]):
for i from 1 to nsegments do
area := area + evalf(int(fX[1][i](x), x = fX[2][i] .. fX[2][i + 1])):
AbsArea := AbsArea + evalf(int(abs(fX[1][i](x)), x = fX[2][i]..fX[2][i + 1])):
od:
#
# If int(f(x)) = 1 and int(abs(f(x))) = 1, then f(x) >= 0. Otherwise, f(x) is
# negative for some value x in its support and is NOT a valid pdf
#
if (AbsArea > 0.9999999 and AbsArea < 1.0000001) then
print(`The area under f(x) is: `, area):
else
print(`ERROR(NewVerifyPDF): f(x) is negative for some value x in its support`):
print(`The pdf of the given random variable is NOT valid`):
RETURN():
fi:
#
# Check to see whether the random variable X is discrete
#
elif (fX[3][1] = "Discrete") then
SubList1 := fX[1]:
SubList2 := fX[2]:
IllPDF := false:
#
# If the random variable X is in the discrete "dotdot" case, first call procedure
# Convert(X) to convert its support to the *standard dotdot* support format:
# [anything .. anything, incremented by k, transformed by g(x)]
#
if type(SubList2[1], dotdot) then
fX := Convert(fX):
if (fX = false) then
print(`ERROR: Discrete RV X is NOT in a legal APPL form`):
RETURN(false):
fi:
SubList2 := fX[2]:
Support := SubList2[1]:
Lo := lhs(Support):
Hi := rhs(Support):
IncrBy := SubList2[-2]:
#
# Transform the pdf f(x) by g(x)
#
Transformation := unapply(SubList2[-1](x))(x):
TransfPDF := subs(x = Transformation, unapply(SubList1(x))(x)):
#
# Check that transformed pdf is >= 0 for all x in its support
#
if (not(type(Lo, symbol)) and not(type(Hi, symbol))) then
i := Lo:
while (i <> Hi) do
if (type(subs(x = i, op(TransfPDF)), negative)) then
IllPDF := true:
break:
fi:
i := i + IncrBy:
od:
fi:
#
# Sum the transformed pdf over all x in its support
# Deal w/ support [a .. b, 1, x -> x] as a special case
#
if not(IllPDF) then
if ((IncrBy = 1) and (ispoly(Transformation, linear, x, 'a0', 'a1')) and
(a0 = 0) and (a1 = 1)) then
fXsum := simplify(evalf(sum(op(SubList1(x)), x = Lo .. Hi))):
else
for i from Lo by IncrBy to Hi do
PDFValues := subs(x = i, op(TransfPDF)):
fXsum := simplify(fXsum + PDFValues):
od:
fi:
else
print(`ERROR: PDF values must be positive`):
RETURN(false):
fi:
#
# If the random variable X is in the discrete "no dotdot" case, first call
# procedure Convert(X) to convert its support to the *standard no dotdot*
# pdf/support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
#
else
fX := Convert(fX):
if (fX = false) then
print(`ERROR: Discrete RV X is NOT in a legal APPL form`):
RETURN(false):
fi:
SubList1 := fX[1]:
#
# Check that f(x) >= 0 for all x in its support
#
n := nops(SubList2):
for i from 1 to n do
if (type(SubList1[i], negative)) then
IllPDF := true:
break:
fi:
od:
#
# Sum f(x) over all x in its support
#
if not(IllPDF) then
fXsum := add(SubList1[i], i = 1 .. n):
else
print(`ERROR: PDF values must be positive`):
RETURN(false):
fi:
fi:
#
# ERROR: RV is neither continuous or discrete
#
else
print(`ERROR: Procedure requires continuous or discrete RV`):
RETURN():
fi:
#
# If X is continuous and the area under its pdf is is 1, then report to the user
# that X is a valid RV. Similarly, if X is discrete and its pdf is nonnegative
# for all values in its support and sums to 1 over its support, then also report
# to the user that X is a valid RV
#
if ((area > 0.9999999 and area < 1.0000001) or
(fXsum > 0.9999999 and fXsum < 1.0000001)) then
RETURN(true):
else
RETURN(false):
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: variance1.map
#
# Procedure Name: Variance(X)
#
# Other APPL Procedures Called: PDF, Mean, ExpectedValue
#
# Date: April 14, 1999
#
# Purpose: Returns the variance of a distribution.
#
# Arguments: X: Random Variable
#
# Algorithm:
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in a list-of-lists format
# 3. Convert X to PDF form if not already in that form
# 4. Compute and return the Variance of the RV X
#
# NOTE: Has NOT been updated since a discrete data structure has
# been developed ... will need to redo the discrete portion of
# the code
#
Variance := proc(X :: list(list))
local NumLists, fX, Mu, ExpValueXSqrd:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(Variance): This procedure requires 1 argument:`):
print(`A random variable`):
RETURN():
fi:
#
# Check that the RV X is in a list-of-lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(Variance): X must be in a list of 3 lists format`):
RETURN():
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif ((X[3][2] = "CDF") or
(X[3][2] = "CHF") or
(X[3][2] = "HF") or
(X[3][2] = "IDF") or
(X[3][2] = "SF")) then
fX := PDF(X):
else
print(`ERROR(Variance): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
Mu := Mean(fX):
ExpValueXSqrd := ExpectedValue(fX, x -> x^2):
RETURN(simplify(ExpValueXSqrd - Mu ^ 2)):
end:
#1111111111222222222233333333334444444444555555555566666666667777777777
# Filename: verify21.map
#
# NOTES:
# Discrete Cases:
# (I) dot cases
# (a) incremented by 1
# (b) transformed by g(x)
# (i) incremented by k
# (ii) incremented by 1
# (c) incremented by k
# (II) no dot cases
# (a) arrow case
# (b) no arrow case
#
# standard "dot" support format:
# [anything .. anything, incremented by k, transformed by g(x)]
#
# standard "no dot" pdf and support format:
# [frac1, frac2, frac3, ... , fracN], [a1, a2, a3, ... , aN]
# Example: [0.1, 0.3, 0.2, 0.4], [1, 4, 11, 34 / 3]
#
# Procedure name: VerifyPDF(X)
#
# Other APPL Procedures Called: PDF, Convert
#
# Date: August 27, 2000
#
# Purpose: For a continuous random variable X, verify that:
# (1) integral(f(x)dx) from 0 to +inf = 1, and
# (2) f(x) >= 0 for all x >= 0.
# * New Conjecture: If int(f(x)) = 1 and int(abs(f(x))) = 1, then
# f(x) >= 0
#
# For a discrete random variable X, verify that:
# (1) f(x) sums to 1 over its support, and
# (2) f(x) >= 0 for all x >= 0.
#
# Argument: The random variable of interest X in the list-of-sublists
# format:
# [[f(x)], [support], ["Continuous" or "Discrete", "XXX"]],
# where XXX is PDF, CDF, IDF, SF, HF, or CHF
#
# Algorithm
# 1. Check for the appropriate number of arguments
# 2. Check that the RV X is in the list of 3 sublists format
# 3. Convert X to PDF form if not already in that form
# 4. Check to see whether the RV X is continuous or discrete
# 5. If the RV X is continuous, calculate the integral(f(x)dx) from
# 0 to +inf and the integral(abs(f(x))dx) from 0 to +inf. If
# int(f(x)) = 1 and int(abs(f(x))) = 1, then f(x) >= 0.
# Otherwise, f(x) is negative for some value x in its support
# and is NOT a valid pdf
# 6. If the RV X is discrete, determine if it is in the "dot" or
# "no dot" case. In startup.map, dot is a defined structure
# type for discrete random variables:
# `type/dot` := {constant .. constant, symbol .. constant,
# constant .. symbol, symbol .. symbol}:
# 7. Convert the support of X to its standard "dot" or "no dot"
# form:
# (a) standard "dot" form:
# [anything .. anything, incremented by k, transformed by g(x)]
# (b) standarc "no dot" form:
# [[fraction1, fraction2, fraction3, ... , fractionN],
# [a1, a2, a3, ... , aN], ["Discrete", "PDF"]]
# 8. If X has the "dot" form, transform the pdf f(x) by g(x) if
# f(x)'s support is NOT of the form:
# [a .. b, 1, x -> x]
# 9. Check that transformed pdf is >= 0 for all x in its support
# 10. Check that the transformed pdf sums to 1 over its support
# 11. If X is in the "no dot" case, check that f(x) >= 0 for all x
# in its support
# 12. Sum f(x) over all x in its support
# 13. If X is continuous and the area under its PDF is is 1, then
# report to the user that X is a valid RV. Similarly, if X is
# discrete and its PDF is nonnegative for all values in its
# support and sums to 1 over its support, then also report to
# the user that X is a valid RV.
#
VerifyPDF := proc(X :: list(list))
local NumLists, fX, area, AbsArea, fXsum, nsegments, numericcheck, i,
SubList1, SubList2, Support, Lo, Hi, IncrBy, Transformation,
TransfPDF, PDFVal, n:
#
# Check for the appropriate number of arguments
#
if (nargs <> 1) then
print(`ERROR(VerifyPDF): This procedure requires 1 argument:`):
print(`A random variable`):
RETURN():
fi:
#
# Check that the RV X is in the list of 3 lists format
#
NumLists := nops(X):
if (NumLists <> 3) then
print(`ERROR(VerifyPDF): The RV X must be a list of 3 sublists`):
RETURN():
fi:
#
# Convert X to PDF form if not already in that form
#
if (X[3][2] = "PDF") then
fX := X:
elif member(X[3][2], {"CDF", "SF", "HF", "CHF", "IDF"}) then
fX := PDF(X):
else
print(`ERROR(VerifyPDF): RV must be given as`):
print(`PDF, CDF, SF, HF, CHF, or IDF`):
RETURN():
fi:
#
# Check to see whether the random variable X is continuous
#
area := 0:
AbsArea := 0:
fXsum := 0:
if (fX[3][1] = "Continuous") then
nsegments := nops(X[1]):
# numericcheck := Mean(X):
# print(`Mean is`, numericcheck):
# print(whattype(numericcheck)):
# print(fX[1]):
# if type(numericheck, function) then
# print(`mean is a function`):
for i from 1 to nsegments do
area := area + evalf(int(fX[1][i](y), y = fX[2][i] ..
fX[2][i + 1])):
print(`area is`, area):
AbsArea := AbsArea + int(abs(fX[1][i](x)), x = fX[2][i] ..
fX[2][i + 1]):
od:
# elif not(type(evalf(numericcheck), numeric)) then
# print(`not numeric mean`):
# for i from 1 to nsegments do
# area := area + evalf(int(fX[1][i](y),
# y = fX[2][i] .. fX[2][i + 1])):
# od:
# area := simplify(area):
# AbsArea := 1:
#else
# print(`nonnumeric mean`):
# for i from 1 to nsegments do
# area := area + evalf(int(fX[1][i](y), y = fX[2][i] ..
# fX[2][i + 1])):
# print(`area is`, area):
# AbsArea := AbsArea + evalf(int(abs(fX[1][i](x)), x = fX[2][i] ..
# fX[2][i + 1])):
# od:
#fi:
#
# If int(f(x)) = 1 and int(abs(f(x))) = 1, then f(x) >= 0. Otherwise,
# f(x) is negative for some value x in its support and is NOT a valid
# PDF
#
# SHOULDN'T BE RETURNING ERROR MESSAGES ... JUST STATEMENTS!
print(`The area under f(x) is: `, area): print(`now checking for Absolute value.`);
if (evalf(area) > 0.9999999 and evalf(area) < 1.0000001) then
if (AbsArea < 0.9999999 or AbsArea > 1.0000001) then
print(`ERROR(VerifyPDF): The PDF of the given random variable`):
print(`is NOT valid because f(x) is negative for some value x`):
print(`in its support`):
RETURN():
fi:
# situation where area = -1 and absarea = 1
elif evalf(area) < 0.9999999 or evalf(area) > 1.0000001 then
if (AbsArea > 0.9999999 and AbsArea < 1.0000001) then
print(`ERROR(VerifyPDF): The PDF of the given random variable`):
print(`is NOT valid because f(x) is negative for some value x`):
print(`in its support`):
RETURN():
fi:
fi:
print(`The area under f(x) is: `, area):
print(`f(x) is nonnegative`):
#
# Check to see whether the random variable X is discrete
#
elif (fX[3][1] = "Discrete") then
fX := Convert(fX):
if (fX = false) then
print(`ERROR(VerifyPDF): Discrete random variable X is`):
print(`NOT in a legal APPL form`):
RETURN():
fi:
SubList1 := fX[1]:
SubList2 := fX[2]:
#
# Check to see whether the random variable X is in the discrete "dot"
# case
#
if type(SubList2[1], dot) then
Support := SubList2[1]:
Lo := lhs(Support):
Hi := rhs(Support):
IncrBy := SubList2[-2]:
Transformation := unapply(SubList2[-1](x))(x):
TransfPDF := subs(x = Transformation, unapply(SubList1(x))(x)):
#
# Check that transformed pdf is >= 0 for all x in its support
#
if (not(type(Lo, symbol)) and not(type(Hi, symbol))) then
i := Lo:
while (i <> Hi) do
if (type(subs(x = i, op(TransfPDF)), negative)) then
print(`ERROR(VerifyPDF): PDF values must be positive`):
RETURN():
fi:
i := i + IncrBy:
od:
fi:
#
# Sum the transformed pdf over all x in its support
# Deal w/ support [a .. b, 1, x -> x] as a special case
#
if (IncrBy = 1) and ispoly(Transformation, linear, x, 'a0', 'a1')
and (a0 = 0) and (a1 = 1) then
# June 1, 2000: Took out: and type(Lo, integer) and type(Hi, integer))
# PROBLEM ... fXsum only computes correctly if Lo and Hi are integers
# See example C3a_N1 in VerAug2000 (needed further conditions in above
# if statement -- added type(Lo, integer) and type(Hi, integer)
fXsum := simplify(evalf(sum(op(SubList1(x)), x = Lo .. Hi))):
else
print(`incrby is`, IncrBy):
for i from Lo by IncrBy to Hi do
PDFVal := subs(x = i, op(TransfPDF)):
# print(`PDFVal is`, PDFVal):
# PDFValues := simplify(subs(x = vals, op(SubList1(x)))):
# fXsum := simplify(fXsum + PDFValues):
fXsum := simplify(fXsum + PDFVal):
# print(`fxsum is`, fXsum):
od:
fi:
#
# The random variable X is in the discrete "no dot" case
#
else
#
# Check that f(x) >= 0 for all x in its support
#
n := nops(SubList2):
for i from 1 to n do
if (type(SubList1[i], negative)) then
print(`ERROR(VerifyPDF): PDF values must be positive`):
RETURN():
fi:
od:
#
# Check that symbols or infinity are not support values
#
for i from 1 to n do
if (type(SubList2[i], symbol)) then
print(`ERROR(VerifyPDF): PDF values must be numeric`):
RETURN():
fi:
od:
#
# Sum f(x) over all x in its support
#
fXsum := add(SubList1[i], i = 1 .. n):
fi:
print(`The PDF sums to: `, fXsum):
#
# ERROR: RV is neither continuous or discrete
#
else
print(`ERROR(VerifyPDF): Procedure requires a`):
print(`Continuous or Discrete RV`):
RETURN():
fi:
#
# If X is continuous and the area under its PDF is is 1 and f(x) >= 0
# for all x in its support, then report to the user that X is a valid
# RV. Similarly, if X is discrete and its PDF is nonnegative
# for all values in its support and sums to 1 over its support, then
# report to the user that X is a valid RV.
#
if ((area > 0.9999999 and area < 1.0000001) or
(fXsum > 0.9999999 and fXsum < 1.0000001)) then
print(`The PDF of the given random variable`, X):
print(`is valid`):
RETURN():
else
print(`The PDF of the given random variable is NOT valid`):
RETURN():
fi:
end:
#1111111111222222222233333333334444444444555555555566666666667777777777#
# Filename: weibullvariate1.map
#
# Procedure name: WeibullVariate(lambda, kappa, m)
#
# Other APPL Procedures Called: UniformVariate
#
# Date Revised: September 3, 1999
#
# Purpose: Given the parameters lambda and kappa for the Weibull distribution,
# WeibullVariate returns n Weibull variates and the mean and variance
# values of these variates
#
# Arguments: lambda: nonnegative shape parameter,
# kappa: nonnegative scale parameter, and
# m: integer indicating the number of Weibull variates to generate
#
WeibullVariate := proc(lambda :: nonneg, kappa :: nonneg, m :: integer)
local VariateList, i, U, NewVariate, Mean, Variance:
VariateList := []:
for i from 1 to n do
U := UniformVariate():
NewVariate := kappa * (log((1 - U) ^ (-1))) ^ (1 / lambda):
VariateList := [op(VariateList), NewVariate]:
od:
# print(`The`, n, ` Weibull variates are:`):
# print(VariateList):
Mean := sum(VariateList[j] , j = 1 .. n) / n:
Variance := sum((VariateList[j] - Mean) ^ 2, j = 1 .. 1000) / (n - 1):
print(`The mean of the Weibull variates is`, Mean):
print(`The variance of the Weibull variates is`, Variance):
end: