I am trying to make a Shiny app that will plot gene of interest for a chosen patient. Each row is the gene name, and each column is a patient ID. For example:
99901 99902 99903 99904
SKI 4.789 5.789 6.324 1.2222
VWA1 6.901 7.002 5.89 4.567
TTLL10 6.783 7.345 8.987 6.345
library(shiny)
library(shinythemes)
library(lattice)
anno <- as.matrix(anno_genExp_gen3[1:3, 1:3])
#Define UI
ui <- fluidPage(
sidebarPanel(
titlePanel(title = "Gen3 Gene Expression Data"),
selectInput(inputId = "patients",
label = strong("Please choose patient/s to examine"),
choices = colnames(anno_genExp_off[,1:25]),
multiple = TRUE),
selectInput(inputId = "geneExp",
label = "Please select gene expressions/s to examine",
choices = rownames(anno_genExp_off[1:25,]),
multiple = TRUE)),
mainPanel(plotOutput("testPlot"))
)
server <- function(input, output) {
pdata <- reactive(input$patients)
gdata <-reactive(input$geneExp)
output$testPlot <- renderPlot ({
levelplot(anno,
col.regions=colorRampPalette(c("red","green","blue")))
})
}
shinyApp(ui = ui, server = server)
The code above just plots a small matrix, but how do I get it to plot user inputs using reactivity?
If the user chooses SKI and TTlLL10 only for patient 99901, how will I go about plotting this?
I've myself created a sample dataframe as you mentioned above. Here's the modified code.
Changes i made:
input$geneExp and input$patients are already reactive so there is no need to use a separate reactive function.
Filtered the dataframe for plotting use the same
Also, made a default selected value in the selectInput to avoid the initial error message when nothing is selected
library(shiny)
library(shinythemes)
library(lattice)
anno_genExp_off <- data.frame(`99901` = c(4.3,6.5,6.6),
`99902` = c(5.3,7.5,8.6),
`99903` = c(6.3,8.5,9.6),
row.names = c("SKI","VWA1","TTLL10"))
anno <- as.matrix(anno_genExp_off)
#Define UI
ui <- fluidPage(
sidebarPanel(
titlePanel(title = "Gen3 Gene Expression Data"),
selectInput(inputId = "patients",
label = strong("Please choose patient/s to examine"),
choices = colnames(anno_genExp_off),
selected = colnames(anno_genExp_off)[1],
multiple = TRUE),
selectInput(inputId = "geneExp",
label = "Please select gene expressions/s to examine",
choices = rownames(anno_genExp_off),
selected = rownames(anno_genExp_off)[1],
multiple = TRUE)),
mainPanel(plotOutput("testPlot"))
)
server <- function(input, output) {
#pdata <- reactive(input$patients)
#gdata <-reactive(input$geneExp)
output$testPlot <- renderPlot ({
levelplot(x = as.matrix(anno_genExp_off[which(rownames(anno_genExp_off) %in% input$geneExp) ,input$patients]),
col.regions=colorRampPalette(c("red","green","blue")))
})
}
shiny::shinyApp(ui,server)
Related
I am trying to have the selectinput widget "Years - Slide" change the data used by the graph to the specific date range shown. I was able to connect the axis options in the ui code to the server code since the graph changes, but I do not know how to do the same to the date range widget.
I am trying to use a selectInput widget instead of a date input widget since I only have the year to work with.
Would anyone know how to resolve this?
I was expecting to see the graph according to the changes in the widget, but that is not working.
functional code without selectinput in the server code
library(gapminder)
gm <- gapminder
library(shiny)
library(plotly)
library(tibble)
library(tidyverse)
library(tidyr)
library(readr)
library(dplyr)
library(ggplot2)
# set working directory
setwd("~/BDSWD")
# Define UI ----
ui <- fluidPage(
column(3,offset = 4, titlePanel("Explore Gapminder Data with Shiny")),
headerPanel('Graphs'),
mainPanel(
plotlyOutput('plot')
),
sidebarPanel(
#variable selection for x-axis
selectInput(inputId ='xvrbl', #The input slot that will be used to access the value.
label = 'X-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'lifeExp'
),
#variable selection for y-axis
selectInput(inputId ='yvrbl', #The input slot that will be used to access the value.
label = 'Y-Axis Variable', #Display label for the control, or NULL for no label.
choices = colnames(gm), #List of values to select from
selected = 'gdpPercap'
),
#date range - slider
sliderInput(inputId = "time",
label = "Years - Slide",
min = min(gm$year),
max = max(gm$year),
step = 5,
value = c(min(gm$year),max(gm$year))),
)
)
server <- function(input, output) {
x <- reactive({
pull(gm[,input$xvrbl])
})
y <- reactive({
pull(gm[,input$yvrbl]) #pull used to turn tibble into vctr bc plotly only takes vctrs
})
output$plot <- renderPlotly(
plot1 <- plot_ly(
x = x(),
y = y(),
type = 'scatter',
mode = 'markers',
color = gm$continent,
data <- subset(gm,
continent %in% input$continents &
year >= input$years[1] & year <= input$years[2])
)
)
}
# Run the app
shinyApp(ui = ui, server = server)
code with my attempt to connect selectInput to the server code (not working)
Unfortunately you code was not working. As first step I added a reactive to create the filtered dataset based on the user input. Second step was to add the selectInput to select the year to be plotted.
library(gapminder)
library(shiny)
library(plotly)
library(tidyverse)
gm <- gapminder
# Define UI ----
ui <- fluidPage(
column(3, offset = 4, titlePanel("Explore Gapminder Data with Shiny")),
headerPanel("Graphs"),
mainPanel(
plotlyOutput("plot")
),
sidebarPanel(
# variable selection for x-axis
selectInput(
inputId = "xvrbl", # The input slot that will be used to access the value.
label = "X-Axis Variable", # Display label for the control, or NULL for no label.
choices = colnames(gm), # List of values to select from
selected = "lifeExp"
),
# variable selection for y-axis
selectInput(
inputId = "yvrbl", # The input slot that will be used to access the value.
label = "Y-Axis Variable", # Display label for the control, or NULL for no label.
choices = colnames(gm), # List of values to select from
selected = "gdpPercap"
),
# date range - slider
selectInput(
inputId = "time",
label = "Years - Slide",
choices = unique(gm$year),
selected = max(gm$year)
)
)
)
server <- function(input, output) {
x <- reactive({
dat()[[input$xvrbl]]
})
y <- reactive({
dat()[[input$yvrbl]]
})
dat <- reactive({
subset(gm, year %in% input$time)
})
output$plot <- renderPlotly({
plot_ly(
x = x(),
y = y(),
type = "scatter",
mode = "markers",
color = dat()$continent
)
})
}
# Run the app
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:5182
I am trying to create my first shiny app but I am facing a difficulty: in the reproducible example below I am creating a reactive pickerInput (i.e. only show brands proposing a cylindre equal to the input visitors select).
I then want that based on the combination input_cyl and picker_cny (remember that picker_cny depends on input_cyl) to display a table which shows the relevant data for the observation matching the combination input_cyl and picker_cny.
Thank you for your help!
df <- mtcars
df$brand <- rownames(mtcars)
df$brand <- gsub("([A-Za-z]+).*", "\\1", df$brand)
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinycssloaders)
# Define UI -----------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Parameters
sidebarLayout(
sidebarPanel(
selectInput(inputId = "input_cyl", label = "Cyl",
choices = c("6", "4", "8")),
pickerInput(
inputId = "picker_cny",
label = "Select Company",
choices = paste0(unique(df$brand)),
options = list(`actions-box` = TRUE),
multiple = TRUE),
width = 2),
# Show Text
mainPanel(
tableOutput("table"),
width = 10)
))
# Define Server ------------------------------------------
server <- function(input, output, session) {
# Reactive pickerInput ---------------------------------
observeEvent(input$input_cyl, {
df_mod <- df[df$cyl == paste0(input$input_cyl), ]
# Method 1
disabled_choices <- !df$cyl %in% df_mod$cyl
updatePickerInput(session = session,
inputId = "picker_cny",
choices = paste0(unique(df$brand)),
choicesOpt = list(
disabled = disabled_choices,
style = ifelse(disabled_choices,
yes = "color: rgba(119, 119, 119, 0.5);",
no = "")
))
}, ignoreInit = TRUE)
output$table <- renderTable(df)
}
}
# Run the application
shinyApp(ui = ui, server = server)
You need a reactive that will handle the change in the input and subset the dataframe before giving it to the output table. For that, you just need to add this block to your server:
data <- reactive({
if (length(input$picker_cny) > 0)
df[df$brand %in% input$picker_cny,]
else
df
})
and update the output$table like this:
output$table <- renderTable(data())
Note: feel free to remove the if else in the reactive to get that:
data <- reactive({
df[df$brand %in% input$picker_cny,]
})
The only difference in that case is: would you show all or nothing when no input has been entered yet. That's a matter of taste.
I have two datasets, one with a list of two hundred cities and their corresponding state and another much larger dataset that I'd like to make an app to sort through. I need help making two drop down boxes in my shiny app where the first is the state variable and the second is the list of cities within that chosen state. I then want those selections to filter the much larger, second dataset in the output. I've tried solutions from several similar but slightly different examples online, but I'm having trouble translating it to what I'm doing.
So far I have this:
ui <- fluidPage(
headerPanel(''),
sidebarPanel(
#add selectinput boxs
htmlOutput("state_selector"),
htmlOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DT::dataTableOutput("table")
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$State == input$state, "state"]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available), #calls list of available cities
selected = unique(data_available)[1])
})
shinyApp(ui = ui, server = server)
I tried to take out the portions of the code that weren't specifically related to the drop down boxes, since that's what I was more specifically asking about. So I'm sorry if I've left anything out! Let me know if I need to include anything else
Using available gapminder data, you can try this.
df <- gapminder
df$state <- gapminder$continent
df$city <- gapminder$country
citystatedata <- df
ui <- fluidPage(
headerPanel('Test'),
sidebarPanel(
#add selectinput boxs
uiOutput("state_selector"),
uiOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DTOutput("table")
)
)
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$state == req(input$state),]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available$city), #calls list of available cities
selected = 1)
})
mydt <- reactive({
citystatedata %>% filter(citystatedata$state == req(input$state) & citystatedata$city %in% req(input$city))
})
output$table <- renderDT(mydt())
}
shinyApp(ui = ui, server = server)
I'm making a Shiny app whose ui and server functions look like this:
ui <- fluidPage(
# App title ----
titlePanel("All Histograms!"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
selectInput(inputId = 'dataset', label = 'Choose a dataset:',
choices = list.files(path = "#path here",
full.names = FALSE,
recursive = FALSE)),
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot")
)
))
server<- function( input, output, session){
outputdf <- reactive({
infile <- input$dataset
if (is.null(infile)){
return(NULL)
}
df<-read_feather(paste0("path_here",infile))
})
output$checkboxCompany <- renderUI({
checkboxGroupInput(inputId = "company_selection",
label="Company",
choices = unique(outputdf()$Company)
)
})
output$checkboxPredictedCondition <- renderUI({
checkboxGroupInput(inputId = "predicted_condition_selection",
label="Predicted Condition",
choices = unique(outputdf()$Predicted.Condition)
)
})
reactive_data <- reactive({
df%>%
filter(Company %in% input$company_selection)%>%
filter(Predicted.Condition %in% input$predicted_condition_selection)%>%
pull(Predicted.Probability)
})
output$distPlot <- renderPlot({
hist(reactive_data(), xlab = 'Predicted Probability', ylab = 'Frequency')
})
}
The user should be able to select from a list of datasets using selectInput, then based on the dataset, two checkbox groups company and Predict.Condition get modified - e.g. one dataset might have options a,b,c for company while a different dataset has options a,c,d for company.
Then, depending on the dataset selected and the resulting checkboxes marked, I'm making a reactive histogram.
However, when I run the app, I get "no applicable method for filter_ applied to an object of class function" error. I'm guessing R thinks that the df I'm passing in in reactive_data is a function? What did I do wrong here?
Turns out my reactive_data should have started with outputdf() and my ui was missing two uiOutputs for Company and Predicted COndition
I'm working with Shiny, and i have another question, hopefully much easier:
I have a dataframe (uploaded from a CSV), where I want the user to select a Dependent variable, and then select their independent variables, but the list of available columns for the IV selection should now not include the dependent variable that they just selected.
I've been staring and reactive expressions all day, and have no clue. It's probably really obvious too.
Any help would be great.
Here is a code snippet from the Server code
# Read file ----
df <- reactive({
req(input$uploaded_file)
read.csv(input$uploaded_file$datapath,
header = input$header,
sep = input$sep)
})
# dynamically allow the user to select a dependent variable ----
output$selectbox <- renderUI({
selectInput(inputId = "select_dev",
label = "Select target variable",
choices = names(df()))
})
# Dynamically allow the user to select their independent variables using checkboxes ----
###
### Here is where I would like to remove the variable from the DF that they selected in output$selectbox.
###
output$checkbox <- renderUI({
checkboxGroupInput(inputId = "select_var",
label = "Select variables",
choices = names(df()),
selected = names(df()))
})
Perhaps there is an easier way than this to manipulate a reactive function. The goal is to have dataframe that I can treat as a set of independent variables, and be able to call on it for multiple analyses.
There you go -
library(shiny)
shinyApp(
ui = fluidPage(
uiOutput("selectbox"),
uiOutput("checkbox")
),
server = function(input, output, session) {
df <- reactive(iris)
output$selectbox <- renderUI({
selectInput(inputId = "select_dev",
label = "Select target variable",
choices = names(df()))
})
output$checkbox <- renderUI({
checkboxGroupInput(inputId = "select_var",
label = "Select variables",
choices = setdiff(names(df()), input$select_dev),
selected = setdiff(names(df()), input$select_dev))
})
}
)