问题描述
我正在尝试将闪亮的交互式工作表合并到我现有的flexdashboard中。
这是使用dput（）函数创建的数据结构
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter,lag
#> The following objects are masked from 'package:base':
#>
#> intersect,setdiff,setequal,union
library(tibble)
dat <- tibble::tribble(
~group,~var1,~var2,"A","foo",NA,"bar","B","C","D","E","bar"
)
expected_output <- tibble::tribble(
~group,"bar"
)
expected_output
#> # A tibble: 5 x 3
#> group var1 var2
#> <chr> <chr> <chr>
#> 1 A foo bar
#> 2 B foo <NA>
#> 3 C foo bar
#> 4 D <NA> bar
#> 5 E foo bar
数据是关于8个不同的离线导航应用的评论中的常用词。
我使用以下代码创建了闪亮的小型应用程序（有效）
structure(list(words1 = structure(c(1L,10L,19L,20L,7L,8L,3L,15L,2L,9L,11L,14L,12L,4L,5L,6L,16L,18L,17L,13L
),.Label = c("app","can","connect","dont","free","get","good","great","like","map","navig","need","one","phone","purchas","road","rout","updat","use","work"),class = "factor"),pct1 = c(70.8,40.4,26.4,25.6,22.7,18.4,13.7,11.2,10.8,10.5,10.1,9.4,9,8.3,8.3),words2 = structure(c(1L,13L
),"download","just","Now","time","tom","tomtom","work","year"),pct2 = c(69.1,32.9,27.3,25,21.4,20,16.6,16.2,14.7,13.1,13,12.7,12.2,11.8,10.4,10.3,10.2
),words3 = structure(c(1L,13L,7L),"copilot","new","version",pct3 = c(57.9,45.7,30.1,21.7,19.5,19,18.5,18,17.1,16.7,14.9,14.6,14,12.5,11.5,10.9,10.6,10.5),words4 = structure(c(1L,17L),"doesnt","even","find","navmii","tri",pct4 = c(56.1,41.2,36.5,32.5,22.6,20.9,18.9,15.8,14.1,12.9,12.4,11.7,11.3,11.1,10.1),words5 = structure(c(1L,"best","gps","love","nice","offlin","sygic",pct5 = c(39.7,23.5,20.5,19.3,13.8,10.2,8.6,7.7,6.7,6.1,6,5.9,5.5,5.1,5,4.9),words6 = structure(c(1L,12L),"help","thank","travel",pct6 = c(37.4,23,20.7,13.3,13.2,9.1,6.5,5.6,5.4,4.9,4.8,4.6),words7 = structure(c(1L,2L),"drive","googl","traffic","waze",pct7 = c(57.9,32.4,24.6,20.3,15.9,15.2,12.8,12.3,10,9.9,9.7,9.1),words8 = structure(c(1L,3L),"better",pct8 = c(44.6,39.3,25.2,22.3,15.4,12.6,8.8,8.7,7.3,7.1,6.8,6.6,6.4,5.5)),class = "data.frame",row.names = c(NA,-20L))
现在我正在尝试使用以下代码，并使用以下代码将其合并到我现有的flexdashboard中，但是我无法使其正常工作。
library(shiny)
library(ggplot2)
library(plyr)
library(dplyr)
# Data Preparation Steps
data <- read.csv("word_frequency_v2.csv")
my_colors2 <- c("#F29E4C","#EFEA5A","#6930C3","#0077B6","#F94144","#16DB93","#621708","#DA627D")
ui <- fluidPage(
# App title ----
titlePanel("Shiny - First Interactive Visualization Example"),# Sidebar layout with input and output deFinitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
selectInput(inputId="app1",label="App1",choices = c("Genius"="Genius","TomTom"="TomTom","copilot"="copilot","Navmii"="Navmii","sygic"="sygic","Mapsme"="Mapsme","Waze"="Waze","Here"="Here"),selected = "Genius",multiple = F),selectInput(inputId="app2",label="App2",selected = "TomTom",multiple = F)
),# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot1"),plotOutput(outputId = "distPlot2")
)
)
)
# Define server logic required to draw a histogram ----
server <- function(input,output){
# 1. It is "reactive" and therefore should be automatically
# re-executed when inputs (input$bins) change
# 2. Its output type is a plot
output$distPlot1 <- renderPlot({
p2 <- data %>% ggplot()
if(input$app1 == "Genius"){
p2 <- p2 + geom_col(aes(x=reorder(words1,-pct1),y=pct1),fill = my_colors2[1]) +
geom_text(aes(x=reorder(words1,y=pct1,label =pct1),position = position_dodge(0.9),size = 3.5,fontface = "bold",vjust = -1)
}else if(input$app1 == "TomTom"){
p2 <- p2 + geom_col(aes(x=reorder(words2,-pct2),y=pct2),fill = my_colors2[2]) +
geom_text(aes(x=reorder(words2,y=pct2,label =pct2),vjust = -1)
}else if(input$app1 == "copilot"){
p2 <- p2 + geom_col(aes(x=reorder(words3,-pct3),y=pct3),fill = my_colors2[3]) +
geom_text(aes(x=reorder(words3,y=pct3,label =pct3),vjust = -1)
}else if(input$app1 == "Navmii"){
p2 <- p2 + geom_col(aes(x=reorder(words4,-pct4),y=pct4),fill = my_colors2[4]) +
geom_text(aes(x=reorder(words4,y=pct4,label =pct4),vjust = -1)
}else if(input$app1 == "sygic"){
p2 <- p2 + geom_col(aes(x=reorder(words5,-pct5),y=pct5),fill = my_colors2[5]) +
geom_text(aes(x=reorder(words5,y=pct5,label =pct5),vjust = -1)
}else if(input$app1 == "Mapsme"){
p2 <- p2 + geom_col(aes(x=reorder(words6,-pct6),y=pct6),fill = my_colors2[6]) +
geom_text(aes(x=reorder(words6,y=pct6,labe6 =pct6),vjust = -1)
}else if(input$app1 == "Waze"){
p2 <- p2 + geom_col(aes(x=reorder(words7,-pct7),y=pct7),fill = my_colors2[7]) +
geom_text(aes(x=reorder(words7,y=pct7,label =pct7),vjust = -1)
}else if(input$app1 == "Here"){
p2 <- p2 + geom_col(aes(x=reorder(words8,-pct8),y=pct8),fill = my_colors2[8]) +
geom_text(aes(x=reorder(words8,y=pct8,label =pct8),vjust = -1)
}
p2 <- p2 + theme_bw()+
scale_y_continuous(limits = c(0,100),expand = c(0,0)) +
theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank(),panel.background = element_blank(),axis.line = element_line(colour = "black"),plot.title = element_text(hjust = 0.5),axis.text.x = element_text(angle = 90,vjust = 0.5,hjust=1,face = "bold")) +
labs(x="Words",y="Share of words in reviews",title=paste("Frequency of words -",input$app1,sep = " "))
p2
})
output$distPlot2 <- renderPlot({
p2 <- data %>% ggplot()
if(input$app2 == "Genius"){
p2 <- p2 + geom_col(aes(x=reorder(words1,vjust = -1)
}else if(input$app2 == "TomTom"){
p2 <- p2 + geom_col(aes(x=reorder(words2,vjust = -1)
}else if(input$app2 == "copilot"){
p2 <- p2 + geom_col(aes(x=reorder(words3,vjust = -1)
}else if(input$app2 == "Navmii"){
p2 <- p2 + geom_col(aes(x=reorder(words4,vjust = -1)
}else if(input$app2 == "sygic"){
p2 <- p2 + geom_col(aes(x=reorder(words5,vjust = -1)
}else if(input$app2 == "Mapsme"){
p2 <- p2 + geom_col(aes(x=reorder(words6,label =pct6),vjust = -1)
}else if(input$app2 == "Waze"){
p2 <- p2 + geom_col(aes(x=reorder(words7,vjust = -1)
}else if(input$app2 == "Here"){
p2 <- p2 + geom_col(aes(x=reorder(words8,input$app2,sep = " "))
p2
})
}
shinyApp(ui = ui,server = server)
如果我运行rmarkdown：render（“ filename.Rmd”），则会收到以下错误：未提供html_dependency的路径
如果我运行rmarkdown：run（“ filename.Rmd”），我得到的应用程序将不会显示任何过滤器或图表。我想尽可能地运行render函数，因为我以前用过以前的flexdashboard来做到这一点，如果将仪表板导出到.html文件，一切看起来都会更好。
解决方法
诀窍是仅使用{r}而忽略include = FALSE。另外，我已经更正了列和侧栏的定义。
---
title: "Shiny in flexdashboard"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup,include=FALSE}
library(dplyr)
library(ggplot2)
library(shiny)
```
```{r}
#Import data
data <- read.csv("word_frequency_v2.csv")
my_colors2 <- c("#F29E4C","#EFEA5A","#6930C3","#0077B6","#F94144","#16DB93","#621708","#DA627D")
```
# Word frequency
Column {.sidebar}
-----------------------------------------------------------------------
Embedding a Shiny Module
```{r}
selectInput(inputId="app1",label="App1",choices = c("Genius"="Genius","TomTom"="TomTom","CoPilot"="CoPilot","Navmii"="Navmii","Sygic"="Sygic","Mapsme"="Mapsme","Waze"="Waze","Here"="Here"),selected = "Genius",multiple = F)
selectInput(inputId="app2",label="App2",selected = "TomTom",multiple = F)
```
Column
-----------------------------------------------------------------------
```{r}
renderPlot({
p2 <- data %>% ggplot()
if(input$app1 == "Genius"){
p2 <- p2 + geom_col(aes(x=reorder(words1,-pct1),y=pct1),fill = my_colors2[1]) +
geom_text(aes(x=reorder(words1,y=pct1,label =pct1),position = position_dodge(0.9),size = 3.5,fontface = "bold",vjust = -1)
}else if(input$app1 == "TomTom"){
p2 <- p2 + geom_col(aes(x=reorder(words2,-pct2),y=pct2),fill = my_colors2[2]) +
geom_text(aes(x=reorder(words2,y=pct2,label =pct2),vjust = -1)
}else if(input$app1 == "CoPilot"){
p2 <- p2 + geom_col(aes(x=reorder(words3,-pct3),y=pct3),fill = my_colors2[3]) +
geom_text(aes(x=reorder(words3,y=pct3,label =pct3),vjust = -1)
}else if(input$app1 == "Navmii"){
p2 <- p2 + geom_col(aes(x=reorder(words4,-pct4),y=pct4),fill = my_colors2[4]) +
geom_text(aes(x=reorder(words4,y=pct4,label =pct4),vjust = -1)
}else if(input$app1 == "Sygic"){
p2 <- p2 + geom_col(aes(x=reorder(words5,-pct5),y=pct5),fill = my_colors2[5]) +
geom_text(aes(x=reorder(words5,y=pct5,label =pct5),vjust = -1)
}else if(input$app1 == "Mapsme"){
p2 <- p2 + geom_col(aes(x=reorder(words6,-pct6),y=pct6),fill = my_colors2[6]) +
geom_text(aes(x=reorder(words6,y=pct6,labe6 =pct6),vjust = -1)
}else if(input$app1 == "Waze"){
p2 <- p2 + geom_col(aes(x=reorder(words7,-pct7),y=pct7),fill = my_colors2[7]) +
geom_text(aes(x=reorder(words7,y=pct7,label =pct7),vjust = -1)
}else if(input$app1 == "Here"){
p2 <- p2 + geom_col(aes(x=reorder(words8,-pct8),y=pct8),fill = my_colors2[8]) +
geom_text(aes(x=reorder(words8,y=pct8,label =pct8),vjust = -1)
}
p2 <- p2 + theme_bw()+
scale_y_continuous(limits = c(0,100),expand = c(0,0)) +
theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank(),panel.background = element_blank(),axis.line = element_line(colour = "black"),plot.title = element_text(hjust = 0.5),axis.text.x = element_text(angle = 90,vjust = 0.5,hjust=1,face = "bold")) +
labs(x="Words",y="Share of words in reviews",title=paste("Frequency of words -",input$app1,sep = " "))
p2
})
renderPlot({
p2 <- data %>% ggplot()
if(input$app2 == "Genius"){
p2 <- p2 + geom_col(aes(x=reorder(words1,vjust = -1)
}else if(input$app2 == "TomTom"){
p2 <- p2 + geom_col(aes(x=reorder(words2,vjust = -1)
}else if(input$app2 == "CoPilot"){
p2 <- p2 + geom_col(aes(x=reorder(words3,vjust = -1)
}else if(input$app2 == "Navmii"){
p2 <- p2 + geom_col(aes(x=reorder(words4,vjust = -1)
}else if(input$app2 == "Sygic"){
p2 <- p2 + geom_col(aes(x=reorder(words5,vjust = -1)
}else if(input$app2 == "Mapsme"){
p2 <- p2 + geom_col(aes(x=reorder(words6,label =pct6),vjust = -1)
}else if(input$app2 == "Waze"){
p2 <- p2 + geom_col(aes(x=reorder(words7,vjust = -1)
}else if(input$app2 == "Here"){
p2 <- p2 + geom_col(aes(x=reorder(words8,input$app2,sep = " "))
p2
})
```