Insert reactive for fileInput (shapefile)

Question

The code below is generating a scatterplot from a shapefile file. It is generating normally (see the attached image). However, instead of inserting the file directory directly into the code, I would like to insert the file through a fileInput. I inserted the fileInput below, but I would like help to adjust my server. I believe it is necessary to adjust something related to the reactive.

Thank you so much!

library(shiny)
library(ggplot2)
library(shinythemes)
library(rdist)
library(geosphere)
library(rgdal)

function.cl<-function(df,k){
  
  shape<-readOGR(dsn="C:/Users/Jose Souza/Documents/Test",layer="Export_Output_3") 
  df<-shape@data
  
  #clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average") 
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 
  
  #all cluster data df1 and specific cluster df_spec_clust
  df1<-df[c("Latitude","Longitude")]
  df1$cluster<-as.factor(clusters)
    
  #Colors
  my_colors <- rainbow(length(df1$cluster))
  names(my_colors) <- df1$cluster
  
  #Scatter Plot for all clusters
  g <- ggplot(data = df1,  aes(x=Longitude, y=Latitude, color=cluster)) + 
    geom_point(aes(x=Longitude, y=Latitude), size = 4) +
    scale_color_manual("Legend", values = my_colors)
  plotGD <- g
  

  return(list(
    "Plot" = plotGD
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      fileInput("shp", h3("Shapefile Import"), multiple = TRUE, accept = c('.shp', '.dbf','.sbn', '.sbx', '.shx', '.prj')),
                      sidebarLayout(
                        sidebarPanel(
                        
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 4, value = 3),
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", plotOutput("ScatterPlot"))))
                        
                      ))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,input$Slider)
  })
  
  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })
     
}

shinyApp(ui = ui, server = server)

Thanks for the answer. I would like to do the clustering after uploading the files via fileInput. Wouldn't you have to make a reactive in server for this fileInput? — Antonio
Why does function.cl have a df argument which you overwrite at the second line of the function? — Waldi

Waldi Waldi · Accepted Answer · 2020-06-20T21:56:23

Add a new path argument to function.cl, remove df argument which is not used because assigned directly in the function
Use `eventReactive' in the server :

  Modelcl <- eventReactive(input$shp,{
    req(input$shp)
    mydir <- tempdir()
    on.exit(unlink(mydir))
    print(paste("names:",input$shp$name))
    file.copy(input$shp$datapath,file.path(mydir, input$shp$name) )
    function.cl(input$Slider,mydir)
    
  })

The difficulty was that readOGR expects a path but fileInput returns files.

The workaround was to create a temporary directory to get a path (on the server), to copy the fileInput files into it and to give the path of this temporary directory to readOGRfor further processing.

This works with the example files you provided:

library(shiny)
library(ggplot2)
library(shinythemes)
library(rdist)
library(geosphere)
library(rgdal)

function.cl<-function(k,path,filename){
  print(dir(path))
  shape<-readOGR(dsn=path,layer=filename) 
  df<-shape@data
  
  #clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average") 
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 
  
  #all cluster data df1 and specific cluster df_spec_clust
  df1<-df[c("Latitude","Longitude")]
  df1$cluster<-as.factor(clusters)
  
  #Colors
  my_colors <- rainbow(length(df1$cluster))
  names(my_colors) <- df1$cluster
  
  #Scatter Plot for all clusters
  g <- ggplot(data = df1,  aes(x=Longitude, y=Latitude, color=cluster)) + 
    geom_point(aes(x=Longitude, y=Latitude), size = 4) +
    scale_color_manual("Legend", values = my_colors)
  plotGD <- g
  
  
  return(list(
    "Plot" = plotGD
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      fileInput("shp", h3("Shapefile Import"), multiple = TRUE, accept = c('.shp', '.dbf','.sbn', '.sbx', '.shx', '.prj')),
                      sidebarLayout(
                        sidebarPanel(
                          
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 4, value = 3),
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", plotOutput("ScatterPlot"))))
                        
                      ))))

server <- function(input, output, session) {
  
  # Modelcl<-reactive({
  #   function.cl(df,input$Slider,input$Filter1)
  # })
  Modelcl <- eventReactive(c(input$shp, input$Slider),{
    req(input$shp)
    tmpdir <- tempdir()
    on.exit(unlink(tmpdir))
    filename <- substr(input$shp$name[1],1,nchar(input$shp$name[1])-4)
    file.copy(input$shp$datapath,file.path(tmpdir,input$shp$name) )
    function.cl(input$Slider,tmpdir,filename)
    
  })
  
  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })
  
  observeEvent(input$Slider, {
    abc <- req(Modelcl()$Data)
    updateSelectInput(session,'Filter1',
                      choices=sort(unique(abc$cluster)))
  }) 
  
}

shinyApp(ui = ui, server = server)

Insert reactive for fileInput (shapefile)

1 Answers