I want to have a shiny app where I upload an xlsx file, which will be splitted and prepared. And this splitted and prepared data should be the params for a flexdashboard. But I always get the error that params are not declared in YAML (exact error message see below)
shiny app:
library(shiny)
library(readr)
library(readxl)
library(tidyverse)
ui <- fluidPage(
titlePanel("File: Kundenstruktur Upload"),
sidebarLayout(
sidebarPanel(
fileInput("file", "Upload Kundenstruktur.xlsx")
),
mainPanel(
tableOutput("data_table"),
downloadButton("report", "Generate report")
)
)
)
server <- function(input, output, session) {
# get color codes
uploaded_colors <- reactive({
req(input$file)
df <- readxl::read_xlsx(input$file$datapath, sheet = "Gruppen") %>%
janitor::clean_names()
df
})
# get color codes
uploaded_data <- reactive({
req(input$file)
df <- readxl::read_xlsx(input$file$datapath, sheet = "Stammdaten") %>%
janitor::clean_names()
df
})
# prep the data
prep_data <- reactive({
kunden <- unique(uploaded_data()$kundenname)
kundenstruktur_tbl <- tibble()
for (i in 1:length(kunden)){
kunde <- uploaded_data() %>%
filter(kundenname == kunden[i])
empfehlungen <- uploaded_data() %>%
filter(empfehlung_von == kunde$kundenname)
temp_tbl <- tibble(
from_name = kunde$kundenname,
to_name = empfehlungen$kundenname,
from_id = kunde$kunden_id,
to_id = empfehlungen$kunden_id,
from_gruppe = kunde$gruppe,
to_gruppe = empfehlungen$gruppe,
from_verbindung = kunde$verbindung,
to_verbindung = empfehlungen$verbindung
)
kundenstruktur_tbl <- bind_rows(kundenstruktur_tbl, temp_tbl)
}
kundenstruktur_tbl
})
# create nodes
nodes <- reactive({
uploaded_data() %>%
select(id = kunden_id, label = kundenname, group = gruppe, verbindung) %>%
left_join(uploaded_colors(), by = c("group" = "gruppen")) %>%
mutate(
shape = "box",
icon.face = "fontAwesome",
icon.code = "f0ce",
icon.size = 50,
icon.color = farbe
)
})
# create nodes
edges <- reactive({
prep_data() %>%
select(from = from_id, to = to_id, from_gruppe) %>%
left_join(uploaded_colors(), by = c("from_gruppe" = "gruppen")) %>%
rename(font.color = farbe)
})
output$report <- downloadHandler(
# For PDF output, change this to "report.pdf"
filename = "report.html",
content = function(file) {
tempReport <- "KundenNetzwerk_Shiny.Rmd"
file.copy("report.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
params <- list(params = list(nodes = isolate(nodes()), edges = isolate(edges()), data = isolate(prep_data())))
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
# Display the first few rows of the uploaded data
output$data_table <- renderTable({
head(uploaded_data())
})
}
shinyApp(ui = ui, server = server)
flexdashboard:
---
title: "Kundennetzwerk"
output:
flexdashboard::flex_dashboard:
css: css/styles-default.css
#logo: img/KC.png
params:
edges: NA
nodes: NA
data: NA
---
```{r include= FALSE}
library(visNetwork)
library(tidyverse)
library(DT)
```
Sidebar {.sidebar}
=============================================================================
<br>
<br>
{width=100%}
Kundenstruktur {data-icon="fa-sitemap"}
=============================================================================
Row {.tabset}
-------------------------------------
### Netzwerk
```{r}
visNetwork(params$nodes, params$edges, width = "100%") %>%
visGroups(groupname = "Familie", color = "#c72237", shape = "ellipse") %>%
visGroups(groupname = "Freunde", color = "#868b91", shape = "ellipse") %>%
visGroups(groupname = "Bekannte", color = "#808080", shape = "ellipse") %>%
visGroups(groupname = "Fremde", color = "#b3bac2", shape = "ellipse") %>%
visGroups(groupname = "Arbeitskollegen", color = "#e0e9f3", shape = "ellipse") %>%
visGroups(groupname = "Ersttermin offen", color = "#db3c30", shape = "ellipse") %>%
visGroups(groupname = "Zweittermin offen", color = "#f6685e", shape = "ellipse") %>%
visGroups(groupname = "Noch nicht kontaktiert", color = "#f1c232", shape = "ellipse") %>%
visIgraphLayout(randomSeed = 123) %>%
visEdges(smooth = list(enabled = TRUE, type = "diagonalCross")) %>%
visInteraction(
keyboard = TRUE,
tooltipDelay = 0,
hideEdgesOnDrag = TRUE,
hoverConnectedEdges = TRUE
) %>%
visOptions(
highlightNearest = TRUE,
selectedBy = "group",
nodesIdSelection = TRUE,
) %>%
visLegend() %>%
addFontAwesome()
Error Message: Warning: Error in knit_params_get: render params not declared in YAML: params