Plot a graph from a function in shiny

Question

I want to insert a graph that is generated from the function.LetControl <-function (coverage). I couldn't show this graphic on my shiny, the others worked. I believe it may be because this function is within another function. Could someone help me solve this problem please.

The executable code is below:

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

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

}
    function.LetControl<-function(coverage)
{
  m <- mean(coverage[,1])
  MR <- mean(abs(diff(coverage[,1])))
  d2 <- 1.1284
  LIC <- m - 3*(MR/d2)
  LSC <- m + 3*(MR/d2)
  LetCover<-plot(coverage[,1], type = "b", pch = 16, ylim = c(LIC-0.1*LIC,LSC+0.5*LSC), axes = FALSE) 
  axis(1, at = 1:35)
  axis(2)
  box()
  grid()
  abline(h = MR,
         lwd = 2)
  abline(h = LSC, lwd = 2, col = "red")
  abline(h = LIC, lwd = 2, col = "red")}


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),
        
        tags$hr(),
        
            helpText(h3("Are you satisfied with the solution?")),
            helpText(h4("(1) Yes")),
            helpText(h4("(2) No")),
            helpText(h4("(a) Change the number of clusters")),
          sliderInput("Slider", h3("Number of clusters"),
                        min = 2, max = 34, value = 8),
          helpText(h4("(b) Change the filter options"))
          ),
          
        mainPanel(
            uiOutput("tabela"),  
            plotOutput("ScatterPlot"),
            plotOutput("LetCoverage"),
            
        )))

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$LetCoverage <- renderPlot(Modelclustering()[["plot_env"]][["LetCover"]])
    
}

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

ERROR TO CHECK

ERROR 1: Argument 1 is not a vector

ERROR 2: non-numeric argument to mathematical

Thank you very much friends!

You define the function, but you don't call it anywhere. Also, as shown, the function is not within another function. — teofil, Apr 27 '20 at 00:25

score 1 · Accepted Answer · answered Apr 27 '20 at 01:01

Normally, we want to return values from functions, rather than trying to access them with, e.g., [["plot_env"]][["plotGD"]]. In R to return multiple elements from a function, we must wrap them in a list(). For your app, the function function.clustering() needs to return 3 elements: the coverage data, the clustering table and the scatter plot. This is handled by:

  return(list(
    "Data" = data_table_1,
    "Plot" = plotGD,
    "Coverage" = coverage
  ))

Note that plotGD is simply the plot object, not the printed plot. The latter prints the plot to a plotting window/pane, so you have to do the double [[]][[]] gymnastics.

Similar for the kable. Return the data.frame (or data.table or matrix), and do the styling inside the server function.

Finally, to use function.LetCoverage, we just pass the third element returned by the clustering function. This will make the plot and render it.

HTH,

Working app:

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

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

  return(list(
    "Data" = data_table_1,
    "Plot" = plotGD,
    "Coverage" = coverage
  ))
}

function.LetControl <- function(coverage) {
  m <- mean(coverage[, 1])
  MR <- mean(abs(diff(coverage[, 1])))
  d2 <- 1.1284
  LIC <- m - 3 * (MR / d2)
  LSC <- m + 3 * (MR / d2)
    plot(
      coverage[, 1],
      type = "b",
      pch = 16,
      ylim = c(LIC - 0.1 * LIC, LSC + 0.5 * LSC),
      axes = FALSE
    )
  axis(1, at = 1:35)
  axis(2)
  box()
  grid()
  abline(h = MR,
         lwd = 2)
  abline(h = LSC, lwd = 2, col = "red")
  abline(h = LIC, lwd = 2, col = "red")
}


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

      tags$hr(),

      helpText(h3("Are you satisfied with the solution?")),
      helpText(h4("(1) Yes")),
      helpText(h4("(2) No")),
      helpText(h4("(a) Change the number of clusters")),
      sliderInput("Slider", h3("Number of clusters"),
                  min = 2, max = 34, value = 8),
      helpText(h4("(b) Change the filter options"))
    ),

    mainPanel(
      uiOutput("tabela"),  
      plotOutput("ScatterPlot"),
      plotOutput("LetCoverage"),

    )))

server <- function(input, output) {

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


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

  output$tabela <- renderUI({
    data_table_1 <- Modelclustering()[[1]]
    x <- kable(data_table_1[order(data_table_1$cluster), c(1, 4, 2, 3)], align = "c", row.names = FALSE)
    x <- kable_styling(kable_input = x, full_width = FALSE)
    HTML(x)
  })

  output$ScatterPlot <- renderPlot({
    Modelclustering()[[2]]
  })

  output$LetCoverage <- renderPlot({
    function.LetControl(Modelclustering()[[3]])
    })

}

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

Thanks friend, it worked on this example. However I tested it on another base, it shows two errors (I put it as the image above for you to check. However, when I insert my base through the inputFile, it works. I find it strange to appear these two errors at the beginning. What do you think it is? — , Apr 27 '20 at 02:19
Shiny is trying to make the tables/plots before clustering is done, because you haven't uploaded a dataset yet. This is usually solved by making reactives wait for some input or event. Have a look at the function `shiny::req` — teofil, Apr 27 '20 at 02:23
If it happened in this example, what would you do? Would you use a specific code ?? — , Apr 27 '20 at 02:28
`?req` has examples. But in this case, adding `req( Modelclustering() )` inside the `renderUI/renderPlot` expressions (before anything else happens) should be enough. Haven't tested. — teofil, Apr 27 '20 at 02:31
If you just want the first 5 rows, do head(x,5) before rendering the table. If you want to show 5 rows and have all the other times available, look into the DT package that has table pagination. — teofil, Apr 27 '20 at 03:01
Teofil, could you please take a look at either of these two questions? https://stackoverflow.com/questions/61569169/plot-scatterplot-on-a-map-in-shiny https://stackoverflow.com/questions/61559805/link-selectinput-with-sliderinput-in-shiny Thank you very much! — , May 03 '20 at 03:46

Plot a graph from a function in shiny

ERROR TO CHECK

1 Answers1