Nothing
expr2R <- function(fname) {
myexpr <- readLines(fname)
myexpr <- gsub("Log", "log", myexpr)
#### The following are no longer needed after changes in archmDer.m
#### to write expressions in separate lines.
# myexpr <- sub("List\\(", "", myexpr)
# myexpr <- sub("\\)$", "", myexpr)
# myexpr <- strsplit(myexpr, ",")[[1]]
## return
parse(text=myexpr, keep.source=FALSE)
}
getDExpr <- function(expr, name) {
## expr is a vector of expression
#### I was using sapply(expr, D, "u1), but somehow it returns a matrix
val <- rep(NA, length(expr))
for (i in 1:length(expr)) val[i] <- as.expression(D(expr[i], name))
val
}
## Note:
## 1) deriv(x, "s"): in fact pdf.expr doesn't contain "s"; just a trick to
## get the algorithmic expression for pdf, not its derivative
## 2) pdfDerWrtPar expression for frank cannot be obtained from Mathematica
## even for dim = 5. Recall the max dim for pdf expression for frank is 6.
## So I basically use D on pdf expressions and use deriv. Having something
## slow is better than having nothing.
expr2algr2dump <- function(cname) {
cdf.expr.name <- paste(cname, "Copula.cdf.expr", sep="")
cdfDerWrtArg <- paste(cname, "Copula.cdfDerWrtArg.expr", sep="")
cdfDerWrtPar <- paste(cname, "Copula.cdfDerWrtPar.expr", sep="")
cdf.algr.name <- sub("expr", "algr", cdf.expr.name)
cdfDerWrtArg.algr <- sub("expr", "algr", cdfDerWrtArg)
cdfDerWrtPar.algr <- sub("expr", "algr", cdfDerWrtPar)
pdf.expr.name <- paste(cname, "Copula.pdf.expr", sep="")
pdfDerWrtArg <- paste(cname, "Copula.pdfDerWrtArg.expr", sep="")
pdfDerWrtPar <- paste(cname, "Copula.pdfDerWrtPar.expr", sep="")
pdf.algr.name <- sub("expr", "algr", pdf.expr.name)
pdfDerWrtArg.algr <- sub("expr", "algr", pdfDerWrtArg)
pdfDerWrtPar.algr <- sub("expr", "algr", pdfDerWrtPar)
genfunDer.expr.name <- paste(cname, "Copula.genfunDer.expr", sep="")
genfunDer.algr.name <- sub("expr", "algr", genfunDer.expr.name)
assign(cdf.expr.name, cdf.expr <- expr2R(cdf.expr.name))
assign(cdf.algr.name, sapply(cdf.expr, function(x) deriv(x, "s")))
## assign(cdfDerWrtArg, myExpr <- expr2R(cdfDerWrtArg))
## assign(cdfDerWrtArg, myExpr <- as.expression(sapply(cdf.expr, D, "u1")))
assign(cdfDerWrtArg, myExpr <- getDExpr(cdf.expr, "u1"))
assign(cdfDerWrtArg.algr, sapply(myExpr, function(x) deriv(x, "s")))
## assign(cdfDerWrtPar, myExpr <- expr2R(cdfDerWrtPar))
## assign(cdfDerWrtPar, myExpr <- as.expression(sapply(cdf.expr, D, "alpha")))
assign(cdfDerWrtPar, myExpr <- getDExpr(cdf.expr, "alpha"))
assign(cdfDerWrtPar.algr, sapply(myExpr, function(x) deriv(x, "s")))
assign(pdf.expr.name, pdf.expr <- expr2R(pdf.expr.name))
assign(pdf.algr.name, sapply(pdf.expr, function(x) deriv(x, "s")))
## assign(pdfDerWrtArg, myExpr <- expr2R(pdfDerWrtArg))
## assign(pdfDerWrtArg, myExpr <- as.expression(sapply(pdf.expr, D, "u1")))
assign(pdfDerWrtArg, myExpr <- getDExpr(pdf.expr, "u1"))
assign(pdfDerWrtArg.algr, sapply(myExpr, function(x) deriv(x, "s")))
## assign(pdfDerWrtPar, myExpr <- expr2R(pdfDerWrtPar))
## assign(pdfDerWrtPar, myExpr <- as.expression(sapply(pdf.expr, D, "alpha")))
assign(pdfDerWrtPar, myExpr <- getDExpr(pdf.expr, "alpha"))
assign(pdfDerWrtPar.algr, sapply(myExpr, function(x) deriv(x, "s")))
assign(genfunDer.expr.name, genfunDer.expr <- expr2R(genfunDer.expr.name))
assign(genfunDer.algr.name, sapply(genfunDer.expr, function(x) deriv(x, "s")))
## dname <- paste("../../../R/", cname, "Expr.R", sep="")
dname <- paste("./", cname, "Expr.R", sep="")
cat("## This file is not to be edited. It is generated by ../inst/docs/mathnb/exprPrep.R\n", file = dname)
dump(c(cdf.expr.name, cdf.algr.name,
cdfDerWrtArg, cdfDerWrtArg.algr,
cdfDerWrtPar, cdfDerWrtPar.algr,
pdf.expr.name, pdf.algr.name,
pdfDerWrtArg, pdfDerWrtArg.algr,
pdfDerWrtPar, pdfDerWrtPar.algr,
genfunDer.expr.name, genfunDer.algr.name),
file = dname, append = TRUE)
}
## this is not working as expected:
## assign(pdf.algr.name, sapply(as.name(pdf.expr.name), function(x) deriv(x, "s")))
expr2algr2dump("clayton")
expr2algr2dump("gumbel")
expr2algr2dump("frank")
expr2algr2dump("amh")
#### Old code used before the change of archmDer.m
## galambosCopula.expr <- expr2R("galambos.expr")
## galambosCopula.algr <- sapply(galambosCopula.expr,
## function(x) deriv(x, "s"))
## names(galambosCopula.expr) <- names(galambosCopula.algr) <- c("cdf", "pdf", "deriv1cdf")
## dump(c("galambosCopula.expr", "galambosCopula.algr"),
## file="../../R/galambosExpr.R")
###################################################################
## For explicit copula, say, plackett
## Note: expressions are prefixed with 0 to cover nuissance dim = 1
###################################################################
algr2dump <- function(copula) {
cname <- class(copula)[1]
cname <- gsub("Copula", "", cname)
cdf.expr.name <- paste(cname, "Copula.cdf.expr", sep="")
cdfDerWrtArg <- paste(cname, "Copula.cdfDerWrtArg.expr", sep="")
cdfDerWrtPar <- paste(cname, "Copula.cdfDerWrtPar.expr", sep="")
cdf.algr.name <- sub("expr", "algr", cdf.expr.name)
cdfDerWrtArg.algr <- sub("expr", "algr", cdfDerWrtArg)
cdfDerWrtPar.algr <- sub("expr", "algr", cdfDerWrtPar)
pdf.expr.name <- paste(cname, "Copula.pdf.expr", sep="")
pdfDerWrtArg <- paste(cname, "Copula.pdfDerWrtArg.expr", sep="")
pdfDerWrtPar <- paste(cname, "Copula.pdfDerWrtPar.expr", sep="")
pdf.algr.name <- sub("expr", "algr", pdf.expr.name)
pdfDerWrtArg.algr <- sub("expr", "algr", pdfDerWrtArg)
pdfDerWrtPar.algr <- sub("expr", "algr", pdfDerWrtPar)
assign(cdf.expr.name, cdf.expr <- as.expression(c(0, copula@exprdist$cdf)))
assign(cdf.algr.name, sapply(cdf.expr, function(x) deriv(x, "s")))
## assign(cdfDerWrtArg, myExpr <- as.expression(sapply(cdf.expr, D, "u1")))
assign(cdfDerWrtArg, myExpr <- getDExpr(cdf.expr, "u1"))
assign(cdfDerWrtArg.algr, sapply(myExpr, function(x) deriv(x, "s")))
## assign(cdfDerWrtPar, myExpr <- as.expression(sapply(cdf.expr, D, "alpha")))
assign(cdfDerWrtPar, myExpr <- getDExpr(cdf.expr, "alpha"))
assign(cdfDerWrtPar.algr, sapply(myExpr, function(x) deriv(x, "s")))
assign(pdf.expr.name, pdf.expr <- as.expression(c(0, copula@exprdist$pdf)))
assign(pdf.algr.name, sapply(pdf.expr, function(x) deriv(x, "s")))
## assign(pdfDerWrtArg, myExpr <- as.expression(sapply(pdf.expr, D, "u1")))
assign(pdfDerWrtArg, myExpr <- getDExpr(pdf.expr, "u1"))
assign(pdfDerWrtArg.algr, sapply(myExpr, function(x) deriv(x, "s")))
## assign(pdfDerWrtPar, myExpr <- as.expression(sapply(pdf.expr, D, "alpha")))
assign(pdfDerWrtPar, myExpr <- getDExpr(pdf.expr, "alpha"))
assign(pdfDerWrtPar.algr, sapply(myExpr, function(x) deriv(x, "s")))
## dname <- paste("../../../R/", cname, "Expr.R", sep="")
dname <- paste("./", cname, "Expr.R", sep="")
cat("## This file is not to be edited. It is generated by ../inst/docs/mathnb/exprPrep.R\n", file = dname)
dump(c(cdf.expr.name, cdf.algr.name,
cdfDerWrtArg, cdfDerWrtArg.algr,
cdfDerWrtPar, cdfDerWrtPar.algr,
pdf.expr.name, pdf.algr.name,
pdfDerWrtArg, pdfDerWrtArg.algr,
pdfDerWrtPar, pdfDerWrtPar.algr
## genfunDer.expr.name, genfunDer.algr.name
),
file = dname, append = TRUE)
}
library(copula)
algr2dump(plackettCopula(1)) ## generates ../../../R/plackettExpr.R
algr2dump(galambosCopula(1)) ## generates ../../../R/galambosExpr.R
algr2dump(huslerReissCopula(1)) ## generates ../../../R/huslerReissExpr.R
algr2dump(tawnCopula(0)) ## generates ../../../R/tawnExpr.R
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.