R/modelagem.R

Defines functions ajustar_modelo2 ajustar_modelo nomes_total decodificar2 decodificar ajustar_svm decodificar_stack

Documented in ajustar_modelo2 ajustar_svm decodificar decodificar2 decodificar_stack nomes_total

#' Ajustar um modelo
#'
#' @export
#'
ajustar_modelo2 <- function(d, prop, n_pca = 30) {
  inTrain <- createDataPartition(d$letra, p = prop)[[1]]
  d_treino <- d[inTrain, ]
  prep <- preProcess(select(d_treino, -letra), 
                     method = 'pca', 
                     pcaComp = n_pca)
  d2 <- cbind(predict(prep, select(d_treino, -letra)), select(d_treino, letra))
  d2$letra <- factor(d2$letra)
  m <- train(letra~., data = d2, ntree = 743)
  d_teste <- d[-inTrain, ]
  prep_test <- cbind(predict(prep, select(d_teste, -letra)), select(d_teste, letra))
  d_teste$pred <- predict(m, prep_test)
  acerto <- sum(diag(table(d_teste$pred, d_teste$letra))) / nrow(d_teste)
  return(list(prep = prep, modelo = m, acerto = acerto))
}

#' @export
#'
ajustar_modelo <- function(d, prop) {
  inTrain <- createDataPartition(d$letra, p = prop)[[1]]
  d_treino <- d[inTrain, ]
  d_treino$letra <- factor(d_treino$letra)
  m <- train(letra~., data = d_treino, ntree = 743)
  d_teste <- d[-inTrain, ]
  d_teste$pred <- predict(m, d_teste)
  acerto <- sum(diag(table(d_teste$pred, d_teste$letra))) / nrow(d_teste)
  return(list(modelo = m, acerto = acerto, 
              d_treino = d_treino, d_teste = d_teste))
}

#' nomes total
#'
#' @export
nomes_total <- function() {
  expand.grid(1:26, 1:26) %>%
    dplyr::mutate(xy = sprintf('x%02d_y%02d', Var1, Var2)) %>%
    with(xy)
}

#' Decodificar
#'
#' @export
#'
decodificar2 <- function(arq, modelo) {
  d0 <- ler(arq)
  tmp <- tempfile()
  saveRDS(d0, tmp)
  d <- arrumar_bd(tmp)
  d <- select(d, -letra)
  file.remove(tmp)
  rm(tmp)
  nm <- nomes_total()
  d[, nm[!nm %in% names(d)]] <- 0
  d2 <- predict(modelo$prep, data.frame(d))
  pred <- predict(modelo$modelo, d2)
  paste(as.character(pred), collapse = '')
}


#' Decodificar
#'
#' @export
#'
decodificar <- function(arq, modelo) {
  d0 <- ler(arq)
  tmp <- tempfile()
  saveRDS(d0, tmp)
  d <- arrumar_bd(tmp)
  d <- dplyr::select(d, -letra)
  file.remove(tmp)
  rm(tmp)
  nm <- nomes_total()
  d[, nm[!nm %in% names(d)]] <- 0
  # d2 <- predict(modelo$prep, data.frame(d))
  pred <- predict(modelo$modelo, data.frame(d))
  paste(as.character(pred), collapse = '')
}

#' Ajustar SVM
#'
#'
#'@export
#'
ajustar_svm <- function(treino, prop) {
  inTrain <- caret::createDataPartition(treino$letra, p = prop)[[1]]
  d_treino <- treino[inTrain, ]
  d_treino$letra <- factor(d_treino$letra)
  m <- caret::train(letra~., data = d_treino, method = "svmRadial")
  d_teste <- treino[-inTrain, ]
  d_teste$pred <- predict(m, d_teste)
  acerto <- sum(diag(table(d_teste$pred, d_teste$letra))) / nrow(d_teste)
  modelo <- list(
    modelo = m, acerto = acerto, 
    d_treino = d_treino, d_teste = d_teste
  )
  modelo
}

#' Decodificar stack
#'
#'
#'@export
#'
decodificar_stack <- function(arq, modelo1, modelo2, modelo_stack) {
  d0 <- ler(arq)
  tmp <- tempfile()
  saveRDS(d0, tmp)
  d <- arrumar_bd(tmp)
  d <- dplyr::select(d, -letra)
  file.remove(tmp)
  rm(tmp)
  nm <- nomes_total()
  d[, nm[!nm %in% names(d)]] <- 0
  d_stack <- data.frame(x1 = predict(modelo1$modelo, d),
                        x2 = predict(modelo2$modelo, d))
  pred <- predict(modelo_stack, d_stack)
  paste(as.character(pred), collapse = '')
}
jtrecenti/captchaReceita documentation built on May 20, 2019, 3:16 a.m.