I am building an authentication part in my app by comparing the code sent in email and the code users submit. I have tried adding if-statement by using either in reactive(),isolate(), renderTable(). I either get the value should be in the reactive part error, or the app does not respond at all.
Below is what I have in Server.R, the app does not respond at all with no error.
shinyServer(function(input, output, session) {
myData <- reactive({
req(input$Id)
#connect to the database, get the data, res
#send an email with random number, rnd
list(res,rnd)
})
output$tbTable <- renderTable({req(input$Auth)
if (input$AuthCode==myData()$rnd) {
myData()$res
}
else{
as.data.frame(c("Authentication Failed"))
}
})
output$downloadData <- downloadHandler(
filename = function() {
paste(input$Id, " filname.xlsx", sep = "")
},
content = function(file) {
write.csv(myData(), file, row.names = FALSE)
}
)#this part need to depend on the if-statement as well
}
)
UI.R
ui <- shinyUI(fluidPage(title = "aaa",
titlePanel("aaa"),
sidebarLayout(
sidebarPanel(
textInput("Id", "Enter Acct Name below"),
submitButton(text="Submit"),
tags$hr(),
numericInput("AuthCode",label="Authentication",value=""),
actionButton("Auth",label="Submit"),
tags$hr(),
tags$hr(),
downloadButton("downloadData", "Download Data")
),
mainPanel(
tabsetPanel(
tabPanel("Data", tableOutput("tbTable"))
))
),
)
)
I think I've got the fixed to do what you want. Please check. I've done the following changes
Replaced your submitButton to actionButton as Acc and using observeEvent to call that.
The authentication is also now triggered by an observeEvent when the second button is clicked
Excel extension wouldn't work in write.csv so changed the extension.
server.R
shinyServer(function(input, output, session) {
# the first button will trigger this
observeEvent(input$Acc,{
# myData <- reactive({
req(input$Id)
#connect to the database, get the data, res
#send an email with random number, rnd
#list(res,rnd)
myData <<- list(res = 123,rnd = 345) #passing test value and storing it as global variable for accessing in other functions
# })
cat("mydata done")
})
# the second button will trigger this
observeEvent(input$Auth,{
output$tbTable <- renderTable({
#req(input$Auth)
if (input$AuthCode==myData$rnd) {
myData$res
}
else{
#as.data.frame(c("Authentication Failed"))
shiny::showModal(modalDialog(
title = "Important message",
"Authentication Failed!"
))
}
})
})
output$downloadData <- downloadHandler(
filename = function() {
paste(input$Id, " filname.csv", sep = "") #renamed it to csv because write.csv writes to csv not excel
},
content = function(file) {
write.csv(myData, file, row.names = FALSE)
}
)#this part need to depend on the if-statement as well
}
)
ui.R
ui <- shinyUI(fluidPage(title = "aaa",
titlePanel("aaa"),
sidebarLayout(
sidebarPanel(
textInput("Id", "Enter Acct Name below"),
actionButton("Acc",label="Click to send code"),
tags$hr(),
numericInput("AuthCode",label="Authentication",value=000),
actionButton("Auth",label="Submit"),
tags$hr(),
tags$hr(),
downloadButton("downloadData", "Download Data")
),
mainPanel(
tabsetPanel(
tabPanel("Data", tableOutput("tbTable"))
))
)
)
)
Related
Let's say I have 4 sets of UI/Server modules in 4 different directories ("./X1/Y1/", "./X1/Y2/", "./X2/Y1/", "./X2/Y2/"). I want to load the selected set based on the input in the sidebar.
I tried using source() within dashboardBody(), but I was not successful.
library(shiny)
library(shinydashboard)
# path to modules
in_path <- "C:/a/b/c/"
# ui
ui <- dashboardPage(
dashboardHeader(title = "test"),
dashboardSidebar(
br(),
selectInput('f1', 'Folder 1', choices = c("X1", "X2")),
helpText(""),
selectInput('f2', 'Folder 2', choices = c("Y1", "Y2")),
br(),
actionButton("load", "Load", icon("thumbs-up"), width = "85%")
),
dashboardBody(
# UI module here from, e.g., "C:/a/b/c/X1/Y2/my_UI.R"
)
)
# server
server <- function(input, output, session) {
# server module here from, e.g., "C:/a/b/c/X1/Y2/my_Server.R"
}
shinyApp(ui, server)
As shiny modules are simply functions, I'd source them in the beginning, and use uiOutput to display the differnt modules.
Here's a working example of the general idea (sample module code proudly stolen from the official Shiny documentation):
<mod1.R>
counterButton <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out"))
)
}
counterServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$out <- renderText({
count()
})
count
}
)
}
<mod2.R>
csvFileUI <- function(id, label = "CSV file") {
ns <- NS(id)
tagList(
fileInput(ns("file"), label),
checkboxInput(ns("heading"), "Has heading"),
selectInput(ns("quote"), "Quote", c(
"None" = "",
"Double quote" = "\"",
"Single quote" = "'"
))
)
}
csvFileServer <- function(id, stringsAsFactors = TRUE) {
moduleServer(
id,
## Below is the module function
function(input, output, session) {
# The selected file, if any
userFile <- reactive({
# If no file is selected, don't do anything
validate(need(input$file, message = FALSE))
input$file
})
# The user's data, parsed into a data frame
dataframe <- reactive({
read.csv(userFile()$datapath,
header = input$heading,
quote = input$quote,
stringsAsFactors = stringsAsFactors)
})
# We can run observers in here if we want to
observe({
msg <- sprintf("File %s was uploaded", userFile()$name)
cat(msg, "\n")
})
# Return the reactive that yields the data frame
return(dataframe)
}
)
}
<app.R>
library(shiny)
source("mod1.R")
source("mod2.R")
my_mods <- list("Counter Button" = list(ui = counterButton,
server = counterServer),
"CSV Uploader" = list(ui = csvFileUI ,
server = csvFileServer))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("mod_sel",
"Which Module should be loaded?",
names(my_mods))
),
mainPanel(
uiOutput("content"),
verbatimTextOutput("out")
)
)
)
server <- function(input, output) {
uuid <- 1
handler <- reactiveVal()
output$content <- renderUI({
my_mods[[req(input$mod_sel)]]$ui(paste0("mod", uuid))
})
observeEvent(input$mod_sel, {
handler(my_mods[[req(input$mod_sel)]]$server(paste0("mod", uuid)))
uuid <<- uuid + 1
})
output$out <- renderPrint(req(handler())())
}
shinyApp(ui, server)
Some Explanation
You put the module code in mod[12].R and it is rather straight forward.
In your main app, you load both(!) source files and for housekeeping reasons, I put both modules functions (ui and server) in a list, but this is not strictly necessary, but facilitates future extension.
In your UI you have an uiOutput which renders dynamically according to the selected module.
In your server you put the code to dynamically render the UI and call the respective server function.
The uid construct is basically there to force a fresh render, whenever you change the selection. Otherwise, you may see still some old values whenever you come back to a module which you have rendered already.
I want to be able to upload multiple images with file input and display the single image selected in the UI
ui.R
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file","Upload the file", multiple = TRUE), # fileinput() function is used to get the file upload contorl option
uiOutput("selectfile")
),
mainPanel(
uiOutput('images')
)
)
)
server.R
server <- function(input,output) {
## Side bar select input widget coming through renderUI()
# Following code displays the select input widget with the list of file loaded by the user
output$selectfile <- renderUI({
if(is.null(input$file)) {return()}
list(hr(),
helpText("Select the files for which you need to see data and summary stats"),
selectInput("Select", "Select", choices=input$file$name)
)
})
output$images <- renderImage({
if(is.null(input$file)) {return(NULL)}
for (i in 1:nrow(input$file))
{
if(input$file$name[i] == input$Select){
list(src=input$file$datapath[i],
alt= "error")
print(input$file$name[i])
print(input$file$datapath[i])
}
}
})
}
With this solution, the prints of the datapath and the name shows me the right answer but i keep getting the same error after trying to render the image: "Warning: Error in basename: a character vector argument expected".
Here is a solution using base64 encoding.
library(shiny)
library(base64enc)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file", "Upload the file", multiple = TRUE),
uiOutput("selectfile")
),
mainPanel(
uiOutput('image')
)
)
)
server <- function(input,output) {
output$selectfile <- renderUI({
req(input$file)
list(hr(),
helpText("Select the files for which you need to see data and summary stats"),
selectInput("Select", "Select", choices=input$file$name)
)
})
output$image <- renderUI({
req(input$Select)
i <- which(input$file$name == input$Select)
if(length(i)){
base64 <- dataURI(file = input$file$datapath[i], mime = input$file$type[i])
tags$img(src = base64, alt= "error")
}
})
}
shinyApp(ui, server)
I am trying to download a file using downloadHandler with observeEvent shiny but I am not able to download the file,
library(shiny)
load(url("http://s3.amazonaws.com/assets.datacamp.com/production/course_4850/datasets/movies.Rdata"))
ui <- fluidPage(
sidebarLayout(
# Input
sidebarPanel(
# Numeric input for number of rows to show
numericInput(inputId = "n_rows",
label = "How many rows do you want to see?",
value = 10),
# Action button to show
actionButton(inputId = "button",
label = "Show")
),
# Output:
mainPanel(
tableOutput(outputId = "datatable")
)
)
)
server <- function(input, output, session) {
# creating a reactive expression
df <- eventReactive(input$button, {
movies %>% head(input$n_rows)
})
# download a csv everytime when user click on show button
observeEvent(input$button, {
output$button <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(df(), file)
}
)
cat("done downloading file \n")
})
# displays the data on the web in tabular format, data comes from reactive event
output$datatable <- renderTable({
df()
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
I was able to execute above code without any errors, but csv file is not downloading, i want to display the data table and download the displayed data on same button click event , how can i achieve this, Am I missing something, any help would be appreciated
Try this:
library(shiny)
library(dplyr)
load(url("http://s3.amazonaws.com/assets.datacamp.com/production/course_4850/datasets/movies.Rdata"))
ui <- fluidPage(
sidebarLayout(
# Input
sidebarPanel(
# Numeric input for number of rows to show
numericInput(inputId = "n_rows",
label = "How many rows do you want to see?",
value = 10),
# Action button to show
downloadButton('downloadData', 'Download data')
),
# Output:
mainPanel(
tableOutput(outputId = "datatable")
)
)
)
server <- function(input, output, session) {
# Reactive value for selected dataset ----
df <- reactive({
movies %>% head(input$n_rows)
})
output$datatable <- renderTable({
df()
})
output$downloadData <- downloadHandler(
filename = function() {
paste("dataset-", ".csv", sep = "")
},
content = function(file) {
write.csv(df(), file, row.names = FALSE)
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
I am very new to Shiny web app with R. I want to generate summary according to choice from checkboxGroupInput which i generated dynamically when browsing the CSV file. My problem is that when i want to convert from String to numeric that time it prints NA.
I am uploading my two files which are ui.r and server.r. I am trying since two days. If anyone help me then it will be very beneficial for me.
If i did anything wrong in my code then please suggest me right way.
ui.r
library(shiny)
library(shinythemes)
shinyUI(fluidPage(
theme = shinytheme("cyborg"),
themeSelector(),
# Application title
titlePanel("Data Analytics and Visualization Dashboard"),
sidebarLayout(
sidebarPanel(
fileInput('datafile', 'Choose CSV file',accept=c('text/csv', 'text/comma-
separated-values,text/plain')),
h5("Max file size to upload is 5 MB."),
radioButtons("sep", "Seperator", choices = c(Comma = ',', semicolon = ';',
tab = "\t", space = " " )),
#checkboxInput("header", "Header?")
br(),
h4("Select columns from CSV"),
uiOutput("toCol"),
br(),
h4("Summary"),
textOutput("sum")
# tableOutput("disp")
),
mainPanel(
numericInput("obs", "Enter the number of rows to display:", 5),
tableOutput("input_file"),
plotOutput("p")
)
)
))
server.r
library(shiny)
shinyServer(function(input, output,session) {
#This function is repsonsible for reading a csv file
output$input_file <- renderTable({
file_to_read = input$datafile
if(is.null(file_to_read))
{
return()
}
read.csv(file_to_read$datapath, sep = input$sep, nrows = input$obs))
})
#This function is repsonsible for loading in the selected file
filedata <- reactive({
infile <- input$datafile
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
read.csv(infile$datapath,nrows = input$obs)
})
#The following set of functions populate the column selectors
output$toCol <- renderUI({
df <-filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
checkboxGroupInput("to", "Columns",items)
})
observe({
# db <- gsub(",","",input$to)
# print(db)
# paste( intToUtf8(160), input$to, intToUtf8(160))
# print(summary(as.numeric(as.character( paste( " ", input$to, "
#"))))) })
print(summary(as.numeric( input$to) ))})
# output$sum <- renderPrint({
# summary(input$data.frame[,as.numeric(input$var)])
# })
# output$disp <- renderTable({
# input$to
# })
# output$summary1 <- renderPrint({
# sum <- as.numeric(as.character(input$to))
# summary(sum)
#})
})
This could be a starting point, although I dont recommend using this for a productive app, as the login-process is not really safe nor encrypted. It is based solely on text-data.
But you will have to put the ui in the server and render the page depending on the login status. So there are 2 renderUI but just 1 server-function. I dont know if you can have 2 different server-functions and redirect them. I think it all has to be in 1 server-function.
library(shiny)
username = "joe"
password = "joe123"
ui <- fluidPage(
uiOutput("ui")
)
server <- function(input, output, session) {
LOGGED <- reactiveValues(user = FALSE)
observeEvent(input$action, {
if ((input$name == username ) & (input$pass == password)) {
LOGGED$user = TRUE
} else {
LOGGED$user = FALSE
}
})
observe({
if (LOGGED$user == FALSE) {
output$ui <- renderUI({
tagList(
p(HTML("User is joe <br> and password is joe123")),
textInput("name", "Enter your username"),
passwordInput("pass", "Enter your password"),
actionButton("action", label = "Action")
)
})
} else if (LOGGED$user == TRUE) {
output$ui <- renderUI({
tagList(
h1("You are logged in.")
)
})
}
})
}
shinyApp(ui, server)
Like #Codeer said, there is no line in your code like this one summary(as.numeric(paste(input$to, “input$to”))). I edited your code, so all the uncommented lines dont appear, as its not necessary to show them.
In your example, your loading the csv file twice, which you can definitly avoid.
I moved the csv-loading into the reactive only. Then you can access the loaded file everywhere in your shiny-app. And i think in your print(summary()) statement, you're missing the data, as your only printing out the summary of the input$tovariable, which is only text and if you convert it to numeric you create NA-values.
So i rearranged your code a bit, and I think its behaving the way you intend it to.
library(shiny)
library(shinythemes)
ui <- {shinyUI(fluidPage(
theme = shinytheme("cyborg"),
themeSelector(),
titlePanel("Data Analytics and Visualization Dashboard"),
sidebarLayout(
sidebarPanel(
fileInput('datafile', 'Choose CSV file',accept=c('text/csv', 'text/comma-
separated-values,text/plain')),
h5("Max file size to upload is 5 MB."),
radioButtons("sep", "Seperator", choices = c(Comma = ',', semicolon = ';',
tab = "\t", space = " " )),
br(),
h4("Select columns from CSV"),
uiOutput("toCol"),
br(),
h4("Summary"),
textOutput("sum")
),
mainPanel(
numericInput("obs", "Enter the number of rows to display:", 5),
tableOutput("input_file"),
verbatimTextOutput("summary"),
plotOutput("p")
)
)
))}
server <- shinyServer(function(input, output,session) {
#This function is repsonsible for loading and reading a csv file
filedata <- reactive({
req(input$datafile)
infile <- input$datafile
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
read.csv(infile$datapath,nrows = input$obs, sep = input$sep)
})
output$input_file <- renderTable({
filedata()
})
#The following set of functions populate the column selectors
output$toCol <- renderUI({
df <- filedata()
if (is.null(df)) return(NULL)
items=names(df)
names(items)=items
checkboxGroupInput("to", "Columns",items)
})
output$summary <- renderPrint({
req(input$to)
data <- filedata()
print(summary(data[,input$to]))
})
})
shinyApp(ui, server)
The csv file is loaded in the reactive (filedata). In the renderTable, you just enter the reactive variable - filedata(). And in the observe, you call again the reactive variable and only print out the summary of the data in the clicked column (input$to).
I am building an app in shiny (R). At the beginning the user can upload a file to use (I am doing a sort data analysis). My goal is to be able to use files without knowing how many columns this file has, and how the data exactly looks like.
So now I have to select the columns by number, and I made a small preview app for this to select columns and then display them next to the original:
library(shiny)
ui <-fluidPage(
headerPanel("Select data"),
sidebarLayout(
sidebarPanel(
fileInput("uploadFile", "XLSX file"),
textInput('vec1', 'Choose training columns', "3,4"),
actionButton("choose","choose data")
),
mainPanel(
fluidRow(
column(6,tableOutput("data_raw")),
column(6,tableOutput("data_selected"))
)
)
)
)
server <- function(input, output) {
output$data_raw <- renderTable({
inFile <- input$uploadFile
if (is.null(inFile))
return(NULL)
data_raw <<-read.xlsx(inFile$datapath, 1)
})
observe({
if(input$choose>0){
selectvec <- as.numeric(unlist(strsplit(input$vec1,",")))
output$data_selected <- renderTable(
data_selected<- data_raw[,selectvec]
)
}
})
}
shinyApp(ui,server)
Now I would like to be able to select the columns to use on basis of their header.
It feels unnatural: changing the app while running.. but in a reactive environment.. why not?
QUESTION: How can I change the UI while it is allready running, with values originating from the input?
kind regards,
Pieter
To make me feel not as dirty for answering this...I didn't debug or handle reactives properly. But here ya go. You need to respond to the file that is uploaded on the server side, extract the column names, and append thosed to the choices in a select input that then passes down to the table function as a column filter.
upload_app <- function(){
library(shiny)
ui <- bootstrapPage(
tags$div(class = "container",
column(3,
fluidRow(
fileInput(inputId = 'user_data',
label = 'Upload Data (csv)',
multiple = FALSE,
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
))
),
fluidRow(
uiOutput('column_vars')
)
),
column(9,
tableOutput('filtered_table'))
)
)
server <- function(session, input, output){
var_table <- reactive({
var_data <- input$user_data
read.csv(var_data$datapath, header = TRUE,sep = ",", quote = '')
})
output$column_vars <- renderUI({
if(!is.null(var_table())){
selectInput(inputId = 'cols',
choices = colnames(var_table()),
multiple = T,
label = "Choose Columns")
}
})
output$filtered_table <- renderTable({
if(!is.null(var_table())){
if(length(input$cols)>0){
get_these <- input$cols
new_table <- var_table()[,c(get_these)]
}else {
new_table <- var_table()
}
}else {
new_table <- data.frame(data = 'Waiting')
}
return(new_table)
})
}
shinyApp(ui, server)
}