3
我對閃亮很新，對ggplot有點新鮮。我創建了一個在RStudio中看起來很好的情節，但在renderPlot中使用它時，情節的頂部會被截斷。我試着改變大小（在renderPlot函數中添加'height = X'），並且工作正常，但fluidRows最終將渲染放在彼此之上。有沒有辦法不切斷劇情的頂部？要麼通過調整渲染大小，要麼改變ggplot？ggplot的閃亮切割頂部
我有這樣的UI和服務器：
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)
}
})
})
我的瀑布（）函數如下：
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)
}
這一切都將產生以下情節，它擁有頂級的只是一點點丟失：
注意它的只是頂部文本，（77％和100％）。不截止低於：
看起來不切斷。你可以發佈uncuttoff圖的樣子嗎？ –