R shiny不会重置fileInput并将其保留在内存中

Question

我正在使用一个R Shiny应用程序，该应用程序在输入中获取两个shapefile，然后将它们相交并计算区域。 我想在上传第一个shapefile时重置并删除输入中的第二个shapefile，因此在新分析中我想将第二个shapefile（file2）设置为NULL。 我尝试使用shinyjs::reset("file2")，但第二个shapefile（input$file2）仍在内存中，当我上传新的shapefile（file1，input$file1）然后点击分析按钮（无需上传另一个file2）应用程序启动分析，例如file2未重置。

这是我正在使用的代码：

库和函数

      library(shiny)
      library(shinyjs)
      library(leaflet)
      library(mapview)
      library(rgdal)
      library(rgeos)
      library(maptools)
      library(DT)


        fIntersect<-function(file1,file2){
        CRSfrom <- CRS("+proj=utm +zone=33 +datum=WGS84 +units=m+no_defs")
        CRSto   <- CRS("+proj=longlat +datum=WGS84")
        shpInt <- disaggregate(intersect(file1, file2))
        shpInt@data$area<- round(gArea(shpInt, byid = TRUE) / 10000,digits= 2)
        IntData<-data.table(shpInt@data)
        return(list("IntData"=IntData))           
        }

ui.R

    ui <- fluidPage( 
    useShinyjs(),
    fileInput('file1', 'Choose File',multiple = TRUE),
    fileInput('file2', 'Choose File',multiple = TRUE),
    actionButton("Analize", "Analize"),

    box(leafletOutput("Map",width ="100%")),  

    box(dataTableOutput("IntData"))),

server.R

    server <- function(input, output) {
    #CRS setting            
    CRSfrom <- CRS("+proj=utm +zone=33 +datum=WGS84 +units=m +no_defs")
    CRSto   <- CRS("+proj=longlat +datum=WGS84")

    #Render Input file and upload           
    output$Map <- renderLeaflet({
        leaflet() %>%setView(16,40,zoom=6)%>%
            addTiles() })


    output$file1 <- renderText({
        file1 <- input$file1
        if (is.null(input$file1))
            return(NULL)
    })

    output$file2 <- renderText({
        file2 <- input$file2
        if (is.null(file2))
            return(NULL)
    })


    uploadfile1 <- reactive({
        if (!is.null(input$file1)) {
            shpDF <- input$file1
            prevWD <- getwd()
            uploadDirectory <- dirname(shpDF$datapath[1])
            setwd(uploadDirectory)
            for (i in 1:nrow(shpDF)) {
                file.rename(shpDF$datapath[i], shpDF$name[i])
            }
            shpName <- shpDF$name[grep(x = shpDF$name, pattern = "*.shp")]
            shpPath <- paste(uploadDirectory, shpName, sep = "/")
            setwd(prevWD)
            file <- readShapePoly(shpPath,
                                  proj4string =CRS("+proj=utm +zone=33 +datum=WGS84 +units=m +no_defs"))
            return(file)


        } else {
            return(NULL)
        }
    })

    uploadfile2 <- reactive({
        if (!is.null(input$file2)) {
            shpDF <- input$file2
            prevWD <- getwd()
            uploadDirectory <- dirname(shpDF$datapath[1])
            setwd(uploadDirectory)
            for (i in 1:nrow(shpDF)) {
                file.rename(shpDF$datapath[i], shpDF$name[i])
            }
            shpName <- shpDF$name[grep(x = shpDF$name, pattern = "*.shp")]
            shpPath <- paste(uploadDirectory, shpName, sep = "/")
            setwd(prevWD)
            file <- readShapePoly(shpPath,
                                  proj4string =CRS("+proj=utm +zone=33 +datum=WGS84 +units=m +no_defs"))
            return(file)
        } 
        else {
            return(NULL)
        }
    })

    output$IntData  <- renderDataTable(datatable(data.table("id" = "0")))

    observeEvent(input$file1, {
        # Show upload polygon on Map
        shinyjs::reset('file2')
        leafletProxy("Map")%>%clearGroup(c("file1")) ####
        shpUpload <- spTransform(uploadfile1(), CRSto)
        leafletProxy("Map") %>%
            addPolygons(data = shpUpload,
                        color = "#33a02c",
                        group = "file1",
                        fill = FALSE,
                        weight = 2.5)
    })

    observeEvent(input$file2, {
        # Show upload polygon on Map
        leafletProxy("Map")%>%clearGroup(c("file2")) ####
        shpUpload <- spTransform(uploadfile2(), CRSto)
        leafletProxy("Map") %>% 
            addPolygons(data = shpUpload,
                        color = "#33a02c",
                        group = "file2",
                        fill = FALSE,
                        weight = 2.5)
    })


    #Start analysis            
    observeEvent(input$Analize,{

        if(input$Analize>0){ withProgress(message = "Sto eseguendo l'analisi...",
                             value =0, {
                             Intersection<-fIntersect(uploadfile1(),uploadfile2())
                             observe({
                             output$IntData<-renderDataTable({
                             datatable(Intersection$IntData)
                             })
                       })

                 }
        )
        }else{}

    }

    )
    #End Analysis            
}

shinyApp（ui，server）

感谢您的任何建议。

Answer 1

此代码显示如何创建自己的reativeValues以获得所需的控件。首先创建自己的可写反应值，然后使用它们而不是输入。

library(shiny)
library(DT)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- fluidPage( 
  fileInput('file1', 'Choose File',multiple = TRUE),
  fileInput('file2', 'Choose File',multiple = TRUE),
  actionButton("Analize", "Analize"),
  # Show the state of the input files
  verbatimTextOutput('file1'),
  verbatimTextOutput('file2'),
  # This will change only when the action button is used
  verbatimTextOutput('look_at_input')
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  # Create your own reactive values that you can modify because input is read only 
  rv <- reactiveValues() 

  # Do something when input$file1 changes 
  # * set rv$file1, remove rv$file2
  observeEvent(input$file1, {
    rv$file1=input$file1
    rv$file2=NULL
  })

  # Do something when input$file2 changes
  # * Set rv$file2
  observeEvent(input$file2, {
    rv$file2=input$file2
  })

  # Show the value of rv$file1 
  output$file1 <- renderPrint ({ str(rv$file1) })

  # Show the value of rv$file2 
  output$file2 <- renderPrint({ str(rv$file2) })


  #Start analysis            
  # Do something when the Analize button is selected
  look_at_input<-eventReactive(input$Analize,{
    list(rv$file1,rv$file2)
  })
  output$look_at_input <-renderPrint({ str( look_at_input()    )})

  #End Analysis            
}
# Run the application 
shinyApp(ui = ui, server = server)