
R version 2.8.1 (2008-12-22)
Copyright (C) 2008 The R Foundation for Statistical Computing
ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

  Natural language support but running in an English locale

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 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]]
+ 
+   myexpr <- c(parse(text=myexpr)) ## c is important!
+ #### The following no longer work because it adds an attribute
+ #### which stops the sourcing
+ #  myexpr <- parse(text=myexpr)
+   myexpr
+ }
> 
> 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")
Warning messages:
1: In readLines(fname) :
  incomplete final line found on 'claytonCopula.cdf.expr'
2: In readLines(fname) :
  incomplete final line found on 'claytonCopula.pdf.expr'
3: In readLines(fname) :
  incomplete final line found on 'claytonCopula.genfunDer.expr'
> expr2algr2dump("gumbel")
Warning messages:
1: In readLines(fname) :
  incomplete final line found on 'gumbelCopula.cdf.expr'
2: In readLines(fname) :
  incomplete final line found on 'gumbelCopula.pdf.expr'
3: In readLines(fname) :
  incomplete final line found on 'gumbelCopula.genfunDer.expr'
> expr2algr2dump("frank")
Warning messages:
1: In readLines(fname) :
  incomplete final line found on 'frankCopula.cdf.expr'
2: In readLines(fname) :
  incomplete final line found on 'frankCopula.pdf.expr'
3: In readLines(fname) :
  incomplete final line found on 'frankCopula.genfunDer.expr'
> expr2algr2dump("amh")
Warning messages:
1: In readLines(fname) :
  incomplete final line found on 'amhCopula.cdf.expr'
2: In readLines(fname) :
  incomplete final line found on 'amhCopula.pdf.expr'
3: In readLines(fname) :
  incomplete final line found on 'amhCopula.genfunDer.expr'
> 
> #### 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)
Loading required package: mvtnorm
Loading required package: scatterplot3d
Loading required package: sn
Loading required package: mnormt
Loading required package: adapt
Loading required package: pspline
> algr2dump(plackettCopula(1))      ## generates plackettExpr.R
> algr2dump(galambosCopula(1))      ## generates galambosExpr.R
> algr2dump(huslerReissCopula(1))   ## generates huslerReissExpr.R
> algr2dump(tawnCopula(0))          ## generates tawnExpr.R
> 
> proc.time()
   user  system elapsed 
  3.134   0.030   3.158 
