2017-05-31 60 views
1

我正在使用R Shiny应用程序,它在输入中采用两个shapefile,然后将它们相交并计算面积。 当第一个shapefile上传时,我想重置并移除输入中的第二个shapefile,所以在新分析中,我想将第二个shapefile(file2)设置为NULL。 我尝试使用shinyjs::reset("file2")但第二shape文件(input$file2)仍然在内存中,当我上传了新的shape文件(file1input$file1),然后点击分析按钮(内部消除上传其他file2)应用程序开始分析,如file2没有重置了。R闪亮不重置fileInput并将其保存在内存中

这是我使用的代码:

库和功能

 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)) 
     [email protected]$area<- round(gArea(shpInt, byid = TRUE)/10000,digits= 2) 
     IntData<-data.table([email protected]) 
     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,服务器)

感谢您的任何建议。

+0

我想问题在于_function call_ ie。当'input $ file1,input $ file2'被上传时,** observeEvent **下的操作被执行一次。但是当你第二次上传文件时,**注意:**'输入$ file1,输入$ file2'仍然是用旧值初始化的,所以没有'observeEvent'被触发。 您需要将'observeEvent'操作创建为'reactive'函数并在服务器读取文件时调用它们 – parth

回答

0

此代码显示如何创建自己的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) 
+0

谢谢您的回答! reactiveValues是我的问题的答案! –