How to reactively define first column with dplyr in Shiny - r

Let's say I want to have a user-uploaded dataset similar to the CO2 one provided in R in my Shiny app. I'm looking for people to load any dataset of this type and then generate a new value from existing ones using dplyr's mutate. I've coded reactive values that check to see if "conc" and "uptake" are present in the data, and if so to use them to generate the new value.
I then want a new table rendered that shows the first column (that identifies the sample) and this new value. However, since the datasets will change depending on user input, I can't specify the column (for the CO2 dataset, it would be "Plants").
Here's my toy example:
library(shiny)
library(dplyr)
ui <- pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
fileInput('file1', 'Choose CSV File',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
tags$hr(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',c(Comma=',',Semicolon=';',Tab='\t'),',')
),
mainPanel(
tableOutput("inputfile"),
tableOutput("do")
)
)
server <- function(input, output, session) {
upData <- reactive({
if(is.null(input$file1)) return(CO2)
inFile <- input$file1
dat <- read.csv(inFile$datapath)
return(dat)
})
output$inputfile <- renderTable({
head(upData())
})
concvar <- reactive({
if("conc" %in% colnames(upData())==TRUE) {upData()$conc}
else{0}
})
uptakevar <- reactive({
if("uptake" %in% colnames(upData())==TRUE) {upData()$uptake}
else{0}
})
newvalue <- reactive({
upData() %>%
mutate(newvalue=concvar()/uptakevar()) %>%
select(newvalue)
})
output$do <- ({
renderTable(head(newvalue()))
})
}
shinyApp(ui = ui, server = server)
This does almost everything I want, but I can't figure out how to get this new column of values to also have a column that identifies the respective sample.
I've tried defining upData()[,1] and using select_ in the "newvalue" dplyr chain but I keep getting errors. How can I reactively define the first column of various hypothetical datasets in a select call so my new values are contextualized with sample names?

The issue is that your concvar and uptakevar functions are returning the full vector of the values, but you are trying to treat them as column names. Either, use the vectors directly like this:
newvalue <- reactive({
data.frame(
newvalue = concvar() / uptakevar()
)
})
Or, return the column names, then use mutate_ to construct the column of interest, like this. Note that I used select_ as well to allow you to select the first column in addition to the newvalue. It would probably be even better to define this as a character as well (like your conc and uptake variables) to allow the user to pick a reasonable ID column to include (instead of assuming the first column is an ID).
concvar <- reactive({
if("conc" %in% colnames(upData())==TRUE) {"conc"}
else{0}
})
uptakevar <- reactive({
if("uptake" %in% colnames(upData())==TRUE) {"uptake"}
else{0}
})
newvalue <- reactive({
upData() %>%
mutate_(newvalue = paste(concvar(), "/", uptakevar())) %>%
select_(names(upData())[1], "newvalue")
})
I would recommend the latter, as I assume you are planning on using a select box of some sort to let the user pick the column names to use (which will return a character vector with the column name).

Related

Shiny App: How to collect all text inputs into a data frame without listing them individually (how to index reactive values?)

