【问题标题】:Insert warning message in Shiny在 Shiny 中插入警告信息
【发布时间】:2020-10-18 03:39:15
【问题描述】:

当 fileInput 中插入的文件不同于“.xlsx”、“.shp”、“.shx”、“.dbf”时,我想插入一条警告消息。你能帮助我吗?我在下面输入了一个可执行代码。你甚至可以在我的 observeEvent (input$data,我插入了类似的东西,但我希望它在 Shiny 中显示为文本框。

谢谢!

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

function.cl<-function(df,k){
 
}

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)
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", plotOutput("ScatterPlot"))))
                        
                      ))))

server <- function(input, output, session) {
  
  v <- reactiveValues(df = NULL)
  
  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){
        print("You Need 3 files, '*.shp', '*shx' and '*.dbf'")
      }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{
      print("Wrong File")
    }
  })
  
  
  Modelcl<-reactive({if (!is.null(v$df)) {
    function.cl(v$df,input$Slider)
  }
  })
  
  
  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })
  
}

shinyApp(ui = ui, server = server)

【问题讨论】:

  • 您可以使用shinyWidgets 包触发所谓的甜蜜警报。
  • shinyFeedback 是另一种选择。

标签: r shiny


【解决方案1】:

正如@Stéphane Laurent 在 cmets 中已经指出的那样,shinyWidgets 可用于显示甜蜜警报。对于某些输入,{shinyFeedback} 包也可以工作,但是,fileInputs 尚不支持。

以下是使用sendSweetAlert 替换您的print 调用的一种可能实现。

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

function.cl<-function(df,k){
  
}

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)
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", plotOutput("ScatterPlot"))))
                        
                      ))))

server <- function(input, output, session) {
  
  v <- reactiveValues(df = NULL)
  
  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"
        )
        
      }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"
      )
    
      }
  })
  

  Modelcl<-reactive({if (!is.null(v$df)) {
    function.cl(v$df,input$Slider)
  }
  })
  
  
  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })
  
}

shinyApp(ui = ui, server = server)

【讨论】:

猜你喜欢
  • 2012-11-21
  • 1970-01-01
  • 2018-09-27
  • 2010-11-19
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2018-06-02
  • 1970-01-01
相关资源
最近更新 更多