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.
Related
I'm working on an app which takes up a CSV via reactiveFileReader and applies some functions. I would like to modify the contents of the data before applying these functions.
I understand that reactive objects cannot be modified directly, but I can't even seem to be able to make a new object with the desired modifications (in this case, new column names in the dataframe).
This is where I am at in the server code:
data <- reactiveFileReader(1000, session, "path", read.csv)
data_new <- reactive({ colnames(data) <- c("Col 1"," Col 2","Col 3") })
output$data <- renderDataTable(data_new())
Unfortunately this yields the error "Error: attempt to set 'colnames' on an object with less than two dimensions".
Any suggestions on how to properly modify and store the data?
Many thanks!
Try this
ui <- fluidPage(
uiOutput("data1"),
uiOutput("data")
)
server <- function(input, output, session) {
data <- reactiveFileReader(1000, session, "file2.csv", read.csv)
data_new <- reactive({
df <- data()
colnames(df) <- c("Col 1"," Col 2","Col 3")
df
})
output$data <- renderTable(data_new())
output$data1 <- renderTable(head(data()))
}
shinyApp(ui, server)
I am new to Shiny. I was trying to subset a data frame and the data frame, but encountered an error message:
"Can't access reactive value 'xx' outside of reactive consumer."
Could anybody tell me why?
The design idea is to (1) let the users to select the subgroup that they'd like to look into, which I tried to accomplish using the reactiveValues() command but failed, and then (2), an delayed action, which is within that subgroup, sort the data based on a key variable. Below are the codes, and I appreciate your help:
library(shiny)
library(tidyverse)
data(iris)
ui <- fluidPage(
navbarPage(
title = "Test",
tabsetPanel(
tabPanel(
"Tab 3, subset and then sort",
sidebarLayout(
sidebarPanel(
selectInput("xx", "species:", choices = unique(iris$Species), selected = "setosa"),
actionButton("click", "sort")
),
mainPanel(
tableOutput("table3")
)
)
)
)
)
)
server <- function(input, output) {
rv <- reactiveValues(
#### This line caused a problem whenever I added %>% dplyr::filter ####
df3 = iris %>% dplyr::filter(Species == !!input$xx)
)
observeEvent(input$click, {
rv$df3 <- rv$df3[order(rv$df3$Sepal.Length), ]
})
output$table3 <- renderTable({
rv$df3
})
}
# Run the application
app <- shinyApp(ui = ui, server = server)
runApp(app)
reactiveValues should be used like a list of values that are updated/evaluated within reactive/observe blocks. It's being used incorrectly here, I think you should be using reactive or eventReactive.
Double-bang !! is relevant for NSE (non-standard evaluation) within rlang (and much of the tidyverse), but that's not what you're doing here. In your case, input$xx is character, in which case you can simply compare to it directly, ala Species == input$xx.
Sometimes, depending on the startup of an app, the reactive is triggered before the input has a valid value, instead it'll be NULL. This causes an error and glitches in the shiny interface, and can be avoided by the use if req.
Unfortunately, you can't resort a reactive data block outside of it.
Here's one alternative:
server <- function(input, output) {
rv_unsorted <- reactive({
req(input$xx)
dplyr::filter(iris, Species == input$xx)
})
rv_sorted <- reactive({
req(input$click)
dplyr::arrange(isolate(rv_unsorted()), Sepal.Length)
})
output$table3 <- renderTable({
rv_sorted()
})
}
Another method, which is less efficient (more greedy, less lazy),
server <- function(input, output) {
rv <- reactiveVal(iris)
observeEvent(input$xx, {
rv( dplyr::filter(iris, Species == input$xx) )
})
observeEvent(input$click, {
rv( dplyr::arrange(rv(), Sepal.Length) )
})
output$table3 <- renderTable({
rv()
})
}
This may seem more straight-forward logically, but it will do more work than will technically be necessary. (observe blocks are greedy, firing as quickly as possible, even if their work is not used/noticed. reactive blocks are lazy in that they will never fire unless something uses/needs them.)
Edit: I corrected the previous behavior, which was:
Load iris, have all species present, store in rv().
Immediately filter, showing just setosa, store in rv().
Display in the table.
Change selector to a new species.
Filter the contents of rv() so that only the new species are in the frame. Unfortunately, since the contents of rv() were just setosa, this next filtering removed all rows.
The means that the current observe-sequence (as greedy and inefficient as it may be) must start with a fresh frame at some point, so I changed the input$xx observe block to always start from iris.
I am trying to access the data frame created in one render function into another render function.
There are two server outputs, lvi and Category, in lvi I have created Data1 data frame and Category I have created Data2 dataframe. I want to select Data2 where Data1 ID is matching.
I am following the below steps to achieve my objective but I get error "Object Data1 not found".
My UI is
ui <- fluidPage(
# App title ----
titlePanel("Phase1"),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file1", "Import file1")
)
),
fluidPage(
column(4,
# Input: Select a file ----
fileInput("file2", "Import File2")
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
dataTableOutput("lvi"),
dataTableOutput("category")
)
)
My server code is
server <- function(input, output) {
output$lvi <- renderDataTable({
req(input$file1)
Data1 <- as.data.frame(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$category <- renderDataTable({
req(input$file2)
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1$ID == "ID001",]
})
}
shinyApp(ui, server)
Once a reactive block is done executing, all elements within it go away, like a function. The only thing that survives is what is "returned" from that block, which is typically either the last expression in the block (or, when in a real function, something in return(...)). If you think of reactive (and observe) blocks as "functions", you may realize that the only thing that something outside of the function knows of what goes on inside the function is if the function explicitly returns it somehow.
With that in mind, the way you get to a frame inside one render/reactive block is to not calculate it inside that reactive block: instead, create that frame in its own data-reactive block and use it in both the render and the other render.
Try this (untested):
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
output$lvi <- renderDataTable({ req(Data1_rx()) })
output$category <- renderDataTable({
req(input$file2, file.exists(input$file2$datapath),
Data1_rx(), "ID" %in% names(Data1_rx()))
Data2 <- as.data.frame(read_excel(input$file2$datapath, sheet = "Sheet1"))
Data2 <- Data2[,c(2,8)]
Data2 <- Data2[Data1_rx()$ID == "ID001",]
})
}
shinyApp(ui, server)
But since we're already going down the road of "better design" and "best practices", let's break data2 out and the data2-filtered frame as well ... you may not be using it separately now, but it's often better to separate "loading/generate frames" from "rendering into something beautiful". That way, if you need to know something about the data you loaded, you don't have to (a) reload it elsewhere, inefficient; or (b) try to rip into the internals of the shiny DataTable object and get it manually. (Both are really bad ideas.)
So a slightly better solution might start with:
server <- function(input, output) {
Data1_rx <- eventReactive(input$file1, {
req(input$file1, file.exists(input$file1$datapath))
as.dataframe(read_excel(input$file1$datapath, sheet = "Sheet1"))
})
Data2_rx <- eventReactive(input$file2, {
req(input$file2, file.exists(input$file2$datapath))
dat <- as.dataframe(read_excel(input$file2$datapath, sheet = "Sheet1"))
dat[,c(2,8)]
})
Data12_rx <- reactive({
req(Data1_rx(), Data2_rx())
Data2_rx()[ Data1_rx()$ID == "ID001", ]
})
output$lvi <- renderDataTable({ req(Data1_rx()); })
output$category <- renderDataTable({ req(Data12_rx()); })
}
shinyApp(ui, server)
While this code is a little longer, it also groups "data loading/munging" together, and "render data into something beautiful" together. And if you need to look at early data or filtered data, it's all right there.
(Side note: one performance hit you might see from this is that you now have more copies of data floating around. As long you are not dealing with "large" data, this isn't a huge deal.)
So, I've been on google for hours with no answer.
I want to create a user-defined function inside the server side that takes inputs that I already know to wrap reactive({input$feature)} but the issue is how to incorporate reactive values as inputs too.
The reason why I want to do this is because I have a navbarPage with multiple tabs that shares elements such as same plots. So I want a user defined function that creates all the similar filtering and not have to create multiple of the same reactive expression with different input and reactive variable names which take up 2000+ lines of code.
server <- function(input, output) {
filtered_JointKSA <- reactiveVal(0)
create_filtered_data <- function(df, input_specialtya, filtered_JointKSA) {
if (input_specialtya == 'manual') {
data <- filter(data, SPECIALTY %in% input_specialtyb)
}
if (filtered_JointKSA != 0) {
data <- filter(data, SPECIALTY %in% filtered_JointKSA)
}
reactive({return(data)})
}
filtered_data <- create_filtered_data(df,
reactive({input$specialty1}),
filtered_JointKSA())
observeEvent(
eventExpr = input$clickJointKSA,
handlerExpr = {
A <- filtered_JointKSA(levels(fct_drop(filtered_data()$`Joint KSA Grouping`))[round(input$clickJointKSA$y)])
A
}
)
This gets me an error:
"Error in match(x, table, nomatch = 0L) :
'match' requires vector arguments"
The error is gone if I comment out where I try to create filtered_data but none of my plots are created because filtered_data() is not found.
What is the correct approach for this?
Ideally, I would like my observeEvents to be inside user defined functions as well if that has a different method.
This example may provide some help, but it's hard to tell without a working example. The change is to wrap the call to your function in reactive({}) rather than the inputs to that function, so that the inputs are all responsive to user input and the function will update.
library(shiny)
ui <- fluidPage(
numericInput("num", "Number", value = NULL),
verbatimTextOutput("out")
)
server <- function(input, output){
## User-defined function, taking a reactive input
rvals <- function(x){
req(input$num)
if(x > 5){x * 10} else {x*1}
}
# Call to the function, wrapped in a reactive
n <- reactive({ rvals(input$num) })
# Using output of the function, which is reactive and needs to be resolved with '()'
output$out <- renderText({ n() })
}
shinyApp(ui, server)
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).