I have a tab of my app where I display a bunch of text inputs based on a three-column data frame that contains: variable_name, text_prompt, and example_data. The code below seems to work fine since it displays how I want it to. Eventually, I will be feeding it different data frames, depending on the circumstances, so I need to be able to do everything programmatically.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
#THIS IS THE PART I DON'T KNOW HOW TO DO
#input.data <- ???
#I'll add dummy data so that the program loads
input.data <- tibble(var.names,
temp = 1:length(var.names))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)
But what I want - and really have no idea how to do - is to get it back into a data frame after the user hits "submit" (I only need two columns in the subsequent data frame; I don't need the text_prompt data again.)
I know that the user input creates a list of read-only ReactiveValues called "input". But I can't figure out how to do anything with this list besides access using known names (i.e. I know that there is a variable named "project_id" which I can access using input$project_id). But what I want is not to have to write them all out, so that I can change the data used to create the input fields. So I need a way to collect them in a data frame without knowing all the individual names of the variables or even how many there are.
I figured this out on my own. You can't index reactive values with []. However, for some reason you can using [[]].
I would love to know why this is, if anyone has an answer that can help me understand why it works this way.
Here's the key bit of code that I was missing before:
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
The full code that works as I want it is pasted below. I'd still appreciate any feedback or recommendations for improvement.
library(shiny)
library(tidyverse)
library(DT)
additional.data.fields <- tibble (var.name = c("project.id", "director.name"),
prompt.text = c("Enter Project ID", "Enter Director's name"),
var.value = c("e.g. 09-111", "e.g. Paul Smith"))
ui <- fluidPage(
tabsetPanel(
#Generate Input fields from dataframe
tabPanel("Input", #value = "input.2",
# Generate input fields with pmap
actionButton("submit", "Submit"),
pmap(additional.data.fields, ~textInput(..1, ..2, value = ..3)),
),
#Output data to tell if it updates with button click
tabPanel("Output", value = "output",
DT::dataTableOutput("data")
)
)
)
server <- function(input, output, session) {
# Create a reactive values object to store the input data
values <- reactiveValues()
# Set the reactive values object when the submit button is clicked
observeEvent(input$submit, {
var.names <- pull(additional.data.fields, var.name)
input.data <- tibble (names = var.names,
values = map_chr(var.names, ~input[[.x]]))
values$data <- input.data
})
# Render the input data table
output$data <- DT::renderDataTable({
values$data
})
}
shinyApp(ui, server)

reactiveValues issue

I'm trying to merge two uploaded data frames, output it as a table, then being able to download it and reset the inputs, but only get the error: "Error 'by' must match numbers of columns".
I have trouble understanding reactiveValues I guess, since I can't simply call them as data frames in the app...
library(shiny)
library(shinyjs)
library(readxl)
library(DT)
ui <- fluidPage(
useShinyjs(),
fileInput('inFile1', 'Choose file'),
fileInput('inFile2', 'Choose file'),
actionButton('reset', 'Reset'),
tableOutput('overlap')
)
server <- function(input, output, session) {
rv <- reactiveValues()
observe({
req(input$inFile1)
rv$data1 <- readxl::read_xls(input$inFile1$datapath)
})
observe({
req(input$inFile2)
rv$data2 <- readxl::read_xls(input$inFile2$datapath)
})
observeEvent(input$reset, {
rv$data1 <- NULL
rv$data2 <- NULL
reset('inFile1')
reset('inFile2')
})
dataframe<-reactive({
if (!is.null(rv$data1) | !is.null(rv$data2))
return(NULL)
df <- merge(as.data.frame(rv$data1),as.data.frame(rv$data2),by.x = 1,by.y = 1)
colnames(df) <- c("GeneID",paste0(colnames(rv$data1)[2:ncol(rv$data1)],"_file_1"),
paste0(colnames(rv$data2)[2:ncol(rv$data2)],"_file_2"))
df
})
overlap1 <- reactive({
if(!is.null(dataframe()))
dataframe()
})
output$overlap <- renderDataTable({
datatable(overlap1())
})
}
shinyApp(ui, server)
At a first glance your reactive expressions look fine to me. And given that error message the error is caused by merge(). Taking a closer look there, what strikes me are those is.null checks at the top of the dataframe<-reactive(. The condition (!is.null(rv$data1) | !is.null(rv$data2)) means that you are trying to merge two objects that are NULL because only then the code wont't stop with return(NULL). If one or both rv-values are "Truthy" the code won't run and all the reactive is going to return is NULL.
I used isTruthy() below. I think it helps in two ways:
isTruthy() checks if the values contain anything "usable". That way, you do not have to care about how rv is initialised. It could be NA or integer(0) or anything else that is meaningless. isTruthy handles all these cases. Merging now only takes place when there are two values with "meaningful" data (note that this does not necessarily mean that the data can be coerced to data.frame).
It avoids a complicated double negative in the if-statement.
dataframe <- reactive({
if (isTruthy(rv$data1) && isTruthy(rv$data2)) {
df <- merge(rv$data1, rv$data2, by.x = 1,by.y = 1)
colnames(df) <- c("GeneID", paste0(colnames(rv$data1)[2:ncol(rv$data1)], "_file_1"),
paste0(colnames(rv$data2)[2:ncol(rv$data2)], "_file_2"))
} else df <- NULL
df
})
Final tweak: I removed as.data.frame in the merge statement because the first thing merge is trying to do is coerce the arguments to a data frame.

How to use the result of using reactive function as input in ui? - r shiny

I used a reactive function on the server to create a data frame.
And I want to express the unique vector of one column of this data frame as selectinput in the UI.
ex)
DATA<-data.frame(ID, NAME)
####server#####
DATAFRAME<-reactive({DATA[DATA$ID %in% input$ID,})
####UI######
selectizeInput("name",label="name:",choices=unique(DATAFRAME$NAME))
In other words, I want to show a list of Names for data that has been refined once by ID in advance.
In order to react to changes in the reactive expression DATAFRAME you can use an observer and update the list of names with updateSelectizeInput (as pointed out by #MrFlick).
library(shiny)
ui <- fluidPage(
titlePanel("Widget Dependencies Sample App"),
selectizeInput("IdSelect", "Choose ID", "N/A"), # IDs to select from
selectizeInput("IdName", "Choose Name", "N/A"), # Names depend on selected ID
tableOutput("IdDatatable") # show the whole data set to understand what happens
)
server <- function(input, output, session) {
ID <- paste("ID", 1:3, sep = "_")
NAME <- LETTERS[1:(3*5)]
DATA <- data.frame(ID, NAME)
updateSelectizeInput(session, "IdSelect", choices = unique(ID))
DATAFRAME <- reactive({DATA[DATA$ID %in% input$IdSelect, ]})
observe({
updateSelectizeInput(session, "IdName", choices = unique(DATAFRAME()$NAME))
})
output$IdDatatable <- renderTable(DATA)
}
shinyApp(ui = ui, server = server)
However, if you need the reactive expression DATAFRAME only once, you can make the code even simpler. In that case, you wouldn't observe a DATAFRAME that reacts to changes in a widget. You can omit the DATAFRAMEand observe the input widget directly. This observer generates a filtered vector of Names and changes the choices in the selectizeInput with only one observer.
observe({
Names <- DATA$NAME[DATA$ID %in% input$IdSelect]
updateSelectizeInput(session, "IdName", choices = unique(Names))
})

Subset a Column of a dataframe stored as a reactive expression eventReactive

Forgive the non-reproducible example. A theoretical solution will do just fine. I want to know how to subset a dataframe stored in a reactive expression for one particular column, to be be assigned a unique output_id, and ultimately displayed in the UI. This is analogous to accessing a column of a dataframe like so: df$column_name
I store a dataframe as a reactive expression called data(), using eventReactive() which is linked with an actionButton() in the UI.
Code in Environment:
# dataframe with n columns and k rows
df
UI:
actionButton(inputId = "go", label = "Update")
SERVER:
# create a reactive expression 'data()', a subsetted data.frame based on other reactive values
data() <- eventReactive( input$go, { df %>% filter(based on other reactive values) } )
output$output_id <- renderSomething( { code depends on data()$specific column })
May be the following example answers what you are after. The UI has a multi select list, the entries of the lists can be used to subset the Species column of iris data set.
# Using multi select list to sum columns
library(shiny)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Subset and sum a column of iris"),
fluidRow(
selectInput('Species', 'Species', levels(iris$Species), multiple = TRUE, selectize = FALSE)
),
fluidRow(verbatimTextOutput('selection')),
fluidRow(tableOutput('dataColumn')),
fluidRow(
tags$h2("sum:"),
verbatimTextOutput('sum')
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$selection <- reactive(input$Species)
subiris = reactive({
subset(iris, Species %in% input$Species)
})
output$dataColumn <- renderTable(subiris()$Sepal.Length)
output$sum <- renderPrint(sum(subiris()$Sepal.Length))
}
# Run the application
shinyApp(ui = ui, server = server)

Filter data use textinput in shiny got error: argument is not a character vector

Got Error in enc2utf8: argument is not a character vector.
I am using selectInput, checkboxGroupInput, textInput to filter data in the server, and get the above error; I have tried filter(),subset(),which() but they turn to have the same problem when filter the data by over four columns and the arguments are character vectors(eg. corp %in% c('Honda','Nissan'))
In the dataset, there are Market , Corp, Med_type, Med_id, measure, date, value columns.
And in the codes, brands, name_tmp, year are the character vectors used to filter data.
library(shiny)
library(dplyr)
library(DT)
ui<-fluidPage(pageWithSidebar(
headerPanel('Table'),
sidebarPanel(
fileInput('file1', 'Upload Data',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
selectInput('TA',"Market-type",c('Asia','Europe')),
selectInput('Length',"Length",c('1 year'='0','2 years'='1','3 years'='2','4 years'='3','5 years'='4')),
selectInput('NoBrand',"Top Brand/Cor",c('one'='1','two'='2','three'='3','four'='4','five'='5')),
selectInput('Period',"Period",c('Quarter'='Quarter','YR'='year')),
checkboxGroupInput('Measure','Measurement',c('Unit','RMB','Dollar')),
selectInput('Med_type','Med_type',c('Imported','Joint Venture','Local')),
textInput('Med_id','Med_id',value='Honda;Nissan')),
mainPanel(
dataTableOutput('table')
)))
server<-function(input,output){
options(shiny.maxRequestSize=100*1024^2)
## importing dataset
tmp <- reactive({inFile <- input$file1
if (is.null(inFile))
return(NULL)
data<-read_csv(inFile$datapath,na=c("", "NA",'-'))
})
tmp2<-reactive({
## modify the inputs
data_df <- tbl_df(tmp())
year<-(2017-as.numeric(input$Length)):2017
name_tmp<-as.vector(unlist(strsplit(input$Med_id,';')))
temp_data<-summarize(group_by(data_df,Corp),VValue=sum(value,na.rm = TRUE))
brands<-as.vector(arrange(temp_data,desc(VValue))$Corp[1:as.numeric(input$NoBrand)])
## filtering by the input
mod_data<-data_df %>%
select(Market,Corp,Med_type,Med_id,measure,date,value) %>%
filter(Market==input$TA,
Corp%in%brands,
Med_id%in%name_tmp,
Med_type==input$Med_type,
measure==input$Measure,
substr(date,1,4)%in%year
)
## Aggregation() & reformating
if(input$Period=="year"){
mod_data$date<-substr(mod_data$date,1,4)
mod_data<-group_by_if(mod_data,is.character)
mod_data<-summarise(mod_data,Value=sum(value,na.rm = TRUE))
} else {mod_data<-summarise(group_by_if(mod_data,is.character),Value=sum(value,na.rm=TRUE))}
})
## printing table
output$table<-DT::renderDataTable({tmp2()})
}
shinyApp(ui=ui,server = server)
The problem has been solved. The error actually comes from spread() function. When there is a empty data frame, spread() will call Error in enc2utf8: argument is not a character vector. So I add some conditional arguments to prevent the data frame from being empty once I run the shinyapp. Besides, isolate() is also a useful function for user to take in control of the execution of inputs.
Try print(input$measure) before you subset all the data, it is initialized as NULL. You should add:
if(is.null(input$measure))
measure = unique(data_df$measure)
else
measure = input$Measure
and modify
measure==input$Measure,
to
measure==measure
So when the use has made no selection, there will be effectively no filter on that column.
Working example
The following works fine for me. Note that I have created my own dataset 'df' and modified your tmp() reactive so it uses my df as input dataset in this example.
df = data.frame(Market=c("Asia","Asia","Europe","Europe"),
Corp=c("a","b","c","d"),
Med_type = c('Imported','Joint Venture','Local','Local'),
Med_id = c("Honda","Honda","Nissan","Nissan"),
measure=c('Unit','RMB','Dollar','Dollar'),
date = c('2017','2016','2017','2016'),
value=c(1,2,3,4 ))
library(shiny)
library(dplyr)
library(DT)
ui<-fluidPage(pageWithSidebar(
headerPanel('Table'),
sidebarPanel(
fileInput('file1', 'Upload Data',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
selectInput('TA',"Market-type",c('Asia','Europe')),
selectInput('Length',"Length",c('1 year'='0','2 years'='1','3 years'='2','4 years'='3','5 years'='4')),
selectInput('NoBrand',"Top Brand/Cor",c('one'='1','two'='2','three'='3','four'='4','five'='5')),
selectInput('Period',"Period",c('Quarter'='Quarter','YR'='year')),
checkboxGroupInput('Measure','Measurement',c('Unit','RMB','Dollar')),
selectInput('Med_type','Med_type',c('Imported','Joint Venture','Local')),
textInput('Med_id','Med_id',value='Honda;Nissan')),
mainPanel(
dataTableOutput('table')
)))
server<-function(input,output){
options(shiny.maxRequestSize=100*1024^2)
## importing dataset
tmp <- reactive({
df
})
tmp2<-reactive({
## modify the inputs
data_df <- tbl_df(tmp())
year<-(2017-as.numeric(input$Length)):2017
name_tmp<-as.vector(unlist(strsplit(input$Med_id,';')))
temp_data<<-summarize(group_by(data_df,Corp),VValue=sum(value,na.rm = TRUE))
brands<-as.vector(arrange(temp_data,desc(VValue))$Corp[1:as.numeric(input$NoBrand)])
if(is.null(input$measure))
measure = unique(data_df$measure)
else
measure = input$Measure
## filtering by the input
mod_data<-data_df %>%
select(Market,Corp,Med_type,Med_id,measure,date,value) %>%
filter(Market==input$TA,
Corp%in%brands,
Med_id%in%name_tmp,
Med_type==input$Med_type,
measure==measure,
substr(date,1,4) %in% year
)
print(mod_data)
## Aggregation() & reformating
if(input$Period=="year"){
mod_data$date<-substr(mod_data$date,1,4)
mod_data<-group_by_if(mod_data,is.character)
mod_data<-summarise(mod_data,Value=sum(value,na.rm = TRUE))
} else {mod_data<-summarise(group_by_if(mod_data,is.character),Value=sum(value,na.rm=TRUE))}
})
## printing table
output$table<-DT::renderDataTable({tmp2()})
}
shinyApp(ui=ui,server = server)

Resources