I am creating two interactive plots in R Shiny and while I can get one plot to show up and work, the second plot keeps giving me the "Warning: Error in [.data.frame: undefined columns selected" and will not appear.
I have looked at many solutions online and none so far have been able to help me or fix my issue.
I am having a hard time seeing how my columns are undefined, but I am also relatively new to R Shiny and could be easily overlooking something, so I was hoping someone could help me figure this out.
Here is my code:
library(shiny)
library(dplyr)
library(readr)
library(ggplot2)
library(tidyverse)
age <- c(1, 4, 7,10, 15)
v_m_1 <- c(10, 14, 17, 20, 25)
v_m_2 <- c(9, 13, 16, 19, 24)
sex <- c("F", "M","U", "F", "M")
P_v_rn <- c(0.11, 0.51, 0.61, 0.91, 1)
C_v_rn <- c(11.1, 15.1, 16.1, 19.1, 20.1)
P_v_rk <- c(0.11, 0.51, 0.61, 0.91, 1)
B_v_rk <- c("Low", "Medium", "Medium", "High", "High")
df_test <- data.frame(age, v_m_1, v_m_2, sex, P_v_rn, C_v_rn, P_v_rk, B_v_rk)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Test"),
# Sidebar with a slider input for number of bins
verticalLayout(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "xvar",
label = "Choose X variable", #All variables are numeric
c("Age" = 1),
selected = 1),
selectInput(inputId = "yvar",
label = "Choose bone variable", #All variables are numeric
c("v_m_1" = 2,
"v_m_2" = 3),
selected = 2),
checkboxInput(inputId = "regression",
label = "Fit LOESS - By Sex",
value = FALSE)),
mainPanel(
plotOutput('dataplot1')
)
),
tags$hr(),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "xvar_name",
label = "Choose X variable", #All variables are numeric
c("Age" = 1),
selected = 1),
selectInput(inputId = "yvar_name",
label = "Choose Y variable", #The first variable option is numeric, the rest are factors
c("P_v_rk" = 7,
"B_v_rk" = 8),
selected = 7),
selectInput(inputId = "zvar_name",
label = "Choose Z variable", #All variables are numeric
c("C_v_rn" = 6,
"P_v_rn" = 5),
selected = 6)),
# Show a plot of the generated distribution
mainPanel(
plotOutput('dataplot2')
)
),
tags$hr(),
))
# Define server logic required to draw a scatterplot
server <- function(input, output) {
df <- df_test %>%
select(age, v_m_1, v_m_2, sex, P_v_rn, C_v_rn, P_v_rk, B_v_rk)
df$B_v_rk <- as.factor(df$B_v_rk)
#Growth Curve
output$dataplot1 <- renderPlot({
xvar <- as.numeric(input$xvar)
yvar <- as.numeric(input$yvar)
Sex <- as.factor(df$sex)
p <- ggplot() +
aes(x = df[ ,xvar],
y = df[ ,yvar],
col = sex) +
geom_point(alpha = 0.5, aes(size = 1.5)) + # 50% transparent
labs(x = names(df[xvar]),
y = names(df[yvar])) +
theme_classic()
if(input$regression) {
# add a line to the plot
p <- p + geom_smooth()
}
p # The plot ('p') is the "return value" of the renderPlot function
})
#Environmental metrics
output$dataplot2 <- renderPlot({
xvar_name <- input$xvar_name
yvar_name <- input$yvar_name
zvar_name <- input$zvar_name
#Color palette for ggplots as blue color range was difficult for me
fun_color_range <- colorRampPalette(c("yellow", "red"))
my_colors <- fun_color_range(20)
p2 <- ggplot() +
aes(x = df[ ,xvar_name],
y = df[ ,yvar_name],
col = df[ ,zvar_name]) +
geom_point(alpha = 0.5, aes(size = 1.5)) + # 50% transparent
scale_colour_gradientn(colors = my_colors) +
labs(x = names(df[xvar_name]),
y = names(df[yvar_name])) +
theme_classic()
p2 # The plot ('p2') is the "return value" of the renderPlot function
})
}
# Run the application
shinyApp(ui = ui, server = server)
Again the first plot works fine, it is the second plot that is producing an error code.
I guess I am confused as the code for the first plot works fine but it won't work for the second plot.
For reference, this is the layout I want, except I want another plot in the error code location.
My guess is that the bug is in the line with names(df[xvar_name]). If df is a data frame, this will throw the error you quoted. To subset a data frame with indices or column names you either use double brackets (df[[...]]) or a comma (df[ ..., ... ]). I think you meant names(df[ , xvar_name ]). This error is repeated on the line below as well.
In general, to identify the place where the problem occurs, use browser() in your code.
I'm working on cancer data from TCGA.
Im new to shiny and creating web applications (learning it!!)
I'm working on a shiny tool to plot the volcanoplot using highcharter package.
sometimes I'm successfully able to plot the volcanoplot in the UI. but sometimes it fails to plot it and throws an error saying,
"An error has occurred!
could not find function "highchartOutput"
and one warning message is given for the error;
Listening on http://127.0.0.1:5335
Warning: Error in highchartOutput: could not find function "highchartOutput"
83: dots_list
82: div
81: tabPanel
I think there is some problem with the tabset panel.
is this error has anything to do with indentation? (wherever I adjust the brackets it works magically. not sure how it works for sometimes.)
I am attaching the UI and server files with this post.
code is attached for one type of comparison
UI file below:
library(shiny)
# Define UI for application
shinyUI(fluidPage(
# Application title
titlePanel("miR-Gyn-Explorer"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
## select the count matrix
selectInput("file", label = h3("Count Matrix"),
choices = list("Stage I - Normal" = list("TCGA-BRCA" = "Data/TCGA-BRCASI_NT.rda", "TCGA-UCEC" = "Data/TCGA-UCECSI_NT.rda"))),
## select the phenodata of samples
selectInput("phenofile", label = h3("Sample Phenodata"),
choices = list("Stage I - Normal" = list("TCGA-BRCA" = "Data/TCGA-BRCA_phenoSI_NT.rda", "TCGA-UCEC" = "Data/TCGA-UCEC_phenoSI_NT.rda"))),
submitButton("Update View")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("DEmiRNA", DT::dataTableOutput("DEmiRNA"),
"Volcano-Plot", highchartOutput("volcanoPlot", height = "500px"))
#tabPanel("miRNA-Targets", DT::dataTableOutput('miRTarget'),
#plotOutput("GO"))
)
)
)
)
)
server file:
library(shiny)
library(R.utils)
##function to find the DEmiRNA by edgeR method
library(limma)
library(edgeR)
library(DT)
library(dplyr)
library(multiMiR)
library(miRBaseConverter)
library(ggplot2)
#library(ggrepel)
library(tidyverse)
library(highcharter)
library(org.Hs.eg.db)
library(clusterProfiler)
library(purrr)
gdcDEmiRNA <- function(counts, groups, comparison, filter=TRUE) {
## method = edgeR
dge = DGEList(counts = counts, samples = groups)
group <- factor(groups$group)
design <- model.matrix(~0+group)
colnames(design) <- levels(group)
contrast.matrix <- makeContrasts(contrasts=comparison,
levels=design)
keep = filterByExpr(dge,design)
dge <- dge[keep,,keep.lib.sizes = TRUE]
dge <- calcNormFactors(dge)
dge <- estimateDisp(dge, design)
fit <- glmFit(dge, design)
lrt <- glmLRT(fit, contrast=contrast.matrix)
DEGAll <- lrt$table
DEGAll$FDR <- p.adjust(DEGAll$PValue, method = 'fdr')
o <- order(DEGAll$FDR)
DEGAll <- DEGAll[o,]
return (DEGAll)
}
# Define server logic required to perform the DEmiRNA analysis
server <- function(input, output) {
d <- reactive({
#DEmiRNA calculation
file <- load(input$file)
phenofile <- load(input$phenofile)
if(file == "SI_NT"){
if(phenofile == "phenoSI_NT"){
DEmiRNA <- gdcDEmiRNA(counts = SI_NT, groups = phenoSI_NT,
comparison = 'StageI-Normal')
}
}
})
output$DEmiRNA <- DT::renderDataTable({
mir <- d()
#mir <- mir[mir$FDR < input$FDR,]
})
output$volcanoPlot <- renderHighchart({
x <- d()
x$mirna <- rownames(x)
x$sig <- ifelse(x$PValue < 0.05 & abs(x$logFC) > 0.57, "DEmiRNA", "Not Regulated")
hc <- highchart() %>%
hc_add_series(x, "scatter", hcaes(logFC, -log10(PValue), group = sig, value = mirna),
color = c('rgba(67, 67, 72, 0.6)', 'rgba(124, 181, 236, 0.6)'),
enableMouseTracking = c(TRUE, TRUE),
showInLegend = TRUE, marker = list(radius = 4)) %>%
hc_tooltip(pointFormat = "{point.value}", headerFormat = "") %>%
hc_xAxis(title = list(text = "Log fold change"), gridLineWidth = 1,
tickLength = 0, startOnTick = "true", endOnTick = "true", min = -6, max = 6) %>%
hc_yAxis(title = list(text = "-Log10(p-value)")) %>%
hc_chart(zoomType = "xy", width=700) %>%
hc_exporting(enabled = TRUE, filename = "volcano")
hc
})
}
any comment and help from you guys is appreciated
Thank you in advance!
-Ankita
I can not figure out what is wrong with the following code. After running runApp('script.R'), I am getting the following error Error: object 'data_survival_curve' not found. I run debug in RStudio and on line nr 60 this variable is created and it exists till the moment when error comes.
script.R file:
library(shiny)
library(survival)
library(survminer)
library(directlabels)
data <- read.csv('dataset.csv', header = TRUE, sep = ",", fileEncoding="UTF-8")
unique_transplant_years_decreasing <- as.numeric(sort(unique(c(data$transplant_year)), decreasing = TRUE))
krivkaPreziti <- sidebarLayout(
# all inputs for graph survival analysis (krivka preziti)
sidebarPanel(
sliderInput("krivka_preziti_input_years", 'Years:',
min = unique_transplant_years_decreasing[length(unique_transplant_years_decreasing)],
max = unique_transplant_years_decreasing[1],
value = c(unique_transplant_years_decreasing[length(unique_transplant_years_decreasing)],
unique_transplant_years_decreasing[1]),
step = 1),
numericInput('krivka_preziti_input_seskupit_po', 'Group by (years):',
value = 0,
min = 0),
checkboxInput('krivka_preziti_input_facet', 'Facet', value = FALSE),
width = 3
),
# Create a spot for bar plot
mainPanel(
h2('Survival curve'),
br(),
plotOutput('krivka_preziti', height = "750px"),
width = 12
)
)
panelAnalyzaPreziti <- tabPanel(
'Survival analysis',
krivkaPreziti
)
ui <- navbarPage(
title = "Application",
panelAnalyzaPreziti
)
server <- shinyServer(
function(input, output, session)
{
output$krivka_preziti <- renderPlot(
{
krivka_year_bottom <- input$krivka_preziti_input_years[1]
krivka_year_top <- input$krivka_preziti_input_years[2]
krivka_seskupit_po <- input$krivka_preziti_input_seskupit_po
# data which fit the range of selected years
# data which meet the condition that survival_time is not NA
data_survival_curve <- data[data$transplant_year %in% seq(krivka_year_bottom, krivka_year_top) &
!is.na(data$survival_time) &
data$survival_time >= 0,]
# if seskupit_po != 0, then cut
if(krivka_seskupit_po != 0) {
data_survival_curve$time_period <- cut(as.numeric(data_survival_curve$transplant_year),
seq(krivka_year_bottom, krivka_year_top, krivka_seskupit_po),
include.lowest = T)
data_survival_curve <- data_survival_curve[!is.na(data_survival_curve$time_period),]
data_survival_curve$time_period <- as.factor(data_survival_curve$time_period)
}
else {
data_survival_curve$time_period = data_survival_curve$transplant_year
}
# validate number of rows of data set > 0
shiny::validate(
need(nrow(data_survival_curve) > 0, 'Broader your input')
)
surv_obj <- Surv(data_survival_curve$survival_time/365,data_survival_curve$patient_died)
fit <- survfit(surv_obj ~ time_period, data = data_survival_curve)
krivka_preziti_plt <- ggsurvplot(fit,
linetype = c('solid'),
ggtheme = theme_bw(),
surv.scale = 'percent',
xlab = 'Years',
ylab = '%',
censor = FALSE,
break.x.by = 1,
break.y.by = 0.1)
plot2 <- krivka_preziti_plt + geom_dl(aes(label = time_period), method = list("last.points"), cex = 0.8)
plot2
}
)
}
)
shinyApp(
ui = ui,
server = server
)
Here is the data set that I am using: enter link description here
I've been struggling with the same issue since almost 1 hour and finally found the solution !
There have been a change in the "ggsurvplot" function and you now need to specify the dataset used in the "fit" element. So in your code you have to add :
krivka_preziti_plt <- ggsurvplot(fit, data = data_survival_curve,
linetype = c('solid'),
ggtheme = theme_bw(),
surv.scale = 'percent',
xlab = 'Years',
ylab = '%',
censor = FALSE,
break.x.by = 1,
break.y.by = 0.1)
Source : Github Issue, 13th of January 2018
So I am trying to tackle the following but I may have started down the wrong road.
As these sample sizes increase, I need to update the y-limits so the highest bar in geom_histogram() doesn't go off the top. The especially happens if the st. dev. is set near 0.
This is literally my second day working with Shiny and reactive applications so I feel I've gotten myself into a pickle.
I think I need to save the ggplot() objects and then update their ylimit reactively with the value of the largest bar from the last histogram. Just not sure if I can do that the way this thing is set up now.
(I am realizing I had a similar problem over 2 years ago)
ggplot2 Force y-axis to start at origin and float y-axis upper limit
This is different because it is the height of a histogram that needs to tell the y-axis to increase, not the largest data value. Also, because Shiny.
My server.R function looks like
library(shiny)
library(ggplot2)
library(extrafont)
# Define server logic for random distribution application
function(input, output, session) {
data <- reactive({
set.seed(123)
switch(input$dist,
norm = rnorm(input$n,
sd = input$stDev),
unif = runif(input$n,-4,4),
lnorm = rlnorm(input$n)
)
})
height="100%"
plotType <- function(blah, maxVal, stDev, n, type) {
roundUp <- function(x) 10^ceiling(log10(x)+0.001)
maxX<- roundUp(maxVal)
breakVal<-max(floor(maxX/10),1)
switch(type,
norm = ggplot(as.data.frame(blah), aes(x=blah))+
geom_histogram(binwidth = 0.2,
boundary = 0,
colour = "black") +
scale_y_continuous(limits = c(0, maxX),
breaks = seq(0, maxX, breakVal),
expand = c(0, 0)) +
scale_x_continuous(breaks = seq(-4, 4, 1),
expand = c(0, 0)) +
theme_set(theme_bw(base_size = 40) +
ylab("Frequency")+
xlab("")+
coord_cartesian(xlim=c(-4, 4))+
ggtitle(paste("n = ",n, "St Dev =", stDev," Normal Distribution ", sep = ' ')),
unif = ggplot(as.data.frame(blah), aes(x=blah))+
geom_histogram(binwidth=0.1, boundary =0,colour = "black")+
scale_y_continuous(limits = c(0,roundUp(maxVal*(3/stDev))),
breaks=seq(0,roundUp(maxVal*(3/stDev)), roundUp(maxVal*(3/stDev))/10),
expand = c(0, 0))+
scale_x_continuous(breaks=seq(-4,4,1),expand = c(0, 0))+
theme_set(theme_bw(base_size = 40))+
ylab("Frequency")+xlab("")+
coord_cartesian(xlim=c(-4,4))+
ggtitle(paste("n = ",n, " Uniform Distribution ", sep = ' ')),
lnorm = ggplot(as.data.frame(blah), aes(x=blah))+
geom_histogram(binwidth=0.2, boundary =0,colour = "black")+
scale_y_continuous(limits = c(0,maxX),
breaks=seq(0,maxX, breakVal),
expand = c(0, 0))+
scale_x_continuous(breaks=seq(0,8,1),expand = c(0, 0))+
theme_set(theme_bw(base_size = 40))+
ylab("Frequency")+xlab("")+
coord_cartesian(xlim=c(0,8))+
ggtitle(paste("n = ",n, " Log-Normal Distribution ", sep = ' '))
)
}
observe({
updateSliderInput(session, "n",
step = input$stepSize,
max=input$maxN)
})
plot.dat <- reactiveValues(main=NULL, layer1=NULL)
#plotType(data, maxVal, stDev, n, type)
output$plot <- renderPlot({
plotType(data(),
switch(input$dist,
norm = max((input$n)/7,1),
unif = max((input$n)/50,1),
lnorm =max((input$n)/8,1)
),
input$stDev,
input$n,
input$dist) })
# Generate a summary of the data
output$summary <- renderTable(
as.array(round(summary(data())[c(1,4,6)],5)),
colnames=FALSE
)
output$stDev <- renderTable(
as.array(sd(data())),
colnames=FALSE
)
# Generate an HTML table view of the data
output$table <- renderTable({
data.frame(x=data())
})
}
And my ui.R looks like
library(shiny)
library(shinythemes)
library(DT)
# Define UI for random distribution application
shinyUI(fluidPage(theme = shinytheme("slate"),
# Application title
headerPanel("Michael's Shiny App"),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the
# br() element to introduce extra vertical spacing
sidebarLayout(
sidebarPanel(
tags$head(tags$style("#plot{height:90vh !important;}")),
radioButtons("dist", "Distribution:",
c("Standard Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm")),
br(),
numericInput("stepSize", "Step", 1, min = 1, max = NA, step = NA,
width = NULL),
numericInput("maxN", "Max Sample Size", 50, min = NA, max = NA, step = NA,
width = NULL),
br(),
sliderInput("n",
"Number of observations:",
value = 0,
min = 1,
max = 120000,
step = 5000,
animate=animationOptions(interval=1200, loop=T)),
sliderInput("stDev",
"Standard Deviation:",
value = 1,
min = 0,
max = 3,
step = 0.1,
animate=animationOptions(interval=1200, loop=T)),
p("Summary Statistics"),
tabPanel("Summary", tableOutput("summary")),
p("Sample St. Dev."),
tabPanel("Standard Dev", tableOutput("stDev")),
width =2
),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", tableOutput("table"))
))
)))
The whole thing has a lot of redundancy. What I want to do, is once the biggest bar on the histogram gets close to the upper y-limit, I want the ylimit to jump to the next power of 10.
Any suggestions are greatly appreciated.
Update Loosely, the solution that I ended up using is as follows: In the renderPlot() function, you need to save the ggplot object. Then as mentioned below, access the ymax value (still within renderPlot()),
ggplot_build(norm)$layout$panel_ranges[[1]]$y.range[[2]]
and then use that to update the y-axis. I used the following function to make the axis limit "nice".
roundUpNice <- function(x, nice=c(1,2,4,5,6,8,10)) {
10^floor(log10(x)) * nice[[which(x <= 10^floor(log10(x)) * nice)[[1]]]]
}
Then updating the y-axis. (still within renderplot())
ymaxX = roundUpNice(ggplot_build(norm)$layout$panel_ranges[[1]]$y.range[[2]])
norm+scale_y_continuous(limits = c(0, max(ymaxX, 20)),
expand=c(0,0))
First, store the histogram (default axes).
p1 <- ggplot(...) + geom_histogram()
Then, Use ggplot_build(p1) to access the heights of the histogram bars. For example,
set.seed(1)
df <- data.frame(x=rnorm(10000))
library(ggplot2)
p1 <- ggplot(df, aes(x=x)) + geom_histogram()
bar_max <- max(ggplot_build(p1)[['data']][[1]]$ymax) # where 1 is index 1st layer
bar_max # returns 1042
You will need a function to tell you what the next power of 10 is, for example:
nextPowerOfTen <- function(x) as.integer(floor(log10(x) + 1))
# example: nextPowerOfTen(999) # returns 3 (10^3=1000)
You will want to check whether the bar_max is within some margin (based on your preference) of the next power of 10. If an adjustment is triggered, you can simply do p1 + scale_y_continuous(limits=c(0,y_max_new)).
I found the answer hidden in the "scale_y_continuous()" portion of your code. The app was very close, but in some cases, the data maxed out the y-axis, which made it appear like it was running further than the axis limits as you said.
To fix this problem, the expand argument within the scale_y_continuous section needs to be set to "c(0.05, 0)", instead of "c(0, 0)".
First, I've replicated an example of the graph run-off you were describing by setting the sample size to 50 and standard deviation to 0.3 within your app. After running the original code with "expand=c(0, 0)", we can see we get the following graph:
This problem is fixed by changing the argument to "expand=c(0.05, 0)", as shown here:
For copies of the fixed scripts, see below.
Part 1 -- server.R
library(shiny)
library(ggplot2)
library(extrafont)
# Define server logic for random distribution application
function(input, output, session) {
data <- reactive({
set.seed(123)
switch(input$dist,
norm = rnorm(input$n,
sd = input$stDev),
unif = runif(input$n,-4,4),
lnorm = rlnorm(input$n)
)
})
height="100%"
plotType <- function(blah, maxVal, stDev, n, type){
roundUp <- function(x){10^ceiling(log10(x)+0.001)}
maxX<- roundUp(maxVal)
breakVal<-max(floor(maxX/10),1)
switch(type,
norm=ggplot(as.data.frame(blah), aes(x=blah)) +
geom_histogram(binwidth = 0.2,
boundary = 0,
colour = "black") +
scale_y_continuous(limits = c(0, maxX),
breaks = seq(0, maxX, breakVal),
expand = c(0.05, 0)) +
scale_x_continuous(breaks = seq(-4, 4, 1),
expand = c(0, 0)) +
theme_set(theme_bw(base_size = 40)) +
ylab("Frequency") +
xlab("") +
coord_cartesian(xlim=c(-4, 4))+
ggtitle(paste("n = ",n, "St Dev =", stDev,
" Normal Distribution ", sep = ' ')),
unif=ggplot(as.data.frame(blah), aes(x=blah)) +
geom_histogram(binwidth=0.1, boundary=0, colour="black")+
scale_y_continuous(
limits = c(0,roundUp(maxVal*(3/stDev))),
breaks=seq(0,roundUp(maxVal*(3/stDev)),
roundUp(maxVal*(3/stDev))/10),
expand = c(0.05, 0))+
scale_x_continuous(breaks=seq(-4,4,1),expand=c(0, 0)) +
theme_set(theme_bw(base_size = 40))+
ylab("Frequency")+xlab("")+
coord_cartesian(xlim=c(-4,4))+
ggtitle(paste("n = ",n,
" Uniform Distribution ", sep = ' ')),
lnorm=ggplot(as.data.frame(blah), aes(x=blah))+
geom_histogram(binwidth=0.2,boundary=0, colour="black") +
scale_y_continuous(limits=c(o,maxX),
breaks=seq(0,maxX, breakVal),
expand = c(0.05, 0)) +
scale_x_continuous(breaks=seq(0,8,1),
expand = c(0, 0)) +
theme_set(theme_bw(base_size = 40)) +
ylab("Frequency") +
xlab("") +
coord_cartesian(xlim=c(0,8)) +
ggtitle(paste("n = ",n,
" Log-Normal Distribution ",
sep = ' '))
)
}
observe({
updateSliderInput(session, "n",
step = input$stepSize,
max=input$maxN)
})
plot.dat <- reactiveValues(main=NULL, layer1=NULL)
#plotType(data, maxVal, stDev, n, type)
output$plot <- renderPlot({
plotType(data(),
switch(input$dist,
norm = max((input$n)/7,1),
unif = max((input$n)/50,1),
lnorm =max((input$n)/8,1)
),
input$stDev,
input$n,
input$dist) })
# Generate a summary of the data
output$summary <- renderTable(
as.array(round(summary(data())[c(1,4,6)],5)),
colnames=FALSE
)
output$stDev <- renderTable(
as.array(sd(data())),
colnames=FALSE
)
# Generate an HTML table view of the data
output$table <- renderTable({
data.frame(x=data())
})
}
Part 2 -- ui.R
library(shiny)
library(shinythemes)
library(DT)
# Define UI for random distribution application
shinyUI(fluidPage(theme = shinytheme("slate"),
# Application title
headerPanel("Michael's Shiny App"),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the
# br() element to introduce extra vertical spacing
sidebarLayout(
sidebarPanel(
tags$head(tags$style("#plot{height:90vh !important;}")),
radioButtons("dist", "Distribution:",
c("Standard Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm")),
br(),
numericInput("stepSize", "Step", 1,
min = 1, max = NA, step = NA, width = NULL),
numericInput("maxN", "Max Sample Size", 50,
min = NA, max = NA, step = NA,width = NULL),
br(),
sliderInput("n", "Number of observations:", value = 0,
min = 1, max = 120000, step = 5000,
animate=animationOptions(interval=1200, loop=T)),
sliderInput("stDev","Standard Deviation:",value = 1,
min = 0,max = 3,step = 0.1,
animate=animationOptions(interval=1200, loop=T)),
p("Summary Statistics"),
tabPanel("Summary", tableOutput("summary")),
p("Sample St. Dev."),
tabPanel("Standard Dev", tableOutput("stDev")),
width =2),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", tableOutput("table"))
))
)))
Update Loosely, the solution that I ended up using is as follows: In the renderPlot() function, you need to save the ggplot object. Then as mentioned below, access the ymax value (still within renderPlot()),
ggplot_build(p1)$layout$panel_ranges[[1]]$y.range[[2]]
and then use that to update the y-axis. I used the following function to make the axis limit "nice".
roundUpNice <- function(x, nice=c(1,2,4,5,6,8,10)) {
if(length(x) != 1) stop("'x' must be of length 1")
10^floor(log10(x)) * nice[[which(x <= 10^floor(log10(x)) * nice)[[1]]]]
}
I have the following simplified example of a Shiny app using plotly graphic.
# Function, library, data
PlotResponseRate <- function(EntryData)
{
PlotData <- as.data.frame(apply(X = EntryData, MARGIN = 2,
function(x) round(length(which(!is.na(x)))/length(x)*100)))
colnames(PlotData) <- "TheData"
PlotData$TheLabel <- factor(str_wrap(colnames(EntryData), width = 30),
levels = unique(str_wrap(colnames(EntryData), width = 30)))
PlotData$TheLabel <- gsub(pattern = "\n", replacement = "<br>", PlotData$TheLabel)
Graphe <- ggplot(data = PlotData, aes(x = TheLabel, y = TheData)) +
geom_bar(stat = "identity", fill = "red", width = 0.8) +
coord_flip() +
labs(title = "Response rate")
}
library(stringr)
library(ggplot2)
library(plotly)
a <- c(1, 2, 2, 2, NA, 1, 2, 2, 1)
b <- c(2, 1, 2, NA, 2, NA, 1, NA, 1)
df <- data.frame(a, b)
colnames(df) <- c("This Is A Long Answer To A Long Question Label For The First Question",
"This Is A Long Answer To A Long Question Label For The Second Question")
# The Shiny app
Interface <-
{
fluidPage(
sliderInput(inputId = "Num",
label = "Choose the questions",
value = c(1:2), min = 1, max = 2, step = 1),
plotlyOutput("Myplot")
)
}
Serveur <- function(input, output)
{
output$Myplot <- renderPlotly({
Plot1 <- PlotResponseRate(EntryData = df[c(input$Num[1]:input$Num[2])])
ggplotly(Plot1)
})
}
shinyApp(ui = Interface, server = Serveur)
The main feature I want is modifying the structure of the plot. Therefore, I add this line of code in renderPlotly after the conversion in a plotly graphic.
ggplotly(Plot1)
Plot1$x$layout$margin$l <- 180
Or when I add this line, I have an error "no applicable method for 'ggplotly' applied to an object of class ”c('double', 'numeric')" and despite efforts I cannot debug. Any idea ?
I precise that it works fine in R command line :
Handle long labels in plotly
According to the comments above, the correct code is the following.
Serveur <- function(input, output)
{
output$Myplot <- renderPlotly({
Plot1 <- PlotResponseRate(EntryData = df[c(input$Num[1]:input$Num[2])])
Plot1 <- plotly_build(Plot1)
Plot1$x$layout$margin$l <- 180
Plot1 <- ggplotly(Plot1)
})
}