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'm fairly new to r and shiny, so bear with me - I have created a plot which shows the accumulated weekly distance covered by players in a sports team, where the user can select the player and the week range. Each player has an individual target distance they should meet and I want the data points in the plot to be green if they have met the target and red if they have not.
The data for weekly distance and target distance are located in different data frames (and they need to be) so I need that when a player is selected in selectInput(), the weekly distance is pulled from the first data frame and the target for the same player is pulled from the second data frame and used for conditional formatting.
EDIT - This is the gps2 data frame (though the PlayerName column lists the actual name which I've changed to initials here):
structure(list(Week = c(14, 14, 14, 14, 14, 15), PlayerName = c("CF",
"DR", "GB", "KB", "RA",
"AM"), Distance = c(3.8088, 2.1279, 2.4239, 1.3565,
4.5082, 4.4097), SprintDistance = c(291.473, 146.97, 11.071,
67.596, 252.787, 0), TopSpeed = c(22.6402, 21.3442, 20.5762,
21.6002, 20.5602, 18.6401)), row.names = c(NA, -6L), groups = structure(list(
Week = c(14, 15), .rows = structure(list(1:5, 6L), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = 1:2, class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"))
And the targets data frame:
structure(list(PlayerName = c("AM", "AB", "AMc",
"BC", "CD", "CM"), Distance = c(28.2753333333333,
34.867, NA, 31.633, 34.6122, 32.1405), SprintDistance = c(1355.2,
1074.85, NA, 2426.55, 2430.54, 2447.9), TopSpeed = c(32.61, 30.3,
NA, 36.82, 42, 33.44)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
I have been working on this for a few days now and can't wrap my head around how to do it or find a post which describes what I want to do. So far this is what I have:
# DEFINE UI ####
ui <- fluidPage(
titlePanel("GPS Monitoring Dashboard"),
sidebarLayout(
sidebarPanel(
#select player
selectInput(inputId = "name",
label = strong("Choose player"),
choices = unique(gps2$PlayerName),
selected = "AB"),
#select weeks
numericRangeInput(inputId = "week",
label = strong("Choose weeks"),
value = c(36, 37))),
# graphs and tables
mainPanel(
plotOutput(outputId = "TD"),
tableOutput(outputId = "TDsum"))
)
)
# DEFINE SERVER ####
server <- function(input, output) {
# Total Distance ----
# Data for distance plot
TD_plot <- reactive({
gps2 %>%
filter(PlayerName == input$name,
Week >= input$week [1] &
Week <= input$week [2],
) %>%
select(Distance)
})
# Build distance plot
output$TD <- renderPlot({
ggplot(TD_plot()) +
geom_point(aes(Week, Distance,
color = Distance > 5),
stat = "identity", size = 3) +
scale_color_manual(name = "Target met", values = set_names(c("green", "red"), c(TRUE, FALSE))) +
geom_line(aes(Week, Distance), size = 1) +
labs(title = "Weekly Total Distance", x = "Week", y = "Distance (km)")
})
# Data for distance table
TD_sum <- reactive({
gps2 %>%
filter(PlayerName == input$name,
Week >= input$week [1] &
Week <= input$week [2])%>%
select(Distance) %>%
pivot_wider(.,
names_from = Week,
values_from = Distance)
})
# Build distance table
output$TDsum <- renderTable(TD_sum())
}
shinyApp(ui = ui, server = server)
Right now the data points changes based on an arbitrary value (5) as I was trying to expand on that. I hope this explains in enough detail what I'm trying to do, thanks in advance for your help!
Here's a working example that may be helpful.
First, would left_join your actual distances by players, and their target distances. This will rename columns with "Actual" or "Target" as suffixes to keep them apart.
In geom_point you can use color = DistanceActual > DistanceTarget to have differential color based on whether a distance is greater or less than the target.
I simplified the other functions for demonstration.
library(shiny)
library(tidyverse)
full_data <- left_join(gps2, df_targets, by = "PlayerName", suffix = c("Actual", "Target"))
# DEFINE UI ####
ui <- fluidPage(
titlePanel("GPS Monitoring Dashboard"),
sidebarLayout(
sidebarPanel(
#select player
selectInput(inputId = "name",
label = strong("Choose player"),
choices = unique(full_data$PlayerName),
selected = "player1"),
#select weeks
numericRangeInput(inputId = "week",
label = strong("Choose weeks"),
value = c(36, 37))),
# graphs and tables
mainPanel(
plotOutput(outputId = "TD"),
tableOutput(outputId = "TDsum"))
)
)
# DEFINE SERVER ####
server <- function(input, output) {
# Filter by week and player name
TD_data <- reactive({
full_data %>%
filter(PlayerName == input$name,
Week >= input$week [1],
Week <= input$week [2])
})
# Build distance plot
output$TD <- renderPlot({
ggplot(TD_data()) +
geom_point(aes(Week, DistanceActual, color = DistanceActual > DistanceTarget), stat = "identity", size = 3) +
scale_color_manual(name = "Target met", values = set_names(c("green", "red"), c(TRUE, FALSE))) +
geom_line(aes(Week, DistanceActual), size = 1) +
labs(title = "Weekly Total Distance", x = "Week", y = "Distance (km)")
})
# Build distance table
output$TDsum <- renderTable(
TD_data() %>%
select(Week, DistanceActual)
)
}
shinyApp(ui = ui, server = server)
I would like to have a dynamic regression qqplot in Shiny that has a drop-down menu for x value(predictor variable). Youn can find my code below where I have defined an LM function that takes the response variable form first place and predictor variable from the second place when I run the model afterward. The problem is that I have to write exactly the variable names when I run the model (see below in the code), but I would like to have selectInput function which will deliver the variable name to the model. Link to my ShinyApp in order to have a more clear picture (last dashboard): https://schnappi.shinyapps.io/coronavirus/
The code is below:
Regression model function:
ggplot(fit$model, aes_string(
x = names(fit$model)[2],
y = names(fit$model)[1],
label = names(fit$model)[3]
)) +
geom_point() + labs(x = "Population density (km2)", y = "Cases per 1M") +
stat_smooth(method = "lm") +
labs(title = paste(
"R2 =",
signif(summary(fit)$r.squared, 2),
" Slope =",
signif(fit$coef[[2]], 2),
" P =",
signif(summary(fit)$coef[2, 4], 2)
))
}```
UI code:
tabItem(
tabName = "Dens",
titlePanel(h1(
"Population density and Covid-19 cases", align = "center"
)),
absolutePanel(
top = 130,
left = 250,
draggable = FALSE,
numericInput(
"num",
"x-axis cut off:",
max(join$Pop_density),
min = 1,
max = max(join$Pop_density)
)
),
absolutePanel(
top = 130,
left = 550,
draggable = FALSE,
numericInput(
"num2",
"y-axis cut off:",
max(join$TotCases_1M),
min = 1,
max = max(join$TotCases_1M)
)
),
absolutePanel(
top = 130,
left = 850,
draggable = FALSE,
selectInput("con", "Select continent:", choices =
join$Continent)
),
absolutePanel(
top = 130,
left = 1050,
draggable = FALSE,
selectInput("paraM", "Select parameter:", choices = colnames(join)) ## This is the part of the code that defines the predictor variable
),
absolutePanel(
top = 190,
left = 220,
width = 1700,
height = 500,
draggable = FALSE,
mainPanel(plotlyOutput("plotDens"))
)
)
This is part which RUN the regression model:
output$plotDens <- renderPlotly({
ggplotRegression(lm(
TotCases_1M ~ input$paraM, ## Here the LM model should recognize "input$paraM" as the column name but this does not work.
data = subset(join, Continent == input$con | input$con == "") %>%
filter(input$paraM > input$num &
TotCases_1M < input$num2)
))
})
THANK YOU.
You don't provide the full code of ggplotRegression, but I believe you want:
ggplotRegression(lm(
as.formula(paste0("TotCases_1M ~ ", input$paraM)),
......
I'm trying to create and render an interactive formattable table in a shiny app.
Here is a sample dataframe:
tcharts <- data.frame(pgm = c(1,2,3,4,5,6,7,8),
horse = c("Cigar", "Funny Cide", "Animal Kingdom", "Blame", "Zenyatta", "New Years Day", "Northern Dancer", "Beautiful Pleasure"),
groundloss = c(55,70,85,42,90,45,53,50),
distanceRun = c(5050,5070,5085,5045,5090,5045,5053,5050),
ttl = c(50,70,85,42,90,45,53,50),
fps = c(52.3,51.8,51.9,52.0,53.6,52.9,53.7,53.1),
finishTime = c(52.3,51.8,51.9,52.0,53.6,52.9,53.7,53.1),
finish = c(4,7,1,2,5,6,3,8),
BL = c(0,1,2,6,2,9,6,8),
rnum = c(1,1,1,1,1,1,1,1),
sixteenth = c(330,330,330,330,330,330,330)
)
Working version
This version of the code, when list() is empty (use all variables in dataframe) produces a table as expected.
library(shiny)
library(formattable)
inputPanel(
selectInput("rnum", label = "Race Number:",
choices = c(1,2,3,4,5,6,7,8,9), selected = 1),
sliderInput("poc", label = "Point of Call:",
min = 330, max = 5280, value = 330, step = 330)
)
cdat <- reactive({
tcharts %>% filter(rnum %in% input$rnum) %>%
filter(Sixteenth %in% input$poc)
})
renderFormattable({
formattable(cdat(),list(
))
})
Error Version:
With this version, I get an ERROR: object pgm not found
library(shiny)
library(formattable)
inputPanel(
selectInput("rnum", label = "Race Number:",
choices = c(1,2,3,4,5,6,7,8,9), selected = 1),
sliderInput("poc", label = "Point of Call:",
min = 330, max = 5280, value = 330, step = 330)
)
cdat <- reactive({
tcharts %>% filter(rnum %in% input$rnum) %>%
filter(Sixteenth %in% input$poc)
})
renderFormattable({
formattable(cdat(),list(
pgm,
Horse
))
})
The error message leads me to believe I'm not specifying the variable correctly, but I'm not sure how to do it. I'v looked at several formattable / shiny SO questions and responses, but have not come up with the correct sytax.
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]]]]
}