Shasha
Shasha

Reputation: 7

How to make each shiny radiobutton functioning differently?

The system is an Audit Sample Selection System in which I used RStudio to develop the system. The system behaves as follows:

  1. User upload Excel file or PDF file .
  2. User need to choose between two radiobuttons, one is 'Low Risk' and another one is 'High Risk'.
  3. The user click on 'Submit' button.
  4. The system automatically selects certain number of audit samples depending on the number of rows of the table in the file.
  5. The number of audit samples selected is different between 'Low Risk' and 'High Risk'.
  6. The system displays the selected audit samples.

This is the code for 'Low Risk' without functioning radiobuttons:

library(shiny)
library(xlsx)
library(xlsxjars)
library(rJava)
library(pdftools)
library(tabulizer)

ui <- fluidPage(
 titlePanel("Audit Sample Selection System"),
  sidebarLayout(
   sidebarPanel(
    fileInput("file1", "Choose file", accept = c(".xlsx", ".pdf")),
    radioButtons("select", "Level of Risk", choices=list("Low Risk" = "low","High Risk" = "high")),
  actionButton("submit", "Submit")
),
mainPanel(
  tableOutput("contents")
  )
 )
)

server <- function(input, output){

output$contents <- renderTable({

input$submit

isolate({
  inFile <- input$file1

  if (is.null(inFile[1])){
    return(NULL)
  } else if (grepl("*.xlsx",inFile[1]) == TRUE){

  file.rename(inFile$datapath, paste(inFile$datapath, ".xlsx", sep = ""))          
  wb <- read.xlsx(paste(inFile$datapath, ".xlsx", sep = ""), 1)

  nrow(wb) -> rows

  if (rows == 1) {
    outdf <- wb[sample(rows, 1), ]
  } else 
    if (rows >= 2 & rows <= 4) {
      outdf <- wb[sample(rows, 1), ]
    } else 
      if (rows >= 5 & rows <= 12) {
        outdf <- wb[sample(rows, 2), ]
      } else 
        if (rows >= 13 & rows <= 52) {
          outdf <- wb[sample(rows, 5), ]
        } else
          if (rows >= 53 & rows <= 365) {
            outdf <- wb[sample(rows, 15), ]
          } else
            if (rows > 365) {
              outdf <- wb[sample(rows, 25), ]
            } 
    outdf 
  } else if (grepl("*.pdf",inFile[1]) == TRUE){

    outtable <- extract_tables(inFile$datapath)
    outtable[[1]] <- outtable[[1]][-c(1,1),] # Remove header from the table on the first page
    df <- do.call(rbind, outtable) # Turn matrix into data frame
    nrow(df) -> rows

    if (rows == 1) {
      outdf <- df[sample(rows, 1), ]
    } else 
      if (rows >= 2 & rows <= 4) {
        outdf <- df[sample(rows, 1), ]
      } else 
        if (rows >= 5 & rows <= 12) {
          outdf <- df[sample(rows, 2), ]
        } else 
          if (rows >= 13 & rows <= 52) {
            outdf <- df[sample(rows, 5), ]
          } else
            if (rows >= 53 & rows <= 365) {
              outdf <- df[sample(rows, 15), ]
            } else
              if (rows > 365) {
                outdf <- df[sample(rows, 25), ]
              } 
    outdf  
   }
  })
 })
}

shinyApp(ui = ui, server = server)

And this is another piece of code for selecting audit samples for "High Risk":

