R/funcion_ab_total.R

In PabloMBooster/CAMPtools:

# funcion para calcular a y b de toda la cosecha

funcion_ab_total <- function(data = DSB_AB, sector = DSB_AB$Lote, isometrico = FALSE){
  calculo_ab <- lapply(split(data, sector, drop = TRUE),function(x){

    Semana_inicio <- x$Semana[which.min(x$Fecha)]
    Semana_fin    <- x$Semana[which.max(x$Fecha)]
    Fecha_inicio  <- min(x$Fecha)
    Fecha_fin     <- max(x$Fecha)
    Paltos_muestreados  <- length(x$Fecha)
    Variedad     <- x$Variedad[1]
    Cantidad     <- x$Cantidad[1]
    Fundo        <- as.character(x$Fundo[1])
    Parcela      <- as.character(x$Parcela[1])
    Lote         <- as.character(x$Lote[1])
    LotesInpseccion <- x$LotesInpseccion[1]
    numero_dias = as.numeric(Fecha_fin - Fecha_inicio)

    if(!is.na(sum(x$Peso)) & !is.na(sum(x$Valor))){
      if(isTRUE(isometrico)){
        model = nls(Peso ~ a*Valor^3, data = x, start = c(a = 0.0001))
        a = coef(model)[1] # si es isometrico solo calculamos a y asumimos b = 3
        b = 3

      }else{ # revisar los nas
        model  <- glm(log(Peso) ~ log(Valor), data=x)
        pars   <- summary(model)$coefficients[, 1:2]
        b_par  <- pars["log(Valor)", ]
        a_par  <- pars["(Intercept)", ]
        a = as.numeric(exp(a_par[1] + 0.5*a_par[2])) # se corrige el parametro al ser reconvertido
        b = as.numeric(b_par[1])
      }
    }else{
      a  <- NA
      b  <- NA
    }
    cbind.data.frame(Semana_inicio, Semana_fin, Fecha_inicio, Fecha_fin,
                     Paltos_muestreados, Variedad, Cantidad, Fundo,
                     Parcela, Lote, LotesInpseccion, numero_dias, a, b)

  })
  require(dplyr)
  resultado <- suppressWarnings(calculo_ab %>% lapply(as.data.frame) %>% bind_rows())
  resultado <- control_ab(ab = resultado)

  write.csv(resultado, "parametros_ab.csv")
  return(resultado)
}

## para ver la calidad de los parametros

control_ab <- function(ab){
  a_outliers = remove_outliers(ab$a)
  ab$revisar = "bien"
  ab$revisar[is.na(a_outliers)] = "revisa"
  return(ab)
}