library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)
library(DT)
library(shinythemes)
# database
df <- structure(list(Properties = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35), Latitude = c(
-23.8, -23.8, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9,
+-23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9
), Longitude = c(
-49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.7,
+-49.7, -49.7, -49.7, -49.7, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6
), Waste = c(
526, 350, 526, 469, 285, 175, 175, 350, 350, 175, 350, 175, 175, 364,
+175, 175, 350, 45.5, 54.6, 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, 350
)), class = "data.frame", row.names = c(NA, -35L))
ui <- bootstrapPage(
navbarPage(
theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel(
"Solution",
# fileInput("data", h3("Import excel")),
sidebarLayout(
sidebarPanel(
radioButtons("filter1", h3("Select properties"),
choices = list(
"All properties" = 1,
"Exclude properties" = 2
),
selected = 1
),
radioButtons("filter2", h3("Select properties"),
choices = list(
"All properties" = 1,
"Exclude properties" = 2
),
selected = 1
),
tags$hr(),
tags$b(h3("Satisfied?")),
tags$b(h5("(a) Choose other filters")),
tags$b(h5("(b) Choose clusters")),
sliderInput("Slider", h5(""),
min = 2, max = 8, value = 5
),
tags$hr(),
actionButton("reset", "Reset")
),
mainPanel(
tabsetPanel(
tabPanel("Solution", plotOutput("ScatterPlot"))
)
)
)
)
),
tabPanel(
"",
sidebarLayout(
sidebarPanel(
selectInput("select", label = h4("Select just one cluster to show"), ""),
),
mainPanel(
tabsetPanel(
tabPanel("Map", plotOutput("ScatterPlot1"))
)
)
)
)
)
server <- function(input, output, session) {
calculated_objects <- reactive({
k <- req(input$Slider)
# Filter1 <- 1
# Filter2 <- 1
# df <- df
# cluster
coordinates <- df[c("Latitude", "Longitude")]
d <- as.dist(distm(coordinates[, 2:1]))
fit.average <- hclust(d, method = "average")
# Number of clusters
clusters <- cutree(fit.average, k)
nclusters <- matrix(table(clusters))
df$cluster <- clusters
# Localization
center_mass <- matrix(nrow = k, ncol = 2)
for (i in 1:k) {
center_mass[i, ] <- c(
weighted.mean(subset(df, cluster == i)$Latitude, subset(df, cluster == i)$Waste),
weighted.mean(subset(df, cluster == i)$Longitude, subset(df, cluster == i)$Waste)
)
}
coordinates$cluster <- clusters
center_mass <- cbind(center_mass, matrix(c(1:k), ncol = 1))
# Coverage
coverage <- matrix(nrow = k, ncol = 1)
for (i in 1:k) {
aux_dist <- distm(rbind(subset(coordinates, cluster == i), center_mass[i, ])[, 2:1])
coverage[i, ] <- max(aux_dist[nclusters[i, 1] + 1, ])
}
coverage <- cbind(coverage, matrix(c(1:k), ncol = 1))
colnames(coverage) <- c("Coverage_meters", "cluster")
# Sum of Waste from clusters
sum_waste <- matrix(nrow = k, ncol = 1)
for (i in 1:k) {
sum_waste[i, ] <- sum(subset(df, cluster == i)["Waste"])
}
sum_waste <- cbind(sum_waste, matrix(c(1:k), ncol = 1))
colnames(sum_waste) <- c("Potential_Waste_m3", "cluster")
return(list("df"=df,
"clusters"=clusters,
"coverage"=coverage,
"sum_waste"=sum_waste,
"center_mass"=center_mass))
})
data_table_1 <- reactive({
co <- req(calculated_objects())
# Output table
data_table <- Reduce(merge, list(co$df, co$coverage, co$sum_waste))
data_table <- data_table[order(data_table$cluster, as.numeric(data_table$Properties)), ]
data_table_1 <- aggregate(. ~ cluster +
Coverage_meters +
Potential_Waste_m3,
data_table[, c(1, 7, 6, 2)], toString)
})
# Scatter Plot 1 # all
splot1<- reactive({
co <- req(calculated_objects())
k <- req(input$Slider)
center_mass<-co$center_mass
df<-co$df
clusters <- co$clusters
df1 <- as.data.frame(center_mass)
colnames(df1) <- c("Latitude", "Longitude", "cluster")
g <- ggplot(data = df,
aes(x = Longitude, y = Latitude, color = factor(clusters))) +
geom_point(aes(x = Longitude, y = Latitude), size = 4)
Centro_View <- g + geom_text(data = df,
mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
size = 3, hjust = -0.1) +
geom_point(data = df1, mapping = aes(Longitude, Latitude), color = "green", size = 4) +
geom_text(data = df1, mapping = aes(x = Longitude, y = Latitude, label = 1:k), color = "black", size = 4)
Centro_View + ggtitle("Scatter Plot") + theme(plot.title = element_text(hjust = 0.5))
})
splot2<- reactive({
co <- req(calculated_objects())
k <- req(input$Slider)
sel <- req(input$select)
center_mass<-co$center_mass
df<-co$df
clusters <- co$clusters
df1 <- as.data.frame(center_mass)
colnames(df1) <- c("Latitude", "Longitude", "cluster")
#filter by selection
df<-filter(df,cluster == as.numeric(sel))
df1<-filter(df1,cluster == as.numeric(sel))
g <- ggplot(data = df,
aes(x = Longitude, y = Latitude)) +
geom_point(aes(x = Longitude, y = Latitude), size = 4)
Centro_View <- g + geom_text(data = df,
mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
size = 3, hjust = -0.1) +
geom_point(data = df1, mapping = aes(Longitude, Latitude), color = "green", size = 4) +
geom_text(data = df1, mapping = aes(x = Longitude, y = Latitude, label = sel), color = "black", size = 4)
Centro_View + ggtitle("Scatter Plot") + theme(plot.title = element_text(hjust = 0.5))
})
output$ScatterPlot <- renderPlot({
req(splot1())
})
output$ScatterPlot1 <- renderPlot({
req(splot2())
})
observeEvent(c(df, input$Slider), {
abc <- req(data_table_1())
updateSelectInput(session, "select",
choices = sort(unique(abc$cluster))
)
})
}
shinyApp(ui = ui, server = server)