如何将 shapefile 上传到 Shiny App

Question

我试图弄清楚用户如何使用 Shiny App 通过 fileInput 提交 shapefile，然后将其映射到传单底图上。我被困在 server.R 脚本上，不确定如何处理用户提交的 shapefile 并将其转换为空间数据框对象。

Answer 1

这适用于我在 Ubuntu Shiny 服务器上。

#You need a folder with write permissions
ruta_conpermiso= "/srv/shiny-server/app"

substrRight <- function(x, n){
  substr(x, nchar(x)-n+1, nchar(x))
   }

ui <- fluidPage(
    column(10,
    fileInput(inputId = "shp", label = "Importar un Shape :", multiple = TRUE, 
   accept = c('.shp', '.dbf','.sbn', '.sbx', '.shx', '.prj')),
  verbatimTextOutput("value"),
  tableOutput("finalizado"),
   )
  )

server_v2 <- function(input, output, session) {
     uploadShpfile <- reactive({
         if (!is.null(input$shp)) {
            shp <<- input$shp
                for(i in (1:length(shp$datapath))){
                print(i)
                ruta_temp<<-shp$datapath[i]
                sub<-str_split(as.character(ruta_temp), "/",n=3)
                #ruta archivo
                sub1<-str_split(as.character(ruta_temp), paste("/",as.character(i- 
                1),".",sep=""),n=3)
                ruta_archivo<-sub1[[1]][1]
                #nombre archivo
                nombre_archivo<-sub[[1]][3]
          
                #nuevo nombre archivo
               nuevo_nombre<-gsub(as.character(i-1),"shapetemp",nombre_archivo)
          
               #nuevo nombre
               #nueva_dir<-paste(ruta_conpermiso,nuevo_nombre,sep="/")
               nueva_dir<-paste(ruta_conpermiso)
          
               #copio el archivo el directorio de trabajo
               file.copy(ruta_temp, nueva_dir)
          
               #Lo renombro
               #nombre original
               nombre_archivo<- substrRight(nombre_archivo, 5)
               nombre_org<<-paste(ruta_conpermiso,nombre_archivo,sep="/")
               #nombre final
               nuevo_nombre<-substrRight(nuevo_nombre, 13)
               nombre_final<<-paste(ruta_conpermiso,nuevo_nombre,sep="/")
                                 
               file.copy(nombre_org, nombre_final)
           }
        

        #aca armo el shapefile
        if(1 == 1){output$value <- renderText({paste(nombre_final)})
                           try(shapefile<<- 
        readOGR(paste(ruta_conpermiso,"shapetemp.shp",sep="/")),silent=T)
                           if (!exists("shapefile")){ output$value <- 
        renderText({"No se puede abrir el archivo"})}
                           if (exists("shapefile")) { output$finalizado <- 
        renderTable(shapefile@data)}
                          }
             }  
       })
observeEvent(input$shp, {
     uploadShpfile()
    })
} 

shinyApp(ui=ui, server=server_v2)

我希望这很有用。最好的问候。

Answer 2

要读入 shapefile，用户必须至少提交强制文件（.shp、.shx 和 .dbf）。上传文件后，您可以通过$datapath 和$name 访问位置和名称。

默认情况下，闪亮的名称文件输入如下： C:\Users\DWISME~1\AppData\Local\Temp\17\RtmpiOjVGv/6903ae29a41daccceee4b8a5/0.dbf C:\Users\DWISME~1\AppData\Local\Temp\17\RtmpiOjVGv/6903ae29a41daccceee4b8a5/1.prj C:\Users\DWISME~1\AppData\Local\Temp\17\RtmpiOjVGv/6903ae29a41daccceee4b8a5/2.sbn C:\Users\DWISME~1\AppData\Local\Temp\17\RtmpiOjVGv/6903ae29a41daccceee4b8a5/3.sbx C:\Users\DWISME~1\AppData\Local\Temp\17\RtmpiOjVGv/6903ae29a41daccceee4b8a5/4.shp C:\Users\DWISME~1\AppData\Local\Temp\17\RtmpiOjVGv/6903ae29a41daccceee4b8a5/5.shx

我的方法是创建一个访问文件输入位置并更改目录的函数：

library(shiny)
library(sf)
library(shinyjs)
library(purrr)

ui <- fluidPage(
      useShinyjs(),  
      br(),
      fluidRow(column(6, offset = 2,
       fileInput("shp", label = "Input Shapfiles (.shp,.dbf,.sbn,.sbx,.shx,.prj)", 
       width = "100%", accept = c(".shp",".dbf",".sbn",".sbx",".shx",".prj"),
       multiple=TRUE)),
          
       column(2, id = "clear", 
       actionButton('reset', 'Clear Data', width = "100%", 
       style = "margin-top: 25px;"))),
    
       br(),
       fluidRow(column(8, offset = 2,
        p("input$shp$datapath" , style = "font-weight: bold"),                              
        verbatimTextOutput("shp_location", placeholder = T))),
          
       br(),
       fluidRow(column(8, offset = 2,
        p("input$shp$name" , style = "font-weight: bold"),                              
        verbatimTextOutput("shp_name", placeholder = T))),  
          
       br(),
       fluidRow(column(8, offset = 2,
        p("simple feature read-in" , style = "font-weight: bold"),                              
        verbatimTextOutput("sf", placeholder = T))))

server <- function(input, output, session) {
       
       # Read-in shapefile function
       Read_Shapefile <- function(shp_path) {
        read_shp <- reactive({
        req(shp_path)
        infiles <- shp_path()$datapath # get the location of files
        dir <- unique(dirname(infiles)) # get the directory
        outfiles <- file.path(dir, shp_path()$name) # create new path name
        name <- strsplit(shp_path()$name[1], "\\.")[[1]][1] # strip name 
        purrr::walk2(infiles, outfiles, ~file.rename(.x, .y)) # rename files
        x <- try(read_sf(file.path(dir, paste0(name, ".shp"))))# try to read-in shapefile
        if(class(x)=="try-error") NULL else x # return Null or SF object
        })
        return(read_shp)
       }    

    # Read-in shapefile
    shp_path <- reactive({input$shp})
    user_shp <- Read_Shapefile(shp_path)
    
    # Print shapefile if it exists 
    observeEvent(input$shp, {
            if(!is.null(user_shp())) {
                output$sf <- renderPrint({user_shp()})
            }else{
                output$sf <- renderPrint({"NULL"})
            }
        
        # Print original file path location and file name to UI
        output$shp_location <- renderPrint({
            full_path <- strsplit(input$shp$datapath," ")
            purrr::walk(full_path, ~cat(.x, "\n")) 
            })
                
        output$shp_name <- renderPrint({
            name_split <- strsplit(input$shp$name," ")
            purrr::walk(name_split, ~cat(.x, "\n")) 
        })
    })
    
    # Clear UI
    observeEvent(input$reset,{
        reset("shp")
        output$sf <- renderPrint({ })
        output$shp_location <- renderPrint({ })
        output$shp_name <- renderPrint({ })
    })
}

shinyApp(ui, server)