R/lr_tr_ilrs.R

In zaenalium/rewlr: Rare Event Weighted Logistics Regression

data <- iris[1:70, ]
data$Species <- ifelse(data$Species == "setosa",0,1)

formula <- "Species ~ ."
weights0 =NULL
weights1 = NULL
na.action = NULL

iter <- 1000
tol <- 0.00001
e1 <- 0.005
iter1 <- 200
w0 <- 0.02/0.01
w1 <- (1-0.02)/(1-0.01)
lambda <- NULL


lr_tr_irs <- function(formula, data, tol = 0.000001, iter = 1000, lambda = NULL) {
  if(any(is.na(data))) {
    stop("data contain missing value")
  }
  df <- model.frame(formula, data =data)
  y <- df[, 1]
  if(length(unique(y)) != 2) {
    stop("Please input binary response") }
  x <- as.matrix(cbind(Intercept = 1, df[, -1]))
  if(!(is.numeric(y))) {
    bn <- to_binary(y)
    base_char <- bn$base_char
    y <- bn$y
    rm(bn); invisible(gc())
  }

  if (is.null(lambda)) {
    lambda <- 1/sd(y) } else { lambda }

  p <-   lr_tr_irs_fit (y, x, lambda, iter, tol)

  class(p) <- "rewlr"

  p

}