The application works locally but does not deploy.
Here you can see part of the code:
paquetes <- c(
"rsconnect", "shiny", "shinyWidgets", "shinydashboard", "shinycssloaders",
"DT", "tidyr", "ggplot2", "plotly", "dplyr", "bslib", "shinythemes", "bs4Dash",
"lubridate", "png", "readxl", "writexl", "leaflet", "webshot", "httr",
"jsonlite", "DBI", "RSQLite", "digest", "shinymanager"
)
paquetes_no_instalados <- paquetes[!paquetes %in% installed.packages()[, "Package"]]
if (length(paquetes_no_instalados) > 0) {
install.packages(paquetes_no_instalados)
} else {
cat("Todos los paquetes ya están instalados.\n")
}
lapply(paquetes, library, character.only = TRUE)
balcarce_EMC <- read_excel("balcarce_EMC.xlsx",
col_types = c("date", "text", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"text", "numeric", "text", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric", "numeric",
"numeric", "numeric"))
dalbulus <- read_excel("dalbulus.xlsx")
ui <-
dashboardPage(
title = "Agrometeorología Balcarce",
skin = "#2596be",
dashboardHeader(
title = div(
style = "font-size: 24px; font-weight: bold; text-align: center; color: black;",
"Agrometeorología Balcarce"
# # titleWidth = 350,
# # tags$style(HTML('.navbar { background-color: #2596be; }'))
),
tags$li(class = "dropdown",
style = "float: right; padding-right: 10px; list-style: none;",
tags$a(href = "https://www.instagram.com/agromet_inta.balcarce/#",
target = "instagram",
icon("instagram"),
title = "Instagram",
style = "font-size: 20px; color: black;")),
tags$li(class = "dropdown",
style = "float: right; padding-right: 10px; list-style: none;",
tags$a(href = "https://github.com/Nuria1982",
target = "gitHub",
icon("github"),
title = "GitHub",
style = "font-size: 20px; color: black;"))
),
dashboardSidebar(
width = 350,
tags$style(HTML("
.main-sidebar {
background-color: white;
}
.main-sidebar .sidebar-menu > li > a {
color: black;
}
")),
fluid = FALSE,
position = "left",
disable = FALSE,
collapsed = FALSE,
br(),
br(),
div(
style = "text-align: center;",
tags$img(src = "EstacionBalcarce.jpg",
height = "80px",
width = "220px")
),
br(),
br(),
sidebarMenu(id = "siderbarID",
menuItem("Condiciones actuales",
tabName = "condiciones",
icon = icon("calendar")),
menuItem("Cambio climático",
tabName = "cambio_climatico",
icon = icon("earth-americas")),
# menuItem("Mapas",
# tabName = "mapas",
# icon = icon("map")),
menuItem("Manejo de los cultivos",
icon = icon("seedling"),
menuSubItem("Ambiente",
tabName = "ambiente"),
menuSubItem("Balance de agua",
tabName = "balance")
# ,
# menuSubItem("Huella hídrica",
# tabName = "huella_hidrica")
# menuSubItem("Dalbulus",
# tabName = "Dalbulus")
),
menuItem("Pronósticos",
tabName = "pronosticos",
icon = icon("bar-chart")),
menuItem("informes",
tabName = "informes",
icon = icon("file")),
menuItem("Descarga de datos",
tabName = "descarga",
icon = icon("download")),
menuItem("Referencias bibliográficas",
tabName = "referencias",
icon = icon("book"))),
br(),
br(),
tags$p(
# strong("Nuestras Redes sociales"),
# br(),
# tags$a(
# icon("instagram"), "Instagram", href= "https://www.instagram.com/agromet_inta.balcarce/#"),
# # br(),
# # tags$a(
# # icon("twitter"), "Twitter", href= "https://twitter.com/agrometbalcarce"),
# br(),
tags$p(
strong("Para comunicarse con el grupo "),
tags$h6(
"Dra. Nuria Lewczuk : lewczuk.nuria@inta.gob.ar"),
tags$h6(
"Dra. Laura Echarte : echarte.laura@inta.gob.ar")
),
div(
style = "text-align: center;",
tags$img(src = "IPADS.png",
height = "80px",
width = "150px"
),
tags$img(src = "Logo_Red_Agromet.jpg",
height = "80px",
width = "200px")
)
)
),
dashboardBody(
tags$head(
tags$style(HTML("
.small-box {height: 80px;
text-align:center;
display: flex;
flex-direction: column;
justify-content: center;
}
.fixed-footer {
position: fixed;
bottom: 0;
left: 50px;
width: 100%;
padding: 10px 0;
}
.small-box .icon {
font-size: 50px;
opacity: 0.6;
}
.small-box h3 {
font-size: 20px;
font-weight: bold;
text-align: center;
}
.small-box p {
font-size: 16px;
font-weight: bold;
text-align: center;
}
"))
),
tabItems(
tabItem(tabName = "condiciones",
fluidRow(
#infoBoxOutput(width = 2, "value5"),
infoBoxOutput(width = 3, "value1"),
infoBoxOutput(width = 3, "value2"),
infoBoxOutput(width = 3, "value3"),
infoBoxOutput(width = 3, "value4")
),
br(),
fluidRow(
infoBoxOutput(width = 4, "precipitation_info_box"),
infoBoxOutput(width = 4, "tempMax_info_box"),
infoBoxOutput(width = 4, "tempMin_info_box")
),
br(),
fluidRow(
column(6,
fluidRow(
column(6,
selectInput(
inputId = "ano_selector",
label = "Selecciona el Año:",
choices = unique(datos$Año),
selected = "2024"
)
),
column(6,
selectInput(
inputId = "mes_selector",
label = "Selecciona los meses:",
choices = c("Mostrar todos los meses",
"enero", "febrero", "marzo", "abril",
"mayo", "junio", "julio", "agosto",
"septiembre", "octubre", "noviembre", "diciembre"),
selected = "Mostrar todos los meses",
multiple = TRUE
)
)
)
)
),
br(),
fluidRow(
box(
title = "Precipitaciones acumuladas mensuales (mm)"
,status = "gray"
,solidHeader = TRUE
,collapsible = TRUE
,withSpinner(plotlyOutput("grafico_lluvia", height = "300px"),
type = 5,
color = "#0dc5c1",
size = 0.5)
),
box(
title = "Precipitaciones y ETo acumuladas mensuales (mm)"
,status = "gray"
,solidHeader = TRUE
,collapsible = TRUE
,withSpinner(plotlyOutput("grafico_lluvia_etp_acum", height = "300px"),
type = 5,
color = "#0dc5c1",
size = 0.5)
),
box(
title = "Temperaturas medias mensuales (ºC)"
,status = "gray"
,solidHeader = TRUE
,collapsible = TRUE
,withSpinner(plotlyOutput("grafico_temperatura", height = "300px"),
type = 5,
color = "#0dc5c1",
size = 0.5)
),
box(
title = "Número de días mensuales con heladas"
,status = "gray"
,solidHeader = TRUE
,collapsible = TRUE
,withSpinner(plotlyOutput("grafico_heladas", height = "300px"),
type = 5,
color = "#0dc5c1",
size = 0.5)
)
)
),
............
server <- function(input, output, session) {
######### Info EMC Balcarce ###########
promedio_historico <- mean(
aggregate(Precipitacion_Pluviometrica ~ Año, data = datos_historicos, FUN = sum)$Precipitacion_Pluviometrica
)
promedio_historico_ttmax <- mean(
aggregate(Temperatura_Abrigo_150cm_Maxima ~ Año, data = datos_historicos, FUN = mean)$Temperatura_Abrigo_150cm_Maxima
)
promedio_historico_ttmin <- mean(
aggregate(Temperatura_Abrigo_150cm_Minima ~ Año, data = datos_historicos, FUN = mean)$Temperatura_Abrigo_150cm_Minima
)
current_year <- max(datos_actuales$Año)
pp_acum <- sum(subset(datos_actuales, Año == current_year)$Precipitacion_Pluviometrica)
ttmax_anual <- mean(subset(datos_actuales, Año == current_year)$Temperatura_Abrigo_150cm_Maxima)
ttmin_anual <- mean(subset(datos_actuales, Año == current_year)$Temperatura_Abrigo_150cm_Minima, na.rm = TRUE)
ultima_fecha <- max(datos_actuales$Fecha)
ultimos_datos <- datos_actuales[datos_actuales$Fecha == ultima_fecha, ]
lluvia_ultimo_dia <- ultimos_datos$Precipitacion_Pluviometrica
Tmax_ultimo_dia <- ultimos_datos$Temperatura_Abrigo_150cm_Maxima
Tmin_ultimo_dia <- ultimos_datos$Temperatura_Abrigo_150cm_Minima
datasetInput <- reactive({
if (input$ano_selector == "Todos los años") {
datos_filtrados <- datos_actuales
} else {
datos_filtrados <- subset(datos_actuales, Año == input$ano_selector)
}
if (!"Mostrar todos los meses" %in% input$mes_selector) {
meses_seleccionados <- input$mes_selector
datos_filtrados <- subset(datos_filtrados, Mes %in% meses_seleccionados)
} else {
datos_filtrados <- datos_filtrados
}
return(datos_filtrados)
})
output$value1 <- renderInfoBox({
infoBox(
title = div(p("Ultima fecha",
style = "text-align: center; font-size: 20px; font-weight: bold;"),
style = "margin-bottom: 6px;"),
value = div(format(ultima_fecha, "%d/%m/%Y"),
style = "text-align: center; font-size: 28px; font-weight: bold;"),
icon = icon("calendar"),
color = "orange",
fill = TRUE
)
})
output$value2 <- renderInfoBox({
infoBox(
title = div(p("Lluvia",
style = "text-align: center;font-size: 20px; font-weight: bold;"),
style = "margin-bottom: 6px;"),
value = div(paste(round(lluvia_ultimo_dia, 1), "mm"),
style = "text-align: center; font-size: 28px; font-weight: bold;"),
icon = icon("tint"),
color = "info",
fill = TRUE
)
})
output$value3 <- renderInfoBox({
infoBox(
title = div(p("Temperatura Máxima",
style = "text-align: center;font-size: 20px; font-weight: bold;"),
style = "margin-bottom: 6px;"),
value = div(paste(round(Tmax_ultimo_dia, 1), "ºC"),
style = "text-align: center; font-size: 28px; font-weight: bold;"),
icon = icon("sun"),
color = "danger",
fill = TRUE
)
})
output$value4 <- renderInfoBox({
infoBox(
title = div(p("Temperatura Mínima",
style = "text-align: center;font-size: 20px; font-weight: bold;"),
style = "margin-bottom: 6px;"),
value = div(paste(round(Tmin_ultimo_dia, 1), "ºC"),
style = "text-align: center; font-size: 28px; font-weight: bold;"),
icon = icon("snowflake"),
color = "warning",
fill = TRUE
)
})
output$precipitation_info_box <- renderInfoBox({
infoBox(
title = "Precipitaciones Acumuladas",
value = paste("Acumulado Año ", current_year, ": ", round(pp_acum, 0), "mm"),
subtitle = paste("Promedio Histórico anual (1991-2020): ", round(promedio_historico, 0), "mm"),
icon = icon("tint"),
color = "info"
)
})
output$tempMax_info_box <- renderInfoBox({
infoBox(
title = "Temperaturas Máximas",
value = paste("Promedio Año ", current_year, ": ", round(ttmax_anual, 2), "ºC"),
subtitle = paste("Promedio Histórico anual (1991-2020): ", round(promedio_historico_ttmax, 2), "ºC"),
icon = icon("sun"),
color = "danger"
)
})
output$tempMin_info_box <- renderInfoBox({
infoBox(
title = "Temperaturas Mínimas",
value = paste("Promedio Año ", current_year, ": ", round(ttmin_anual, 2),"ºC"),
subtitle = paste("Promedio Histórico anual (1991-2020): ", round(promedio_historico_ttmin, 2), "ºC"),
icon = icon("snowflake"),
color = "warning"
)
})
output$grafico_lluvia <- renderPlotly({
dataset_acumulado <- datasetInput() %>%
mutate(Mes = month(Fecha, label = TRUE)) %>%
group_by(Mes) %>%
summarise(Precipitacion_Acumulada = round(sum(Precipitacion_Pluviometrica,
na.rm = TRUE), 1)) %>%
ungroup()
historical_precipitation <- datos_historicos %>%
mutate(Mes = month(Fecha, label = TRUE)) %>%
group_by(Año, Mes) %>%
summarise(Precipitacion_Historica = sum(Precipitacion_Pluviometrica,
na.rm = TRUE),
.groups = 'drop')
historical_precipitation_mensual <- historical_precipitation %>%
group_by(Mes) %>%
summarise(Precipitacion_Historica_Mensual = round(mean(Precipitacion_Historica,
na.rm = TRUE), 1),
.groups = 'drop')
dataset_completo <- dataset_acumulado %>%
left_join(historical_precipitation_mensual, by = "Mes")
anio_seleccionado_label <- input$ano_selector
dataset_completo_long <- dataset_completo %>%
pivot_longer(cols = c(Precipitacion_Historica_Mensual,
Precipitacion_Acumulada),
names_to = "Tipo_Precipitacion",
values_to = "Precipitacion") %>%
mutate(Tipo_Precipitacion = factor(Tipo_Precipitacion,
levels = c("Precipitacion_Historica_Mensual",
"Precipitacion_Acumulada"),
labels = c("Histórico (1991 - 2020)",
paste("Año", anio_seleccionado_label))))
ll <- ggplot(dataset_completo, aes(x = Mes)) +
geom_bar(aes(y = Precipitacion_Historica_Mensual),
stat = "identity",
fill = "#6C757D",
color = "#495057",
alpha = 0.5) +
geom_bar(aes(y = Precipitacion_Acumulada),
stat = "identity",
fill = "#007EA7",
color = "#003459",
alpha = 0.5) +
labs(x = "", y = "Precipitación acumulada \nmensual (mm)", fill = "") +
ggtitle("") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 0, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "black"))
ggplotly(ll) %>%
layout(legend = list(orientation = "h",
x = 0.3,
y = 1.2))
})
output$grafico_lluvia_etp_acum <- renderPlotly({
dataset_acumulado <- datasetInput() %>%
mutate(Mes = month(Fecha, label = TRUE)) %>%
group_by(Mes) %>%
summarise(Precipitacion_Acumulada = round(sum(Precipitacion_Pluviometrica,
na.rm = TRUE), 1),
Evapotranspiracion_Acumulada = round(sum(Evapotranspiracion_Potencial,
na.rm = TRUE)), 1)
acum <- ggplot(dataset_acumulado, aes(x = Mes)) +
geom_bar(aes(y = Precipitacion_Acumulada),
stat = "identity",
fill = "#007EA7",
color = "#003459",
alpha = 0.5) +
geom_bar(aes(y = Evapotranspiracion_Acumulada),
stat = "identity",
fill = "#BF4342",
color = "#8C1C13",
alpha = 0.5) +
scale_fill_manual(name = "") +
labs(x = "", y = "Acumulado mensual (mm)",
fill = "") +
ggtitle("") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 0,
hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "black"))
ggplotly(acum) %>%
layout(legend = list(orientation = "h",
x = 0.1,
y = 1.2))
})
output$grafico_temperatura <- renderPlotly({
# Datos de temperaturas para el año seleccionado
temperaturas_mensuales <- datasetInput() %>%
mutate(Mes = month(Fecha,
label = TRUE)) %>%
group_by(Mes) %>%
summarise(Temperatura_Maxima = round(mean(Temperatura_Abrigo_150cm_Maxima,
na.rm = TRUE), 1),
Temperatura_Minima = round(mean(Temperatura_Abrigo_150cm_Minima,
na.rm = TRUE), 1))
historico_temperaturas_mensual <- datos_historicos %>%
mutate(Mes = month(Fecha,
label = TRUE)) %>%
group_by(Mes) %>%
summarise(Temp_Max_Historica = round(mean(Temperatura_Abrigo_150cm_Maxima,
na.rm = TRUE), 1),
Temp_Min_Historica = round(mean(Temperatura_Abrigo_150cm_Minima,
na.rm = TRUE), 1)) %>%
ungroup()
dataset_completo_temperatura <- temperaturas_mensuales %>%
left_join(historico_temperaturas_mensual,
by = "Mes")
dataset_completo_temperatura_long <- dataset_completo_temperatura %>%
pivot_longer(cols = c(Temp_Max_Historica, Temp_Min_Historica,
Temperatura_Maxima, Temperatura_Minima),
names_to = "Temperatura",
values_to = "temperatura") %>%
mutate(Temperatura = factor(Temperatura,
levels = c("Temperatura_Maxima",
"Temp_Max_Historica",
"Temperatura_Minima",
"Temp_Min_Historica"),
labels = c("Máxima Año Seleccionado",
"Máxima Histórica (1991 - 2020)",
"Mínima Año Seleccionado",
"Mínima Histórica (1991 - 2020)")))
temp_plot <- ggplot(dataset_completo_temperatura_long, aes(x = Mes,
y = temperatura,
color = Temperatura,
group = Temperatura)) +
geom_line(linewidth = 1) +
geom_point(size = 1) +
scale_color_manual(values = c("Máxima Año Seleccionado" = "#D00000",
"Máxima Histórica (1991 - 2020)" = "#FCB9B2",
"Mínima Año Seleccionado" = "#FFBA08",
"Mínima Histórica (1991 - 2020)" = "#EDDEA4"
)) +
labs(x = "", y = "Temperatura media mensual (ºC)",
color = "") +
ggtitle("") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 0,
hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "black"))
ggplotly(temp_plot) %>%
layout(legend = list(orientation = "v",
x = 0.4,
y = 1.2))
})
output$grafico_heladas <- renderPlotly({
promedio_heladas <- datasetInput() %>%
filter(Temperatura_Abrigo_150cm_Minima < 3) %>%
group_by(Mes) %>%
summarise(Dias_Temperatura_Minima_Menor_3C = n()) %>%
mutate(Mes = factor(substr(Mes, 1, 3), levels = c("ene", "feb", "mar", "abr",
"may", "jun", "jul", "ago",
"sep", "oct", "nov", "dic"),
ordered = TRUE))
hh <- ggplot(promedio_heladas, aes(x = Mes,
y = Dias_Temperatura_Minima_Menor_3C)) +
geom_bar(stat = "identity", fill = "#FFBA08", color = "#FF9F1C") +
labs(title = "",
x = "",
y = "Número de días con\nTemperatura mínimas < 3ºC") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 0, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.ticks = element_blank(),
axis.line = element_line(color = "black"))
ggplotly(hh) %>%
layout(legend = list(orientation = "h", x = 0.1, y = 1.2))
})
datasetInput_climatico <- reactive({
datos_filtrados_climatico <- datos
if (!is.null(input$mes_climatico) && !"Anual" %in% input$mes_climatico) {
datos_filtrados_climatico <- subset(datos_filtrados_climatico, Mes == input$mes_climatico)
}
return(datos_filtrados_climatico)
})
..............
shinyApp(ui = ui, server = server)