This is my first query in this community, I hope I'm not doing it wrong.
I recently started using Rstudio to make interactive web. The user selects some values (number of months, months and/or days) and the system adds or subtracts the number of individuals. Then it shows it in a bar chart. The problem is that everything works fine on my machine, locally, but when I upload to shinyapps.io one of the 4 bars that contains the graph does not change (neither adds nor subtracts, it does not “react”). It is the right bar, the other bars are modified and updated. I have no idea why and I can't find any errors in the log.
Here is a screenshot of how it reacts on my machine locally:
this is the Rstudio code:
library(shiny)
library(dplyr)
library(readxl)
library(lubridate)
library(ggplot2)
### para conectar con shinyapp.io
if(!require("devtools"))
install.packages("devtools")
devtools::install_github("rstudio/rsconnect")
library(rsconnect)
# Cargar el archivo Excel
df <- read_excel("Datos crudos2.xlsx")
# Convertir la columna 'Fecha' a formato Date
df$Fecha <- dmy(df$Fecha)
# Generar una secuencia completa de fechas entre el primer y el último día del dataframe
fechas_completas <- seq(min(df$Fecha), max(df$Fecha), by = "day")
# Unir con el dataframe original para rellenar los días faltantes
df_completo <- data.frame(Fecha = fechas_completas) %>%
left_join(df, by = "Fecha")
# Convertir la columna 'Numero de individuos' a numérica
df_completo <- df_completo %>%
mutate(`Numero de individuos` = as.numeric(`Numero de individuos`))
# Agregar columna con el día de la semana en letras (en español)
df_completo$DiaSemana <- weekdays(df_completo$Fecha, abbreviate = FALSE)
# Lista de meses en español
meses_espanol <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",
"Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
# Interfaz de usuario (UI)
ui <- fluidPage(
# Aplicar estilos CSS personalizados
tags$style(HTML("
body {
background-color: #666666;
color: white; /* Cambiar el color del texto para contraste */
}
.container-fluid {
background-color: #666666;
}
.well {
background-color: #666666;
color: white;
}
.shiny-input-container {
color: white;
}
.shiny-output-error {
color: white;
}
.shiny-output-error:before {
color: white;
}
h2 {
text-align: center; /* Centrar el título */
}
")),
titlePanel(h2("Evaluación de restricciones de pesca")),
sidebarLayout(
sidebarPanel(
# Paso 1: Elegir span para LOESS
tags$p("Primero se graficarán los valores reales,"), # Texto explicativo
tags$p("luego debes seleccionar un valor de span para ajustar la suavización del gráfico con LOESS."), # Texto explicativo
numericInput("span_loess", "Valor de span para LOESS:",
value = 0.01, min = 0, max = 1, step = 0.01),
tags$p("Elige un valor para ajustar la suavización del gráfico con LOESS."), # Texto explicativo
actionButton("aplicar_loess", "Aplicar span LOESS"), # Botón para aplicar el cambio de LOESS
# Espacio entre los gráficos
tags$br(),
tags$br(),
tags$hr(),
tags$br(),
tags$br(),
tags$hr(),
tags$br(),
tags$br(),
tags$hr(),
tags$hr(style = "border: 2px solid black;"),
tags$p("Ahora tienes que elegir la cantidad de meses y desde que mes comieza la restricción de pesca."), # Texto explicativo
# Paso 2: Elegir el número de meses de restricción
numericInput("meses_restriccion", "Número de meses de restricción:",
value = 1, min = 1, max = 12),
# Paso 2.1: Elegir el mes de inicio
selectInput("mes_inicio", "Mes de inicio para la restricción:",
choices = meses_espanol),
tags$hr(),
tags$hr(style = "border: 2px solid black;"),
tags$br(),
tags$p("También pedes elegir que días de la semana restringes la pesca."), # Texto explicativo
# Paso 3: Elegir los días de la semana que se restringen
checkboxGroupInput("dias_restringidos", "Selecciona los días a restringir:",
choices = c("Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Domingo"),
selected = c("Sábado", "Domingo")),
actionButton("aplicar", "Aplicar restricciones") # Botón para aplicar restricciones
),
mainPanel(
# Gráfico comparativo
plotOutput("grafico_comparativo", height = "400px"),
# Espacio entre los gráficos
tags$br(),
tags$br(),
tags$hr(),
tags$hr(style = "border: 2px solid black;"),
tags$br(),
tags$br(),
# Gráfico de barras
plotOutput("barra_comparativa", height = "400px")
)
)
)
# Servidor (Server)
server <- function(input, output) {
# Datos originales sin LOESS
df_completo_original <- reactive({
df_completo
})
# Generar datos con el ajuste LOESS solo al presionar el botón
df_completo_loess <- eventReactive(input$aplicar_loess, {
fit_loess <- loess(`Numero de individuos` ~ as.numeric(Fecha), data = df_completo, span = input$span_loess)
# Predecir valores y asegurar que no sean negativos
df_completo %>%
mutate(Numero_de_individuos_LOESS = pmax(0, predict(fit_loess, as.numeric(Fecha))))
})
# Calcular restricciones solo cuando se presiona el botón
resultados_veda <- eventReactive(input$aplicar, {
resultados <- list()
total_individuos <- sum(df_completo_loess()$Numero_de_individuos_LOESS, na.rm = TRUE)
resultados[["Sin restricciones"]] <- total_individuos
# Veda tradicional: noviembre y diciembre
veda_tradicional <- df_completo_loess() %>%
filter(month(Fecha) %in% c(11, 12)) %>%
pull(Numero_de_individuos_LOESS)
total_veda_tradicional <- total_individuos - sum(veda_tradicional, na.rm = TRUE)
resultados[["Veda tradicional"]] <- total_veda_tradicional
# Restricción por meses (seleccionados por el usuario)
mes_inicio_num <- match(input$mes_inicio, meses_espanol)
meses_restriccion <- ((mes_inicio_num - 1 + 0:(input$meses_restriccion - 1)) %% 12) + 1
veda_modificada <- df_completo_loess() %>%
filter(month(Fecha) %in% meses_restriccion) %>%
pull(Numero_de_individuos_LOESS)
total_veda_modificada <- total_individuos - sum(veda_modificada, na.rm = TRUE)
resultados[["Veda tradicional con modificaciones"]] <- total_veda_modificada
# Restricción por días seleccionados (transformamos los días a minúsculas para la comparación)
dias_restringidos <- tolower(input$dias_restringidos)
# Comparamos con los días de la semana del dataframe, también convertidos a minúsculas
dias_permitidos <- !(tolower(df_completo_loess()$DiaSemana) %in% dias_restringidos)
# Filtramos los datos permitidos y calculamos el total con la restricción por días
total_veda_extendida <- sum(df_completo_loess() %>%
filter(dias_permitidos) %>%
pull(Numero_de_individuos_LOESS), na.rm = TRUE)
resultados[["Veda extendida"]] <- total_veda_extendida
resultados
})
# Gráfico comparativo de datos originales y LOESS
output$grafico_comparativo <- renderPlot({
plot_data <- df_completo_original()
p <- ggplot(plot_data, aes(x = Fecha)) +
geom_point(aes(y = `Numero de individuos`, color = "Datos originales"), linewidth = 2, alpha = 0.6) +
labs(
title = "Comparación de datos originales y ajuste LOESS",
x = "Fecha",
y = "Número de individuos",
color = "Leyenda"
) +
scale_y_continuous(labels = scales::comma) +
scale_x_date(breaks = seq(min(df_completo$Fecha), max(df_completo$Fecha), by = "year"), date_labels = "%Y") +
scale_color_manual(values = c("Datos originales" = "white", "Ajuste LOESS" = "cyan3"),
guide = guide_legend(title = NULL))+ # Ocultar título de la leyenda))
theme_minimal() +
theme(
plot.background = element_rect(fill = "black"),
plot.title = element_text(hjust = 0.5, size = 16, color = "white"),
axis.text.x = element_text(size = 12, angle = 45, hjust = 1, color = "white"),
axis.title = element_text(size = 16, color = "white"),
axis.text.y = element_text(size = 12, color = "white"),
legend.position = c(0.05, 0.95),
legend.justification = c(0, 1),
legend.text = element_text(size = 12),
legend.background = element_rect(fill = "lightblue", # Background
colour = 1),
)
# Agregar la línea de LOESS solo cuando se haya presionado el botón
if (input$aplicar_loess > 0) {
p <- p + geom_line(data = df_completo_loess(), aes(y = Numero_de_individuos_LOESS, color = "Ajuste LOESS"), size = 1.2)
}
p
})
# Gráfico de barras con los resultados de las restricciones
output$barra_comparativa <- renderPlot({
req(resultados_veda()) # Asegura que el cálculo de restricciones haya sucedido
# Obtener el total de individuos sin restricciones como referencia para el 100%
total_sin_restricciones <- resultados_veda()[["Sin restricciones"]]
df_resultado <- data.frame(
Tipo_Veda = factor(c("Sin restricciones", "Veda tradicional",
"Veda tradicional con modificaciones", "Veda extendida"),
levels = c("Sin restricciones", "Veda tradicional",
"Veda tradicional con modificaciones", "Veda extendida")),
Total_Individuos = unlist(resultados_veda())
)
# Calcular el porcentaje en base al total sin restricciones
df_resultado$Porcentaje <- (df_resultado$Total_Individuos / total_sin_restricciones) * 100
ggplot(df_resultado, aes(x = Tipo_Veda, y = Total_Individuos, fill = Tipo_Veda)) +
geom_bar(stat = "identity") +
geom_text(aes(
label = paste0(
scales::comma(round(Total_Individuos/1000)), " ind.\n",
"Protege: ", round(100 - Porcentaje, 1), "%"
)
), vjust = 1.5, linewidth = 5, color = "black") +
labs(
title = "Comparación del total de individuos por tipo de veda",
x = "Tipo de veda",
y = "Número de individuos (x 1.000)",
fill = "Tipo de veda"
) +
scale_y_continuous(
labels = function(x) x / 1000,
breaks = seq(0, max(df_resultado$Total_Individuos, na.rm = TRUE), by = 100000)
) +
scale_fill_manual(values = c("Sin restricciones" = "lightblue",
"Veda tradicional" = "lightgreen",
"Veda tradicional con modificaciones" = "lightcoral",
"Veda extendida" = "lightgoldenrod")) +
theme_minimal() +
theme(
plot.background = element_rect(fill = "black"),
plot.title = element_text(hjust = 0.5, size = 16, color = "white"),
axis.text.x = element_blank(),
axis.title = element_text(size = 16, color = "white"),
axis.text.y = element_text(size = 12,color = "white"),
legend.position = "right",
legend.title = element_text(size = 12),
legend.text = element_text(size = 12),
legend.key.size = unit(1, "cm"),
legend.background = element_rect(fill = "#E5E5E5", # Background
colour = 1) # Border
)
})
}
shinyApp(ui = ui, server = server)
This is what the shinyapps.io log shows:
2024-09-12T13:51:26.716246+00:00 shinyapps[12676668]:
2024-09-12T13:51:26.722101+00:00 shinyapps[12676668]: Listening on http://127.0.0.1:36689
2024-09-12T13:52:00.720938+00:00 shinyapps[12676668]: Running on host: bdd439508af2
2024-09-12T13:52:00.728259+00:00 shinyapps[12676668]: Running as user: uid=10001(shiny) gid=10001(shiny) groups=10001(shiny)
2024-09-12T13:52:00.733535+00:00 shinyapps[12676668]: Connect version: 2024.05.0
2024-09-12T13:52:00.739811+00:00 shinyapps[12676668]: LANG: C.UTF-8
2024-09-12T13:52:00.744908+00:00 shinyapps[12676668]: Working directory: /srv/connect/apps/Veda_mejorado
2024-09-12T13:52:00.750591+00:00 shinyapps[12676668]: Using R 4.4.1
2024-09-12T13:52:00.757821+00:00 shinyapps[12676668]: R.home(): /opt/R/4.4.1/lib/R
2024-09-12T13:52:00.765004+00:00 shinyapps[12676668]: Content will use current R environment
2024-09-12T13:52:00.770890+00:00 shinyapps[12676668]: R_LIBS: (unset)
2024-09-12T13:52:00.779326+00:00 shinyapps[12676668]: .libPaths(): /usr/lib/R, /opt/R/4.4.1/lib/R/library
2024-09-12T13:52:00.785297+00:00 shinyapps[12676668]: shiny version: 1.8.1.1
2024-09-12T13:52:00.790881+00:00 shinyapps[12676668]: httpuv version: 1.6.15
2024-09-12T13:52:00.796939+00:00 shinyapps[12676668]: rmarkdown version: 2.27
2024-09-12T13:52:00.803327+00:00 shinyapps[12676668]: knitr version: 1.48
2024-09-12T13:52:00.808797+00:00 shinyapps[12676668]: jsonlite version: 1.8.8
2024-09-12T13:52:00.815658+00:00 shinyapps[12676668]: RJSONIO version: (none)
2024-09-12T13:52:00.822625+00:00 shinyapps[12676668]: htmltools version: 0.5.8.1
2024-09-12T13:52:00.829501+00:00 shinyapps[12676668]: reticulate version: (none)
2024-09-12T13:52:00.836820+00:00 shinyapps[12676668]: Using pandoc: /opt/connect/ext/pandoc/2.16
2024-09-12T13:52:00.842394+00:00 shinyapps[12676668]:
2024-09-12T13:52:00.847753+00:00 shinyapps[12676668]: Starting R with process ID: '154'
2024-09-12T13:52:00.853833+00:00 shinyapps[12676668]: Shiny application starting ...
2024-09-12T13:52:01.715761+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.723832+00:00 shinyapps[12676668]: Attaching package: ‘dplyr’
2024-09-12T13:52:01.731252+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.740696+00:00 shinyapps[12676668]: The following objects are masked from ‘package:stats’:
2024-09-12T13:52:01.748229+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.754817+00:00 shinyapps[12676668]: filter, lag
2024-09-12T13:52:01.762290+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.768840+00:00 shinyapps[12676668]: The following objects are masked from ‘package:base’:
2024-09-12T13:52:01.776410+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.781726+00:00 shinyapps[12676668]: intersect, setdiff, setequal, union
2024-09-12T13:52:01.787646+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.794802+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.801421+00:00 shinyapps[12676668]: Attaching package: ‘lubridate’
2024-09-12T13:52:01.807220+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.816332+00:00 shinyapps[12676668]: The following objects are masked from ‘package:base’:
2024-09-12T13:52:01.826171+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.831524+00:00 shinyapps[12676668]: date, intersect, setdiff, union
2024-09-12T13:52:01.838399+00:00 shinyapps[12676668]:
2024-09-12T13:52:01.844906+00:00 shinyapps[12676668]: Loading required package: devtools
2024-09-12T13:52:01.852791+00:00 shinyapps[12676668]: Loading required package: usethis
2024-09-12T13:52:02.716244+00:00 shinyapps[12676668]: Downloading GitHub repo rstudio/rsconnect@HEAD
2024-09-12T13:52:03.740725+00:00 shinyapps[12676668]: digest (0.6.36 -> 0.6.37) [CRAN]
2024-09-12T13:52:03.746060+00:00 shinyapps[12676668]: curl (5.2.1 -> 5.2.2 ) [CRAN]
2024-09-12T13:52:03.751426+00:00 shinyapps[12676668]: Installing 2 packages: digest, curl
2024-09-12T13:52:03.756835+00:00 shinyapps[12676668]: Installing packages into ‘/usr/lib/R’
2024-09-12T13:52:03.763674+00:00 shinyapps[12676668]: (as ‘lib’ is unspecified)
I could use any help I can get. Thank you in advance.