在闪亮的应用程序中错误加载文件时创建警报

Question

我在 fileInput 中加载非 ".xlsx" 格式的文件时创建了一个错误警报。为此，我创建了 sendSweetAlert。这是工作。我现在想要的是以下内容：每当我加载 ".xlsx" 文件时，显然代码不会给出任何错误，但是我只想接受 ".xlsx" 文件，这些文件实际上可由我的函数使用.

我用的文件可以从这个link下载：encurtador.com.br/dqsOQ

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 import"),
                                accept = c(".xlsx"),
                                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,clear=FALSE)
  
  observeEvent(input$data, {
    if(any(grepl(".xlsx",input$data$name))){
      v$df <- read_excel(input$data$datapath)
      showModal(modalDialog("Once you have uploaded the file, it is necessary to choose the filter options below.", easyClose=TRUE, footer = modalButton("OK")))
    }
      else{
      sendSweetAlert(
        session = session,
        title = "Erro!!",
        text = "File Wrong.",
        type = "error"
      )
      return(NULL)
    }
    v$clear <- TRUE
  })
  
  Modelcl<-reactive({
    req(v$df)
    function.cl(v$df, input$Slider)
  })

  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

试试这个

needvars <- c("Latitude","Longitude")   ###  define variables of interest

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 import"),
                                accept = c(".xlsx"),
                                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,clear=FALSE)
  
  observeEvent(input$data, {
    if(any(grepl(".xlsx",input$data$name))){
      df1 <- read_excel(input$data$datapath)
      chkvars <- sum(needvars %in% names(df1))
      if (chkvars==length(needvars)) {
        showModal(modalDialog("Once you have uploaded the file, it is necessary to choose the filter options below.", easyClose=TRUE, footer = modalButton("OK")))
        v$df <- df1
      }else {
        sendSweetAlert(
          session = session,
          title = "Error!",
          text = "Required variables not present.",
          type = "error"
        )
        return(NULL)
      }
    }else{
      sendSweetAlert(
        session = session,
        title = "Erro!!",
        text = "File Wrong.",
        type = "error"
      )
      return(NULL)
    }
    v$clear <- TRUE
  })
  
  Modelcl<-reactive({
    req(v$df)
    function.cl(v$df, input$Slider)
  })
  
  output$ScatterPlot <- renderPlot({
    Modelcl()[[1]]
  })
  
}

shinyApp(ui = ui, server = server)

在闪亮的应用程序中错误加载文件时创建警报

Create alert for when a file is incorrectly loaded in a shiny app

r

shiny