inFile <- input$file1

  if (is.null(inFile[1])){
    return(NULL)
  } else if (grepl("*.xlsx",inFile[1]) == TRUE){

    file.rename(inFile$datapath, paste(inFile$datapath, ".xlsx", sep = ""))          
    wb <- read.xlsx(paste(inFile$datapath, ".xlsx", sep = ""), 1)

    nrow(wb) -> rows

    if (rows == 1) {
      outdf <- wb[sample(rows, 1), ]
    } else 
      if (rows >= 2 & rows <= 4) {
        outdf <- wb[sample(rows, 2), ]
      } else 
        if (rows >= 5 & rows <= 12) {
          outdf <- wb[sample(rows, 3), ]
        } else 
          if (rows >= 13 & rows <= 52) {
            outdf <- wb[sample(rows, 8), ]
          } else
            if (rows >= 53 & rows <= 365) {
              outdf <- wb[sample(rows, 25), ]
            } else
              if (rows > 365) {
                outdf <- wb[sample(rows, 40), ]
              } 
    outdf 
  } else if (grepl("*.pdf",inFile[1]) == TRUE){

    outtable <- extract_tables(inFile$datapath)
    outtable[[1]] <- outtable[[1]][-c(1,1),] # Remove header from the table on the first page
    df <- do.call(rbind, outtable) # Turn matrix into data frame
    nrow(df) -> rows

    if (rows == 1) {
      outdf <- df[sample(rows, 1), ]
    } else 
      if (rows >= 2 & rows <= 4) {
        outdf <- df[sample(rows, 2), ]
      } else 
        if (rows >= 5 & rows <= 12) {
          outdf <- df[sample(rows, 3), ]
        } else 
          if (rows >= 13 & rows <= 52) {
            outdf <- df[sample(rows, 8), ]
          } else
            if (rows >= 53 & rows <= 365) {
              outdf <- df[sample(rows, 25), ]
            } else
              if (rows > 365) {
                outdf <- df[sample(rows, 40), ]
              } 
    outdf  
  }

My problem is I don't know how to make the radiobuttons funtioning so that after choosing between 'Low Risk' or'High Risk' and click on the 'Submit' button, the number audit samples will be selected accordingly.

Upvotes: 0

Views: 69

Answers (2)

thmschk
thmschk

Reputation: 644

I was just about to write an example and when I finished, qfazille already answered. While qfazille's answer is more detailled, I gave you a general example, so I post it anyway.

library(shiny)

ui <- fluidPage(
titlePanel("Audit Sample Selection System"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose file", accept = c(".xlsx", ".pdf")),
radioButtons("select", "Level of Risk", choices=list("Low Risk" = "low","High Risk" = "high")),
actionButton("submit", "Submit")
),
mainPanel(
htmlOutput("contents") # change output function depending on type
)
)
)

server <- function(input, output){

out<-eventReactive(input$submit,{

#validate(need(!is.null(input$file),"please choose a file"))

if (input$select=='low') {
  showout<-"dosomething" # replace this with your functions for 'low'
  }
else if (input$select=='high') {
  showout<-"dosomethingelse" # replace this with your functions for 'high'
  }

showout

})  

output$contents <- renderText({ # change render depending on type
  out()
  })

}

shinyApp(ui = ui, server = server)

Upvotes: 1

qfazille
qfazille

Reputation: 1671

Replace my comments by concerned piece of codes. You can finish each piece of code by return(outdf)

library(shiny)
library(xlsx)
library(xlsxjars)
library(rJava)
library(pdftools)
library(tabulizer)

ui <- fluidPage(
  titlePanel("Audit Sample Selection System"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose file", accept = c(".xlsx", ".pdf")),
      radioButtons("select", "Level of Risk", choices=list("Low Risk" = "low","High Risk" = "high")),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      tableOutput("contents")
    )
  )
)

server <- function(input, output){

  mydf <- eventReactive(input$submit, {
    req(input$select)
    req(input$file1)
    if (grepl("*.xlsx",inFile[1]) == TRUE){
      file.rename(inFile$datapath, paste(inFile$datapath, ".xlsx", sep = ""))          
      wb <- read.xlsx(paste(inFile$datapath, ".xlsx", sep = ""), 1)

      nrow(wb) -> rows
      if (input$select == "low") {
        # Create here your sample for low risk (xlsx)
      } else {
        # Create here your sample for high risk (xlsx)
      }
    } else if (grepl("*.pdf",inFile[1]) == TRUE) {
      outtable <- extract_tables(inFile$datapath)
      outtable[[1]] <- outtable[[1]][-c(1,1),] # Remove header from the table on the first page
      df <- do.call(rbind, outtable) # Turn matrix into data frame
      nrow(df) -> rows
      if (input$select == "low") {
        # Create here your sample for low risk (pdf)
      } else {
        # Create here your sample for high risk (pdf)
      }
    } else {
      NULL
    }
  })
  output$contents <- renderTable({
    mydf()
  })
}

shinyApp(ui = ui, server = server)

Upvotes: 3

Related Questions