Allow User to Set Path to Shapefile Files

I have a Shiny application which works great locally, and it allows the user to enter a path to a directory of shapefiles to support mapping.

When I publish the app to my server.io account I would like to also allow the user to enter a path to their own shapefile on their pc (it's a .shp file and other supporting files). In other words, I would like the server based app to read the .shp based on an entered path (text input ok) rather than having them upload their shapefiles into a temporary location which then needs to be fetched by the application. Is this possible, that is, is there a suggested syntax for allowing this mapping from the server to the app, or is the only solution an upload of files to support mapping. Uploading multiple files and pointing to just the .shp is complicated since the shp is bundled with .prj, .shx, sbx, .dbf, etc.

Appreciate any suggestions allowing end users to use their own shapefiles with my app.

I think this is a distinction with no difference. When you 'read' a file over the internet, you are copying it (usually to somewhere temporary) ...

I would just tell the user to zip their shapefile directory and have my app load the zip, and unzip it to a temporary serverside path to work on .

good suggestion. I know how to do this with one file (like an .xlsx), but have no experience with uploading\unzipping multiple files and then pointing to the file that matters with the extension .shp. In other words, if there're multiple files being unzipped to a temporary location and I know the file$datapath, how do I have my code just pick the shp file out of the group?

list.files(path=mypath,pattern=".shp")

returns a vector of .shp extension files in your path

awesome, I didn't see this in my research! I'll give this a go, and appreciate your time.

My code returns Error in :: NA/NaN argument

UI

fileInput("admin_sf", "Load Shapefiles", multiple = T)

Server

shp <- reactive({list.files(path=input$admin_sf$datapath,pattern=".shp")})

sf <- eventReactive(input$T_1b_rows_selected,{shapefile(shp()$datapath) %>% sf::st_as_sf()})

The code works if I put the path explicitly in the shapefile expression. It seems like shp() does not contain the shapefile but I don't know how to figure this out in Shiny. Seems simple, I'm just trying to pick the shapefile out of the 7 related files uploaded together and pass the .shp to the eventReactive expression. Any suggestions are quite appreciated.

is this any better ?


shinyApp(ui, server)
sf <- eventReactive(input$T_1b_rows_selected, {
  shapefile(head(req(shp()), n = 1)) %>% sf::st_as_sf()
})

I don't get any errors, but the leaflet map does not render. If I comment out all the places using the sf then the map renders ok, so it seems like the sf file is not available or reading. In addition, the map does work fine if I enter in the direct path to the shapefile on my hard drive in place of the "head(req(shp()), n = 1)"

Assume you are judging this after both admin_sf has set a shp reactive,and your input$T_1b_rows_selected has a valid value ?

If I was you I'd browser() or debug() my way to seeing what the sf() reactive contains when triggered,
or perhaps make a verbatimtextoutput whose contents are str(sf()) so I can see state changes of sf() and what it contains

I'd be willing to play around with this more, but I would ask you to make a reprex.

Yes, everything works when I change out the "head(req(shp()), n = 1)" with a direct path to the shapefile, so I think the issue is related to fetching the file. I do appreciate your help, and will make a reprex since this is important to the user experience.

library(shiny)
library(sf)

ui <- fluidPage(
  
dashboardPagePlus(
    dashboardHeaderPlus(title = "Inspection Analysis", titleWidth = "250px",
                        tags$li(a(href = 'http://www.pipeline-risk.com',img(src = 'Logo.png',
                                  title = "Pipeline-Risk Web Site", height = "30px"),
                                  style = "padding-top:10px; padding-bottom:10px;"),
                                  class = "dropdown")
                        ),
    footer = dashboardFooter(left_text = h6("Copyright Pipeline-Risk 2020")
                        ),
    dashboardSidebar(width = "250px",
                     sidebarMenu(
                       menuItem("Anomaly Analysis", tabName = "INSP", icon = icon("dashboard")),
                       menuItem("Administration", tabName = "ADMIN", icon = icon("dashboard"))          
                                )            
                        ),
dashboardBody(
      
tabItems(
    tabItem("INSP",          
      fluidRow(
          tabBox(
                id = "INSP_1", width = 12,
                tabPanel("Results",
                     fluidRow(
                       box(width = 12, collapsible = TRUE,
                           column(width = 4,
                                  fileInput("file_1", "Select Results Data Set to View")
                           )
                       )),
                     fluidRow(
                       box(width = 12, collapsible = TRUE, collapsed = FALSE,
                           column(width = 12,
                                  dataTableOutput("T_1b")
                           )
                       )),
                     fluidRow(
                       box(width = 12, collapsible = TRUE, collapsed = FALSE,
                           column(width = 12,
                                  leafletOutput("M_1", height = "800px")
                           )
                       ))    
)))),
  tabItem(tabName = "ADMIN",
      fluidRow(
        tabBox(id = " admin_1", width = 12,
               tabPanel("Project Set-Up",
                     fluidRow(
                       box(width = 12, collapsible = T,
                           column(width = 5,
                                  fileInput("admin_sf", "Load Shapefiles", multiple = T)
                              ))
                        )))))
)
)
))

server <- function(input, output, session) {

# the results set in a table which links to the map M_1
results <- eventReactive(
  input$file_1$datapath,
  {if(is.null(input$file_1$datapath))
    return()
    else
    {results <- read.table(input$file_1$datapath, header = TRUE, sep = ",")}
})
  
output$T_1b  <- renderDataTable({
  datatable(results(), extensions = 'FixedHeader', selection = 'single',filter = 'top',rownames=F,
            options = list(fixedHeader = TRUE, scrollX=T, lengthMenu = c(10,100,200), autoWidth = TRUE))%>%
    formatStyle(names(results()),lineHeight='70%')
})  


shp <- eventReactive(input$admin_update2,input$admin_sfpath)
  
sf <- eventReactive(input$T_1b_rows_selected, {
    shapefile(shp()) %>% sf::st_as_sf()
})

# Leaflet Map  
observeEvent(
  input$T_1b_rows_selected,
  
  output$M_1 <- renderLeaflet({
    
    sf <- sf::st_transform(sf(), 4326)
    results <- results()[input$T_1b_rows_selected,c("Long", "Lat")]
    
    map <- leaflet() %>%
      addTiles(group = "Open Street")%>% 
      addProviderTiles(providers$Esri.WorldImagery, group = "World Imagery", options = providerTileOptions(opacity = .7))%>%   
      
      addPolylines(data=sf, group = "Pipeline",  color = "blue", opacity = 1, label = sf$Route)%>%
      addMarkers(results, lng = results$Long, lat = results$Lat, group = "Results" , label = "test")%>%
      
      setView(lng = results$Long, lat = results$Lat, zoom = 20) %>%
      
      addMeasure()%>%
      addLayersControl(
        baseGroups = c("Open Street", "World Imagery"),
        overlayGroups = c("Pipeline", "Results"),
        options = layersControlOptions(collapsed = FALSE)
      )%>%
      addMiniMap(
        toggleDisplay = TRUE,
        tiles = providers$Stamen.TonerLite
      )
    map
}))  

}

shinyApp(ui = ui, server = server)

Here's the shiny code with the key code, it asks for shapefiles and a results set which has Lat\Longs. How can I provide these to you?

might depend on how big they are ... small I hope ?

quite small like each being <20 kb

You can sign up to github at the free tier and host files in a repository there conveniently. Then you can link to it.

here you go!

https://github.com/Pipeline-Risk/Test_Files

I owe you something if you figure this out.

ok, I adjusted your code to make a working example.
I borrowed ideas from Suggestions for fileInput to work on Shiny ??
I find its easier to require a zip of the relates shp files so user loads a single zip, than multi files.
So try this by loading a zip of the shapefiles

library(shiny)
library(sf)
library(shinydashboardPlus)
library(shinydashboard)
library(leaflet)
library(DT)
library(raster)
ui <- fluidPage(
  dashboardPagePlus(
    dashboardHeaderPlus(
      title = "Inspection Analysis", titleWidth = "250px",
      tags$li(a(
        href = "http://www.pipeline-risk.com", img(
          src = "Logo.png",
          title = "Pipeline-Risk Web Site", height = "30px"
        ),
        style = "padding-top:10px; padding-bottom:10px;"
      ),
      class = "dropdown"
      )
    ),
    footer = dashboardFooter(left_text = h6("Copyright Pipeline-Risk 2020")),
    dashboardSidebar(
      width = "250px",
      sidebarMenu(
        menuItem("Anomaly Analysis", tabName = "INSP", icon = icon("dashboard")),
        menuItem("Administration", tabName = "ADMIN", icon = icon("dashboard"))
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          "INSP",
          fluidRow(
            tabBox(
              id = "INSP_1", width = 12,
              tabPanel(
                "Results",
                fluidRow(
                  box(
                    width = 12, collapsible = TRUE,
                    column(
                      width = 4,
                      fileInput("file_1", "Select Results Data Set to View")
                    )
                  )
                ),
                fluidRow(
                  box(
                    width = 12, collapsible = TRUE, collapsed = FALSE,
                    column(
                      width = 12,
                      dataTableOutput("T_1b")
                    )
                  )
                ),
                fluidRow(
                  box(
                    width = 12, collapsible = TRUE, collapsed = FALSE,
                    column(
                      width = 12,
                      leafletOutput("M_1", height = "800px")
                    )
                  )
                )
              )
            )
          )
        ),
        tabItem(
          tabName = "ADMIN",
          fluidRow(
            tabBox(
              id = " admin_1", width = 12,
              tabPanel(
                "Project Set-Up",
                fluidRow(
                  box(
                    width = 12, collapsible = T,
                    column(
                      width = 5,
                      fileInput("admin_sf", "Load Shapefiles", multiple = T)
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
  )
)

server <- function(input, output, session) {

  # the results set in a table which links to the map M_1
  results <- eventReactive(
    input$file_1$datapath,
    {
      if (is.null(input$file_1$datapath)) {
        return()
      } else {
        results <- read.table(input$file_1$datapath, header = TRUE, sep = ",")
      }
    }
  )

  output$T_1b <- renderDataTable({
    datatable(results(),
      extensions = "FixedHeader", selection = "single", filter = "top", rownames = F,
      options = list(fixedHeader = TRUE, scrollX = T, lengthMenu = c(10, 100, 200), autoWidth = TRUE)
    ) %>%
      formatStyle(names(results()), lineHeight = "70%")
  })


  shp <- reactive({
    req(input$admin_sf)
    mytempdir <- tempdir()
    unzip(input$admin_sf$datapath, exdir = mytempdir)
    shape_path <- dir(path = mytempdir, pattern = ".shp$")
    shape_path_full <- file.path(mytempdir, shape_path)
    print("shape_path")
    print(shape_path)
    print("shape_path_full")
    print(shape_path_full)

    shape_path_full
  })

  sf <- eventReactive(input$T_1b_rows_selected, {
    shapefile(shp()) %>% sf::st_as_sf()
  })

  # Leaflet Map
  observeEvent(
    input$T_1b_rows_selected,

    output$M_1 <- renderLeaflet({
      sf <- sf::st_transform(sf(), 4326)
      results <- results()[input$T_1b_rows_selected, c("Long", "Lat")]

      map <- leaflet() %>%
        addTiles(group = "Open Street") %>%
        addProviderTiles(providers$Esri.WorldImagery, group = "World Imagery", options = providerTileOptions(opacity = .7)) %>%
        addPolylines(data = sf, group = "Pipeline", color = "blue", opacity = 1, label = sf$Route) %>%
        addMarkers(results, lng = results$Long, lat = results$Lat, group = "Results", label = "test") %>%
        setView(lng = results$Long, lat = results$Lat, zoom = 20) %>%
        addMeasure() %>%
        addLayersControl(
          baseGroups = c("Open Street", "World Imagery"),
          overlayGroups = c("Pipeline", "Results"),
          options = layersControlOptions(collapsed = FALSE)
        ) %>%
        addMiniMap(
          toggleDisplay = TRUE,
          tiles = providers$Stamen.TonerLite
        )
      map
    })
  )
}

shinyApp(ui = ui, server = server)
1 Like

awesome, that works! Really appreciate your help.

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.