Reputation: 7
The system is an Audit Sample Selection System in which I used RStudio to develop the system. The system behaves as follows:
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
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
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