Appears condition panel only when a correct file is loaded

丶灬走出姿态 提交于 2020-07-10 03:14:46

问题


Even though the file has problems and is loaded in fileInput my condition panel is being shown, as shown in the Figure. However, I would like this panel to be shown only when the correct file is loaded. Can someone help me ?? The executable code is below:

I believe you need to adjust something in the Modelcl of the server.

Thank you so much!

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(shinythemes)
library(rdist)
library(openxlsx) 
library(geosphere)
library(rgdal)

function.cl<-function(df,k){
  
  #clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average") 
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 
  
  #all cluster data df1 and specific cluster df_spec_clust
  df1<-df[c("Latitude","Longitude")]
  df1$cluster<-as.factor(clusters)
  
  #Colors
  my_colors <- rainbow(length(df1$cluster))
  names(my_colors) <- df1$cluster
  
  #Scatter Plot for all clusters
  g <- ggplot(data = df1,  aes(x=Longitude, y=Latitude, color=cluster)) + 
    geom_point(aes(x=Longitude, y=Latitude), size = 4) +
    scale_color_manual("Legend", values = my_colors)
  plotGD <- g
  
  
  return(list(
    "Plot" = plotGD
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      fileInput("data", h3("Excel or Shapefile import"),
                                accept = c(".xlsx",".shp",".shx",".dbf"),
                                multiple= T),  
                      sidebarLayout(
                        sidebarPanel(
                          
                          sliderInput("Slider", h5(""),
                                      min = 2, max = 4, value = 3),
                          
                          conditionalPanel(
                            "output.fileUploaded == true",
                            tags$p(h3("Are you satisfied?")),
                            tags$b(h5("(a) Choose others filters")),
                            tags$b(h5("(b) Choose number of clusters"))), 
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", plotOutput("ScatterPlot"))))
                        
                      ))))

server <- function(input, output, session) {
  
  v <- reactiveValues(df = NULL,clear=FALSE)
  
  observeEvent(input$data, {
    if(any(grepl(".xlsx",input$data$name))){
      v$df <- read.xlsx(input$data$datapath) 
    }else if(any(grepl(".shp",input$data$name))){
      shpDF <- input$data
      failed <- F
      if(!any(grepl(".shx",input$data$name))){
        failed<-T
      }
      
      if(!any(grepl(".dbf",input$data$name))){
        failed<-T
      }
      
      if(failed){
        
        sendSweetAlert(
          session = session,
          title = "Error !!",
          text = "You Need 3 files, '*.shp', '*shx' and '*.dbf'",
          type = "error"
        )
        return(NULL)
      }else{
        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")]
        shpName<-substr(shpName,1,nchar(shpName)-4)
        
        setwd(prevWD)
        shpFile<-readOGR(dsn=uploadDirectory,layer=shpName)
        
        v$df<-shpFile@data
      } 
    }else{
      sendSweetAlert(
        session = session,
        title = "Error !!",
        text = "Wrong File",
        type = "error"
      )
      return(NULL)
    }
    v$clear <- TRUE 
  })
  
  
  Modelcl <- reactive({
    req(v$df)
    out <- NULL
    tryCatch({
      out <<- function.cl(v$df, input$Slider)
    }, error = function(e){
      sendSweetAlert(
        session, 
        "An error occured",
        "Try to upload another file.", 
        "error"
      )
    })
    out
  })
  
  
  output$fileUploaded <- reactive({
    v$clear
  })
  outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
  
  
  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })
  
}

shinyApp(ui = ui, server = server)


回答1:


I'm not sure to understand. But if I correctly understand, you can do:

  output$fileUploaded <- reactive({
    v$clear && !is.null(Modelcl())
  })


来源:https://stackoverflow.com/questions/62684270/appears-condition-panel-only-when-a-correct-file-is-loaded

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!