I'm having trouble with my shiny app. I want that the user can type in all the variables needed for the substr function to filter data from a data frame using dplyr.
I made an example using the dataframe iris.
In the textInput(select1) I like to type in "Species".
In the numericInput(start1) I like to type in "4".
In the numericInput(end1) I like to type in "6".
In the textInput(match1) I like to type in "osa".
Now I want that the tableOutput only shows the rows which matches the criteria "osa" in the column "Species" from digit 4 to 6.
The numericInput(start1), the numericInput(end1) and the textInput(match1) are working. But the textInput(select1) doesn't work. When I'm using the input as variable I'm getting an empty data frame.
When I change the code an type in "Species" instead of reactivevar1() in the substr function I get the data frame I want.
Example:
filter(substr(Species, reactivevar2(), reactivevar3()) == reactivevar4())
This alternative works. But this is not what I want.
I want this to work:
filter(substr(reactivevar1(), reactivevar2(), reactivevar3()) == reactivevar4())
I tried different functions like substring and stringr::str_sub. I also tried as.character.
This is the full example:
library(shiny)
library(dplyr)
ui = fluidPage(
textInput(inputId="select1", label="Type in variable", value = "", width = NULL, placeholder = NULL),
numericInput(inputId="start1", label="Start digit", value=NULL, min = NA, max = NA, step = NA,
width = NULL),
numericInput(inputId="end1", label="End digit", value=NULL, min = NA, max = NA, step = NA,
width = NULL),
textInput(inputId="match1", label="Criteria to match", value = "", width = NULL, placeholder = NULL),
actionButton(inputId="startfil", label="Start filter", icon = NULL, width = NULL),
tableOutput('table')
)
server = function(input, output,session) {
obs <- observeEvent(input$startfil, {
var1 <- NA
reactivevar1 <- reactive({
var1 <- input$select1
return(var1)})
var2 <- NA
reactivevar2 <- reactive({
var2 <- input$start1
return(var2)})
var3 <- NA
reactivevar3 <- reactive({
var3 <- input$end1
return(var3)})
var4 <- NA
reactivevar4 <- reactive({
var4 <- input$match1
return(var4)})
irisfiltered <- iris %>%
filter(substr(reactivevar1(), reactivevar2(), reactivevar3()) == reactivevar4()) #reactivevar1() doesn't work
output$table <- renderTable(irisfiltered)
})
}
shinyApp(ui = ui, server = server)
I just can't figure out what is wrong with my code. It is important that the user can type in a start and an end digit to filter the substring.
Welcome to SO!
reactivevar1() has the value "Species", so your substr function returns "cie". And
substr(reactivevar1(), reactivevar2(), reactivevar3()) == reactivevar4()
returns FALSE, when you type i.e. "osa" in reactivevar4()
You could use getin your pipe statement like this:
irisfiltered <- iris %>%
filter(substr(get(reactivevar1()), reactivevar2(), reactivevar3()) == reactivevar4())
output$table <- renderTable(irisfiltered)
Or make use of !! and as.name
iris %>%
filter(substr(!!as.name(reactivevar1()), reactivevar2(), reactivevar3()) == reactivevar4())
output$table <- renderTable(irisfiltered)
Hope this helps
Related
I have a dataset with variables for the ID of patients, different tests (MMT), and the treatment.
ID
MMT_II_week15_change
MMT_II_Week20_change
MMT_Tot_week15_change
MMT_Tot_Week20_change
Treatment
As you can see, we have two different tests (MMT_II_change and MMT_Tot_change), for two different timepoints (week15, week20).
What I want is the user to be able to select, first, the test, and then, the timepoint.
In reality, he would be picking just one of the variables, but in two different steps.
Something like:
**Select test:**
MMT_II
MMT_III
**Select timepoint:**
Week15
Week20
And after this, the variable selected would be:
e.g: MMT_II_Week20_change
I though of using regex for this, but it seems quite complicated and coulnd't find of a way of doing it.
Any help really appreciated, as I've been stuck with this for a while.
Would something like this work?
VAR = paste0(test,"_",timepoint,"_change")
...
# then later to use the variable...
.data[[VAR]]
You can wrap the checking of changess occured in a single reactive function in the server section of your code.
uptodateChoice <- reactive({
paste0(input$firstcontrol, "_", input$secondcontrol, "_change")
})
This function will be called once any of the two controls state change.
You can also add any validate(need(...)) checks inside the function if required or simply return() if some conditions are not satisfied.
You can access the string value calling uptodateChoice().
I'm thinking about pivoting the data to longer format, filter it and then pivot again to wider. This way we can filter using filter function directly.
library(tidyverse)
library(shiny)
# create some data
df <- tibble(
ID = 1:5, MMT_II_week15_change = sample(seq(0.01, 0.2, 0.01), 5), MMT_II_week20_change = sample(seq(0.01, 0.2, 0.01), 5),
MMT_Tot_week15_change = sample(seq(0.01, 0.2, 0.01), 5), MMT_Tot_week20_change = sample(seq(0.01, 0.2, 0.01), 5)
)
# pivot wider capturing MMT_* for the first column and the number of week in the second.
df_pivot <- pivot_longer(df, -ID, names_to = c("test", "week"), values_to = "change", names_pattern = "(MMT_.*)_week(\\d+)_change$")
## APP
library(shiny)
ui <- fluidPage(
selectInput("test", "Select Test", choices = unique(df_pivot$test)),
selectInput("timepoint", "Select Timepoint", choices = NULL),
tableOutput("table")
)
server <- function(input, output, session) {
table <- reactiveVal(NULL)
observeEvent(input$test, {
choices <- filter(.data = df_pivot, test == input$test) %>%
{
unique(.$week)
}
updateSelectInput(inputId = "timepoint", choices = choices)
})
# this could also be a reactive.
observe({
table(filter(df_pivot, test == input$test, week == input$timepoint) %>%
pivot_wider(names_from = "test", values_from = "change"))
})
output$table <- renderTable({
table()
})
}
shinyApp(ui, server)
I have this data set:
Area <- c("Mexico", "USA", "USA", "Canada").
Type_of_participants <- c("Doctor", "Doctor", "Engineer", "Dancer".
Salary <- c("4000", "6000", "8000", "5000").
and I am trying to plot the salary base on the user input of Area(level1) and Type_of_participants(level2), but nothing appears. I modified aes to aes_string as I looked up here. Please help me find the error
My Code
`ui <- fluidPage(
titlePanel("Survey Results"),
sidebarLayout(
sidebarPanel(strong("Overview Plot"),
br(),
###1a.Area input
selectInput("selection","Var",
choices = c("Area","Type_of_participants"),
selected = "Area"),
uiOutput("choice_selection")
),
mainPanel(
plotOutput("Overview"))
`server <- function(input, output) {
output$choice_selection <- renderUI({
checkboxGroupInput("baseinput","Detail",
unique(df[,input$selection])
)`
})
dt1 <- reactive({
df %>%
group_by(input$selection,Type) %>%
filter (input$selection %in% input$baseinput) %>%
summarise(avg_salary_by_area = mean(Salary, na.rm = TRUE)) %>%
select(input$selection, Type, avg_Salary_by_area)
})
output$Overview <- renderPlot({
ggplot(data= dt1())+
aes(fill = Type)+
geom_bar(x=input$selection, y = avg_salary_by_area,stat="identity",
position = position_dodge())
The result is I can select the input but can not visualize the plot. The error "unknown column Area or unknow Type of participants
Please help me find the mistake
Thank you
*** Update
Thanks to Mr Flick, I have fixed my code but it still informs error "Object area not found". Please help to advise. Thank you so much
`dt1 <- reactive({
df[df[,input$selection] %in% input$baseinput,] %>%
group_by(input$selection,Type) %>%
summarise(avg_score_by_area = mean(Score, na.rm = TRUE))
})
output$Overview <- renderPlot({
ggplot(data= dt1(),aes_string(x= input$selection,
y = "avg_score_by_area",fill = "Type"))+
geom_bar(stat="identity",
position = position_dodge())`
#Suzie - as mentioned above, it would help if you edited your question with your complete code as you currently have it.
A few things that would help:
Salary should be numeric in your df (or be converted with as.numeric before trying to take the mean
Your reactive expression can use !!as.symbol with input$selection to filter by the string name from df
The plot can use aes_string for the variable names.
Edit:
For further explanation of !!as.symbol, first consider what the result of input$selection. If you use browser() in your shiny code, and inspect what input$selection returns, you will see something like "Area" (it returns a string). But a string would not be appropriate in your filter - it is expecting a symbol that represents a column in your data frame. (A symbol is the name of an object like df or mtcars, etc.)
First, you want to convert a string to a symbol. You can do that either by using as.symbol() or rlang::sym(). You can try this out in your console. If you do as.symbol("df") it would return the symbol df. If you entered eval(as.symbol("df")) it would be the same as just entering df itself (and it would show the contents of your data frame).
The other issue is that tidyverse functions evaluate code expressions in a special context (searching for names within a data frame, for example). In this case dplyr knows that the name Area is in the context of df (one of the column names). This is a complicating factor since arguments are quoted. To address this, you need to unquote (replace a name with its value) with the bang-bang !! operator.
Putting both together you get !!as.symbol().
Of note, varSelectInput is a newer shiny alternative to selectInput that can be considered for use in situations like these.
For more information:
shinymeta special topics
advanced R
library(tidyverse)
library(shiny)
Area <- c("Mexico", "USA", "USA", "Canada")
Type_of_participants <- c("Doctor", "Doctor", "Engineer", "Dancer")
Salary <- c(4000, 6000, 8000, 5000)
df <- data.frame(Area, Type_of_participants, Salary)
ui <- fluidPage(
titlePanel("Survey Results"),
sidebarLayout(
sidebarPanel(strong("Overview Plot"),
br(),
###1a.Area input
selectInput("selection","Var",
choices = c("Area","Type_of_participants"),
selected = "Area"),
uiOutput("choice_selection")
),
mainPanel(
plotOutput("Overview")
)
)
)
server <- function(input, output) {
output$choice_selection <- renderUI({
checkboxGroupInput("baseinput", "Detail", unique(df[,input$selection]))
})
dt1 <- reactive({
df %>%
group_by(Area, Type_of_participants) %>%
filter(!!as.symbol(input$selection) %in% input$baseinput) %>%
summarise(avg_salary_by_area = mean(Salary, na.rm = TRUE))
})
output$Overview <- renderPlot({
ggplot(data = dt1(), aes_string(x = input$selection, y = "avg_salary_by_area", fill = "Type_of_participants")) +
geom_bar(stat="identity", position = position_dodge())
})
}
shinyApp(ui, server)
My problem is that I have a given data frame and I have to search for different patterns. When the pattern matches the given character vector the content of the same row, but of a different column should update a textInput.
I created a little shiny app as an example, because my original code is too big. The example works, but I'm using for loops and I don't want to do this. Do anyone know a better solution? Is there a solution with a vectorised function? I really would appreciate if someone knows a dplyr solution.
Example:
library(shiny)
ui <- fluidPage(
textInput(inputId="wave1", label="wavelength"),
textInput(inputId="wave2", label="wavelength")
)
server <- name <- function(input,output,session) {
df <- data.frame("color" = c("red","blue","green"), "wavelength" = c("700 nm","460 nm","520 nm"))
for (i in 1:nrow(df)) {
if(grepl("lue",df$color[i],fixed=TRUE) == TRUE){updateTextInput(session, inputId="wave1", label = NULL, value = df$wavelength[i],placeholder = NULL)}
}
for (i in 1:nrow(df)) {
if(grepl("ee",df$color[i],fixed=TRUE) == TRUE){updateTextInput(session, inputId="wave2", label = NULL, value = df$wavelength[i],placeholder = NULL)}
}
}
shinyApp(ui = ui, server = server)
Any help would be appreciated.
Instead of looping, you can index the dataframe directly from the result of grep:
server <- name <- function(input,output,session) {
df <- data.frame("color" = c("red","blue","green"), "wavelength" = c("700 nm","460 nm","520 nm"))
updateTextInput(session, inputId="wave1", label = NULL,
value = df$wavelength[grep("lue", df$color, fixed=TRUE)],
placeholder = NULL)
updateTextInput(session, inputId="wave2", label = NULL,
value = df$wavelength[grep("ee", df$color, fixed=TRUE)],
placeholder = NULL)
}
And one way to do this using dplyr is:
server <- name <- function(input,output,session) {
df <- data.frame("color" = c("red","blue","green"), "wavelength" = c("700 nm","460 nm","520 nm"))
updateTextInput(session, inputId="wave1", label = NULL,
value = dplyr::filter(df, grepl("lue", color, fixed=TRUE)) %>% dplyr::pull(wavelength),
placeholder = NULL)
updateTextInput(session, inputId="wave2", label = NULL,
value = dplyr::filter(df, grepl("ee", color, fixed=TRUE)) %>% dplyr::pull(wavelength),
placeholder = NULL)
}
Here is my code - creating a dashboard that will filter by date. One tab will show our wellness survey data, the other will show post-practice loading data. I am pulling in the first 3 columns from "post.csv" which are Date, Name, Daily. Then I am looking to create and add the next 3 columns with the math.
Where I am first stuck is that I need my Daily_Load to aggregate data for a specific athlete on the given Date. Then I need to create a rolling 7-day sum for each athlete using the Daily load data from the last 7 days (including Date selected). A 28-Day Rolling Sum/4 and 7-Day/28-Rolling is the last piece.
Thanks again for all of the help!
library(shiny)
library(dplyr)
library(lubridate)
library(ggplot2)
library(DT)
library(zoo)
library(tidyr)
library(tidyverse)
library(data.table)
library(RcppRoll)
AM_Wellness <- read.csv("amwell.csv", stringsAsFactors = FALSE)
Post_Practice <- read.csv("post.csv", stringsAsFactors = FALSE)
Post_Data <- Post_Practice[, 1:3]
Daily_Load <- aggregate(Daily~ ., Post_Data, sum)
Acute_Load <- rollsum(Post_Data$Daily, 7, fill = NA, align = "right")
Chronic_Load <- rollsum(Post_Data$Daily, 28, fill = NA, align = "right")/4
Post_Data['Day Load'] <- aggregate(Daily~ ., Post_Data, sum)
Post_Data['7-Day Sum'] <- Acute_Load
Post_Data['28-Day Rolling'] <- Chronic_Load
Post_Data['Ratio'] <- Acute_Load/Chronic_Load
ui <- fluidPage(
titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(
dateInput('date',
label = "Date",
value = Sys.Date()
),
selectInput("athleteInput", "Athlete",
choices = c("All"))
),
mainPanel(tabsetPanel(type = "tabs",
tabPanel("AM Wellness", tableOutput("amwell")),
tabPanel("Post Practice", tableOutput("post"))
)
)
)
)
server <- function(input, output) {
output$amwell <- renderTable({
datefilter <- subset(AM_Wellness, AM_Wellness$Date == input$date)
}, hover = TRUE, bordered = TRUE, spacing = "xs", align = "c")
output$post <- renderTable({
datefilter <- subset(Post_Data, Post_Data$Date == input$date)
}, hover = TRUE, bordered = TRUE, spacing = "xs", align = "c")
}
shinyApp(ui = ui, server = server)
asked this on the shiny google group, w no help yet: I'm struggling with how to pass an input switch to dplyr's group_by_ in the code below.
I bolded the two parts of relevant code in the not-so-MRE below (ie, lines 9:11, and 24).
effectively, if the user selects "daily" in the UI, the resultant grouping should be group_by(year = year(my_date), month = month(my_date), day = day(my_date) in line 24, or remove ANY grouping as the data is already daily.
selecting "monthly", should yield group_by(year = year(my_date), month = month(my_date))
"yearly", should yield group_by(year = year(my_date))
I welcome meta-suggestions/ criticism about how my code/ structures are organized.
Thank you
library(shiny)
library(dplyr)
library(lubridate)
ui <- fluidPage(
dateInput("start", label = "start date", value = "2010-01-01"),
dateInput("end", label = "end date", value = "2020-01-01"),
selectInput("grouping_freq", label = "Granularity",
choices = list("daily" = 1,"monthly" = 2, "Yearly" = 3),
selected = 2),
tableOutput("my_table")
)
server <- function(input, output) {
df <- reactive({ data_frame(my_date = seq(input$start, input$end, by = 'day')) }) ## 10 years of daily data
df2 <- reactive({ df() %>% mutate(dummy_data = cumsum(rnorm( nrow( df() ) ))) })
output$my_table <- renderTable({
df2() %>% group_by(year = year(my_date), month = month(my_date)) %>%
summarise(dummy_data = sum(dummy_data), my_date = as.Date(min(my_date)))
})
}
shinyApp(ui = ui, server = server)
You can use the value chosen in selectInput to create a list of formulas that are passed into group_by_, the version of dplyr::group_by that uses standard evaluation.
group_list <- switch(input$grouping_freq,
list(yr=~year(my_date), mn=~month(my_date), dy=~day(my_date)),
list(yr=~year(my_date), mn=~month(my_date))
list(yr=~year(my_date)))
or if you prefer if statements,
group_list <- if (input$grouping_freq == 1) {
list(yr=~year(my_date), mn=~month(my_date), dy=~day(my_date))
} else if (input$grouping_freq == 2) {
list(yr=~year(my_date), mn=~month(my_date))
} else if (input$grouping_freq == 3) {
list(yr=~year(my_date))
} else {
list()
}
and then you can pass group_list into the renderTable expression
output$my_table <- renderTable({
df2() %>%
group_by_(.dots=group_list) %>%
summarise(dummy_data = sum(dummy_data), my_date = as.Date(min(my_date)))
})
I am not sure what you meant by "remove ANY grouping as the data is already daily." but if the data might already be grouped you can use the ungroup function to remove any groups before applying the groupings in group_list.
Edit: Forgot to include ~ in the list elements so that they evaluate correctly.