Related
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 am attempting to build my first shiny app. I need to include multiple graphics (about 50) and I am having problems selecting them based on their label from the dropdown control. I am able to show the first one but I don't know how to display the other ones on the main panel. I currently have 3 on the dropdown control but only the first one works. How do I make lambda2, lambda3 and so on show on the main panel? I also would like to dynamically plot the number of years selected on the slider. Here is the code:
library(shiny)
library(tidyverse)
library(shinythemes)
library(plotly)
library(scales)
library(shinyWidgets)
library(shinydashboard)
# Define input choices
type <- c("lambda","lambda2","lambda3")
table <- structure(list(year = 1991:2010,
lambda = c(0.68854, 0.75545,
1.63359, 1.22282, 1.70744, 1.09692, 0.51159, 1.3904, 1.09132,
0.59846, 0.43055, 0.80135, 0.69027, 0.65646, 0.95485, 1.04818,
0.67859, 1.00461, 1.16665, 1.28203)), row.names = c(NA, -20L), class = "data.frame")
# Define UI
ui <- fluidPage(
navbarPage("Fish",
windowTitle = "Fish Graphs",
sidebarPanel(
h3("Select Graphics to Visualize"),
selectInput(inputId = "graphtype",
label = "Graphic",
choices = type,
selected = "lambda"),
sliderInput(inputId = "Yearslider",
label="Years to plot",
sep="",
min=1991,
max=2011,
value=c(1991,2011))),
mainPanel(plotOutput("plot"))))
####################################
server<- function (input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
output$plot <- renderPlot({
xlabels <- 1991:2011
ggplot(table,aes(year,lamda)) + geom_line(size=1.5,colour="blue") + geom_point(colour="orange",size=4) +
scale_x_continuous("",breaks = xlabels) +
theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
labs(x="",y=expression("Lambda ("~lambda *")"),title="Population growth rate - fraction per year- \nof Delta Smelt")
if (input$lambda2 == TRUE) {
xlabels <- 1991:2011
ggplot(table,aes(year,lamda)) + geom_line(size=1.5,colour="green") + geom_point(colour="orange",size=4) +
scale_x_continuous("",breaks = xlabels) +
theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
labs(x="",y=expression("Lambda ("~lambda *")"),title="Population growth rate - fraction per year- \nof Delta Smelt")
}
if (input$lambda3 == TRUE) {
xlabels <- 1991:2011
ggplot(table,aes(year,lamda)) + geom_line(size=1.5,colour="red") + geom_point(colour="orange",size=4) +
scale_x_continuous("",breaks = xlabels) +
theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
labs(x="",y=expression("Lambda ("~lambda *")"),title="Population growth rate - fraction per year- \nof Delta Smelt")
}
})
}
shinyApp(ui = ui, server = server)
The main issue with your code is that the element of the input list containing the lambda choice is called graphtype. Using input$lambda2 returns NULL. Do e.g. input$graphtype == "lambda2" instead. Also, if you want to switch between different choices you have to use an if-else with a branch for "each" choice or perhaps use switch as I do below. To make your plot react to the year slider I use an reactive which filters the data for years in the selected range. Also, instead of duplicating the ggplot code I would suggest to move it in a separate function outside of the server which also makes it easier to debug the code.
plot_fun <- function(.data, point.color = "black") {
breaks <- unique(.data$year)
ggplot(.data, aes(year, lambda)) +
geom_line(size = 1.5, colour = "blue") +
geom_point(colour = point.color, size = 4) +
scale_x_continuous("", breaks = breaks) +
theme(axis.text.x = element_text(angle = 45, vjust = 0.5)) +
labs(x = "", y = expression("Lambda (" ~ lambda * ")"), title = "Population growth rate - fraction per year- \nof Delta Smelt")
}
server <- function(input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
plot_data <- reactive({
table[table$year >= input$Yearslider[1] & table$year <= input$Yearslider[2], ]
})
output$plot <- renderPlot({
switch(input$graphtype,
"lambda" = plot_fun(plot_data(), point.color = "orange"),
"lambda2" = plot_fun(plot_data(), point.color = "purple"),
"lambda3" = plot_fun(plot_data(), point.color = "green")
)
})
}
shinyApp(ui = ui, server = server)
I'm trying to include a stacked bar chart in shiny that depends on a select input. It works fine outside of shiny but in shiny it is not displaying multiple bars.
Code:
library(shiny)
library(ggplot2)
# Define UI ----
ui <- fluidPage(
# Application title
titlePanel("Group fairness analysis"),
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput("group", "Group:",
c("Age" = "age",
"Gender" = "gender",
"Region" = "region",
"Ethnicity"="ethnicity"))
),
# Show a plot of the generated distribution
mainPanel(
h3("Accuracy bar chart"),
plotOutput("accPlot")
)
)
)
# Define server logic ----
server <- function(input, output) {
output$accPlot <- renderPlot({
g2 <- ggplot(df %>% count(get(input$group),correct) , aes(x=c(input$group),y=n,fill=as.factor(correct))) +
geom_bar(stat="identity",position=position_fill())+
scale_y_continuous(labels = scales::percent) +
geom_text(aes(label = paste0((n/nrow(df))*100,"%")), position = position_fill(vjust = 0.5), size = 5)+
theme_bw()+
ylab("")+
coord_flip()
g2
})
}
shinyApp(ui, server)
Sample data
# data -----------------------------------------------------------
n<-20 #number of users
threshold <- 60 #threshold in risk score for referral to YS
df <- data.frame(age = rep(0,n),
gender = rep(0,n),
ethnicity = rep(0,n),
region = rep(0,n),
score = rep(0,n),
referred = rep(0,n),
target = rep(0,n))
df$age <- as.factor(sample(c(15,16,17),size=n,replace=TRUE))
df$gender <- as.factor(sample(c('M','F'),size=n,replace=TRUE))
df$ethnicity<- as.factor(sample(c('European','Maori','Pacific','other'),size=n,replace=TRUE))
df$region<-as.factor(sample(c('North','Mid','South'),size=n,replace=TRUE))
df$score<-runif(n,min=0,max=100)
df$target<-sample(c(0,1),size=n,replace = TRUE)
df[which(df$score>=threshold),"referred"]<-1
df$colour<-rep(0,n)
df[which(df$referred==1 & df$target==1),"colour"]<-1
df[which(df$referred==1 & df$target==0),"colour"]<-2
df[which(df$referred==0 & df$target==1),"colour"]<-3
df[which(df$referred==0 & df$target==0),"colour"]<-4
df$correct<-rep(0,n)
df[which(df$referred==0 & df$target==0),"correct"]<-1
df[which(df$referred==1 & df$target==1),"correct"]<-1
df[which(df$referred==0 & df$target==1),"correct"]<-0
df[which(df$referred==1 & df$target==0),"correct"]<-0
It should look like
Your input$group from selectInput is a string, not a variable symbol. You can convert it to a symbol for your ggplot with rlang::sym and evaluate with !!.
In addition, your aesthetic for ggplot can use aes_string and refer to your column names as strings.
And would convert your correct column to a factor separately.
df$correct <- as.factor(df$correct)
...
g2 <- ggplot(df %>% count(!!rlang::sym(input$group), correct), aes_string(x=c(input$group), y="n", fill="correct")) +
...
I am new to shiny package,I want to create an app for my Data which choose 3 specific variables among 4 variables and create the plot according to them.My data is:
month <-
as.factor(c("sep","oct","nov","nov","oct","oct","oct","nov","sep","oct"))
cost <- as.numeric(sample(1000:10000,10,replace=F))
Type <- as.factor(c("T1","T1","T3","T1","T2","T3","T1","T3","T2","T2"))
class <- as.factor(c("R","Q","R","R","R","Q","Q","Q","R","R"))
sex <- as.factor(c("M","F","F","F","M","F","F","M","M","F"))
f <- data.frame(month , cost , Type , class , sex)
f
f1 <- as.data.frame(aggregate(f[c("cost")],
by=f[c("month","Type","class","sex")],
FUN="mean"))
f1$percent <- f1$cost/sum(f1$cost)
f1
As you can see my data has 4 factor variable,I want the user to choose 3 of them and plot according to the 3 chosen variables.It is important that which variable is chosen for x_axis and which is chosen for fill parameter and which one for facet_grid's argument.
what I want to do in an interactive way:
library(ggplot2)
ggplot(f1 , aes(x=month ))+
geom_bar(stat="identity",aes(y=percent , fill=Type) ,colour="black",
position = position_dodge())+
scale_y_continuous(labels = scales::percent)+
labs(x="month" , y="cost percentage")+
facet_grid(sex ~ class)+
theme(strip.text.x = element_text(size=8),
strip.text.y = element_text(size=5, face="bold"),
strip.background = element_rect(colour="red", fill="#CCCCFF"))+
labs(x="month" , y="percentage" )
What I have tried:
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Report"),
sidebarLayout(
sidebarPanel(
selectInput("variable1", "Variable1:",
choices = c("month","Type","class","sex")),
selectInput("variable2", "Variable2:",
choices = c("month","Type","class","sex")),
selectInput("variable3", "Variable3:",
choices = c("month","Type","class","sex")),
),
mainPanel(
plotOutput("disPlot")
)
)
)
server <- function(input, output) {
var1 <- reactive({
switch (input$variable1,
"month"=month,
"Type"=Type,
"class"=class,
"sex"=sex
)
})
var2 <- reactive({
switch (input$variable2,
"month"=month,
"Type"=Type,
"class"=class,
"sex"=sex
)
})
var3 <- reactive({
switch (input$variable3,
"month"=month,
"Type"=Type,
"class"=class,
"sex"=sex
)
})
output$disPlot <- renderPlot({
variable1 <- var1()
variable2 <- var2()
variable3 <- var3()
ggplot(f1 , aes(x=variable1 ))+
geom_bar(stat="identity",aes(y=percent , fill=variable2)
,colour="black", position = position_dodge())+
scale_y_continuous(labels = scales::percent)+
labs(x="variable1" , y="cost percentage")+
facet_grid(. ~ variable3)+
theme(strip.text.x = element_text(size=8),
strip.text.y = element_text(size=5, face="bold"),
strip.background = element_rect(colour="red", fill="#CCCCFF"))+
labs(x="variable1" , y="percentage" )
})
}
shinyApp(ui,server)
My first problem is : how can I delete the selected variable1 from inputselect() of variable2,that any of the variables has been chosen for variable1 does not appear in selectinput() of variable2 and any of them that has been chosen for variable2 does not appear in the list of selectinput() for variable3.In other words,the 3 variables should not be equal at all.They have to be different.
The second one:I am a little confused about the usage of reactive() function and if I used it correctly,what is the correct form of ui and server for my purpose?
Any help or solution would be greatly appreciated.If any more information about my question is needed,I'll be answering.
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]]]]
}