我很有趣地制作一个带有条形图输出和图像作为其轴的报告，就像这个项目一样： Image as x axis
我已经成功地在Shiny中实现了它，但是当在Shiny-flexdashboard中实现它时，会出现如下错误：
Warning: Error in pngfun: invalid 'width' or 'height'
125: pngfun
124: startPNG
123: drawPlot
109: <reactive:plotObj>
93: drawReactive
80: origRenderFunc
79: output$bar4
3: <Anonymous>
1: rmarkdown::run
显示了ggplot的条形图，但未显示文本和图像的x轴。
你们能告诉我会发生什么吗？我该怎么办？谢谢
这是我的代码：
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
```
```{r, echo = FALSE}
## ##########
## INDEPENDENT CODE TO BE SOURCED:
## ##########
# user-level interface to the element grob
my_axis = function(img) {
structure(
list(img=img),
class = c("element_custom","element_blank", "element") # inheritance test workaround
)
}
# returns a gTree with two children: the text label, and a rasterGrob below
element_grob.element_custom <- function(element, x,...) {
stopifnot(length(x) == length(element$img))
tag <- names(element$img)
# add vertical padding to leave space
g1 <- textGrob(paste0(tag, "\n\n\n\n\n"), x=x, vjust=0.6)
g2 <- mapply(rasterGrob, x=x, image=element$img[tag],
MoreArgs=list(vjust=1, interpolate=FALSE),
SIMPLIFY=FALSE)
gTree(children=do.call(gList, c(g2, list(g1))), cl="custom_axis")
}
# gTrees don't know their size and ggplot would squash it, so give it room
grobHeight.custom_axis = heightDetails.custom_axis = function(x, ...)
unit(6, "lines")
## ##########
## END
## ##########
```
```{r, echo = FALSE}
image.file <- list.files(path = "C:/Users/Documents/Project/",
pattern = ".png",
all.files = TRUE, full.names = TRUE, no.. = TRUE)
image.file <- sub("C:/Users/Documents/Project/","",
sub(".png","",image.file))
```
```{r, echo=FALSE}
server <- function(input, output) {
output$text <- renderText("Output")
output$bar <- renderPlot({
airline.cr <- airline
if (input$fis.year != 2018) {
airline.cr <- airline.cr[airline.cr$fis_year == input$fis.year,]
}
if (input$fis.quarter != "Q1") {
airline.cr <- airline.cr[airline.cr$fis_quarter_name == input$fis.quarter,]
}
if (input$region != "All") {
airline.cr <- airline.cr[airline.cr$region == input$region,]
}
if (input$fare.type.desc != "All") {
airline.cr <- airline.cr[airline.cr$fare_type_desc == input$fare.type.desc,]
}
airline.ticket <- as.data.frame(tapply(X = airline.cr$ticket_id,
INDEX = list(airline.cr$airline_desc, airline.cr$fis_year), FUN = length),
stringsAsFactors = FALSE)
airline.gross <- as.data.frame(tapply(X = airline.cr$gross,
INDEX = list(airline.cr$airline_desc, airline.cr$fis_year), FUN = sum),
stringsAsFactors = FALSE)
airline.gross <- airline.gross %>%
mutate(airline = rownames(airline.gross)) %>%
select(airline, everything())
rownames(airline.gross) <- NULL
airline.ticket <- airline.ticket %>%
mutate(airline = rownames(airline.ticket)) %>%
select(airline, everything())
rownames(airline.ticket) <- NULL
airline.sum <- left_join(airline.ticket, airline.gross, "airline")
colnames(airline.sum) <- c("airline_desc", "ticket", "gross")
airline.sum$atp <- airline.sum$gross / airline.sum$ticket
airline.top <- airline.sum[with(airline.sum, order(-ticket, -gross)), ]
airline.top[-c(1)] <- sapply(airline.top[-c(1)], as.numeric)
airline.top$airline_icao <- airline$airline_icao[match(airline.top$airline_desc,
airline$airline_desc)]
airline.top.10 <- airline.top[1:10,]
maxis <- max(airline.top.10$atp) + 1500
others <- airline.top[-(1:10),]
sum.other <- colSums(others[,2:3], na.rm = TRUE)
mean.other <- mean(others[,4], na.rm = TRUE)
airline.top.10 <- rbind(airline.top.10, c("Others",
sum.other, mean.other))
airline.top.10[-c(1,5)] <- sapply(airline.top.10[-c(1,5)], as.numeric)
airline.total <- colSums(airline.top.10[,2:3], na.rm = TRUE)
airline.mean <- round(mean(airline.top.10[,4], na.rm = TRUE), 2)
airline.top.10 <- rbind(airline.top.10, c("Grand Total", airline.total, airline.mean))
rownames(airline.top.10) <- NULL
airline.top.10[,2:4] <- sapply(airline.top.10[,2:4], as.numeric)
airline.top.10[,2:3] <- round(airline.top.10[,2:3], 0)
airline.top.10[,4] <- round(airline.top.10[,4], 2)
## load the images from filenames
npoints <- length(airline.top.10$airline_icao)
pics <- vector(mode="list", length=npoints)
image.file <- image.file[match(airline.top.10$airline_icao,image.file)]
image.file <- paste0("C:/Users/Documents/Project/",
image.file, ".png")
for(i in 1:npoints) {
pics[[i]] <- EBImage::readImage(image.file[i])
}
names(pics) <- str_wrap(airline.top.10$airline_desc, width = 10)
## create a dummy dataset
y <- as.numeric(airline.top.10[,4])
x <- names(pics)
dat <- data.frame(x=factor(x, levels=names(pics)), y=y)
## create the graph, as per normal now with @baptiste's adapted grob processing
## NB: #85bb65 is the color of money in the USA apparently.
gg <- ggplot(dat, aes(x = x, y = y, group=1))
gg <- gg + geom_bar(fill="#367FB6", stat="identity")
gg <- gg + scale_x_discrete(expand = c(0,0),drop=TRUE)
gg <- gg + theme_minimal()
gg <- gg + geom_text(aes(label = paste0("$", formatC(y, format="f", digits = 2, big.mark=","))), vjust = -0.2,
size = 6)
gg <- gg + scale_fill_discrete(guide=FALSE)
gg <- gg + theme(plot.background = element_rect(fill="#F5F5F5",
linetype = 0),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.background = element_blank())
gg <- gg + scale_y_continuous(labels=function(y) paste0("$", formatC(y, format="f", digits = 2, big.mark=",")),
expand = c(0,0), limits = c(0, maxis))
gg <- gg + labs(x="", y="")
gg <- gg + theme(axis.text.x = my_axis(pics), ## that's much better
axis.text.y = element_text(size=10),
axis.title.x = element_blank(),
axis.ticks.length = unit(.85, "cm"),
axis.line.x = element_line(color="black"),
axis.line.y = element_line(color="black"),
plot.margin = unit(c(0,1,1,1), "cm"))
gg
})
}
ui <- fluidPage(
titlePanel(title = "Result"),
wellPanel(fluidRow(
column(
selectInput("fis.year", "Fis Year:",
unique(as.character(airline$fis_year[order(-airline$fis_year)]))), width = 4),
column(
selectInput("fis.quarter", "Fis Quarter:",
unique(as.character(airline$fis_quarter_name[order(airline$fis_quarter_name)]))), width = 4),
column(
selectInput("region", "Region:",
c("All",
unique(as.character(airline$region[order(airline$region)])))), width = 4))),
textOutput("text"),
tags$head(tags$style("#text{color: blue;
font-size: 20px;
font-style: bold;
}"
)
),
wellPanel(fluidRow(
column(
selectInput("fare.type.desc", "Fare Type Desc:",
c("All",
unique(as.character(airline$fare_type_desc[order(airline$fare_type_desc)])))),
offset = 4, width = 4)),
fluidRow(column(width = 12, tableOutput("table"))),
br(),
fluidRow(column(width = 12, plotOutput("bar"))),
style = "padding: 20px;"),
)
shinyApp(server = server, ui = ui)
```