library(shiny)
library(shinydashboard)
library(shinythemes)
library(DT)
library(leaflet)
library(leaflet.extras)
library(tmap)
library(tmaptools)
library(shinyWidgets)
library(readxl)
library(dplyr)
library(openxlsx)
library(utils)
library(sp)
library(sf)
library(zoo)
library(ggplot2)
library(dplyr)
library(htmlwidgets)
library(lubridate)
library(shinyjs)
#current_directory <- "C:/Users/danie/OneDrive/Documents/Scripts/Geovisor FF"
#setwd(current_directory)
data <- read_excel("FF.xlsx")
data <- subset(data, !is.na(data$'ESTE'))
nrows <- nrow(data)
Geovisor <- data.frame(
Plan_Muestreo = character(nrows),
estex = numeric(nrows),
nortey = numeric(nrows),
Geometria=character(nrows),
Fuente=character(nrows),
CIIU=character(nrows),
FechaMuestreo = as.Date(character(nrows), format = "%Y-%m-%d"),
Contaminantes=character(nrows),
Parametro=character(nrows),
Unidades=character(nrows),
Valor = numeric(nrows)
)
Geovisor$Plan_Muestreo <- data$Plan_Muestral
Geovisor$Fuente <- data$Fuente
Geovisor$CIIU <- data$CIIU
Geovisor$estex <- as.numeric(data$ESTE)
Geovisor$nortey <- as.numeric(data$NORTE2)
Geovisor$Geometria <- data$'Geometria Chimenea'
Geovisor$FechaMuestreo <- data$'Fecha del muestreo (aa-mm-dd)'
Geovisor$Year <- year(Geovisor$FechaMuestreo)
Geovisor$Contaminantes <- data$Contaminantes
Geovisor$Parametro <- data$Parametro
Geovisor$Unidades <- data$Unidades
Geovisor$Valor <- data$Valor
puntos <- subset(Geovisor,!duplicated(Plan_Muestreo))
puntos <- st_as_sf(puntos, coords = c("estex","nortey"))
st_crs(puntos) <- 9377
CIRCULAR <- subset(puntos, puntos$Geometria== "Circular")
RECTANGULAR <- subset(puntos, puntos$Geometria== "Rectangular")
crear_cuadrado <- function(punto, tamano) {
x <- st_coordinates(punto)[1, 1]
y <- st_coordinates(punto)[1, 2]
# Calcular las coordenadas de los vértices del cuadrado
vertices <- matrix(
c(
x - tamano, y - tamano,
x + tamano, y - tamano,
x + tamano, y + tamano,
x - tamano, y + tamano,
x - tamano, y - tamano
),
ncol = 2,
byrow = TRUE
)
# Crear el polígono cuadrado
cuadrado <- st_polygon(list(vertices))
return(cuadrado)
}
# Definir el tamaño del cuadrado en unidades (ajusta según sea necesario)
tamano_cuadrado <- 1 # Por ejemplo, 1 unidad
# Crear un cuadrado alrededor de cada punto
cuadrados <- lapply(RECTANGULAR$geometry, crear_cuadrado, tamano = tamano_cuadrado)
cuadrados_sf <- st_sfc(cuadrados)
st_crs(cuadrados_sf) <- st_crs(9377)
cuadrados_df <- as.data.frame(cuadrados_sf)
cuadrados_df <- st_as_sf(cuadrados_df)
cuadrados_df$Plan_Muestral <- RECTANGULAR$Plan_Muestreo
RECTANGULAR<-cuadrados_df
# Definición de la interfaz de usuario
ui <- dashboardPage(skin="blue",
dashboardHeader(title = " FUENTES FIJAS"),
dashboardSidebar(
sidebarMenu(
img(src = "Car.png", height = 100, width = 100, style="display: block; margin-left: auto; margin-right: auto;"),
shinydashboard::menuItem("GEOVISOR FUENTES FIJAS", tabName = "intro")
)
),
dashboardBody(
useShinyjs(),
tabItems(
tabItem(tabName = "intro",
h1("Historico Fuentes Fijas", align = "center"),
h1(" "),
h1(" "),
h3(" ", align = "justify"),
fluidRow(
column(width = 6,
box(title = "MAPA", height = "1200px", width = NULL,
# Mapa de leaflet
leafletOutput("mapa", width = "100%", height = "1100px")
)),
column(width = 6,
box(title = "CONSULTA", height = "1200px", width = NULL,
h4("Coordenada", align = "justify"),
fluidRow(
column(width = 6,
numericInput("Norteu", "Norte:", value = "2110000")),
column(width = 6,
numericInput("Esteu", "Este:", value = "4880000"))),
fluidRow(
column(width = 6,
pickerInput(
inputId = "Date",
label = "Año",
choices = as.list(sort(unique(Geovisor$Year))),
multiple = TRUE,
options = list(
`actions-box` = TRUE,
`select-all-text` = "Seleccionar todas",
`deselect-all-text` = "Deseleccionar todas",
`none-selected-text` = "Ningun elemento seleccionado"
)
)
),
column(width = 6,
pickerInput(
inputId = "Param",
label = "Parametro",
choices = as.list(sort(unique(Geovisor$Parametro))),
multiple = TRUE,
options = list(
`actions-box` = TRUE,
`select-all-text` = "Seleccionar todas",
`deselect-all-text` = "Deseleccionar todas",
`none-selected-text` = "Ningun elemento seleccionado"
)
)
)
),
actionButton("refreshMap", "Inicializar Mapa"),
downloadButton("downloadData", "Descargar Histórico Completo"),
downloadButton("downloadFiltro", "Descargar Datos Consultados"),
DTOutput("TabFiltro"),)),
)
)
)
)
)
server <- function(input, output,session) {
coordenadas <- reactive({
lat <- as.numeric(input$Norteu)
lon <- as.numeric(input$Esteu)
if (!is.na(lat) && !is.na(lon)) {
data.frame(lon = lon, lat = lat) %>%
st_as_sf(coords = c("lon", "lat"), crs = 9377) # Cambiar el SRS según corresponda
} else {
NULL
}
})
output$mapa <- renderLeaflet({
COORDENADA <- coordenadas()
# Mostrar el mapa interactivo
tmapMap <- tm_basemap(server = "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png") +
tm_shape(COORDENADA) + tm_dots(size = 0.1, col = "#00FF00") +
tm_shape(CIRCULAR) + tm_dots(size = 0.1, col = "red") +
tm_shape(RECTANGULAR) + tm_dots(size = 0.1, col = "blue")
leafletMap <- tmap_leaflet(tmapMap, in.shiny = TRUE) %>%
addLayersControl(overlayGroups = c('COORDENADA','CIRCULAR','RECTANGULAR'), options = layersControlOptions(collapsed = FALSE)) %>%
htmlwidgets::onRender("
function(map) {
var overlayLayers = document.querySelectorAll('.leaflet-control-layers-selector');
overlayLayers.forEach(function(overlayLayer) {
var layerName = overlayLayer.nextSibling.textContent.trim();
var color = 'transparent';
if (layerName === 'COORDENADA') {
color = '#00FF00';
}else if (layerName === 'CIRCULAR') {
color = 'red';
} else if (layerName === 'RECTANGULAR') {
color = 'blue';
}
var dot = document.createElement('span');
dot.style.width = '12px';
dot.style.height = '12px';
dot.style.display = 'inline-block';
dot.style.marginRight = '5px';
dot.style.backgroundColor = color;
overlayLayer.parentNode.insertBefore(dot, overlayLayer);
});
}
")
return(leafletMap)
})
#####################################-METODO ACTUALIZAR PUNTOS CON DATES-############################################
# Observe changes in the Date input and update the map
ultima_fecha <- reactiveVal(NULL)
observeEvent(input$Date, {
# Actualiza el mapa inmediatamente cuando cambia la fecha
actualizar_mapa()
})
# Función para actualizar el mapa después de un retraso
actualizar_mapa <- function() {
isolate({
filtered_data <- Geovisor
if (!is.null(input$Param) && !is.null(input$Date)) {
filtered_data <- subset(filtered_data, `Parametro` %in% input$Param & `Year` %in% input$Date)
} else if (!is.null(input$Param)) {
filtered_data <- subset(filtered_data, `Parametro` %in% input$Param)
} else if (!is.null(input$Date)) {
filtered_data <- subset(filtered_data, `Year` %in% input$Date)
}
datos_filtrados <- filtered_data
puntos <- st_as_sf(datos_filtrados, coords = c("estex", "nortey"))
st_crs(puntos) <- 9377
CIRCULAR <- puntos[puntos$Geometria == "Circular", ]
RECTANGULAR <- puntos[puntos$Geometria == "Rectangular", ]
tmapMap <-
tm_shape(CIRCULAR) + tm_dots(size = 0.1, col = "red") +
tm_shape(RECTANGULAR) + tm_dots(size = 0.1, col = "blue")
leafletMap <- tmap_leaflet(tmapMap, in.shiny = TRUE) %>%
addProviderTiles(providers$OpenStreetMap)
# Actualiza el mapa en Shiny reemplazando el mapa existente
output$mapa <- renderLeaflet({
return(leafletMap)
})
})
observeEvent(input$refreshMap, {
session$reload()
})
}
#Tabla de datos Filtrada
output$TabFiltro <- renderDT({
filtered_data <- Geovisor
if (!is.null(input$Param) && !is.null(input$Date)) {
filtered_data <- subset(filtered_data, `Parametro` %in% input$Param & `Year` %in% input$Date)
} else if (!is.null(input$Param)) {
filtered_data <- subset(filtered_data, `Parametro` %in% input$Param)
} else if (!is.null(input$Date)) {
filtered_data <- subset(filtered_data, `Year` %in% input$Date)
}
datatable(
data = filtered_data,
options = list(
pageLength = 15, # Cantidad de filas por página
lengthMenu = list(c(5,10, 25, 50, 100), c('5','10', '25', '50', '100')), # Opciones de paginación predefinidas
scrollX = TRUE,
scrollXInner = "100%", # Habilitar la barra de desplazamiento horizontal
scrollY = "800px"
),
width = "100%"
) %>%
formatStyle(
columns = c(1000), # Establece el ancho de las columnas 1 y 2 según tus necesidades
width = "100px" # Ajusta el ancho deseado de las columnas
)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("Datos", ".xlsx", sep = "")
},
content = function(file) {
write.xlsx(Geovisor, file, row.names = FALSE)
},
contentType = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
)
#Boton de Descarga Filtro
output$downloadFiltro <- downloadHandler(
filename = function() {
paste("Datos Consultados", ".xlsx", sep = "")
},
content = function(file) {
filtered_data <- Geovisor
if (!is.null(input$Param) && !is.null(input$Date)) {
filtered_data <- subset(filtered_data, `Parametro` %in% input$Param & `Year` %in% input$Date)
} else if (!is.null(input$Param)) {
filtered_data <- subset(filtered_data, `Parametro` %in% input$Param)
} else if (!is.null(input$Date)) {
filtered_data <- subset(filtered_data, `Year` %in% input$Date)
}
write.xlsx(filtered_data, file, row.names = FALSE)
},
contentType = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
)
}
shinyApp(ui, server)
i am having this in the shinyapp.io points in arabic peninsula:
but i need it in colombia working in rstudio but not in de deploying part:
