server.ui
shinyServer(
function(input, output) {
plot <- eventReactive(input$button, {
if (input$gtype == "Time to Change") {
dataset = subset(TDU, LBTEST == input$study, drop=FALSE)
ggplot(dataset, aes_string(x= 'VISITNUM', y = 'LBBLCHGR' , col='factor(ARMAN)')) +
geom_line(data = dataset, aes_string(x='VISITNUM',y = 'LBBLCHGR' ,group='SUBJID')) +
}
else {
dataset = subset(TDU, LBTEST == input$study, drop=FALSE)
ggplot(dataset, aes_string(x = 'ARMCD', y = 'LBBLCHGR', col='factor(VISITNUM)')) + geom_line()
}
output$plot <- renderPlot({
plot()
})
output$brush_info <- renderPrint({
brushedPoints(dataset, input$plot_brush)
})
})
})
I have a corresponding ui.r file which is supposed to display brush_info. But whenever I try to highlight a point in my graph, I get some error stating that the object dataset doesn't exist? Why is that? It clearly exists within a loop. Why would R make this an obstacle to allowing dataset to become a useable dataframe?
shinyUI(fluidPage(titlePanel('Biomarker Comparison'),
fluidRow(column(12, plotOutput('plot', brush = brushOpts(id = "plot_brush"), dblclick = "plot_dblclick"))),
fixedRow(column(3,selectInput('type', label='Select a Study',choices= c('', 'ADLB_TDU', 'ADLB_TDR', 'ADBM_TDR'))), column(3, uiOutput('selectUI'))),
fluidRow(column(3, radioButtons('gtype', label='Graph Type', choices = list('Dosage to Change', 'Time to Change'))) , column(3, uiOutput('UImeasure')), column(6, h4("Brushed points"),verbatimTextOutput("brush_info"))),
actionButton('button', 'Draw Graph')
))
In simpler terms, how do I access a dataframe, or any object embedded in a loop?
EDIT :
Here is a solution that I came up with.
data = reactive({
dataset = subset(TDU, LBTEST == input$study, drop=FALSE)
})
output$brush_info <- renderPrint({
brushedPoints(data(), input$plot_brush)
})
So I put the dataframe into a reactive function, and then I substituted the dataframe name for the function that generates it. I can't believe that I haven't tried this before.
Related
I am building a shiny application with several tabs, each tab takes a user input (unique(data_in$cat), and generates some type of graph. The problem occurs in the second tab--for some reason, it does not generate the graph that is specified by data2. The first graph on the first tab is being displayed correctly.I see no error when I run this code, so I don't know where to start debugging!
library(shiny)
library(openxlsx)
library(ggplot2)
data_in <- read.xlsx("www/dem_data_clean.xlsx")
ui <- navbarPage(title = "Data",
tabPanel(title = "Over-all trends",
plotOutput("Histall"),
selectInput("Indall","Demographic Variable of Interest",choices = unique(data_in$cat))
),
tabPanel(title = "2017-2018"),
plotOutput("Hist17"),
selectInput("Ind17","Demographic Variable of Interest",choices = unique(data_in$cat))
)
server <- function(input, output, session) {
data1 <- reactive({
a <- subset(data_in,cat==input$Indall)
return(a)
})
data2 <- reactive({
a <- subset(data_in,cat==input$Ind17)
return(a)
})
output$Histall <- renderPlot({
ggplot(data1(), aes(x=Year,y=value, group =name, color=name)) + geom_line(stat = "identity") +
ylab("Percent of Population")
})
output$Hist17 <- renderPlot({
data2() %>%
filter(Year=="2017-18") %>%
ggplot(aes(name, value)) + geom_bar(stat = "identity")
})
}
shinyApp(ui, server)
Any suggestions to what I am doing wrong? I've tried playing around with different things for a few hours now to no avail!
The UI code is not correct, second plotOutput and selectInput are not within second tabPanel. It works if you fix it :
ui <- navbarPage(title = "Data",
tabPanel(title = "Over-all trends",
plotOutput("Histall"),
selectInput("Indall",
"Demographic Variable of Interest",
choices = unique(data_in$cat))
),
tabPanel(title = "2017-2018",
plotOutput("Hist17"),
selectInput("Ind17",
"Demographic Variable of Interest",
choices = unique(data_in$cat)))
)
I went a totally different direction in this project -- the issue I have is down at the end I need to clear out the graph when a different variable is selected. The graph as it is stays the same. Thanks.
I am not even sure how this would be phrased in the documents -- rewriting graphs, dynamic plotting ??? I saw display.removePlot(display.activePlotIndex()) but am not sure about that -- what do I look up to figure this out?
library(shiny)
library(DT)
library(ggplot2)
oboler_data <- read_csv(file = "C:/Users/12083/Desktop/ref.csv")
rdate <- as.Date(oboler_data$DATE,"%m/%d/%y")
ui <- fluidPage(sidebarLayout(
sidebarPanel(
selectInput("dataset", "choose a dataset", c("oboler_data")),
selectInput("column", "Type of Transaction", "placeholder1"),
selectInput("level", "select level", "placeholder2")
),
mainPanel(tableOutput("table"), plotOutput("Histo"))
))
server <- function(input, output, session){
dataset <- reactive({
get(input$dataset)
})
observe({
updateSelectInput(session, "column", choices = names(dataset()))
})
observeEvent(input$column, {
column_levels <- as.character(sort(unique(
dataset()[[input$column]]
)))
updateSelectInput(session, "level", choices = column_levels)
})
output$table <- renderTable({
subset(dataset(), dataset()[[input$column]] == input$level)
})
DF <- data.frame(Name = LETTERS[1:10], Value = rnorm(20), Value2 = runif(20))
output$TableOut <- renderDataTable({
DF
})
output$Histo <- renderPlot({
ggplot(DF, aes(Value)) + geom_histogram(binwidth = 0.1,
fill = "blue", color = "white")
})
}
shinyApp(ui, server)
I think you should use req, as it precludes (and clears!) rendering of a plot if conditions are not met.
library(shiny)
shinyApp(
ui = fluidPage(
checkboxInput("cb", "Plot?"),
sliderInput("cyls", "Cylinders", min = 1, max = 8, value = 4, step = 1),
plotOutput("plt")
),
server = function(input, output, session) {
output$plt <- renderPlot({
req(input$cb, input$cyls)
ggplot(mtcars[mtcars$cyl >= input$cyls,,drop = FALSE],
aes(disp, mpg, color = factor(cyl))) +
geom_point()
})
}
)
The three screenshots above are in sequence: start with "Plot?" deselected, no plot shown; select it, plot appears; deselect it, existing plot disappears.
The way you adapt this to you is to replace the req(input$cb) with something that matches your condition of "clear the plot". (I also included input$cyls here just to prevent larger more-complex apps from reaching the plot block before all inputs have stabilized. Perhaps not required in most apps, but it's a defensive move that carries little consequence if it is overkill, but lots of benefit when it is needed.)
A slight modification on a theme, "telling the user why the plot disappeared". Replace the req with a validate and at least one need:
# req(input$cb, input$cyls)
validate(
need(input$cb, "You deselected \"Plot!\"")
)
I have two reactive values input$code and input$variants and I want to redraw the plot once if any of the following conditions are true.
code changes and variants changes
code changes and variants does not change
code does not change and variants changes
I can't call both input$code and input$variants in renderPlotly or else the plot will get redrawn twice for #1 above.
output$choose_test <- renderUI({
data_sets <- loadTest()
selectizeInput(
'test', 'Test', choices = data_sets$test, selected = data_sets$test[1]
)
})
output$choose_code <- renderUI({
validate(
need(input$test, 'Please choose a test.')
)
code <- loadCode(input$test)
selectizeInput(
'code', 'Code', choices = code$code, selected = code$code[1]
)
})
output$choose_variants <- renderUI({
validate(
need(input$test, 'Please choose a test.'),
need(input$code, 'Please choose a code.')
)
dat <- loadVariants(input$test, input$code)
default_select <- dat$variant[grep('v1|v2', dat$variant)]
if (identical(default_select, factor(0))) {
default_select <- dat$variant[1]
}
checkboxGroupInput("variants", "Variants",
choices = dat$variant,
selected = default_select)
})
output$plot1 <- renderPlotly({
runLocations <- isolate(loadRunsBetweenDates(input$test, input$code, input$variants))
total_min_df <-
runLocations %>%
group_by(change_number, variant) %>%
summarize(memory = min(memory))
total_min_df$change_number <- as.numeric(as.character(total_min_df$change_number))
p <- ggplot(total_min_df,
aes(x=change_number,
y=memory,
group=variant,
color=variant))+
geom_point()+
geom_smooth(se = FALSE)+
scale_x_continuous(labels = function(n){format(n, scientific = FALSE)})+
scale_y_continuous(labels = function(n){format(n, scientific = FALSE)})+
labs(x = "Change Number", y = "Megabytes")
ggplotly(p)
})
Could anyone can tell me why I get an error when I change a dataset in first selectInput widget? When I change a dataset from diamonds to mtcars I get an error Could not find 'carat' in input$bins and in the plot just for one second and after that everything works fine. Why it happened?
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data,
diamonds = diamonds,
mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- data()
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1,
max = max_value,
value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(input$cols) & !is.null(input$bins)) {
basicData <- data()
var <- eval(input$cols)
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
Your respective output objects respond to any changes of your input variables. Thus, when you change your dataset via input$data, the plot rebuilds itself, although input$cols did not yet adjust. Actually, try inserting some print("a") inside the output$plot to see that it is called up to three times if you change input$data.
The fix is to rethink your reaction logic and let your elements respond only to specific changes, to get some kind of response "thread".
For example, input$data should only trigger output$server_cols. And output$server_bins should only be triggered by input$cols (because this already implies that input$data changed earlier). Ultimately, output$plot just has to listen to changes of input$bins (because changes in input$cols and input$data always result in changes of input$bins since it is at the end of the thread).
Here is my suggestion using isolate.
library(shiny)
library(ggplot2)
data(diamonds)
data(mtcars)
ui <- fluidPage(
column(3,
selectInput("data", "", choices = c('mtcars', 'diamonds')),
uiOutput('server_cols'),
uiOutput('server_bins')
),
column(9,
plotOutput("plot")
)
)
server <- function(input, output) {
data <- reactive({
switch(input$data, diamonds = diamonds, mtcars = mtcars)
})
output$server_cols <- renderUI({
data <- data()
nam <- colnames(data)
selectInput('cols', "Choose numeric columns:", choices = nam[sapply(data, function(x) is.numeric(x))])
})
output$server_bins <- renderUI({
if (!is.null(input$cols)) {
df <- isolate(data())
x <- eval(input$cols)
max_value <- max(df[,x])
sliderInput('bins','Choose number of bins:', min = 0.1, max = max_value, value = max_value/2)
}
})
output$plot <- renderPlot({
if (!is.null(isolate(input$cols)) & !is.null(input$bins)) {
basicData <- isolate(data())
var <- eval(isolate(input$cols))
ggplot(basicData, aes_string(var)) +
geom_histogram(binwidth = input$bins, color = 'white', fill = 'red')
}
})
}
shinyApp(ui, server)
You might also want to look into updateSelectInput and updateSliderInput if you want to alter Input Elements depending on other input.
I'm making an app that allows the user to upload any csv file and the app will graph it. I'd like to allow the user to switch between graph styles, gVis and ggplot. The graphs work as implemented by themselves, but I can't seem to figure out how to enable the user to switch them with a checkboxInput (input$switchLine). I'll post only the sample code relative to the problem at hand, let me know if you need more info.
I've tried things like in server:
if (input$switchLine) {
output$gvisLine
} else {
output$plotLine
}
But the problem is that in the ui.R, ggplot line uses plotOutput while gVis uses html Output.
ui.R (I've commented out the gVis line as I only know how to plot one at a time right now)
library(shiny)
dataset <- list('Upload a file'=c(1))
shinyUI(pageWithSidebar(
headerPanel(''),
sidebarPanel(
wellPanel(
selectInput('xLine', 'X', names(dataset)),
selectInput('yLine', 'Y', names(dataset), multiple=T)
),
wellPanel(
checkboxInput('switchLine', 'Switch to gVis')
)
),
mainPanel(
tabPanel("Line Graph", plotOutput('plotLine', height="auto"), value="line"),
#Below is the gvis Line
#tabPanel("Line Graph", htmlOutput("gvisLine"), value="line")
)
))
server.R
library(reshape2)
library(googleVis)
library(ggplot2)
library(plyr)
library(scales)
require(xlsx)
require(xlsxjars)
require(rJava)
require(shiny)
options(shiny.maxRequestSize=-1)
shinyServer(function(input, output, session) {
if (is.null(input$file))
return(NULL)
else if (identical(input$format, 'CSV'))
return(read.csv(input$file$datapath))
else if (identical(input$format, 'XLSX'))
return(read.xlsx2(input$file$datapath, input$sheet))
else
return(read.delim(input$file$datapath))
})
observe({
df <- data()
str(names(df))
updateSelectInput(session, 'xLine', choices = names(df))
updateSelectInput(session, 'yLine', choices = names(df))
}
})
output$gvisLine<- renderGvis( {
tempX <- input$xLine
tempY <- input$yLine
if (is.null(data()))
return(NULL)
if (is.null(tempY))
return(NULL)
gvisLineChart(data(),xvar=tempX,yvar=tempY,
options=list(
title=paste("",tempX," VS ",tempY,""),
titlePosition='out',
hAxis="{slantedText:'true',slantedTextAngle:45}",
titleTextStyle="{color:'black',fontName:'Courier'}",
legend="{color:'black',fontName:'Courier'}",
fontSize="10",
chartArea="{left:40,top:30,width:'90%',height:'85%'}",
height=700, width=1100))
})
output$plotLine <- renderPlot(height=650, units="px", {
tempX <- input$xLine
tempY <- input$yLine
if (is.null(data()))
return(NULL)
if (is.null(tempY))
return(NULL)
widedata <- subset(data(), select = c(tempX, tempY))
melted <- melt(widedata, id = tempX)
p <- ggplot(melted, aes_string(x=names(melted)[1], y="value", group="variable", color="variable")) + geom_line() + geom_point()
p <- p + opts(axis.text.x=theme_text(angle=45, hjust=1, vjust=1))
p <- p + labs(title=paste("",tempX," VS ",tempY,""))
print(p)
})
})
Use
conditionalPanel(
condition = "input.switchLine == false",
plotOutput('plotLine', height="auto")
),
conditionalPanel(
condition = "input.switchLine == true",
htmlOutput("gvisLine")
)
or something similar in ui.R