R/fit_lbfgs.R

fit_lbfgs <- function(x, y, precision, family, offset = NULL, alpha = 0) {
	initial <- numeric(ncol(x))

	env <- new.env()
	env[["x"]] <- x
	env[["y"]] <- y
	env[["precision"]] <- precision
	env[["offset"]] <- if (!is.null(offset)) offset else numeric(length(y))

	if (family$family == "gaussian") {
		ptr_objective <- pointer_objective_gaussian()
		ptr_gradient <- pointer_gradient_gaussian()
	} else if (family$family == "binomial") {
		ptr_objective <- pointer_objective_binomial()
		ptr_gradient <- pointer_gradient_binomial()
	} else {
		stop("family not supported")
	}

	lbfgs::lbfgs(ptr_objective, ptr_gradient, initial, env, invisible = 1,
				 orthantwise_c = alpha)
}
kschmaus/gammmbest documentation built on May 7, 2019, 9 p.m.