nothing important

sestelo · Oct 30, 2017 · 1d18aaf · 1d18aaf
1 parent 99933f7
commit 1d18aaf
Showing 1 changed file with 22 additions and 56 deletions.
diff --git a/R/frfast.R b/R/frfast.R
@@ -277,47 +277,39 @@ frfast <- function(formula, data, na.action = "na.omit",
   ncmax <- 5
   c2 <- NULL
 
-
 
 
-
+
+
+
+
   if (smooth != "splines") {
 
     cl <- match.call()
     mf <- match.call(expand.dots = FALSE)
-    m <- match(x = c("formula", "data", "subset", "weights", "na.action", "offset"), 
-               table = names(mf), nomatch = 0L)
+    m <- match(x = c("formula", "data", "subset", "weights", 
+                     "na.action", "offset"), table = names(mf), nomatch = 0L)
     mf <- mf[c(1L, m)]
     mf$drop.unused.levels <- TRUE
     mf[[1L]] <- quote(stats::model.frame)
-
-
-
-
-
     mf <- eval(expr = mf, envir = parent.frame())
-
     mt <- attr(mf, "terms")
     y <- model.response(mf, "numeric")
     w <- as.vector(model.weights(mf))
     if (!is.null(w) && !is.numeric(w)) 
       stop("'weights' must be a numeric vector")
 
     terms <- attr(mt, "term.labels")
-
-
-
     aux <- unlist(strsplit(terms,split = ":"))
     varnames <- aux[1]
     namef <- aux[2]
     response <- as.character(attr(mt, "variables")[2])
+
     if (unlist(strsplit(varnames,split = ""))[1] == "s") {
       stop("Argument \"formula\" is wrong specified, see details of
            model specification in 'Details' of the frfast help." )
     }
 
-
-    #newdata <- data
     data <- mf
 
     if (na.action == "na.omit"){ # ver la f, corregido
@@ -330,7 +322,8 @@ frfast <- function(formula, data, na.action = "na.omit",
     if (length(aux) == 1) {f <- NULL}else{f <- data[ ,namef]}
     n <- nrow(data)
 
-
+
+
   }else{
 
 
@@ -339,26 +332,20 @@ frfast <- function(formula, data, na.action = "na.omit",
     mf <- match.call(expand.dots = FALSE)
     mf$formula <- ffr$fake.formula
 
-    m <- match(x = c("formula", "data", "subset", "weights", "na.action", "offset"), 
-              table = names(mf), nomatch = 0L)
-   mf <- mf[c(1L, m)]
-
+    m <- match(x = c("formula", "data", "subset", "weights", 
+                     "na.action", "offset"), table = names(mf), nomatch = 0L)
+    mf <- mf[c(1L, m)]
     mf$drop.unused.levels <- TRUE
     mf[[1L]] <- quote(stats::model.frame)
-
     mf <- eval(expr = mf, envir = parent.frame())
-
     mt <- attr(mf, "terms")
     y <- model.response(mf, "numeric")
     w <- as.vector(model.weights(mf))
     if (!is.null(w) && !is.numeric(w)) 
       stop("'weights' must be a numeric vector")
 
     terms <- attr(mt, "term.labels")
-
     response <- as.character(attr(mt, "variables")[2])
-
-
     varnames <- terms[1]
     if (":" %in% unlist(strsplit(ffr$fake.names,split = ""))) {
       stop("Argument \"formula\" is wrong specified, see details of
@@ -368,28 +355,16 @@ frfast <- function(formula, data, na.action = "na.omit",
       warning("Argument \"formula\" could be wrong specified without an 's', see details of
            model specification in 'Details' of the frfast help." )
     }
-
-
-
-    # newdata <- data
-
-    # if (length(ffr$pred.names) == 1) {
-    #   data <- data[ ,c(ffr$response, varnames)]
-    # }else{
-    #   data <- data[ ,c(ffr$response, varnames, namef)]
-    # }
-    # 
+
     datam <- mf
 
-
     if (na.action == "na.omit"){
       datam <- na.omit(datam)
     }else{
-      stop("The actual version of the package only supports 'na.omit' (observations are removed 
-           if they contain any missing values)")
+      stop("The actual version of the package only supports 'na.omit' 
+(observations are removed if they contain any missing values)")
     }
 
-
     if (length(terms) == 1) {
       f <- NULL
       namef <- 1
@@ -400,18 +375,14 @@ frfast <- function(formula, data, na.action = "na.omit",
     n <- nrow(datam)
   }
 
-
-
-
-
+
   if(missing(data)) {
 
     response <- strsplit(response, "\\$")[[1]][2]
     terms2 <- strsplit(terms, "\\$")
 
     if(length(terms) == 1){
       formula <- as.formula(paste0(response, "~s(",terms2[[1]][2],")"))
-      #data <- data
       names(datam) <- c(response, terms2[[1]][2])
       varnames <- terms2[[1]][2]
       namef <- "F"
@@ -422,17 +393,12 @@ frfast <- function(formula, data, na.action = "na.omit",
       varnames <- terms2[[1]][2]
       namef <- terms2[[2]][2]
     }
-
-
-
-  data <- datam
 
+    data <- datam
+}
 
 
-  }
-
-
-#   strsplit(formula,split = "$")
+  #   strsplit(formula,split = "$")
 
 
   if (is.null(f)) f <- rep(1.0, n)
@@ -625,7 +591,7 @@ frfast <- function(formula, data, na.action = "na.omit",
       xgrid <- seq(min(data[ ,varnames]), max(data[ ,varnames]), length.out = kbin)
       newd <- expand.grid(xgrid, unique(f))
       names(newd) <- c(varnames, namef)
-
+      
       # estimations
       p <- array(NA, dim = c(kbin, 3, nf))
       m <- gam(formula, weights = weights, data = data.frame(data, weights), ...)
@@ -646,8 +612,8 @@ frfast <- function(formula, data, na.action = "na.omit",
                           FUN.VALUE = numeric(kfino))
 
       newdfino <- data.frame(as.vector(xgridfino), rep(unique(f), each = kfino))
-        names(newdfino) <- c(varnames, namef)
-
+      names(newdfino) <- c(varnames, namef)
+      
 
       # max
       muhatfino <- as.vector(predict(m, newdata = newdfino, type = "response"))