Question

我是R Shiny的新手。我通过编写以下代码创建了一个Web应用程序。这里我需要一些修改。

我想创建两个按钮（例如：Output，Accuracy）
当用户单击“输出”按钮时，它应显示输出值print(final1)。
当用户单击“准确性”按钮时，应显示混乱状态矩阵（cm）print(caret::confusionMatrix(cm2))。

任何人都可以帮助我。下面是代码：

runApp(
list(
ui = fluidPage(

  titlePanel("Upload & Results"),



  sidebarLayout(

    sidebarPanel(


      fileInput('file1', 'Choose Excel File',accept = c(".xlsx")

      )
    ),

    mainPanel(

      tableOutput('contents'))

  )
),
server = function(input, output){
  output$contents <- renderTable({

    req(input$file1)

    inFile <- input$file1





    df_test=read_excel(inFile$datapath, 1)
    df1_test =  subset(df_test, select=c("Number"    ,                    
                                         "Category"       ,"Country"   ,                     
                                         "State"  , "Region","PkValue" ,"ASTvalue" ,"DMValue" ,"Geo","Demo"))




    Probabilty_Score = predict(classifier, type = 'response',newdata = df1_test)
    Output = as.factor(ifelse(Probabilty_Score<0.55,0,1))

    cm2 = table(df_test$Result, Output)

    print(caret::confusionMatrix(cm2))

    final=df_test[,c("Number","Result")]
    final1=cbind(final,Output,Probabilty_Score)    

    print(final1)






  })
}
)
)

Answer 1

由于您未提供示例数据，所以我只能给您大概（希望）按预期运行的猜测。我知道您希望有两个操作按钮，但是我考虑从shinyWidgets包的清洁选项中添加一个输入开关。我在更改代码的地方添加了注释。请尝试使用您的数据，并告诉我它是否有效。

library(shiny)
library(shinyWidgets) # You'll need this to get the switch widget
runApp(
  list(
    ui = fluidPage(
      titlePanel("Upload & Results"),
      sidebarLayout(
        sidebarPanel(
          fileInput('file1', 'Choose Excel File',accept = c(".xlsx")), # don't forget a "," here

          #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
          # Add a switch
          switchInput("input_switch",
                      "change",
                      value=T,
                      onLabel="Output",
                      offLabel="Accuracy")
          #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

        ),

        mainPanel(
          tableOutput('contents'))
      )
    ),
    server = function(input, output){

      output$contents <- renderTable({
        req(input$file1)
        inFile <- input$file1
        df_test=read_excel(inFile$datapath, 1)
        df1_test =  subset(df_test, select=c("Number"    ,                    
                                             "Category"       ,"Country"   ,                     
                                             "State"  , "Region","PkValue" ,"ASTvalue" ,"DMValue" ,"Geo","Demo"))

        Probabilty_Score = predict(classifier, type = 'response',newdata = df1_test)
        Output = as.factor(ifelse(Probabilty_Score<0.55,0,1))
        cm2 = table(df_test$Result, Output)

        final=df_test[,c("Number","Result")]
        final1=cbind(final,Output,Probabilty_Score)    

        #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        # Determine output depending on switch
        if(input$input_switch){
          print(caret::confusionMatrix(cm2))
        }else{
          print(final1)
        }
        #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

      })
    }
  )
)

Answer 2

我们可以在buttons代码中添加两个UI（如问题所示），如下所示：

  actionButton("output", "Output"),  # Button to get Output
  actionButton("accuracy", "Accuracy") # Button to get accuracy

现在，我们可以观察到如下所示的按钮单击事件（没有数据，我不确定以下代码是否有效）：

observeEvent(input$output, {
   print(final1)    # Print the outvalues here as button Output is clicked
})

observeEvent(input$accuracy, {
   print(caret::confusionMatrix(cm2))   # Print confusion matrix here as button accuracy is clicked
})

更新的代码：

  runApp(
  list(
    ui = fluidPage(

      titlePanel("Upload & Results"),
      sidebarLayout(
        sidebarPanel(
          fileInput('file1', 'Choose Excel File',accept = c(".xlsx")),
          actionButton("output", "Output"),  # Button to get Output
          actionButton("accuracy", "Accuracy") # Button to get accuracy 
        ),

        mainPanel(
          fixedRow(
            column(10,DT::dataTableOutput("contents")) 
          )
        )
     )
    ),
    server = function(input, output){
      output$contents <- renderDataTable({


        req(input$file1)
        inFile <- input$file1
        df_test=read_excel(inFile$datapath, 1)
        df1_test =  subset(df_test, select=c("Number"    ,                    
                                             "Category"       ,"Country"   ,                     
                                             "State"  , "Region","PkValue" ,"ASTvalue" ,"DMValue" ,"Geo","Demo"))


        Probabilty_Score = predict(classifier, type = 'response',newdata = df1_test)
        Output = as.factor(ifelse(Probabilty_Score<0.55,0,1))

        cm2 = table(df_test$Result, Output)

        final=df_test[,c("Number","Result")]
        final1=cbind(final,Output,Probabilty_Score)  

        observeEvent(input$output, {
          print(final1)    # Print the outvalues here as button Output is clicked
        })

        observeEvent(input$accuracy, {
          print(caret::confusionMatrix(cm2))   # Print confusion matrix here as button accuracy is clicked
        })

        # In the following line, return data.frame that you would like to see
        return(DT::datatable(iris, options = list(pageLength = 10)))
      })
    }
  )
)

使用R Shiny在不同的选项卡中创建不同的结果

2 个答案: