stop("Lambda cannot be negative.")
} else if (!is.numeric(lambda) | length(lambda) > 1) {
stop("Lambda must be a scalar.")
}
lambda
}
validate_ll_path <- function(lambda.path) {
if (is.null(lambda.path)) {
lambda.path = c(0, 0.001, 0.01, 0.05, 0.1, 0.3, 0.5, 0.7, 1, 10)
} else if (min(lambda.path)<0) {
stop("Lambda values cannot be negative.")
} else if (!is.numeric(lambda.path)) {
stop("Lambda values must be numeric.")
}
lambda.path
}
validate_newdata <- function(newdata, X) {
if (ncol(newdata) != ncol(X)) {
stop("newdata must have the same number of columns as the training matrix.")
}
validate_X(newdata)
}
validate_sample_weights = function(sample.weights, X) {
if(!is.null(sample.weights)) {
if(length(sample.weights) != nrow(X)) {
stop("sample.weights has incorrect length")
}
if(any(sample.weights < 0)) {
stop("sample.weights must be nonnegative")
}
}
}
coerce_honesty_fraction <- function(honesty.fraction) {
if(is.null(honesty.fraction)) {
return(0)
}
honesty.fraction
}
#' @importFrom Matrix Matrix cBind
#' @importFrom methods new
create_data_matrices <- function(X, ..., sample.weights=NULL) {
default.data <- matrix(nrow=0, ncol=0);
sparse.data <- new("dgCMatrix", Dim = c(0L, 0L))
if (inherits(X, "dgCMatrix") && ncol(X) > 1) {
sparse.data <- cbind(X, ..., sample.weights)
} else {
X <- as.matrix(X)
default.data <- as.matrix(cbind(X, ..., sample.weights))
}
list(default = default.data, sparse = sparse.data)
}
# validate data
validate_X(X)
validate_sample_weights(sample.weights, X)
Y = validate_observations(Y, X)
sample.weights <- NULL
# validate data
validate_X(X)
validate_sample_weights(sample.weights, X)
Y = validate_observations(Y, X)
W = validate_observations(W, X)
Z = validate_Z(Z,X)
# validate parameters that are nict unted
num.threads <- validate_num_threads(num.threads)
num.threads <- NULL
# validate parameters that are nict unted
num.threads <- validate_num_threads(num.threads)
seed <- seed
seed <- NULL
seed <- validate_seed(seed)
clusters<- NULL
clusters <- validate_clusters(clusters, X)
samples.per.cluster <- NULL
honesty.fraction <- validate_honesty_fraction(honesty.fraction, honesty)
honesty <- TRUE
honesty.fraction <-0.5
honesty.fraction <- validate_honesty_fraction(honesty.fraction, honesty)
# center
args.orthog = list(X = X,
num.trees = min(500, num.trees),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = sample.fraction,
mtry = min(ceiling(sqrt(ncol(X)) + 20), ncol(X)),
min.node.size = 5,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = 0.05,
imbalance.penalty = 0,
ci.group.size = 1,
tune.parameters = "none",
num.threads = num.threads,
seed = seed)
args.orthog = list(X = X,
num.trees = min(500, 1000),
sample.weights = NULL,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = sample.fraction,
mtry = min(ceiling(sqrt(ncol(X)) + 20), ncol(X)),
min.node.size = 5,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = 0.05,
imbalance.penalty = 0,
ci.group.size = 1,
tune.parameters = "none",
num.threads = num.threads,
seed = seed)
args.orthog = list(X = X,
num.trees = min(500, num.trees),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = NULL,
mtry = NULL,
min.node.size = NULL,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = NULL,
imbalance.penalty = NULL,
ci.group.size = 1,
tune.parameters = "all",
num.threads = num.threads,
seed = seed)
args.orthog = list(X = X,
num.trees = min(500, 10000),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = NULL,
mtry = NULL,
min.node.size = NULL,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = NULL,
imbalance.penalty = NULL,
ci.group.size = 1,
tune.parameters = "all",
num.threads = num.threads,
seed = seed)
Y.hat <- do.call(grf::regression_forest, c(Y = list(Y), args.orthog))$predictions
W.hat <- do.call(grf::regression_forest, c(Y = list(W), args.orthog))$predictions
# center
args.orthog = list(X = X,
num.trees = min(500, num.trees),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = 0.5,
mtry = min(ceiling(sqrt(ncol(X)) + 20), ncol(X)),
min.node.size = 5,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = 0.05,
imbalance.penalty = 0,
ci.group.size = 1,
tune.parameters = "none",
num.threads = num.threads,
seed = seed)
num.tress = 434234
# center
args.orthog = list(X = X,
num.trees = min(500, num.trees),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = 0.5,
mtry = min(ceiling(sqrt(ncol(X)) + 20), ncol(X)),
min.node.size = 5,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = 0.05,
imbalance.penalty = 0,
ci.group.size = 1,
tune.parameters = "none",
num.threads = num.threads,
seed = seed)
num.trees = 242
num.trees = 242332
# center
args.orthog = list(X = X,
num.trees = min(500, num.trees),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = 0.5,
mtry = min(ceiling(sqrt(ncol(X)) + 20), ncol(X)),
min.node.size = 5,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = 0.05,
imbalance.penalty = 0,
ci.group.size = 1,
tune.parameters = "none",
num.threads = num.threads,
seed = seed)
Y.hat <- do.call(grf::regression_forest, c(Y = list(Y), args.orthog))$predictions
# center
args.orthog = list(X = X,
num.trees = min(500, num.trees),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = sample.fraction,
mtry = min(ceiling(sqrt(ncol(X)) + 20), ncol(X)),
min.node.size = 5,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = 0.05,
imbalance.penalty = 0,
ci.group.size = 1,
tune.parameters = "none",
num.threads = num.threads,
seed = seed)
# center
args.orthog = list(X = X,
num.trees = min(500, num.trees),
sample.weights = sample.weights,
clusters = clusters,
equalize.cluster.weights = FALSE,
sample.fraction = NULL,
mtry = NULL,
min.node.size = NULL,
honesty = TRUE,
honesty.fraction = 0.5,
honesty.prune.leaves = TRUE,
alpha = NULL,
imbalance.penalty = NULL,
ci.group.size = 1,
tune.parameters = "all",
num.threads = num.threads,
seed = seed)
Y.hat <- do.call(grf::regression_forest, c(Y = list(Y), args.orthog))$predictions
library(Rcpp)
library(devtools)
library(testthat)
library(roxygen2)
package.name <- "grftsls"
package.src <- "grftsls/src"
# Copy Rcpp bindings and C++ source into the package src directory. Note that we
# don't copy in third_party/Eigen, because for the R package build we provide
# access to the library through RcppEigen.
unlink(package.src, recursive = TRUE)
dir.create(package.src)
binding.files <- list.files("grftsls/bindings", full.names = TRUE)
file.copy(binding.files, package.src, recursive = FALSE)
file.copy("../core/src", package.src, recursive = TRUE)
file.copy("../core/third_party/optional", package.src, recursive = TRUE)
# Auto-generate documentation files
roxygen2::roxygenise(package.name)
# Run Rcpp and build the package.
compileAttributes(package.name)
clean_dll(package.name)
build(package.name)
# Test installation and run some smoke tests.
install(package.name)
library(package.name, character.only = TRUE)
#test_package(package.name)
library(grftsls)
n <- 2000
p <- 10
X <- matrix(rnorm(n * p), n, p)
W <- rbinom(n, 1, 0.4 + 0.2 * (X[, 1] > 0))
Y <- pmax(X[, 1], 0) * W + X[, 2] + pmin(X[, 3], 0) + rnorm(n)
Z <- cbind(W*0.4 + rnorm(n), W*0.4 + rnorm(n), W*0.2 + rnorm(n), W*0.9 + rnorm(n), W*0.234 + rnorm(n))
forest4 <- tsls_forest(X,Y,W,Z, compute.oob.predictions = TRUE,
Y.hat = NULL, W.hat = NULL, Z.hat = NULL)
library(Rcpp)
library(devtools)
library(testthat)
library(roxygen2)
package.name <- "grftsls"
package.src <- "grftsls/src"
# Copy Rcpp bindings and C++ source into the package src directory. Note that we
# don't copy in third_party/Eigen, because for the R package build we provide
# access to the library through RcppEigen.
unlink(package.src, recursive = TRUE)
dir.create(package.src)
binding.files <- list.files("grftsls/bindings", full.names = TRUE)
file.copy(binding.files, package.src, recursive = FALSE)
file.copy("../core/src", package.src, recursive = TRUE)
file.copy("../core/third_party/optional", package.src, recursive = TRUE)
# Auto-generate documentation files
roxygen2::roxygenise(package.name)
# Run Rcpp and build the package.
compileAttributes(package.name)
clean_dll(package.name)
build(package.name)
# Test installation and run some smoke tests.
install(package.name)
library(package.name, character.only = TRUE)
tune_tsls_forest()
?tune_tsls_forest
library(Rcpp)
library(devtools)
library(testthat)
library(roxygen2)
package.name <- "grftsls"
package.src <- "grftsls/src"
# Copy Rcpp bindings and C++ source into the package src directory. Note that we
# don't copy in third_party/Eigen, because for the R package build we provide
# access to the library through RcppEigen.
unlink(package.src, recursive = TRUE)
dir.create(package.src)
binding.files <- list.files("grftsls/bindings", full.names = TRUE)
file.copy(binding.files, package.src, recursive = FALSE)
file.copy("../core/src", package.src, recursive = TRUE)
file.copy("../core/third_party/optional", package.src, recursive = TRUE)
# Auto-generate documentation files
roxygen2::roxygenise(package.name)
# Run Rcpp and build the package.
compileAttributes(package.name)
clean_dll(package.name)
build(package.name)
# Test installation and run some smoke tests.
install(package.name)
# Test installation and run some smoke tests.
install(package.name)
library(package.name, character.only = TRUE)
library(Rcpp)
library(devtools)
library(testthat)
library(roxygen2)
package.name <- "grftsls"
package.src <- "grftsls/src"
# Copy Rcpp bindings and C++ source into the package src directory. Note that we
# don't copy in third_party/Eigen, because for the R package build we provide
# access to the library through RcppEigen.
unlink(package.src, recursive = TRUE)
dir.create(package.src)
binding.files <- list.files("grftsls/bindings", full.names = TRUE)
file.copy(binding.files, package.src, recursive = FALSE)
file.copy("../core/src", package.src, recursive = TRUE)
file.copy("../core/third_party/optional", package.src, recursive = TRUE)
# Auto-generate documentation files
roxygen2::roxygenise(package.name)
# Run Rcpp and build the package.
compileAttributes(package.name)
clean_dll(package.name)
build(package.name)
# Test installation and run some smoke tests.
install(package.name)
library(Rcpp)
library(devtools)
library(testthat)
library(roxygen2)
package.name <- "grftsls"
package.src <- "grftsls/src"
# Copy Rcpp bindings and C++ source into the package src directory. Note that we
# don't copy in third_party/Eigen, because for the R package build we provide
# access to the library through RcppEigen.
unlink(package.src, recursive = TRUE)
dir.create(package.src)
binding.files <- list.files("grftsls/bindings", full.names = TRUE)
file.copy(binding.files, package.src, recursive = FALSE)
file.copy("../core/src", package.src, recursive = TRUE)
file.copy("../core/third_party/optional", package.src, recursive = TRUE)
# Auto-generate documentation files
roxygen2::roxygenise(package.name)
# Run Rcpp and build the package.
compileAttributes(package.name)
clean_dll(package.name)
build(package.name)
# Test installation and run some smoke tests.
install(package.name)
get_params_from_draw <- function(X, draws, max.sample.fraction = NULL, min.min.node.size = NULL,
min.mtry = NULL) {
if (is.vector(draws))
draws = rbind(c(draws))
n = nrow(draws)
vapply(colnames(draws), function(param) {
if (param == "min.node.size")
return(floor(2^(draws[, param] * (log(nrow(X)) / log(2) - 4))) + min.min.node.size)
else if (param == "sample.fraction")
return(0.05 + (max.sample.fraction - 0.05) * draws[, param])
else if (param == "mtry")
return(pmax(ceiling(min(ncol(X), sqrt(ncol(X)) + 20) * draws[, param]), min.mtry))
else if (param == "alpha")
return(draws[, param] / 4)
else if (param == "imbalance.penalty")
return (-log(draws[, param]))
else
stop("Unrecognized parameter name provided: ", param)
}, FUN.VALUE = numeric(n))
}
X=matrix(rnorm(1000))
X
X=matrix(rnorm(10000),nrow = 1000, ncol = 10 )
colnames(draws) = c("min.node.size", "sample.fraction", "mtry")
draws = matrix(runif(3000), nrow = 1000, ncol = 3)
colnames(draws) = c("min.node.size", "sample.fraction", "mtry")
X=matrix(rnorm(10000),nrow = 1000, ncol = 10 )
get_params_from_draw <- function(X, draws, max.sample.fraction = NULL, min.min.node.size = NULL,
min.mtry = NULL) {
if (is.vector(draws))
draws = rbind(c(draws))
n = nrow(draws)
vapply(colnames(draws), function(param) {
if (param == "min.node.size")
return(floor(2^(draws[, param] * (log(nrow(X)) / log(2) - 4))) + min.min.node.size)
else if (param == "sample.fraction")
return(0.05 + (max.sample.fraction - 0.05) * draws[, param])
else if (param == "mtry")
return(pmax(ceiling(min(ncol(X), sqrt(ncol(X)) + 20) * draws[, param]), min.mtry))
else if (param == "alpha")
return(draws[, param] / 4)
else if (param == "imbalance.penalty")
return (-log(draws[, param]))
else
stop("Unrecognized parameter name provided: ", param)
}, FUN.VALUE = numeric(n))
}
get_params_from_draw <- function(X, draws, max.sample.fraction = 0.2, min.min.node.size = 200,
min.mtry = 2)
d
get_params_from_draw <- function(X, draws, max.sample.fraction = NULL, min.min.node.size = NULL,
min.mtry = NULL) {
if (is.vector(draws))
draws = rbind(c(draws))
n = nrow(draws)
vapply(colnames(draws), function(param) {
if (param == "min.node.size")
return(floor(2^(draws[, param] * (log(nrow(X)) / log(2) - 4))) + min.min.node.size)
else if (param == "sample.fraction")
return(0.05 + (max.sample.fraction - 0.05) * draws[, param])
else if (param == "mtry")
return(pmax(ceiling(min(ncol(X), sqrt(ncol(X)) + 20) * draws[, param]), min.mtry))
else if (param == "alpha")
return(draws[, param] / 4)
else if (param == "imbalance.penalty")
return (-log(draws[, param]))
else
stop("Unrecognized parameter name provided: ", param)
}, FUN.VALUE = numeric(n))
}
get_params_from_draw(X, draws, max.sample.fraction = 0.2, min.min.node.size = 200,
min.mtry = 2)
get_params_from_draw(X, draws, max.sample.fraction = 0.2, min.min.node.size = 200,
min.mtry = 7)
draws = matrix(runif(3000), nrow = 1000, ncol = 3)
colnames(draws) = c("min.node.size", "sample.fraction", "mtry")
X=matrix(rnorm(10000),nrow = 1000, ncol = 5 )
get_params_from_draw(X, draws, max.sample.fraction = 0.2, min.min.node.size = 200,
min.mtry = 7)
X=matrix(rnorm(10000),nrow = 1000, ncol = 1 )
get_params_from_draw(X, draws, max.sample.fraction = 0.2, min.min.node.size = 200,
min.mtry = 7)
X=matrix(rnorm(10000),nrow = 1000, ncol = 8 )
get_params_from_draw(X, draws, max.sample.fraction = 0.2, min.min.node.size = 200,
min.mtry = 1)
get_params_from_draw(X, draws, max.sample.fraction = 0.2, min.min.node.size = 200,
min.mtry = 1)
get_params_from_draw(X, draw,
max.sample.fraction = max.sample.fraction,
min.min.node.size = min.min.node.size-1),
min.mtry = min.mtry)
library(Rcpp)
library(devtools)
library(testthat)
library(roxygen2)
package.name <- "grftsls"
package.src <- "grftsls/src"
# Copy Rcpp bindings and C++ source into the package src directory. Note that we
# don't copy in third_party/Eigen, because for the R package build we provide
# access to the library through RcppEigen.
unlink(package.src, recursive = TRUE)
dir.create(package.src)
binding.files <- list.files("grftsls/bindings", full.names = TRUE)
file.copy(binding.files, package.src, recursive = FALSE)
file.copy("../core/src", package.src, recursive = TRUE)
file.copy("../core/third_party/optional", package.src, recursive = TRUE)
# Auto-generate documentation files
roxygen2::roxygenise(package.name)
# Run Rcpp and build the package.
compileAttributes(package.name)
clean_dll(package.name)
build(package.name)
# Test installation and run some smoke tests.
install(package.name)
library(Rcpp)
library(devtools)
library(testthat)
library(roxygen2)
package.name <- "grftsls"
package.src <- "grftsls/src"
# Copy Rcpp bindings and C++ source into the package src directory. Note that we
# don't copy in third_party/Eigen, because for the R package build we provide
# access to the library through RcppEigen.
unlink(package.src, recursive = TRUE)
dir.create(package.src)
binding.files <- list.files("grftsls/bindings", full.names = TRUE)
file.copy(binding.files, package.src, recursive = FALSE)
file.copy("../core/src", package.src, recursive = TRUE)
file.copy("../core/third_party/optional", package.src, recursive = TRUE)
# Auto-generate documentation files
roxygen2::roxygenise(package.name)
# Run Rcpp and build the package.
compileAttributes(package.name)
clean_dll(package.name)
build(package.name)
# Test installation and run some smoke tests.
install(package.name)
