SliderInput в блестящих функциях - PullRequest
1 голос
/ 24 апреля 2020

Как мне изменить график и таблицу автоматически после изменения моего слайдера? Я сделал функцию, в которой значение k (количество кластеров) может варьироваться от 2 до 18. Я оставил значение k на 8. Если я изменяю значение k с помощью кода, блестящий генерирует новую таблицу и рисунок. Тем не менее, я хотел бы изменить блеск на моем слайдере. Не могли бы вы мне помочь? Исполняемый код и блестящий код приведены ниже.

    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)

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

}

    ui <- fluidPage(

        titlePanel("Clustering "),

        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(
                plotOutput("tabela"), 
                plotOutput("ScatterPlot")

           )))

    server <- function(input, output) {

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

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

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

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

    }

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

Большое спасибо!

1 Ответ

1 голос
/ 24 апреля 2020

Вы можете вызвать функцию в reactive() (обратите внимание на () при ее использовании)

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

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

output$ScatterPlot<-renderPlot(Modelclustering()[["plot_env"]][["plotGD"]])
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...