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)
cordinates should be in colombia but it is appearing in arabic emirates but in shiny of rstudio is working but in shinyapp.io no the logs od the shinyapp.io is thisone
2023-10-02T22:53:53.384692+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.389444+00:00 shinyapps[10053717]: as.Date, as.Date.numeric
2023-10-02T22:53:53.394592+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.399248+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.403769+00:00 shinyapps[10053717]: Attaching package: ‘lubridate’
2023-10-02T22:53:53.408468+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.413705+00:00 shinyapps[10053717]: The following objects are masked from ‘package:base’:
2023-10-02T22:53:53.418963+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.423700+00:00 shinyapps[10053717]: date, intersect, setdiff, union
2023-10-02T22:53:53.428557+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.433500+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.438301+00:00 shinyapps[10053717]: Attaching package: ‘shinyjs’
2023-10-02T22:53:53.443040+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.447812+00:00 shinyapps[10053717]: The following object is masked from ‘package:lubridate’:
2023-10-02T22:53:53.452517+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.457278+00:00 shinyapps[10053717]: show
2023-10-02T22:53:53.461949+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.466673+00:00 shinyapps[10053717]: The following object is masked from ‘package:sp’:
2023-10-02T22:53:53.471515+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.476036+00:00 shinyapps[10053717]: show
2023-10-02T22:53:53.480620+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.485392+00:00 shinyapps[10053717]: The following object is masked from ‘package:shinyWidgets’:
2023-10-02T22:53:53.490237+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.494979+00:00 shinyapps[10053717]: alert
2023-10-02T22:53:53.499649+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.504526+00:00 shinyapps[10053717]: The following object is masked from ‘package:shiny’:
2023-10-02T22:53:53.509640+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.514319+00:00 shinyapps[10053717]: runExample
2023-10-02T22:53:53.519604+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.524545+00:00 shinyapps[10053717]: The following objects are masked from ‘package:methods’:
2023-10-02T22:53:53.529506+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.534585+00:00 shinyapps[10053717]: removeClass, show
2023-10-02T22:53:53.539296+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.544092+00:00 shinyapps[10053717]: Warning: PROJ: proj_create_from_database: crs not found (GDAL error 1)
2023-10-02T22:53:53.549016+00:00 shinyapps[10053717]: Warning: PROJ: proj_create_from_database: crs not found (GDAL error 1)
2023-10-02T22:53:53.553875+00:00 shinyapps[10053717]:
2023-10-02T22:53:53.558510+00:00 shinyapps[10053717]: Listening on http://127.0.0.1:33861
2023-10-02T22:53:55.374344+00:00 shinyapps[10053717]: Warning: PROJ: proj_create_from_database: crs not found (GDAL error 1)
2023-10-02T22:53:55.379205+00:00 shinyapps[10053717]: Simple feature collection with 1 feature and 0 fields
2023-10-02T22:53:55.383828+00:00 shinyapps[10053717]: Geometry type: POINT
2023-10-02T22:53:55.388532+00:00 shinyapps[10053717]: Dimension: XY
2023-10-02T22:53:55.393578+00:00 shinyapps[10053717]: Bounding box: xmin: 4880000 ymin: 2110000 xmax: 4880000 ymax: 2110000
2023-10-02T22:53:55.398384+00:00 shinyapps[10053717]: CRS: NA
2023-10-02T22:53:55.403047+00:00 shinyapps[10053717]: geometry
2023-10-02T22:53:55.407680+00:00 shinyapps[10053717]: 1 POINT (4880000 2110000)
2023-10-02T22:53:55.412336+00:00 shinyapps[10053717]: Warning: The projection of the shape object COORDENADA is not known, while it seems to be projected.
2023-10-02T22:53:55.417137+00:00 shinyapps[10053717]: Warning: Current projection of shape COORDENADA unknown and cannot be determined.
2023-10-02T22:53:55.421856+00:00 shinyapps[10053717]: Warning: Current projection of shape CIRCULAR unknown and cannot be determined.
2023-10-02T22:53:55.426520+00:00 shinyapps[10053717]: Warning: Current projection of shape RECTANGULAR unknown and cannot be determined.
2023-10-02T23:24:51.370047+00:00 shinyapps[10053717]: Container event from container-8684023: stop