#
# This is the server logic of a Shiny web application. You can run the
# application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
shinyServer(function(input, output, session) {
source('global.R', local = T)
options(shiny.maxRequestSize=200*1024^2)
options(DT.options =
list(aLengthMenu = c(10, 30, 50), iDisplayLength = 10,
scrollX = TRUE, language =
list(search = "Buscar:",
info = "Mostrando _START_ - _END_ de _TOTAL_ entradas",
emptyTable = "No hay datos disponibles",
paginate = list(previous = "Anterior", "next" = "Siguiente",
first = "Inicial", last = "Ultimo"))))
session$onSessionEnded(function() {
rm(envir = .GlobalEnv, list = ls(envir = .GlobalEnv))
recover.cat()
stopApp()
})
#' Carga Inicial
#' @author Diego
#' @return functions
#' @export
#'
updateAceEditor(session, "fieldCodeResum", value = "summary(datos)")
updateAceEditor(session, "fieldModelCor", value = modelo.cor())
updateAceEditor(session, "fieldFuncJambu",
value = paste0(extract.code("lead"), "\n",
extract.code("codo.jambu")))
updateAceEditor(session, "fieldFuncNum", value =
extract.code("distribucion.numerico"))
updateAceEditor(session, "fieldFuncCat", value =
extract.code("distribucion.categorico"))
updateAceEditor(session, "fieldCodeCentr", value =
extract.code("calc.centros"))
updateAceEditor(session, "fieldFuncHoriz", value =
extract.code("centros.horizontal.todos"))
updateAceEditor(session, "fieldFuncVert", value =
extract.code("centros.vertical.todos"))
updateAceEditor(session, "fieldFuncRadar",
value = paste0(extract.code("coord_radar"), "\n",
extract.code("centros.radar")))
updateAceEditor(session, "fieldFuncKhoriz", value =
extract.code("centros.horizontal.todos"))
updateAceEditor(session, "fieldFuncKvert", value =
extract.code("centros.vertical.todos"))
updateAceEditor(session, "fieldFuncKradar",
value = paste0(extract.code("coord_radar"), "\n",
extract.code("centros.radar")))
updateData <- reactiveValues(cor.modelo = NULL, pca.modelo = NULL,
hc.modelo = NULL, k.modelo = NULL)
updatePlot <- reactiveValues(
calc.normal=default.calc.normal(), normal=NULL, disp=NULL, pca.ind=NULL,
pca.var=NULL, pca.bi=NULL, cor=NULL, pca.cvc=NULL, mapa=NULL, dya.num=NULL,
dya.cat=NULL, diag=NULL, horiz=NULL, vert=NULL, radar=NULL, cat=NULL,
jambu=NULL, kmapa=NULL, khoriz=NULL, kvert=NULL, kradar=NULL, kcat=NULL)
disp.ranges <- reactiveValues(x = NULL, y = NULL)
ind.ranges <- reactiveValues(x = NULL, y = NULL)
bi.ranges <- reactiveValues(x = NULL, y = NULL)
mapa.ranges <- reactiveValues(x = NULL, y = NULL)
kmapa.ranges <- reactiveValues(x = NULL, y = NULL)
observe({
addClass(class = "disabled", selector = "#sidebarItemExpanded li[class^=treeview]")
addClass(class = "disabled", selector = "#sidebarItemExpanded li a[data-value=acp]")
addClass(class = "disabled", selector = "#sidebarItemExpanded li a[data-value=agrupacion]")
addClass(class = "disabled", selector = "#sidebarItemExpanded li a[data-value=kmedias]")
addClass(class = "disabled", selector = "#sidebarItemExpanded li a[data-value=reporte]")
close.menu()
})
observeEvent(input$loadButton, {
tryCatch({
codigo.carga <- code.carga(
nombre.filas = input$rowname, ruta = input$file1$datapath,
separador = input$sep, sep.decimal = input$dec,
encabezado = input$header)
isolate(eval(parse(text = codigo.carga)))
nombre.datos <<- stringi::stri_extract_first(str = input$file1$name,
regex = ".*(?=\\.)")
if(ncol(datos) <= 1){
showNotification(paste0("Error al cargar los Datos: Revisar separadores"),
duration = 10, type = "error")
return(NULL)
}
}, error = function(e) {
showNotification(paste0("Error al cargar los Datos: ", e),
duration = 10, type = "error")
datos <<- NULL
datos.originales <<- NULL
return(NULL)
})
if(any(is.na(datos))){
tryCatch({
codigo.na <- paste0(code.NA(deleteNA = input$deleteNA), "\n",
"datos <<- datos.originales")
isolate(eval(parse(text = codigo.na)))
datos.reporte[[nombre.datos]] <<- datos
}, error = function(e) {
showNotification(paste0("Error al eliminar NAs: ", e),
duration = 10, type = "error")
datos <<- NULL
datos.originales <<- NULL
return(NULL)
})
} else {
codigo.na <- ""
datos.reporte[[nombre.datos]] <<- datos
}
updateAceEditor(session, "fieldCodeData",
value = paste0(codigo.carga, "\n", codigo.na))
toggleClass(condition = (is.null(datos) || ncol(datos) < 1),
class = "disabled", selector = "#sidebarItemExpanded li[class^=treeview]")
toggleClass(condition = (is.null(datos) || ncol(datos) < 1),
class = "disabled", selector = "#sidebarItemExpanded li a[data-value=acp]")
toggleClass(condition = (is.null(datos) || ncol(datos) < 1),
class = "disabled", selector = "#sidebarItemExpanded li a[data-value=agrupacion]")
toggleClass(condition = (is.null(datos) || ncol(datos) < 1),
class = "disabled", selector = "#sidebarItemExpanded li a[data-value=kmedias]")
toggleClass(condition = (is.null(datos) || ncol(datos) < 1),
class = "disabled", selector = "#sidebarItemExpanded li a[data-value=reporte]")
tryCatch({
isolate(eval(parse(text = modelo.cor())))
updateData$cor.modelo <- correlacion
output$txtcor <- renderPrint(print(correlacion))
updateSelectizeInput(session, "sel.normal",
choices = colnames(var.numericas(datos)))
updateSelectizeInput(session, "select.var",
choices =colnames(var.numericas(datos)))
updateSelectInput(session, "sel.distribucion.num",
choices = colnames(var.numericas(datos)))
updateSelectInput(session, "sel.distribucion.cat",
choices = colnames(var.categoricas(datos)))
updateSelectInput(session, "sel.resumen",
choices = colnames(datos))
updateSelectInput(session, "selVert",
choices = c("Todos", colnames(var.numericas(datos))))
updateSelectInput(session, "sel.Kvert",
choices = c("Todos", colnames(var.numericas(datos))))
updateSelectInput(session, "sel.Kbar",
choices = colnames(var.categoricas(datos)))
updateSelectInput(session, "selBar",
choices = colnames(var.categoricas(datos)))
nmax <- calc.maxK(datos)
updateSliderInput(session, "iteracionesK", max = nmax, value = nmax)
}, error = function(e) {
print(paste0("ERROR EN EVALUAR: ", e))
return(datos <- NULL)
})
output$contents = DT::renderDT(mostrarData(), server = F)
close.menu(is.null(datos))
}, priority = 4)
observeEvent(input$transButton, {
var.noactivas <- c()
code.res <- "datos <<- datos.originales \n"
for (var in colnames(datos.originales)) {
if(input[[paste0("box", var, contador)]]) {
if(input[[paste0("sel", var, contador)]] == "categorico" &
class(datos.originales[, var]) %in% c("numeric","integer")) {
code.res <- paste0(code.res, code.trans(var, "categorico"), "\n")
}
if(input[[paste0("sel", var, contador)]] == "numerico" &
!(class(datos.originales[, var]) %in% c("numeric","integer"))) {
code.res <- paste0(code.res, code.trans(var, "numerico"), "\n")
}
if(input[[paste0("sel", var, contador)]] == "disyuntivo"){
code.res <- paste0(code.res, code.trans(var, "disyuntivo"), "\n")
}
} else {
var.noactivas <- c(var.noactivas, var)
}
}
isolate(eval(parse(text = code.res)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
"\n\n## Transformación de Datos\n\n```{r}\n",
code.res, "\nstr(datos)\n```")
code.des <- ""
if(length(var.noactivas) > 0){
code.des <- code.desactivar(var.noactivas)
isolate(eval(parse(text = code.des)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
"\n\n## Eliminación de Variables\n\n```{r}\n",
code.des, "\nstr(datos)\n```")
}
updateAceEditor(session, "fieldCodeTrans",
value = paste0(code.res, "\n", code.des))
tryCatch({
isolate(eval(parse(text = modelo.cor())))
updateData$cor.modelo <- correlacion
output$txtcor <- renderPrint(print(correlacion))
updateSelectizeInput(session, "sel.normal",
choices = colnames(var.numericas(datos)))
updateSelectizeInput(session, "select.var",
choices = colnames(var.numericas(datos)))
updateSelectInput(session, "sel.distribucion.num",
choices = colnames(var.numericas(datos)))
updateSelectInput(session, "sel.distribucion.cat",
choices = colnames(var.categoricas(datos)))
updateSelectInput(session, "sel.resumen",
choices = colnames(datos))
updateSelectInput(session, "selVert",
choices = c("Todos", colnames(var.numericas(datos))))
updateSelectInput(session, "sel.Kvert",
choices = c("Todos", colnames(var.numericas(datos))))
updateSelectInput(session, "sel.Kbar",
choices = colnames(var.categoricas(datos)))
updateSelectInput(session, "selBar",
choices = colnames(var.categoricas(datos)))
nmax <- calc.maxK(datos)
updateSliderInput(session, "iteracionesK", max = nmax, value = nmax)
}, error = function(e) {
return(datos <- NULL)
})
output$contents = DT::renderDT(mostrarData(), server = F)
close.menu(is.null(datos))
}, priority = 4)
observeEvent(c(input$loadButton, input$transButton,
input$switch.scale, input$slider.npc), {
tryCatch({
if(!is.null(datos)){
codigo <- def.pca.model(scale.unit = input$switch.scale,
npc = input$slider.npc)
updateAceEditor(session, "fieldCodePCAModelo", value = codigo)
isolate(eval(parse(text = codigo)))
updateData$pca.modelo <- pca.modelo
output$txtpca <- renderPrint(print(unclass(pca.modelo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(
env.report$codigo.reporte[[nombre.datos]], "\n\n## Modelo ACP (",
ifelse(input$switch.scale, "Centrada y Reducida",
"Sin Centrar ni Reducir"), ")\n\n```{r}\n", codigo, "\n```")
updateSliderTextInput(session, "slider.ejes", choices =
c(1:input$slider.npc), selected = c(1,2))
}
}, error = function(e) {
showNotification(paste0("ERROR: ", e), duration = 10, type = "error")
return(NULL)
})
}, priority = 2)
mostrarData <- function() {
nombre.columnas <- c("ID", colnames(datos))
tipo.columnas <- c("", sapply(colnames(datos), function(i)
ifelse(class(datos[,i]) %in% c("numeric", "integer"),
"Numérico", "Categórico")))
sketch = htmltools::withTags(table(
tableHeader(nombre.columnas),
tableFooter(tipo.columnas)
))
return(DT::datatable(head(datos, 150), selection = 'none',
editable = TRUE, container = sketch,
options = list(dom = 'frtip', scrollY = "40vh")))
}
output$contents = DT::renderDT(NULL, server = F)
update.trans <- eventReactive(input$loadButton, {
contador <<- contador + 1
if(!is.null(datos) && ncol(datos) > 0) {
res <- data.frame(Variables = colnames(datos),
Tipo = c(1:ncol(datos)), Activa = c(1:ncol(datos)))
res$Tipo <- sapply(colnames(datos), function(i)
paste0('<select id="sel', i, contador, '">',
'<option value="categorico">Categórico</option>',
'<option value="numerico" ',
ifelse(class(datos[, i]) %in% c("numeric","integer"),
' selected="selected"', ''), '>Numérico</option>',
'<option value="disyuntivo">Disyuntivo</option> </select>'))
res$Activa <- sapply(colnames(datos), function(i)
paste0('<input type="checkbox" id="box', i, contador, '" checked/>'))
} else {
res <- as.data.frame(NULL)
showNotification("Tiene que cargar los datos", duration = 10, type = "error")
}
return(res)
})
output$transData =
DT::renderDataTable(update.trans(), escape = FALSE, selection = 'none',
server = FALSE, rownames = F,
options = list(dom = 't', paging = FALSE,
ordering = FALSE, scrollY = "40vh"),
callback = JS(paste0(
"table.rows().every(function(i, tab, row) {\n",
"var $this = $(this.node());\n",
"$this.attr('id', this.data()[0]);\n",
"$this.addClass('shiny-input-checkbox');});\n",
"Shiny.unbindAll(table.table().node());\n",
"Shiny.bindAll(table.table().node());")))
#' Resumen numérico
#' @author Diego
#' @return plot
#' @export
#'
output$resumen.completo = DT::renderDataTable({
return(obj.resum())
}, options = list(dom = 'ft', scrollX = TRUE), rownames = F)
obj.resum <- eventReactive(c(input$loadButton, input$transButton), {
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Resumen Numérico", "summary(datos)"))
data.frame(unclass(summary(datos)), check.names = FALSE,
stringsAsFactors = FALSE)
})
output$resumen = renderUI({
if(input$sel.resumen %in% colnames(var.numericas(datos))){
HTML(resumen.numerico(datos, input$sel.resumen))
} else {
HTML(resumen.categorico(datos, input$sel.resumen))
}
})
#' Gráfico de Test de normalidad
#' @author Diego
#' @return plot
#' @export
#'
output$plot.normal = renderPlot({
tryCatch({
cod.normal <<- updatePlot$normal
res <- isolate(eval(parse(text = cod.normal)))
updateAceEditor(session, "fieldCodeNormal", value = cod.normal)
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog(paste0("Test de Normalidad - ",
input$sel.normal), cod.normal))
return(res)
}, error = function(e){
if(ncol(var.numericas(datos)) <= 0){
error.variables(T)
} else {
showNotification(paste0("ERROR AL GENERAR TEST DE NORMALIDAD: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.normal, {
updatePlot$normal <- input$fieldCodeNormal
})
observeEvent(c(input$loadButton, input$transButton,
input$sel.normal, input$col.normal), {
updatePlot$normal <- default.normal(data = "datos", vars = input$sel.normal,
color = input$col.normal)
})
#' Resumen Test de normalidad
#' @author Diego
#' @return plot
#' @export
#'
observeEvent(c(input$loadButton, input$transButton), {
output$calculo.normal = DT::renderDataTable({
tryCatch({
codigo <- updatePlot$calc.normal
res <- isolate(eval(parse(text = codigo)))
updateAceEditor(session, "fieldCalcNormal", value = codigo)
return(res)
}, error = function(e) {
showNotification(paste0("ERROR AL CALCULAR TEST DE NORMALIDAD: ", e),
duration = 10, type = "error")
return(NULL)
})
}, options = list(scrollY = "60vh"))
})
observeEvent(input$run.calc.normal, {
updatePlot$calc.normal <- input$fieldCalcNormal
})
#' Gráfico de Dispersión
#' @author Diego
#' @return plot
#' @export
#'
observeEvent(c(input$loadButton, input$transButton), {
output$plot.disp = renderPlot({
tryCatch({
cod.disp <<- updatePlot$disp
updateAceEditor(session, "fieldCodeDisp", value = cod.disp)
if(!is.null(cod.disp) && cod.disp != ""){
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog(paste0("Dispersión - ",
paste(input$select.var, collapse = ", ")),
cod.disp))
}
return(isolate(eval(parse(text = cod.disp))))
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR AL GENERAR DISPERSIÓN: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
output$plot.disp.zoom <- renderPlot({
tryCatch({
cod.disp <<- updatePlot$disp
res <- isolate(eval(parse(text = cod.disp)))
res <- res + coord_cartesian(xlim = disp.ranges$x,
ylim = disp.ranges$y, expand = FALSE)
return(res)
}, error = function(e) {
return(NULL)
})
})
output$mostrar.disp.zoom = DT::renderDataTable({
tryCatch({
return(brushedPoints(datos[, input$select.var], input$zoom.disp))
}, error = function(e) {
return(NULL)
})
}, options = list(dom = 't', scrollX = TRUE, scrollY = "20vh",
pageLength = nrow(datos)))
})
observe({
brush <- input$zoom.disp
if (!is.null(brush)) {
disp.ranges$x <- c(brush$xmin, brush$xmax)
disp.ranges$y <- c(brush$ymin, brush$ymax)
} else {
disp.ranges$x <- NULL
disp.ranges$y <- NULL
}
})
observeEvent(input$run.disp, {
updatePlot$disp <- input$fieldCodeDisp
})
observeEvent(c(input$loadButton, input$transButton,
input$select.var, input$col.disp), {
if(length(input$select.var) < 2) {
updatePlot$disp <- ""
} else {
updatePlot$disp <- default.disp(data = "datos", vars = input$select.var,
color = input$col.disp)
}
})
#' Gráfico de PCA (Individuos)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.ind = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
cod.pca.ind <<- updatePlot$pca.ind
res <- isolate(eval(parse(text = cod.pca.ind)))
updateAceEditor(session, "fieldCodeInd", value = cod.pca.ind)
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Plano Principal", cod.pca.ind))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR EN PCA (Individuos): ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
output$plot.ind.zoom <- renderPlot({
tryCatch({
ejex <- ind.ranges$x
ejey <- ind.ranges$y
if(is.null(ejex) & is.null(ejey)){
return(NULL)
} else {
cod.ind <<- updatePlot$pca.ind
res <- isolate(eval(parse(text = cod.ind)))
res <- res + coord_cartesian(xlim = ejex, ylim = ejey, expand = FALSE)
return(res)
}
}, error = function(e) {
return(NULL)
})
})
output$mostrar.ind.zoom = DT::renderDataTable({
tryCatch({
dimensiones <- as.data.frame(pca.modelo$ind$coord)
return(brushedPoints(df = dimensiones[, c(input$slider.ejes)],
brush = input$zoom.ind,
xvar = names(dimensiones)[input$slider.ejes[1]],
yvar = names(dimensiones)[input$slider.ejes[2]]))
}, error = function(e) {
print(e)
return(NULL)
})
}, options = list(dom = 't', scrollX = TRUE, scrollY = "20vh",
pageLength = nrow(datos)))
observe({
brush <- input$zoom.ind
if (!is.null(brush)) {
ind.ranges$x <- c(brush$xmin, brush$xmax)
ind.ranges$y <- c(brush$ymin, brush$ymax)
} else {
ind.ranges$x <- NULL
ind.ranges$y <- NULL
}
})
observeEvent(input$run.pcaInd, {
updatePlot$pca.ind <- input$fieldCodeInd
})
observeEvent(c(input$col.pca.ind, input$ind.cos, input$slider.ejes), {
updatePlot$pca.ind <-
pca.individuos(ind.cos = input$ind.cos * 0.01, color = input$col.pca.ind,
ejes = input$slider.ejes)
})
#' Gráfico de PCA (Variables)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.var = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
cod.pca.var <<- updatePlot$pca.var
res <- isolate(eval(parse(text = cod.pca.var)))
updateAceEditor(session, "fieldCodeVar", value = cod.pca.var)
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Circulo de Correlaciones", cod.pca.var))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR EN PCA (Variables): ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.pcaVar, {
updatePlot$pca.var <- input$fieldCodeVar
})
observeEvent(c(input$var.cos, input$col.pca.var, input$slider.ejes), {
updatePlot$pca.var <-
pca.variables(var.cos = input$var.cos * 0.01, color = input$col.pca.var,
ejes = input$slider.ejes)
})
#' Gráfico de PCA (Sobreposición)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.biplot = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
cod.pca.bi <<- updatePlot$pca.bi
res <- isolate(eval(parse(text = cod.pca.bi)))
updateAceEditor(session, "fieldCodeBi", value = cod.pca.bi)
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Sobreposición del Circulo y el Plano", cod.pca.bi))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR EN PCA (Sobreposición): ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
output$plot.bi.zoom <- renderPlot({
tryCatch({
ejex <- bi.ranges$x
ejey <- bi.ranges$y
if(is.null(ejex) & is.null(ejey)){
return(NULL)
} else {
cod.bi <<- updatePlot$pca.bi
res <- isolate(eval(parse(text = cod.bi)))
res <- res + coord_cartesian(xlim = ejex, ylim = ejey,
expand = FALSE)
return(res)
}
}, error = function(e) {
return(NULL)
})
})
output$mostrar.bi.zoom = DT::renderDataTable({
tryCatch({
dimensiones <- as.data.frame(pca.modelo$ind$coord)
return(brushedPoints(df = dimensiones[, c(input$slider.ejes)],
brush = input$zoom.bi,
xvar = names(dimensiones)[input$slider.ejes[1]],
yvar = names(dimensiones)[input$slider.ejes[2]]))
}, error = function(e) {
print(e)
return(NULL)
})
}, options = list(dom = 't', scrollX = TRUE, scrollY = "20vh",
pageLength = nrow(datos)))
observe({
brush <- input$zoom.bi
if (!is.null(brush)) {
bi.ranges$x <- c(brush$xmin, brush$xmax)
bi.ranges$y <- c(brush$ymin, brush$ymax)
} else {
bi.ranges$x <- NULL
bi.ranges$y <- NULL
}
})
observeEvent(input$run.pcaBi, {
updatePlot$pca.bi <- input$fieldCodeBi
})
observeEvent(c(input$col.pca.ind, input$ind.cos, input$var.cos,
input$col.pca.var, input$slider.ejes), {
updatePlot$pca.bi <-
pca.sobreposicion(ind.cos = input$ind.cos * 0.01,
var.cos = input$var.cos * 0.01,
col.ind = input$col.pca.ind,
col.var = input$col.pca.var,
ejes = input$slider.ejes)
})
#' Gráfico de PCA (Varianza Explicada para cada Eje)
#' @author Diego
#' @return plot
#' @export
#'
output$plotVEE = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
codigo <- code.pca.vee()
updateAceEditor(session, "fieldCodeVEE", value = codigo)
res <- isolate(eval(parse(text = codigo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Varianza Explicada para cada Eje", codigo))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1) {
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
#' Gráfico de PCA (Cosenos Cuadrados de los individuos)
#' @author Diego
#' @return plot
#' @export
output$plotCCI = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
codigo <- code.pca.cci()
updateAceEditor(session, "fieldCodeCCI", value = codigo)
res <- isolate(eval(parse(text = codigo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Cosenos Cuadrados de los individuos", codigo))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e), duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(c(input$loadButton, input$transButton,
input$switch.scale, input$slider.npc), {
updatePlot$pca.cci <- code.pca.cci()
})
#' Gráfico de PCA (Cosenos Cuadrados de las Variables)
#' @author Diego
#' @return plot
#' @export
#'
output$plotCCV = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
codigo <- code.pca.ccv()
updateAceEditor(session, "fieldCodeCCV", value = codigo)
res <- isolate(eval(parse(text = codigo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Cosenos Cuadrados de las Variables", codigo))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
#' Gráfico de PCA (Correlación Variables con los Componenetes)
#' @author Diego
#' @return plot
#' @export
#'
output$plotCVC = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
codigo <- updatePlot$pca.cvc
updateAceEditor(session, "fieldCodeCVC", value = codigo)
res <- isolate(eval(parse(text = codigo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Correlación Variables con los Componenetes", codigo))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$cvc.metodo, {
updatePlot$pca.cvc <- code.pca.cvp(input$cvc.metodo)
})
#' Gráfico de PCA (Contribución de las variables de la Dimensión 1)
#' @author Diego
#' @return plot
#' @export
#'
output$plotPC1 = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
codigo <- code.pca.pc1()
updateAceEditor(session, "fieldCodePC1", value = codigo)
res <- isolate(eval(parse(text = codigo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Contribución de las variables de la Dimensión 1", codigo))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
#' Gráfico de PCA (Contribución de las variables de la Dimensión 2)
#' @author Diego
#' @return plot
#' @export
#'
output$plotPC2 = renderPlot({
tryCatch({
pca.modelo <<- updateData$pca.modelo
codigo <- code.pca.pc2()
updateAceEditor(session, "fieldCodePC2", value = codigo)
res <- isolate(eval(parse(text = codigo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Contribución de las variables de la Dimensión 2", codigo))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e), duration = 10, type = "error")
return(NULL)
}
})
})
#' Gráfico de Correlaciones
#' @author Diego
#' @return plot
#' @export
#'
output$plot.cor = renderPlot({
tryCatch({
updateData$cor.modelo
cod.cor <- updatePlot$cor
res <- isolate(eval(parse(text = cod.cor)))
updateAceEditor(session, "fieldCodeCor", value = cod.cor)
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Matriz de Correlaciones", cod.cor))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR EN Correlacion: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.code.cor, {
updatePlot$cor <- input$fieldCodeCor
})
observeEvent(c(input$cor.metodo, input$cor.tipo), {
updatePlot$cor <- correlaciones(metodo = input$cor.metodo,
tipo = input$cor.tipo)
})
#' Gráfico de Distribuciones (Númericas)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.num = renderPlot({
tryCatch({
cod.dya.num <<- updatePlot$dya.num
res <- isolate(eval(parse(text = cod.dya.num)))
updateAceEditor(session, "fieldCodeNum", value = cod.dya.num)
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog(paste0("Distribución - ",
input$sel.distribucion.num), cod.dya.num))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 0){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.dya.num, {
updatePlot$dya.num <- input$fieldCodeNum
})
observeEvent(c(input$loadButton, input$transButton,
input$sel.distribucion.num, input$col.dist), {
updatePlot$dya.num <-
def.code.num(data = "datos", color = paste0("'", input$col.dist, "'"),
variable = paste0("'", input$sel.distribucion.num, "'"))
})
output$mostrar.atipicos = DT::renderDataTable({
atipicos <- boxplot.stats(datos[, input$sel.distribucion.num])
datos <- datos[datos[, input$sel.distribucion.num] %in% atipicos$out,
input$sel.distribucion.num, drop = F]
datos <- datos[order(datos[, input$sel.distribucion.num]), , drop = F]
datatable(datos, options = list(dom = 't', scrollX = TRUE, scrollY = "28vh",
pageLength = nrow(datos))) %>%
formatStyle(1, color = "white", backgroundColor = "#CBB051", target = "row")
})
#' Gráfico de Distribuciones (Categóricas)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.cat = renderPlot({
tryCatch({
cod.dya.cat <<- updatePlot$dya.cat
res <- isolate(eval(parse(text = cod.dya.cat)))
updateAceEditor(session, "fieldCodeCat", value = cod.dya.cat)
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog(paste0("Distribución - ",
input$sel.distribucion.cat), cod.dya.cat))
return(res)
}, error = function(e) {
if(ncol(var.categoricas(datos)) <= 0){
error.variables(F)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.dya.cat, {
updatePlot$dya.cat <- input$fieldCodeCat
})
observeEvent(c(input$loadButton, input$transButton,
input$sel.distribucion.cat), {
updatePlot$dya.cat <-
def.code.cat(data = "datos",
variable = paste0("'", input$sel.distribucion.cat, "'"))
})
#' Inercia Clusterización Jerarquica
#' @author Diego
#' @return plot
#' @export
#'
#'
output$inercia.cj = renderUI({
return(HTML(panel.inercia(modelo = updateData$hc.modelo$modelo,
cant.clusters = as.numeric(input$cant.cluster))))
})
#' Actualización del Modelo Clusterización Jerarquica
#' @author Diego
#' @return plot
#' @export
#'
observeEvent(c(input$loadButton, input$transButton, input$cant.cluster,
input$sel.dist.method, input$sel.hc.method), {
codigo <- def.model(data = "datos", cant = input$cant.cluster,
dist.method = input$sel.dist.method,
hc.method = input$sel.hc.method)
tryCatch ({
if(!is.null(datos) && !is.null(input$cant.cluster)){
isolate(eval(parse(text = codigo)))
updateData$hc.modelo <- hc.modelo
updateAceEditor(session, "fieldCodeModelo", value = codigo)
output$txthc <- renderPrint(print(unclass(hc.modelo)))
output$txtcentros <- renderPrint(print(unclass(centros)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
"\n\n## Clusterización Jerarquica (Clusters = ",
input$cant.cluster, ", Distancia = ",
input$sel.dist.method, ", Selección = ",
input$sel.hc.method, ")\n\n```{r}\n", codigo, "\n```")
}
}, error = function(e) {
print(paste0("ERROR EN HC: ", e))
return(NULL)
})
if(!is.null(datos) && !is.null(input$cant.cluster)) {
nuevos.colores <- sapply(1:input$cant.cluster, function(i)
paste0("'", input[[paste0("hcColor", i)]], "'"))
color <- ifelse(input$selHoriz %in% c("", "Todos"), "red",
nuevos.colores[as.numeric(input$selHoriz)])
updatePlot$diag <<- diagrama(cant = input$cant.cluster,
colores = nuevos.colores)
updatePlot$mapa <<- cluster.mapa(colores = nuevos.colores)
updatePlot$horiz <<- cluster.horiz(sel = input$selHoriz,
colores = nuevos.colores, color = color)
updatePlot$vert <<- cluster.vert(sel = input$selVert,
colores = nuevos.colores)
updatePlot$radar <<- cluster.radar(colores = nuevos.colores)
updatePlot$cat <<- cluster.cat(var = input$selBar,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeDendo", value = updatePlot$diag)
updateAceEditor(session, "fieldCodeMapa", value = updatePlot$mapa)
updateAceEditor(session, "fieldCodeHoriz", value = updatePlot$horiz)
updateAceEditor(session, "fieldCodeVert", value = updatePlot$vert)
updateAceEditor(session, "fieldCodeRadar", value = updatePlot$radar)
updateAceEditor(session, "fieldCodeBar", value = updatePlot$cat)
}
})
#' Gráfico de Clusterización Jerarquica (Diagrama)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.diag = renderPlot({
tryCatch({
hc.modelo <<- updateData$hc.modelo
code.diagrama <<- updatePlot$diag
res <- isolate(eval(parse(text = code.diagrama)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Dendograma", code.diagrama))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.hcDendo, {
updatePlot$diag <- input$fieldCodeDendo
})
#' Gráfico de Clusterización Jerarquica (Mapa)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.mapa = renderPlot({
tryCatch({
hc.modelo <<- updateData$hc.modelo
pca.modelo <<- updateData$pca.modelo
code.mapa <<- updatePlot$mapa
res <- isolate(eval(parse(text = code.mapa)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("", code.mapa))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
output$plot.mapa.zoom <- renderPlot({
tryCatch({
ejex <- mapa.ranges$x
ejey <- mapa.ranges$y
if(is.null(ejex) & is.null(ejey)){
return(NULL)
} else {
cod.mapa <<- updatePlot$mapa
res <- isolate(eval(parse(text = cod.mapa)))
res <- res + coord_cartesian(xlim = ejex, ylim = ejey, expand = FALSE) +
theme(legend.position="none")
return(res)
}
}, error = function(e) {
return(NULL)
})
})
output$mostrar.mapa.zoom = DT::renderDataTable({
tryCatch({
dimensiones <- as.data.frame(pca.modelo$ind$coord)
return(brushedPoints(df = dimensiones[, c(input$slider.ejes)],
brush = input$zoom.mapa,
xvar = names(dimensiones)[input$slider.ejes[1]],
yvar = names(dimensiones)[input$slider.ejes[2]]))
}, error = function(e) {
print(e)
return(NULL)
})
}, options = list(dom = 't', scrollX = TRUE, scrollY = "20vh",
pageLength = nrow(datos)))
observe({
brush <- input$zoom.mapa
if (!is.null(brush)) {
mapa.ranges$x <- c(brush$xmin, brush$xmax)
mapa.ranges$y <- c(brush$ymin, brush$ymax)
} else {
mapa.ranges$x <- NULL
mapa.ranges$y <- NULL
}
})
observeEvent(input$run.hcMapa, {
updatePlot$mapa <- input$fieldCodeMapa
})
#' Gráfico de Clusterización Jerarquica (Horizontal)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.horiz = renderPlot({
tryCatch({
hc.modelo <<- updateData$hc.modelo
code.horiz <<- updatePlot$horiz
res <- isolate(eval(parse(text = code.horiz)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Horizontal", code.horiz))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.hcHoriz, {
updatePlot$horiz <- input$fieldCodeHoriz
})
observeEvent(input$selHoriz, {
if(!is.null(datos)){
nuevos.colores <- sapply(1:input$cant.cluster, function(i)
paste0("'", input[[paste0("hcColor", i)]], "'"))
color <- ifelse(input$selHoriz %in% c("", "Todos"), "red",
nuevos.colores[as.numeric(input$selHoriz)])
updatePlot$horiz <<- cluster.horiz(sel = input$selHoriz,
colores = nuevos.colores, color = color)
updateAceEditor(session, "fieldCodeHoriz", value = updatePlot$horiz)
}
})
#' Gráfico de Clusterización Jerarquica (Vertical)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.vert = renderPlot({
tryCatch({
hc.modelo <<- updateData$hc.modelo
code.vert <<- updatePlot$vert
res <- isolate(eval(parse(text = code.vert)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Vertical", code.vert))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.hcVert, {
updatePlot$vert <- input$fieldCodeVert
})
observeEvent(input$selVert, {
if(!is.null(datos) && !is.null(input$cant.cluster)) {
nuevos.colores <- sapply(1:input$cant.cluster, function(i)
paste0("'", input[[paste0("hcColor", i)]], "'"))
updatePlot$vert <<- cluster.vert(sel = input$selVert,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeVert", value = updatePlot$vert)
}
})
#' Gráfico de Clusterización Jerarquica (Radar)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.radar = renderPlot({
tryCatch({
hc.modelo <<- updateData$hc.modelo
code.radar <<- updatePlot$radar
res <- isolate(eval(parse(text = code.radar)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Gráfico Radar", code.radar))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.hcRadar, {
updatePlot$radar <- input$fieldCodeRadar
})
#' Gráfico de Clusterización Jerarquica (Categóricas)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.bar.cat = renderPlot({
tryCatch({
hc.modelo <<- updateData$hc.modelo
code.cat <<- updatePlot$cat
res <- isolate(eval(parse(text = code.cat)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Variables Categóricas", code.cat))
return(res)
}, warning = function(w) {
showNotification(paste0("ADVERTENCIA: ", w), duration = 10,
type = "warning")
return(NULL)
}, error = function(e) {
if(ncol(var.categoricas(datos)) <= 0){
error.variables(F)
} else {
showNotification(paste0("ERROR: ", e), duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.hcBar, {
updatePlot$cat <- input$fieldCodeBar
})
observeEvent(input$selBar, {
if(!is.null(datos)){
nuevos.colores <- sapply(1:input$cant.cluster, function(i)
paste0("'", input[[paste0("hcColor", i)]], "'"))
updatePlot$cat <<- cluster.cat(var = input$selBar,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeBar", value = updatePlot$cat)
}
})
#' Actializacion del Modelo K-medias
#' @author Diego
#' @return plot
#' @export
#'
#'
observeEvent(c(input$loadButton, input$transButton, input$cant.kmeans.cluster,
input$num.iter, input$num.nstart, input$sel.algoritmo), {
tryCatch ({
codigo <- def.k.model(data = "datos", cant = input$cant.kmeans.cluster,
iter.max = input$num.iter,
nstart = input$num.nstart,
algorithm = input$sel.algoritmo)
isolate(eval(parse(text = codigo)))
updateData$k.modelo <- k.modelo
updateAceEditor(session, "fieldCodeKModelo", value = codigo)
output$txtk <- renderPrint(print(unclass(k.modelo)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
"\n\n## K-medias (Clusters = ", input$cant.kmeans.cluster,
", Formas Fuertes = ", input$num.nstart,
", Iteraciones = ", input$num.iter, ", Algoritmo = ",
input$sel.algoritmo, ")\n\n```{r}\n",
codigo, "\n```")
}, error = function(e) {
return(NULL)
})
if(!is.null(datos) && !is.null(input$cant.kmeans.cluster)) {
nuevos.colores <- sapply(1:input$cant.kmeans.cluster, function(i)
paste0("'", input[[paste0("kColor", i)]], "'"))
color <- ifelse(input$sel.Khoriz %in% c("", "Todos"), "red",
nuevos.colores[as.numeric(input$sel.Khoriz)])
updatePlot$jambu <<- def.code.jambu(k = input$iteracionesK)
updatePlot$kmapa <<- cluster.mapa(esHC = F, colores = nuevos.colores)
updatePlot$khoriz <<- cluster.horiz(esHC = F, sel = input$sel.Khoriz,
colores = nuevos.colores, color = color)
updatePlot$kvert <<- cluster.vert(esHC = F, sel = input$sel.Kvert,
colores = nuevos.colores)
updatePlot$kradar <<- cluster.radar(esHC = F, colores = nuevos.colores)
updatePlot$kcat <<- cluster.cat(esHC = F, var = input$sel.Kbar,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeJambu", value = updatePlot$jambu)
updateAceEditor(session, "fieldCodeKmapa", value = updatePlot$kmapa)
updateAceEditor(session, "fieldCodeKhoriz", value = updatePlot$khoriz)
updateAceEditor(session, "fieldCodeKvert", value = updatePlot$kvert)
updateAceEditor(session, "fieldCodeKradar", value = updatePlot$kradar)
updateAceEditor(session, "fieldCodeKbar", value = updatePlot$kcat)
}
})
#' Inercia K-medias
#' @author Diego
#' @return plot
#' @export
#'
output$inercia.k = renderUI({
k.modelo <<- updateData$k.modelo
return(HTML(panel.inercia(esHC = F, k.modelo)))
})
#' Gráfico de K-medias (Codo de Jambu)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.jambu = renderPlot({
tryCatch({
code.jambu <<- updatePlot$jambu
isolate(eval(parse(text = code.jambu)))
updateAceEditor(session, "fieldCodeJambu", value = code.jambu)
res <- isolate(eval(parse(text = code.jambu)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Codo de Jambu", code.jambu))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.Jambu, {
updatePlot$jambu <- input$fieldCodeJambu
})
observeEvent(c(input$loadButton, input$transButton, input$iteracionesK), {
updatePlot$jambu <- def.code.jambu(k = input$iteracionesK)
})
#' Gráfico de K-medias (Mapa)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.kmapa = renderPlot({
tryCatch({
k.modelo <<- updateData$k.modelo
pca.modelo <<- updateData$pca.modelo
code.kmapa <<- updatePlot$kmapa
res <- isolate(eval(parse(text = code.kmapa)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Mapa", code.kmapa))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
output$plot.kmapa.zoom <- renderPlot({
tryCatch({
ejex <- kmapa.ranges$x
ejey <- kmapa.ranges$y
if(is.null(ejex) & is.null(ejey)){
return(NULL)
} else {
cod.kmapa <<- updatePlot$kmapa
res <- isolate(eval(parse(text = cod.kmapa)))
res <- res + coord_cartesian(xlim = ejex, ylim = ejey, expand = FALSE) +
theme(legend.position="none")
return(res)
}
}, error = function(e) {
return(NULL)
})
})
output$mostrar.kmapa.zoom = DT::renderDataTable({
tryCatch({
dimensiones <- as.data.frame(pca.modelo$ind$coord)
return(brushedPoints(df = dimensiones[, c(input$slider.ejes)],
brush = input$zoom.kmapa,
xvar = names(dimensiones)[input$slider.ejes[1]],
yvar = names(dimensiones)[input$slider.ejes[2]]))
}, error = function(e) {
print(e)
return(NULL)
})
}, options = list(dom = 't', scrollX = TRUE, scrollY = "20vh",
pageLength = nrow(datos)))
observe({
brush <- input$zoom.kmapa
if (!is.null(brush)) {
kmapa.ranges$x <- c(brush$xmin, brush$xmax)
kmapa.ranges$y <- c(brush$ymin, brush$ymax)
} else {
kmapa.ranges$x <- NULL
kmapa.ranges$y <- NULL
}
})
observeEvent(input$run.Kmapa, {
updatePlot$kmapa <- input$fieldCodeKmapa
})
#' Gráfico de K-medias (Horizontal)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.khoriz = renderPlot({
tryCatch({
k.modelo <<- updateData$k.modelo
code.khoriz <<- updatePlot$khoriz
res <- isolate(eval(parse(text = code.khoriz)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Horizontal", code.khoriz))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.Khoriz, {
updatePlot$khoriz <- input$fieldCodeKhoriz
})
observeEvent(input$sel.Khoriz, {
if(!is.null(datos)){
nuevos.colores <- sapply(1:input$cant.kmeans.cluster, function(i)
paste0("'", input[[paste0("kColor", i)]], "'"))
color <- ifelse(input$sel.Khoriz %in% c("", "Todos"), "red",
nuevos.colores[as.numeric(input$sel.Khoriz)])
updatePlot$khoriz <- cluster.horiz(esHC = F, sel = input$sel.Khoriz,
colores = nuevos.colores, color = color)
updateAceEditor(session, "fieldCodeKhoriz", value = updatePlot$khoriz)
}
})
#' Gráfico de K-medias (Vertical)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.kvert = renderPlot({
tryCatch({
k.modelo <<- updateData$k.modelo
code.kvert <<- updatePlot$kvert
res <- isolate(eval(parse(text = code.kvert)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Vertical", code.kvert))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.KVert, {
updatePlot$kvert <- input$fieldCodeKvert
})
observeEvent(input$sel.Kvert, {
if(!is.null(datos) && !is.null(input$cant.kmeans.cluster)) {
nuevos.colores <- sapply(1:input$cant.kmeans.cluster, function(i)
paste0("'", input[[paste0("kColor", i)]], "'"))
updatePlot$kvert <<- cluster.vert(esHC = F, sel = input$sel.Kvert,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeKvert", value = updatePlot$kvert)
}
})
#' Gráfico de K-medias (Radar)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.kradar = renderPlot({
tryCatch({
k.modelo <<- updateData$k.modelo
code.kradar <<- updatePlot$kradar
res <- isolate(eval(parse(text = code.kradar)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Radar", code.kradar))
return(res)
}, error = function(e) {
if(ncol(var.numericas(datos)) <= 1){
error.variables(T)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.Kradar, {
updatePlot$kradar <- input$fieldCodeKradar
})
#' Gráfico de K-medias (Categórico)
#' @author Diego
#' @return plot
#' @export
#'
output$plot.kcat = renderPlot({
tryCatch({
k.modelo <<- updateData$k.modelo
code.kcat <<- updatePlot$kcat
res <- isolate(eval(parse(text = code.kcat)))
env.report$codigo.reporte[[nombre.datos]] <<-
paste0(env.report$codigo.reporte[[nombre.datos]],
createLog("Interpretación Variables Categóricas", code.kcat))
return(res)
}, error = function(e) {
if(ncol(var.categoricas(datos)) <= 0){
error.variables(F)
} else {
showNotification(paste0("ERROR: ", e),
duration = 10, type = "error")
return(NULL)
}
})
})
observeEvent(input$run.Kbar, {
updatePlot$kcat <- input$fieldCodeKbar
})
observeEvent(input$sel.Kbar, {
if(!is.null(datos)){
nuevos.colores <- sapply(1:input$cant.kmeans.cluster, function(i)
paste0("'", input[[paste0("kColor", i)]], "'"))
updatePlot$kcat <<- cluster.cat(esHC = F, var = input$sel.Kbar,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeKbar", value = updatePlot$kcat)
}
})
#' Mostrar Colores (k-means)
#' @author Diego
#' @return plot
#' @export
#'
observeEvent(c(input$loadButton, input$cant.kmeans.cluster), {
if(!is.null(datos) && !is.null(input$cant.kmeans.cluster)) {
updateSelectInput(session, "sel.Khoriz",
choices = c("Todos", 1:input$cant.kmeans.cluster))
for (i in 1:10) {
if(i <= input$cant.kmeans.cluster) {
shinyjs::show(paste0("kColor", i))
} else {
shinyjs::hide(paste0("kColor", i))
}
}
}
})
#' Mostrar Colores (Cluster jerarquico)
#' @author Diego
#' @return plot
#' @export
#'
observeEvent(c(input$loadButton, input$cant.cluster), {
if(!is.null(datos) && !is.null(input$cant.cluster)){
updateSelectInput(session, "selHoriz",
choices = c("Todos", 1:input$cant.cluster))
for (i in 1:10) {
if(i <= input$cant.cluster) {
shinyjs::show(paste0("hcColor", i))
} else {
shinyjs::hide(paste0("hcColor", i))
}
}
}
})
observeEvent(c(input$hcColor1, input$hcColor2, input$hcColor3, input$hcColor4,
input$hcColor5, input$hcColor6, input$hcColor7, input$hcColor8,
input$hcColor9, input$hcColor10), {
if(!is.null(datos)){
nuevos.colores <- sapply(1:input$cant.cluster, function(i)
paste0("'", input[[paste0("hcColor", i)]], "'"))
color <- ifelse(input$selHoriz %in% c("", "Todos"), "red",
nuevos.colores[as.numeric(input$selHoriz)])
updatePlot$diag <<- diagrama(cant = input$cant.cluster,
colores = nuevos.colores)
updatePlot$mapa <<- cluster.mapa(colores = nuevos.colores)
updatePlot$horiz <<- cluster.horiz(sel = input$selHoriz,
colores = nuevos.colores, color = color)
updatePlot$vert <<- cluster.vert(sel = input$selVert,
colores = nuevos.colores)
updatePlot$radar <<- cluster.radar(colores = nuevos.colores)
updatePlot$cat <<- cluster.cat(var = input$selBar,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeDendo", value = updatePlot$diag)
updateAceEditor(session, "fieldCodeMapa", value = updatePlot$mapa)
updateAceEditor(session, "fieldCodeHoriz", value = updatePlot$horiz)
updateAceEditor(session, "fieldCodeVert", value = updatePlot$vert)
updateAceEditor(session, "fieldCodeRadar", value = updatePlot$radar)
updateAceEditor(session, "fieldCodeBar", value = updatePlot$cat)
}
})
observeEvent(c(input$kColor1, input$kColor2, input$kColor3, input$kColor4,
input$kColor5, input$kColor6, input$kColor7, input$kColor8,
input$kColor9, input$kColor10), {
if(!is.null(datos)){
nuevos.colores <- sapply(1:input$cant.kmeans.cluster, function(i)
paste0("'", input[[paste0("kColor", i)]], "'"))
color <- ifelse(input$sel.Khoriz %in% c("", "Todos"), "red",
nuevos.colores[as.numeric(input$sel.Khoriz)])
updatePlot$kmapa <<- cluster.mapa(esHC = F, colores = nuevos.colores)
updatePlot$khoriz <<- cluster.horiz(esHC = F, sel = input$sel.Khoriz,
colores = nuevos.colores, color = color)
updatePlot$kvert <<- cluster.vert(esHC = F, sel = input$sel.Kvert,
colores = nuevos.colores)
updatePlot$kradar <<- cluster.radar(esHC = F, colores = nuevos.colores)
updatePlot$kcat <<- cluster.cat(esHC = F, var = input$sel.Kbar,
colores = nuevos.colores)
updateAceEditor(session, "fieldCodeKmapa", value = updatePlot$kmapa)
updateAceEditor(session, "fieldCodeKhoriz", value = updatePlot$khoriz)
updateAceEditor(session, "fieldCodeKvert", value = updatePlot$kvert)
updateAceEditor(session, "fieldCodeKradar", value = updatePlot$kradar)
updateAceEditor(session, "fieldCodeKbar", value = updatePlot$kcat)
}
})
observeEvent(input$HCbutton, {
C.Jerarquica <- hc.modelo$clusters
datos <<- cbind(datos, C.Jerarquica)
datos$C.Jerarquica <<- paste0("CJ", datos$C.Jerarquica)
datos$C.Jerarquica <<- as.factor(datos$C.Jerarquica)
output$contents = DT::renderDT(mostrarData(), server = F)
showNotification("Los clústeres fueron correctamente agregados.",
duration = 5, type = "message")
updateSelectInput(session, "sel.distribucion.cat",
choices = colnames(var.categoricas(datos)))
})
observeEvent(input$Kbutton, {
datos <<- cbind(datos, Kmedias = k.modelo$cluster)
datos$Kmedias <<- paste0("K", datos$Kmedias)
datos$Kmedias <<- as.factor(datos$Kmedias)
output$contents = DT::renderDT(mostrarData(), server = F)
showNotification("Los clústeres fueron correctamente agregados",
duration = 5, type = "message")
updateSelectInput(session, "sel.distribucion.cat",
choices = colnames(var.categoricas(datos)))
})
output$downloaDatos <- downloadHandler(
filename = function() {
input$file1$name
},
content = function(file) {
write.csv(datos, file, row.names = input$rowname)
}
)
observeEvent(input$principal, {
if(input$principal == "reporte"){
updateAceEditor(session, "fieldCodeReport",
value = def.reporte(titulo = input$textTitulo,
nombre = input$textNombre, input))
}
})
observeEvent(input$textTitulo, {
updateAceEditor(session, "fieldCodeReport", value =
str_replace(input$fieldCodeReport, "title: '.*'",
paste0("title: '", input$textTitulo, "'")))
})
observeEvent(input$textNombre, {
updateAceEditor(session, "fieldCodeReport", value =
str_replace(input$fieldCodeReport, "author: '.*'",
paste0("author: '", input$textNombre, "'")))
})
output$descargar <- downloadHandler(
filename = function() {
paste(input$textTitulo,'-', input$textNombre, '.zip', sep='')
},
content = function(file) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
files <- NULL;
namermd <- paste(input$textTitulo,'-', input$textNombre, '.rmd', sep='')
writeLines(input$fieldCodeReport, namermd)
files <- c(namermd, files)
src <- normalizePath(namermd)
withCallingHandlers({
overwrite.cat()
salida.code <<- ""
shinyjs::html("txtreport", salida.code)
out <- rmarkdown::render(src, params = NULL, rmarkdown::word_document(),
envir = env.report)
}, message = function(m) {
salida.code <<- paste0(m$message, salida.code)
shinyjs::html(id = "txtreport", html = salida.code)
}
)
recover.cat()
file.rename(out, paste(input$textTitulo,'-', input$textNombre, '.docx', sep=''))
files <- c(paste(input$textTitulo,'-', input$textNombre, '.docx', sep=''), files)
zip::zip(file, files)
}
)
close.menu <- function(valor = T){
select <- 'a[href^="#shiny-tab-parte1"]'
if(valor){
shinyjs::hide(selector = "ul.menu-open");
shinyjs::disable(selector = select)
}else{
shinyjs::enable(selector = select)
}
}
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.