I'm pretty new to shiny (being playing around for about a week). And I'm trying to create an app that takes and input tab-separated text file and perform several exploratory functions. In this case I'm presenting a very simplified version of that app just to highlight what I want to do in a specific case:
Problem:
If you try the app with the sample data (or any data in the same format) you can notice that the app effectively performs the default summary table (if selectInput="summarize", then output$sumfile), but when you try to select "explore", the previous table gets removed from the mainPanel, and outputs the full file (selectInput="explore",then output$gridfile) in the place where it would be as if selectInput="summarize" was still selected.
If you re-select "summarize", excelOutput("sumfile") gets duplicated on the mainPanel.
My goal is simple:
excelOutput("sumfile") when selectInput="summarize" ONLY and
excelOutput("gridfile") when selectInput="explore" ONLY
without placement issues or duplications on the mainPanel
So far I've tried:
inFile=input$df
if(is.null(inFile))
return(NULL)
if(input$show=="summarize")
return(NULL)
or
inFile=input$df
if(is.null(inFile))
return(NULL)
if(input$show=="explore")
return(NULL)
To control what shows up on the mainPanel, but with placement and duplication issues.
sample data:
#Build test data
testdat<-data.frame(W=c(rep("A",3),
rep("B",3),
rep("C",3)),
X=c(letters[1:9]),
Y=c(11:19),
Z=c(letters[1:7],"",NA),
stringsAsFactors = FALSE)
#Export test data
write.table(testdat,
"your/path/file.txt",
row.names = FALSE,
sep = "\t",
quote = FALSE,
na="")
shiny app (app.R):
library(shiny)
library(excelR)
#function to summarize tables
Pivot<-function(df){
cclass<-as.character(sapply(df,
class))
df.1<-apply(df,
2,
function(x) unlist(list(nrows = as.numeric(NROW(x)),
nrows.unique = length(unique(x))-(sum(is.na(x))+length(which(x==""))),
nrows.empty = (sum(is.na(x))+length(which(x==""))))))
df.2<-data.frame(df.1,
stringsAsFactors = FALSE)
df.3<-data.frame(t(df.2),
stringsAsFactors = FALSE)
df.3$col.class<-cclass
df.3$col.name<-row.names(df.3)
row.names(df.3)<-NULL
df.3<-df.3[c(5,4,1,2,3)]
return(df.3)
}
ui <- fluidPage(
ui <- fluidPage(titlePanel(title=h1("Summary generator",
align="center")),
sidebarLayout(
sidebarPanel(
h3("Loading panel",
align="center"),
fileInput("df",
"Choose file (format: file.txt)",
accept = c("plain/text",
".txt")),
selectInput("show",
"Choose what to do with file",
choices=c("summarize","explore")),
p("**'summarize' will output a summary of the selected table"),
p("**'explore' will output the full selected editable table"),
tags$hr()
),
mainPanel(
excelOutput("gridfile"),
excelOutput("sumfile")
))))
server <- function(input, output) {
dat<-reactive({
fp<-input$df$datapath
read.delim(fp,
quote="",
na.strings="\"\"",
stringsAsFactors=FALSE)
})
#get summary
output$sumfile<-renderExcel({
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="explore") #if selectInput = "explore" return nothing
return(NULL)
dat.1<-data.frame(dat())
dat.2<-Pivot(dat.1)
excelTable(dat.2,
defaultColWidth = 100,
search = TRUE)
})
#get full file
output$gridfile<-renderExcel({
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="summarize") #if selectInput = "summarize" return nothing
return(NULL)
dat.1<-data.frame(dat())
excelTable(dat.1,
defaultColWidth = 100,
search = TRUE)
})
}
shinyApp(ui = ui, server = server)
One way to do what you want is to use observeEvent for your inputs input$show and input$df and renderExcel based on your selection of `input$show. Here is an updated version for your code:
library(shiny)
library(excelR)
#function to summarize tables
Pivot<-function(df){
cclass<-as.character(sapply(df,
class))
df.1<-apply(df,
2,
function(x) unlist(list(nrows = as.numeric(NROW(x)),
nrows.unique = length(unique(x))-(sum(is.na(x))+length(which(x==""))),
nrows.empty = (sum(is.na(x))+length(which(x==""))))))
df.2<-data.frame(df.1,
stringsAsFactors = FALSE)
df.3<-data.frame(t(df.2),
stringsAsFactors = FALSE)
df.3$col.class<-cclass
df.3$col.name<-row.names(df.3)
row.names(df.3)<-NULL
df.3<-df.3[c(5,4,1,2,3)]
return(df.3)
}
ui <- fluidPage(
ui <- fluidPage(titlePanel(title=h1("Summary generator",
align="center")),
sidebarLayout(
sidebarPanel(
h3("Loading panel",
align="center"),
fileInput("df",
"Choose file (format: file.txt)",
accept = c("plain/text",
".txt")),
selectInput("show",
"Choose what to do with file",
choices=c("summarize","explore")),
p("**'summarize' will output a summary of the selected table"),
p("**'explore' will output the full selected editable table"),
tags$hr()
),
mainPanel(
excelOutput("gridfile"),
excelOutput("sumfile")
))))
server <- function(input, output) {
dat<-reactive({
fp<-input$df$datapath
read.delim(fp,
quote="",
na.strings="\"\"",
stringsAsFactors=FALSE)
})
observeEvent({
input$show
input$df
}, {
inFile=input$df
if(is.null(inFile)) #if fileInput is empty return nothing
return(NULL)
if(input$show=="explore") {
output$gridfile<-renderExcel({
dat.1<-data.frame(dat())
excelTable(dat.1,
defaultColWidth = 100,
search = TRUE)
})
}
if(input$show=="summarize") {
output$sumfile<-renderExcel({
dat.1<-data.frame(dat())
dat.2<-Pivot(dat.1)
excelTable(dat.2,
defaultColWidth = 100,
search = TRUE)
})
}
})
}
shinyApp(ui = ui, server = server)
Hope it helps!
Related
I have a shiny app where the user uploads a csv file. Then, using the column names from the csv file, I create sortable bucket list. I would like drag the column name from the first rank list and have it cloned (i.e. not depleted). I tried to use the options parameter in add_rank_list() setting pull='clone', but that did not work. Any idea on how to do this? Below is my code, and some fake data can be accessed here.
library(shiny)
library(shinyjs)
library(sortable)
ui <- fluidPage(
titlePanel("App"),
sidebarLayout(
sidebarPanel(
useShinyjs(),
fileInput(inputId = "file1", label = "Select a .csv file",
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")
),
uiOutput("show_button")
),
mainPanel(
DT::dataTableOutput("table")
)
),
fluidRow(uiOutput("buckets"))
)
server <- function(input, output) {
# input csv file
input_file <- reactive({
if (is.null(input$file1)) {
return("")
}
# actually read the file
read.csv(file = input$file1$datapath)
})
# button to hide/show table
## only show when table is loaded
output$show_button = renderUI({
req(input$file1)
actionButton(inputId = "button", label = "show / hide table")
})
## observe the button being pressed
observeEvent(input$button, {
shinyjs::toggle("table")
})
# output table
output$table <- DT::renderDataTable({
# render only if there is data available
req(input_file())
# reactives are only callable inside an reactive context like render
data <- input_file()
data
})
# Drag and Drop Col names
output$buckets = renderUI(
{
# create list of colnames
req(input$file1)
data = input_file()
cols = colnames(data)
# create bucket list
bucket_list(
header = "Drag the items in any desired bucket",
group_name = "bucket_list_group",
orientation = "horizontal",
add_rank_list(
text = "Drag from here",
labels = as.list(cols),
input_id = "rank_list_1",
css_id = "list1",
options = sortable_options(
group = list(
pull = "clone",
name = "list_group1",
put = FALSE))
),
add_rank_list(
text = "to here",
labels = NULL,
input_id = "rank_list_2",
css_id = "list2",
options = sortable_options(group = list(name = "list_group1")))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want to upload two csv files and print both tables out.
Here is the code I wrote:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(inputId = "files", label = "Choose CSV File", multiple = TRUE,accept = c(".csv")
)
),
mainPanel(
fluidRow(tableOutput("Policy1")),
fluidRow(tableOutput("Policy2")),
)
)
)
server <- function(input, output) {
data <- reactiveValues(file1 = NULL,
file2 = NULL)
output$Policy1 <- renderTable({
if(!is.null(input$files$datapath[1]))
data$file1 <- read.csv(input$files$datapath[1], header = TRUE)
data$file1
})
output$Policy2 <- renderTable({
if(is.null(input$files$datapath[2])) {return(1)}
else{return(NULL)}
})
}
shinyApp(ui, server)
and for the output$Policy2 part, I want to test when the is.null(input$files$datapath[2]) is true. I thought it should be true when I only upload one file or don't upload anything but
if I only upload one csv file, it didn't print out the table 1, which means is.null(input$files$datapath[2]) is false in this case.I don't know why this is the case.
And as a result, if I change the code to ask shiny print two tables for me and only upload one file, there will be an error, here is the code:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(inputId = "files", label = "Choose CSV File", multiple = TRUE,accept = c(".csv")
)
),
mainPanel(
fluidRow(tableOutput("Policy1")),
fluidRow(tableOutput("Policy2")),
)
)
)
server <- function(input, output) {
data <- reactiveValues(file1 = NULL,
file2 = NULL)
output$Policy1 <- renderTable({
if(!is.null(input$files$datapath[1]))
data$file1 <- read.csv(input$files$datapath[1], header = TRUE)
data$file1
})
output$Policy2 <- renderTable({
if(!is.null(input$files$datapath[2]))
data$file2 <- read.csv(input$files$datapath[2], header = TRUE)
data$file2
})
}
shinyApp(ui, server)
where I only change a little part and here is the error :
which I assume is because I should return NULL when only one file inputed in, how can I fix this problem, thanks for any help
The value won't be NULL if it's missing. It's better to check that there are enough values checking the length of the vector or something. For example
output$Policy2 <- renderTable({
if(!is.null(input$files) && length(input$files$datapath)>=2)
data$file2 <- read.csv(input$files$datapath[2], header = TRUE)
data$file2
})
I have a question regarding R shiny and the observ function. Is it possible to save the selected factors and the state of the work? For Example I created a programm which can choose colnames from the input data. After using bookmark and reopening the programm with the link in the browser the input data are loaded but the select factors of the colnames are reset. But I want to save the chosen colnames. Has anyone an idea? Thank you for your help!
ui <- function(request) {
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
"fileType_Input",
label = h5(""),
choices = list(".csv" = 1, ".xlsx" = 2),
selected = 1,
inline = TRUE
),
fileInput('file1', '' ),
selectInput("letters", label=NULL, factors, multiple = TRUE),
bookmarkButton()
),
mainPanel(
tableOutput("contents")
)
)
)
}
server <- function(input, output,session) {
myData <- reactive({
inFile <- input$file1
# Get the upload file
if (is.null(inFile)) {
return(NULL) }
if (input$fileType_Input == "1") {
read.csv2(inFile$datapath,
header = TRUE,
stringsAsFactors = FALSE)
} else {
read_excel(inFile$datapath)
}
})
observe({
if(is.null(input$letters)){
data <- myData()
if(is.null(data)){
}else{
factors <- colnames(data)
t$choices <- input$letters # append(u$choices,input$letters2)
updateSelectInput(session, "letters",
choices = factors #[!factors2 %in% u$choices)]
)}
}
})
#Display all input Data
output$contents <- renderTable(digits = NULL,{
df <-myData()
df
})
}
enableBookmarking("server")
shinyApp(ui, server)
You can save all needed inputs in a file, and then reapply them with functions like updateRadioButtons() and others.
Saving it to the file could look like this:
observeEvent(input$someRadioButton, {
states <- list()
states$someRadioButton <- input$someRadioButton
#you can save all the needed inputs like this
...
save(states, file = paste0(getwd(), "/myfile"))
})
I have a Shiny application which lets a user upload a CSV to undertake sentiment analysis.
The Aim:
I want to use Shiny to upload the CSV and then use a separate function (CapSent) to do the analysis and output the results.
Basically I am trying to pass the 'df' uploaded by the user into the function 'CapSent' (which resides in global.R) from Shiny. CapSent undertakes Sentiment analysis using a custom dictionary of words.
My Code So Far:
So far I have:
ui:
library(shiny)
source('global.R')
ui <- fluidPage(
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv"))
))
Server:
server <- function(input, output) {
output$contents <- renderTable({
req(input$file1)
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
CapSent(0.1, df) # 0.1 represents a threashold, df is the data
})
}
shinyApp(ui, server)
Functions.R:
CapSent <- function(0.1, df){
newdf<-data.frame(df,stringsAsFactors = FALSE)
#....Do some sentiment analysis here on newdf
#....Then export the sentiment analysis results
write.csv(newdf,"myResults.csv")
}
The Issue
With the above code I receive the error 'Error in Encoding<-: a character vector argument expected'.
'CapSent' works when I manually add 'df' to the Global Environment (using readr) but I want users to upload their own data to analyse. Hence the question:
Is there a way to pass df to the Global Environment from Shiny?
Any advice would be much appreciated.
Try this:
ui.R
library(shiny)
# Define UI for app that draws a histogram ----
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: ----
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
actionButton("button", "Apply function/download df"),
hr(),
uiOutput("downloadButton")
),
# Main panel for displaying outputs ----
mainPanel(
h2("ORIGINAL DATA FRAME"),
DT::dataTableOutput("contents"),
br(),
uiOutput("modify")
)
)
)
server.R
server <- function(input, output) {
temp_df <- reactiveValues(df_data = NULL)
temp_df2 <- reactiveValues(df_data = NULL)
output$contents <- DT::renderDataTable({
req(input$file1)
temp_df$df_data <- read.csv(input$file1$datapath, sep = ";")
temp_df$df_data
}, options = (list(pageLength = 5, scrollX = TRUE)))
output$contents2 <- DT::renderDataTable({
temp_df2$df_data
}, options = (list(pageLength = 5, scrollX = TRUE)))
observeEvent(input$button,{
if(!is.null(temp_df$df_data)){
temp_df2$df_data <- CapSent(temp = 0.7, temp_df$df_data)
output$modify <- renderUI({
tagList(
h2("MODIFY DATA FRAME"),
DT::dataTableOutput("contents2")
)
})
output$downloadButton <- renderUI({
downloadButton("downloadData", "Download")
})
}else{
showNotification("No data was upload")
}
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(temp_df2$df_data, file)
})
}
as I do not know which CapSent end-use I made CapSent a function that adds a new column in the original data frame;
global.R
CapSent <- function(temp = 0.1, df){
newdf <- df
newdf$New_Col <- temp
return(newdf)
#....Do some sentiment analysis here on newdf
#....Then export the sentiment analysis results
#write.csv(newdf,"myResults.csv")
}
If you want to create a global function/variable just make a global.R which will let you use the function/variable everywhere on the ui.R or server.R.
This is the link to learn more: https://shiny.rstudio.com/articles/scoping.html
Edit: If you want to show the CSV, first of all you need to make a tabpanel and then make a table using the csv data like:
Use the package DT, install.packages("DT), is a package to make dynamic tables.
`output$yourtabpanelid = DT::renderDataTable({
req(input$file1)
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
return(df)
})`
Then don't make a functions.R, just put the function below the one and put the read.csv(.....) before the function to use it in all functions at server.R like:
`df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote
)
server <- function(input, output, session) {`
And you can quit the df <- read.csv.... of the function DT but keep the return(df)
I'm building a simple shiny app which will take inputs from the user and fetch data from a table in the DB and take the number of records to be downloaded as an input and provide a download file option.
Everything below works just fine. My only concern is the textInput bar( variable : uiOutput("text") in the ui and output$text in the server) appears only after the datatableOutput is displayed. I do not understand why this happens.
Ideally, I want the textInput bar ('uiOutput("text")') object to be displayed once the leaf(i.e. input$leaf1 is not null) is selected and then I want the datatableOutput to be displayed and then the Download Button should come up.
Is there a way I can achieve this? Thanks
library(shiny)
library(shinydashboard)
#library(stringr)
library(DT)
#library(shinyBS)
ui <- dashboardPage(
dashboardHeader(title = strong("DASHBOARD"),titleWidth = 240),
dashboardSidebar(
sidebarMenu(
selectizeInput("x", "Choose a number:", choices = sort(unique(lftable$x)), multiple = TRUE),
uiOutput("leaf_categ")
)
),
dashboardBody(
fluidRow(
uiOutput("text"),
dataTableOutput("lm_df"),
downloadButton('downloadData', 'Download')
)))
server <- function(input, output){
output$leaf_categ <- renderUI(
selectizeInput("leaf1", "Choose leaf categories:",
choices = reactive(unique(lftable[lftable$num %in% input$x, c("X_NAME")]))(),
multiple = TRUE)
)
#### creates a text input box
#### number of records to be downloaded is provided as input
output$text <- renderUI({
if(is.null(reactive(input$leaf1)())){
return()
}else{
textInput("var1", label = "Enter the number of records to be downloaded", value = "")
}
})
#### fetches data from DB
lm <- reactive({
if(is.null(input$leaf1)){
return()
}else{
leaf_id <- unique(lftable[lftable$X_NAME %in% input$leaf1, c("leaf_id")])
query_str <- paste('select * from table1 where current_date between start_dt and end_dt and score_num >= 0.1 and x in (' , input$x, ')', ' and X_ID in (', leaf_id, ')', ';', sep = "")
}
lm_data <- getDataFrmDW(query_str)
})
###creates a download tab
output$downloadData <- downloadHandler(
filename = function() { paste("lm_user_data", '.csv', sep='') },
content = function(file) {
lm_df <- lm()
lm_df <- lm_df[1:(as.integer(input$text)),]
print(dim(lm_df))
write.csv(lm_df, file, row.names = F)
})
output$lm_df <- DT::renderDataTable(lm())
}
shinyApp(ui, server)