I am very new to Shiny, and somewhat new to ggplot. I created a plot which looks fine in RStudio, but when using it within renderPlot, the top of the plot gets cutoff. I tried changing the size (adding 'height = X' to the renderPlot function), and that works, but the fluidRows then end up rendering on top of each other. Is there a way to not cut off the top of the plot? Either by sizing the render, or changing the ggplot somehow?
I have this UI and server:
shinyUI(fluidPage(
# Application title
titlePanel("IGP Risk Analysis"),
sidebarLayout(
sidebarPanel(
uiOutput("portfolio"),
uiOutput("portDate"),
uiOutput("portMetrics"),
uiOutput("portFields"),
uiOutput("riskButton"),
width = 2),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Summary",
fluidRow(plotOutput("plots")),
fluidRow(dataTableOutput("summary"))),
tabPanel("Plots"),
tabPanel("Tables", tableOutput("tables"))
)
)
)
))
shinyServer(function(input, output) {
output$portfolio <- renderUI ({
temp <- setNames(sendRequest(theURL, myUN, myPW, action = "GetPortfolios"), "Available Portfolios")
temp <- temp[sapply(temp, function (x) !grepl("AAA|ZZZ|Test|test",x)),]
selectInput("portfolio", "Underlying Portfolio:", choices = c("Pick One",temp))
})
output$portDate <- renderUI ({
if (is.null(input$portfolio) || input$portfolio == "Pick One") return() else {
portfolioDates <- setNames(sendRequest(theURL, myUN, myPW, action = "GetPortfolioDates",
portfolioName = input$portfolio, portfolioCurrency = theCurrency), "Available Dates")
selectInput("portDate", "Portfolio Date",
choices = c("Pick One", portfolioDates),
selected = "Pick One") }
})
output$portMetrics <- renderUI ({
if (is.null(input$portDate) || input$portDate == "Pick One") return() else {
portfolioMetrics <- names(theRiskMetrics)
selectInput("portMetrics", "Portfolio Metrics",
choices = portfolioMetrics,
multiple = TRUE) }
})
output$portFields <- renderUI ({
if (is.null(input$portDate) || input$portDate == "Pick One") return() else {
portfolioFields <- setNames(sendRequest(theURL, myUN, myPW, action = "GetGroupingFields",
portfolioName = input$portfolio, portfolioCurrency = theCurrency, portfolioDate = input$portDate), "Available Fields")
selectInput("portFields", "Portfolio Fields",
choices = portfolioFields,
multiple = TRUE) }
})
output$riskButton <- renderUI ({
if (is.null(input$portFields)) return() else actionButton("riskButton", "Get the Risk")
})
output$summary <- renderDataTable({
if (is.null(input$portFields)) return(data.frame("Choose Portfolio..." = NA, check.names = FALSE)) else {
input$riskButton
dataset <<- sendRequest(theURL, myUN, myPW, action = "GetPortfolioSummary",
portfolioName = input$portfolio, portfolioCurrency = theCurrency, portfolioDate = input$portDate)
dataset <<- dataset[ grepl("Risk Decomp|Contribution", dataset$ID), ]
dataset$val = paste0(round(dataset$val, 4), "%")
dataset #} else return()
}
})
output$plots <- renderPlot({
if (is.null(input$portFields)) return("") else {
input$riskButton
riskDecomp <- dataset[grepl("Risk Decomp",dataset$ID),]
riskDecomp$ID <- gsub(c("Risk Decomp "), "", riskDecomp$ID)
thePlot <- waterfall(categories = riskDecomp$ID, values = riskDecomp$val, labelType = "percent", igpify = TRUE)
print(thePlot)
}
})
})
My waterfall() function looks like this:
waterfall <- function(theTitle = "Risk Decomposition", categories, values, has.total = FALSE,
offset = .475, labelType = c("decimal", "percent"), igpify = FALSE) {
library(scales)
library(grid)
library(ggplot2)
library(dplyr)
theData <- data.frame("category" = as.character(categories), "value" = as.numeric(values))
if (labelType == "percent") theData$value = theData$value/100
if (!has.total) theData <- theData %>% rbind(.,list("Total", sum(.$val)))
theData$sign <- ifelse(theData$val >= 0, "pos","neg")
theData <- data.frame(category = factor(theData$category, levels = unique(theData$category)),
value = round(theData$value,4),
sign = factor(theData$sign, levels = unique(theData$sign)))
theData$id <- seq_along(theData$value)
theData$end <- cumsum(theData$value)
theData$end <- c(head(theData$end, -1), 0)
theData$start <- c(0, head(theData$end, -1))
theData$labels <- paste0(theData$value*100, "%")
theData$labellocs <- pmax(theData$end,theData$start)
theGG <- ggplot(theData, aes(category, fill = sign, color = sign)) +
geom_rect(aes(x = category, xmin = id - offset, xmax = id + offset, ymin = end, ymax = start)) +
scale_x_discrete("", breaks = levels(theData$category), labels = gsub("\\s", "\n", trimSpaces(levels(theData$category)))) +
geom_text(data = theData, aes(id, labellocs, label = labels), vjust = -.5, size = 5, fontface = 4)
if(igpify) {
g <- rasterGrob(blues9, width=unit(1,"npc"), height = unit(1,"npc"), interpolate = TRUE)
thePP <- theGG + annotation_custom(g) +
guides(fill = FALSE, color=FALSE) +
ggtitle(theTitle) +
theme(plot.title = element_text(vjust=1.5, face="bold", size = 20),
axis.title.x = element_blank(), axis.title.y = element_blank()) +
scale_fill_manual(values=c("red", "forestgreen")) +
scale_color_manual(values=c("black", "black")) +
scale_y_continuous(labels = percent)
n1 <- length(thePP$layers)
thePP$layers <- c(thePP$layers[[n1]],thePP$layers[-n1])
return(thePP)
} else return(theGG)
}
This all produces the following plot, which has just a little bit of the top missing:
Note it is just the top of the text, (the 77% and 100%). Not cutoff is below:
