2017-05-31 8 views
1

私は2つのシェープファイルを入力に取り込んでからそれらを交差させて面積を計算するR Shinyアプリケーションを使っています。 新しい解析時に最初のシェイプファイルがアップロードされたときに、入力中の2番目のシェイプファイルを削除したいのですが、2番目のシェイプファイル(file2)をNULLに設定したいとします。 私はshinyjs::reset("file2")を使用してみましたが、第2シェープファイル(input$file2)は、メモリにまだあると私は新しいシェープファイル(file1input$file1)をアップロードしてから(別のfile2をアップロードwhithout)分析]ボタンをクリックすると、アプリは、次のようなfile2がresettedされなかった分析を開始します。R shinyは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、server)

アドバイスありがとうございます。

+0

問題は_function call_ ieにあると思います。 '$ file1、input $ file2'をアップロードすると、** observeEvent **の操作が一度実行されます。しかし、2回目にファイルをアップロードするとき**注意:** 'input $ file1、input $ file2'はまだ古い値で初期化されているので、' observeEvent'はトリガされません。 'reactive'関数として' observeEvent'演算を作成し、サーバでファイルが読み込まれたときに呼び出す必要があります。 – 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

ありがとうございます! reactValuesは私の問題の答えです! –

関連する問題