Categories
Mastering Development

Insert new functionalitys in shiny

Friends, could you please help me with some issue involving shiny. My executable code is working and I inserted below. In my code I am using a predefined database. However, I inserted a shiny fileInput to search for the file on the computer, but I would like to relate it to my shiny server, so that when I use another database, it works too. How do I adjust this?

library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)

#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), 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), 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), Waste = c(526, 350, 526, 469, 285, 175, 175, 350, 350, 175, 350, 175, 175, 364, 
                                                                                                                                                                                                                      + 175, 175, 350, 45.5, 54.6)), class = "data.frame", row.names = c(NA, -19L))
function.clustering<-function(df,k,Filter1,Filter2){
    #df is database
    #k is number of clusters
    #Filter1 is equal to 1, if all properties are used 
    #Filter1 is equal to 2 is to limit the use of properties that have potential for waste production <L e >S

    if (Filter1==2){
        Q1<-matrix(quantile(df$Waste, probs = 0.25)) 
        Q3<-matrix(quantile(df$Waste, probs = 0.75))
        L<-Q1-1.5*(Q3-Q1)
        S<-Q3+1.5*(Q3-Q1)
        df_1<-subset(df,Waste>L[1]) 
        df<-subset(df_1,Waste<S[1])
    }

    #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")

    #Output table
    data_table <- Reduce(merge, list(df, coverage, 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)
    data_table_1<-kable(data_table_1[order(data_table_1$cluster), c(1,4,2,3)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE)

    #Scatter Plot
    suppressPackageStartupMessages(library(ggplot2))
    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)
    plotGD<-print(Centro_View + ggtitle("Scatter Plot") + theme(plot.title = element_text(hjust = 0.5)))


    #Table1 and Plot1 to show in Buttom 2
    table1<- kable(df[order(df$cluster, as.numeric(df$Longitude)),c(1,2,3,4)], align = "c", row.names = FALSE) %>%
        kable_styling(full_width = FALSE) %>%
        column_spec(1, bold = TRUE) %>%
        collapse_rows(columns = 1:4, valign = "middle")
    plot1<-ggplot(data=df,  aes(x=Longitude, y=Latitude,  color=factor(clusters))) +  geom_point()


}
ui <- fluidPage(

    titlePanel("Clustering "),

    fileInput("data", h3("Importing the data matrix")),


    sidebarLayout(
        sidebarPanel(
            helpText(h3("Generation of clustering")),

            radioButtons("filter1", h3("Waste Potential"),
                         choices = list("Select all properties" = 1, 
                                        "Exclude properties that produce less than L and more than S" = 2),
                         selected = 1),

            radioButtons("filter2", h3("Coverage do cluster"),
                         choices = list("Use default limitations" = 1, 
                                        "Do not limite coverage" = 2
                         ),selected = 1),

            sliderInput("Slider", h3("Number of clusters"),
                        min = 2, max = 18, value = 8),

),


        mainPanel(
                    uiOutput("tabela"),  
                    plotOutput("ScatterPlot"),
                    uiOutput("table1"),
                    plotOutput("plot1")

)))

server <- function(input, output) {

    f1<-renderText({input$filter1})
    f2<-renderText({input$filter2})


    Modelclustering<-reactive(function.clustering(df,input$Slider,1,1))

    output$tabela <- renderUI(HTML(Modelclustering()[["plot_env"]][["data_table_1"]]))

    output$ScatterPlot<-renderPlot(Modelclustering()[["plot_env"]][["plotGD"]])

    output$table1 <- renderUI(HTML(Modelclustering()[["plot_env"]][["table1"]]))

    output$plot1 <- renderPlot(Modelclustering()[["plot_env"]][["plot1"]])

}

# Run the application 
shinyApp(ui = ui, server = server)

Thank you very much!

Leave a Reply

Your email address will not be published. Required fields are marked *