[Yuima-commits] r475 - in pkg/yuima: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 4 15:40:05 CEST 2016
Author: lorenzo
Date: 2016-10-04 15:40:05 +0200 (Tue, 04 Oct 2016)
New Revision: 475
Added:
pkg/yuima/R/MethodForLaw.R
Modified:
pkg/yuima/NAMESPACE
pkg/yuima/R/FunctionAndOperators.R
pkg/yuima/R/NewClasses.R
pkg/yuima/R/simulateForMapsIntegralAndOperator.R
pkg/yuima/R/yuima.law.r
Log:
Modified: pkg/yuima/NAMESPACE
===================================================================
--- pkg/yuima/NAMESPACE 2016-10-04 04:34:01 UTC (rev 474)
+++ pkg/yuima/NAMESPACE 2016-10-04 13:40:05 UTC (rev 475)
@@ -116,7 +116,12 @@
"F0",
"Fnorm",
"asymptotic_term",
-"cbind.yuima"
+"cbind.yuima",
+"rand",
+"dens",
+"cdf",
+"quant",
+"char"
#"rbind.yuima"
)
@@ -198,7 +203,14 @@
export(cogarchNoise)
export(Diagnostic.Cogarch)
+# Methods
+export(rand)# random number generator of a Levy process specified by user
+export(dens)
+export(cdf)
+export(quant)
+export(char)
+
export(qgv)
export(mmfrac)
Modified: pkg/yuima/R/FunctionAndOperators.R
===================================================================
--- pkg/yuima/R/FunctionAndOperators.R 2016-10-04 04:34:01 UTC (rev 474)
+++ pkg/yuima/R/FunctionAndOperators.R 2016-10-04 13:40:05 UTC (rev 475)
@@ -149,9 +149,11 @@
paramfunc<-NULL
ddd<-prod(dimens)
funcList<-as.list(character(length=ddd))
+ funcList <- vector(mode ="expression", length=ddd)
func<-as.character(func)
for(i in c(1:ddd)){
- funcList[[i]]<-parse(text=func[i])
+ #funcList[[i]]<-parse(text=func[i])
+ funcList[i]<-parse(text=func[i])
paramfunc<-c(paramfunc,all.vars(funcList[[i]]))
}
# funcList<-array(funcList,dim=dimens)
@@ -229,8 +231,17 @@
if(missing(var.dx)){
yuima.stop("dx object is missing.")
}
+ if(!is(integrand,"yuima.Map")){
+ resFunc<-constFunc(func=integrand, nrow, ncol)
+ }else{
+ resFunc <-list()
+ resFunc$func <- integrand at Output@formula
+ resFunc$dimens <- integrand at Output@dimension
+ if(!(integrand at Output@param at Input.var%in%yuima at solve.variable)){
+ yuima.warn("check integrand function")
+ }
+ }
- resFunc<-constFunc(func=integrand, nrow, ncol)
Integrand <- resFunc$func
dimension <- resFunc$dimens
Added: pkg/yuima/R/MethodForLaw.R
===================================================================
--- pkg/yuima/R/MethodForLaw.R (rev 0)
+++ pkg/yuima/R/MethodForLaw.R 2016-10-04 13:40:05 UTC (rev 475)
@@ -0,0 +1,146 @@
+aux.funForLaw <- function(object, param, my.env, dummy){
+ param <- unlist(param)
+ name.par <- names(param)
+ if(length(object at time.var)>=1){
+ if(object at time.var%in%name.par){
+ assign(object at time.var,param[object at time.var], envir = my.env)
+ }else{
+ yuima.stop("time.var is not assigned")
+ }
+ param <- param[!(name.par %in% object at time.var)]
+ name.par <- names(param)
+ }
+ if(length(param)>0){
+ if(length(param)!=length(object at param.measure)){
+ yuima.stop("mismatch arguments")
+ }
+ for(i in c(1: length(param))){
+ cond<-object at param.measure %in% name.par[i]
+ assign(object at param.measure[cond], param[i], envir = my.env)
+ }
+ }
+ res <- eval(parse(text=dummy),envir=my.env)
+ return(res)
+}
+
+
+# rng
+aux.rand<- function(object, n, param, ...){
+ dummy <- deparse(object at rng)[1]
+ dummy <- gsub("function ", deparse(substitute(object at rng)), dummy)
+ my.env <- new.env()
+ assign("n", n, envir = my.env)
+ res <- aux.funForLaw(object, param, my.env, dummy)
+ return(res)
+ # param <- unlist(param)
+ # name.par <- names(param)
+ # if(length(object at time.var)>=1){
+ # if(object at time.var%in%name.par){
+ # assign(object at time.var,param[object at time.var], envir = my.env)
+ # }else{
+ # yuima.stop("time.var is not assigned")
+ # }
+ # param <- param[!(name.par %in% object at time.var)]
+ # name.par <- names(param)
+ # }
+ # if(length(param)>0){
+ # if(length(param)!=length(object at param.measure)){
+ # yuima.stop("mismatch arguments")
+ # }
+ # for(i in c(1: length(param))){
+ # cond<-object at param.measure %in% name.par[i]
+ # assign(object at param.measure[cond], param[i], envir = my.env)
+ # }
+ # }
+ # res <- eval(parse(text=dummy),envir=my.env)
+ # return(res)
+}
+
+
+setGeneric("rand",
+ function(object, n, param, ...){
+ standardGeneric("rand")
+ }
+)
+
+
+
+# dens
+
+setGeneric("dens",
+ function(object, x, param, log = FALSE, ...)
+ standardGeneric("dens")
+)
+
+
+
+
+aux.dens<- function(object, x, param, log, ...){
+ dummy <- deparse(object at density)[1]
+ dummy <- gsub("function ", deparse(substitute(object at density)), dummy)
+ my.env <- new.env()
+ assign("x", x, envir = my.env)
+ res <- aux.funForLaw(object, param, my.env, dummy)
+
+ if(log){res <- log(res)}
+ return(as.numeric(res))
+}
+
+# CDF
+
+# cdf
+
+setGeneric("cdf",
+ function(object, q, param, ...)
+ standardGeneric("cdf")
+)
+
+
+
+
+aux.cdf<- function(object, q, param, ...){
+ dummy <- deparse(object at cdf)[1]
+ dummy <- gsub("function ", deparse(substitute(object at cdf)), dummy)
+ my.env <- new.env()
+ assign("q", q, envir = my.env)
+ res <- aux.funForLaw(object, param, my.env, dummy)
+ return(as.numeric(res))
+}
+
+# quantile
+
+setGeneric("quant",
+ function(object, p, param, ...)
+ standardGeneric("quant")
+)
+
+
+
+
+aux.quant <- function(object, p, param, ...){
+ dummy <- deparse(object at quantile)[1]
+ dummy <- gsub("function ", deparse(substitute(object at quantile)), dummy)
+ my.env <- new.env()
+ assign("p", p, envir = my.env)
+ res <- aux.funForLaw(object, param, my.env, dummy)
+ return(as.numeric(res))
+}
+
+# characteristic
+
+setGeneric("char",
+ function(object, u, param, ...)
+ standardGeneric("char")
+)
+
+
+
+
+aux.char <- function(object, u, param, ...){
+ dummy <- deparse(object at characteristic)[1]
+ dummy <- gsub("function ", deparse(substitute(object at characteristic)), dummy)
+ my.env <- new.env()
+ assign("u", u, envir = my.env)
+ res <- aux.funForLaw(object, param, my.env, dummy)
+ return(as.numeric(res))
+}
Modified: pkg/yuima/R/NewClasses.R
===================================================================
--- pkg/yuima/R/NewClasses.R 2016-10-04 04:34:01 UTC (rev 474)
+++ pkg/yuima/R/NewClasses.R 2016-10-04 13:40:05 UTC (rev 475)
@@ -8,7 +8,7 @@
time.var = "character"))
setClass("info.Map",
- representation(formula="list",
+ representation(formula="vector",
dimension="numeric",
type="character",
param = "param.Map"))
@@ -41,7 +41,7 @@
#
setMethod("initialize",
"info.Map", function(.Object,
- formula = list(),
+ formula = vector(mode = expression),
dimension = numeric(),
type = character(),
param = new("param.Map")){
Modified: pkg/yuima/R/simulateForMapsIntegralAndOperator.R
===================================================================
--- pkg/yuima/R/simulateForMapsIntegralAndOperator.R 2016-10-04 04:34:01 UTC (rev 474)
+++ pkg/yuima/R/simulateForMapsIntegralAndOperator.R 2016-10-04 13:40:05 UTC (rev 475)
@@ -105,7 +105,7 @@
#Simulation Internal trajectories
sim.Inputs <- simulate(mod1, nsim, seed, xinit, true.parameter,
space.discretized, increment.W, increment.L, method, hurst,
- methodfGn, sampling, subsampling)
+ methodfGn, sampling)
# Data of underlying SDE
@@ -176,5 +176,7 @@
my.data <- zoo(x = t(res), order.by = time)
data1 <- setData(my.data)
object at data <- data1
- return(object)
+ if(missing(subsampling))
+ return(object)
+ subsampling(object, subsampling)
}
Modified: pkg/yuima/R/yuima.law.r
===================================================================
--- pkg/yuima/R/yuima.law.r 2016-10-04 04:34:01 UTC (rev 474)
+++ pkg/yuima/R/yuima.law.r 2016-10-04 13:40:05 UTC (rev 475)
@@ -3,63 +3,95 @@
setClass("yuima.law",representation(rng = "function",
density = "function",
cdf = "function",
+ quantile = "function",
+ characteristic = "function",
param.measure = "character",
- characteristic = "function",
time.var = "character",
- rand.var = "character",
- charact.var = "character",
dim = "numLike")
)
setMethod("initialize", "yuima.law",
function(.Object,
- rng = function(x,...){},
+ rng = function(n,...){},
density = function(x,...){},
- cdf = function(x,...){},
+ cdf = function(q,...){},
+ quantile = function(p,...){},
+ characteristic = function(u,...){},
param.measure = character(),
- characteristic = function(u,...){},
time.var = character(),
- rand.var = character(),
- charact.var = character(),
dim = NA
){
.Object at rng <- rng
.Object at density <- density
.Object at cdf <- cdf
+ .Object at quantile <- quantile
+ .Object at characteristic <- characteristic
.Object at param.measure <- param.measure
- .Object at characteristic <- characteristic
.Object at time.var <- time.var
- .Object at rand.var <- rand.var
- .Object at charact.var <- charact.var
.Object at dim <- dim
return(.Object)
}
)
+setMethod("rand","yuima.law",
+ function(object, n, param, ...){
+ res <- aux.rand(object, n, param, ...)
+ return(res)
+ }
+)
+
+setMethod("dens","yuima.law",
+ function(object, x, param, log = FALSE, ...){
+ res <- aux.dens(object, x, param, log, ...)
+ return(res)
+ }
+)
+
+setMethod("cdf","yuima.law",
+ function(object, q, param, ...){
+ res <- aux.cdf(object, q, param, log, ...)
+ return(res)
+ }
+)
+
+setMethod("quant","yuima.law",
+ function(object, p, param, ...){
+ res <- aux.quant(object, p, param, ...)
+ return(res)
+ }
+)
+
+setMethod("char","yuima.law",
+ function(object, u, param, ...){
+ res <- aux.char(object, u, param, ...)
+ return(res)
+ }
+)
+
+
# Constructor
-setLaw <- function(rng = function(x,...){NULL},
+setLaw <- function(rng = function(n,...){NULL},
density = function(x,...){NULL},
- cdf = function(x,...){NULL},
+ cdf = function(q,...){NULL},
+ quant = function(p,...){NULL},
characteristic = function(u,...){NULL},
time.var="t",
- rand.var = "x",
- character.var = "u",
dim = NA){
-
- param.rng <- extrapParam(myfun = rng, time.var = time.var, aux.var = rand.var )
+ param <- NULL
+ param.rng <- extrapParam(myfun = rng, time.var = time.var, aux.var = "n" )
CondRng<- FALSE
if(all(param.rng %in% "...")){
- yuima.warn("rng is not defined")
+ # yuima.warn("rng is not defined")
}else{
CondRng <- TRUE
param <- param.rng
}
- param.dens <- extrapParam(myfun = density, time.var = time.var, aux.var = rand.var )
+ param.dens <- extrapParam(myfun = density, time.var = time.var, aux.var = "x" )
CondDens<- FALSE
if(all(param.dens %in% "...")){
- yuima.warn("density is not defined")
+ # yuima.warn("density is not defined")
}else{
CondDens <- TRUE
param <- param.dens
@@ -73,46 +105,61 @@
}
}
- param.cdf <- extrapParam(myfun = cdf, time.var = time.var, aux.var = rand.var )
- Condcdf<- FALSE
+ param.cdf <- extrapParam(myfun = cdf, time.var = time.var, aux.var = "q" )
+ #Condcdf<- FALSE
if(all(param.cdf %in% "...")){
- yuima.warn("cdf is not defined")
+ #yuima.warn("cdf is not defined")
}else{
- Condcdf <- TRUE
+ # Condcdf <- TRUE
+ if(is.null(param)){
+ param <- param.cdf
+ }else{
+ if(!all(param %in% param.cdf)){
+ yuima.stop("cdf has different parameters")
+ }
+ }
}
- if(Condcdf){
- if(!all(param %in% param.cdf)){
- yuima.stop("cdf has different parameters")
+ param.quant <- extrapParam(myfun = quant, time.var = time.var, aux.var = "p" )
+# Condquant<- FALSE
+ if(all(param.quant %in% "...")){
+ #yuima.warn("cdf is not defined")
+ }else{
+# Condquant <- TRUE
+ if(is.null(param)){
+ param <- param.quant
+ }else{
+ if(!all(param %in% param.quant)){
+ yuima.stop("quantile has different parameters")
+ }
}
}
param.char <- extrapParam(myfun = characteristic,
time.var = time.var,
- aux.var = character.var )
+ aux.var = "u" )
- Condchar<- FALSE
if(all(param.char %in% "...")){
- yuima.warn("char is not defined")
+ # yuima.warn("char is not defined")
}else{
- Condchar <- TRUE
- }
-
- if(Condchar){
- if(!all(param %in% param.char)){
- yuima.stop("char has different parameters")
+ if(is.null(param)){
+ param <- param.char
+ }else{
+ if(!all(param %in% param.char)){
+ yuima.stop("quantile has different parameters")
+ }
}
}
+
res <- new("yuima.law",
rng = rng,
density = density,
cdf = cdf,
characteristic = characteristic,
+ quantile = quant,
param.measure = param,
time.var = time.var,
- rand.var = rand.var,
- charact.var = character.var,
dim = NA)
return(res)
}
More information about the Yuima-commits
mailing list