newEnv <- new.env() newEnv$newEle <- 3 newEnv$newFunc <- function(x) { print(2 * x) } newEnv$newFunc(newEnv$newEle)
## [1] 6
.GlobalEnv
contains functions and objects that are assigned during the session.search()
## [1] ".GlobalEnv" "package:knitr"
## [3] "package:stats" "package:graphics"
## [5] "package:grDevices" "package:utils"
## [7] "package:datasets" "package:methods"
## [9] "Autoloads" "package:base"
parentEnv <- parent.env(.GlobalEnv)
environmentName(parentEnv)
## [1] "package:knitr"
auxFunc <- function() {
a <- 2
print(a)
}
auxFunc()
## [1] 2
print(a)
## Error: objeto 'a' no encontrado
Using =
or <-
we make local assignments (in the environment)
a <- 1
auxFunc <- function(a) {
a <- a + 1
print(a)
}
auxFunc(a)
## [1] 2
print(a)
## [1] 1
<<-
. R searches for the name through all the enclosing environments. If there is an existing object with this name, then the assignment takes place there. Otherwise, the object is assigned in the global environment.a <- 1
auxFunc <- function(a) {
a <<- a + 1
print(a)
}
auxFunc(a)
## [1] 1
print(a)
## [1] 2
A class is structure containing:
MatrixClass <- setRefClass("MatrixClass",
fields = list(dataMat = "matrix",
detMat = "numeric",
inverseMat = "matrix"
)
)
dataMat
cannot become a "data.frame"
at any point. "ANY"
.MatrixClass$methods(initialize = function(extMat = diag(1), ...){
dataMat <<- extMat
detMat <<- det(dataMat)
if (abs(detMat) > 1e-07){
inverseMat <<- solve(dataMat)
}else{
inverseMat <<- NULL
}
callSuper(...)
})
extMat <- diag(3) * c(1, 2, 3)
newMat <- MatrixClass$new(extMat)
newMat
## Reference class object of class "MatrixClass"
## Field "dataMat":
## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 2 0
## [3,] 0 0 3
## Field "detMat":
## [1] 6
## Field "inverseMat":
## [,1] [,2] [,3]
## [1,] 1 0.0 0.0000
## [2,] 0 0.5 0.0000
## [3,] 0 0.0 0.3333
newMat$dataMat
## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 2 0
## [3,] 0 0 3
MatrixClass$methods(finalize = function() {
print(objects(.self))
for (objName in objects(.self)) {
obj <- get(objName, env = .self)
if (!is.function(obj)) {
print(objName)
print(obj)
}
}
return()
})
newMat$finalize()
## [1] "dataMat" "detMat" "field" "finalize"
## [5] "initFields" "initialize" "inverseMat" "show"
## [1] "dataMat"
## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 2 0
## [3,] 0 0 3
## [1] "detMat"
## [1] 6
## [1] "inverseMat"
## [,1] [,2] [,3]
## [1,] 1 0.0 0.0000
## [2,] 0 0.5 0.0000
## [3,] 0 0.0 0.3333
MatrixClass$methods(linearEq = function(b) {
# Ax = b
x <- inverseMat %*% b
return()
})
altMat <- newMat
altMat$dataMat <- diag(2) * c(1, 2)
altMat$dataMat
## [,1] [,2]
## [1,] 1 0
## [2,] 0 2
newMat$dataMat
## [,1] [,2]
## [1,] 1 0
## [2,] 0 2
altMat <- newMat$copy()
altMat$dataMat <- diag(2) * c(1, 2)
altMat$dataMat
## [,1] [,2]
## [1,] 1 0
## [2,] 0 2
newMat$dataMat
## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 2 0
## [3,] 0 0 3
We can build new classes using old classes. This is called inheritance.
SymMatrixClass <- setRefClass(Class = "SymMatrixClass",
fields = list(eigenValues = "vector"),
contains = "MatrixClass")
SymMatrixClass$methods(initialize = function(extMat, ...) {
if (!all(extMat == t(extMat))) {
print("Non symmetric matrix")
stop()
}
eigenValues <<- eigen(extMat)$values
callSuper(extMat, ...)
})
newSymMat <- SymMatrixClass$new(diag(3) * c(1, 2, 3))
newSymMat
## Reference class object of class "SymMatrixClass"
## Field "dataMat":
## [,1] [,2] [,3]
## [1,] 1 0 0
## [2,] 0 2 0
## [3,] 0 0 3
## Field "detMat":
## [1] 6
## Field "inverseMat":
## [,1] [,2] [,3]
## [1,] 1 0.0 0.0000
## [2,] 0 0.5 0.0000
## [3,] 0 0.0 0.3333
## Field "eigenValues":
## [1] 3 2 1
A <- setRefClass("A", fields = list(elemA = "numeric"))
A$methods(initialize = function(elemAE) {
print("initialize A")
elemA <<- elemAE
callSuper()
})
a <- A$new(1)
## [1] "initialize A"
a
## Reference class object of class "A"
## Field "elemA":
## [1] 1
B <- setRefClass("B", fields = list(elemB = "numeric"), contains = "A")
## [1] "initialize A"
## Error: el argumento "elemAE" est? ausente, sin valor por
## omisi?n
A <- setRefClass("A", fields = list(elemA = "numeric"))
A$methods(initialize = function(elemAE = 1) {
print("initialize A")
elemA <<- elemAE
callSuper()
})
B <- setRefClass("B", fields = list(elemB = "numeric"), contains = "A")
## [1] "initialize A"
## [1] "initialize A"
B$methods(initialize = function(elemBE, ...) {
print("initialize B")
elemB <<- elemBE
callSuper(...)
})
b <- B$new(elemBE = 2, elemAE = 3)
## [1] "initialize B"
## [1] "initialize A"
b
## Reference class object of class "B"
## Field "elemA":
## [1] 3
## Field "elemB":
## [1] 2
...
in the initialization function (definition and CallSuper(...)
) to let the arguments pass to contained classes.
A <- setRefClass("A", fields = list())
A$methods(fun1 = function() {
"documentation of fun1 in test class A"
return()
})
A$help("fun1")
## Call:
## $fun1()
##
##
## documentation of fun1 in test class A
a <- A$new()
a$trace(fun1, browser)
## Tracing reference method "fun1" for object from class "A"
## [1] "fun1"
a$fun1()
## Tracing a$fun1() on entry
## Called from: eval(expr, envir, enclos)
DataStructure
class to manage the data set.ForecastingMethod
class general predictive stuff (common objects such as model
or prediction
). OLS
class implementing ordinary least squares. DataStructure <- setRefClass("DataStructure", fields = list(dataMat = "matrix",
days = "Date"))
DataStructure$methods(initialize = function(dataMatE, ...) {
dataMat <<- dataMatE
days <<- as.Date(rownames(dataMat))
callSuper(...)
})
DataStructure$methods(plotData = function() {
plot(days, dataMat[, 1], type = "l", main = "data plot",
ylab = "value")
return()
})
DataStructure$methods(selectDays = function(selDays) {
indDays <- as.character(days) %in% selDays
dataMat <<- dataMat[indDays, ]
days <<- as.Date(rownames(dataMat))
return()
})
# Synthetic matrix
colN <- 10
rowN <- 40
dataMat <- matrix(nrow = rowN, ncol = colN, runif(colN * rowN))
beta <- runif(colN)
dataMat <- cbind(dataMat %*% beta + rnorm(rowN, sd = 0.1), dataMat)
colnames(dataMat) <- c("Y", paste("X", 1:colN, sep = ""))
days <- as.Date("2012-01-01") + 1:rowN
rownames(dataMat) <- as.character(days)
dataStr <- DataStructure$new(dataMat)
dataStr$plotData()
dataStr$selectDays(as.character(days[1:20]))
dataStr$plotData()
ForecastingMethod <- setRefClass("ForecastingMethod", fields = list(colMedians = "numeric",
model = "ANY", prediction = "matrix"))
ForecastingMethod$methods(buildModel = function(Y, X, optL = NULL) {
colMedians <<- apply(dataMat, 2, function(colData) {
quantile(colData, probs = 0.5)
})
return()
})
ForecastingMethod$methods(predictModel = function(X) {
X <- sapply(1:ncol(X), function(colN) {
colData <- X[, colN]
colData[is.na(colData)] <- colMedians[colN + 1]
return(colData)
})
return(X)
})
OLS <- setRefClass("OLS", fields = list(), contains = "ForecastingMethod")
OLS$methods(buildModel = function(X, Y, optL = NULL) {
callSuper(X, Y)
model <<- solve(t(X) %*% X) %*% t(X) %*% Y
return()
})
OLS$methods(predictModel = function(X) {
X <- callSuper(X)
prediction <<- X %*% beta
return(prediction)
})
forMeth <- OLS$new()
forMeth$buildModel(dataStr$dataMat[, 1], dataStr$dataMat[, -1])
forMeth$predictModel(dataStr$dataMat[, -1])
## [,1]
## 2012-01-02 3.451
## 2012-01-03 2.845
## 2012-01-04 3.865
## 2012-01-05 3.751
## 2012-01-06 2.066
## 2012-01-07 3.923
## 2012-01-08 3.071
## 2012-01-09 2.667
## 2012-01-10 2.352
## 2012-01-11 2.838
## 2012-01-12 2.272
## 2012-01-13 2.851
## 2012-01-14 2.982
## 2012-01-15 4.400
## 2012-01-16 2.617
## 2012-01-17 3.755
## 2012-01-18 3.243
## 2012-01-19 2.367
## 2012-01-20 2.376
## 2012-01-21 3.317
/
#