I am making a Shiny app to keep track of some things that need to be done at work. One component of the app is to send an email letting everyone know what they are responsible for doing that week. I originally wrote the code to do that in two separate pieces, an R markdown file to generate the emails, and an R script to iterate through a table that has user's names in it to generate a personalized email that includes the tasks for which they are responsible. Locally, this works fine. I have a button setup to run the R script, which then sources the R markdown code for each user and sends an email to each user. After deploying the app this no longer works. Debugging the Shiny app has proved tricky, but I'm guessing is has to do with the fact that the R script and R markdown file are not communicating with each other. I was wondering if I could solicit some advice on how to resolve this. Thank you in advance for any insight or advice, I only program a little for work and have been struggling to fix this. The code below is a simplified version of what I'm trying to use.
#DATA
email.addresses <- data.frame(user = as.character(c("Peyton Mannning", "John Elway")),
email.address = as.character(c("Peyton.manning#gmail.com", "john.elway#gmail.com")),
stringsAsFactors=FALSE)
email.complete <- data.frame(task = as.character(c("Do the dishes", "Mop the floor")), next.completion = as.Date("2020-12-10"), Responsible.Persons = as.character(c("Peyton Manning", "John Elway")))
#R script
library(lubridate)
library(blastula)
for (user in unique(email.addresses$User)){
email <- render_email("email markdown.Rmd")
email %>%
smtp_send(
from = "personal#email.net",
to = email.addresses$Email[email.addresses$User == user],
subject = paste("Cleaning Schedule for", floor_date(Sys.Date() - 1, "weeks") + 1, sep = " ", collapse = NULL),
credentials = creds_key(id = "gmail")
)
}
# markdown
```{r, results='asis', echo = FALSE}
email.complete.user <- email.complete[email.complete$Responsible.Persons == user,]
library(kableExtra)
library(dplyr)
email.complete.user %>%
kbl(row.names = FALSE, col.names = c("Task", "Completion Deadline", "Responsible User"), format = "html", table.attr = "style='width:100%;'", longtable = TRUE) %>%
kable_styling(bootstrap_options = c("striped", "hover", position = "left"), font_size = 20) %>%
kable_minimal()```
Related
I have a folder full of charts, generated from a previous step. All of them are PNG files.
I want to be able to choose anyone using Flexdashboard and load it.
As no shiny or server service is needed I tried Crosstalk package
library(crosstalk)
library(magrittr)
library(png)
df <- list.files("plots/", full.names = TRUE) %>%
as_tibble() %>%
magrittr::set_names("path")
shared_data <- SharedData$new(df, key = ~path)
p <- shared_data %>% readPNG(source = path)
bscols( filter_select(id = "file_id",
label = "CHOOSE",
sharedData = shared_data,
group = ~path),
p)
I am stuck on a very simple error i cannot solve as all paths are properly read from file:
Error in path.expand(source) : invalid 'path' argument
Tried to use knitr too:
bscols(filter_select("path", "CHOOSE", shared_data),
knitr::include_graphics(shared_data, ~path))
Error in makeGroupOptions(sharedData, group, allLevels) : argument "group" is missing, with no default
Maybe there is a simpler approach but crosstalk seemed a very simple one as it does not need shiny or any other component but a data frame.
This can be achieved more easily by using bsselectR
The library is 5 years old but works perfectly in my trial. It does not offer the same level of in-plot interaction as crosstalk but might be sufficient for the current purpose.
Below is the code snippet to add to R Markdown document. I've altered the sample code to allow for recursive directory walk.
The plots directory needs to be placed in the same directory as the R file.
```{r}
#
library(stringr)
library(bsselectR)
state_plots <- paste0(list.files("plots", full.names = TRUE, recursive = TRUE))
names(state_plots) <- str_replace_all(state_plots,
c("\\.png" = "",
"plots/" = ""))
bsselect(state_plots, type = "img", selected = "sns_heatmap",
live_search = TRUE, show_tick = TRUE)
```
Output :
I'm working on a project to make it easier to create flex/shiny dashboards from qualtrics surveys. I'd really like to be able to write a couple functions that would let co-workers who have less experience with R be able to make similar documents without having to know Rmarkdown syntax.
For example, if someone wanted to make a one page dashboard with a scatterplot, I'd like to be able to have them use a couple functions like (make_dashboard, make_page) etc:
make_dashboard(
title = "Qualtrics Report Dashboard",
page 1 = make_page(header = "Page 1", format = "column", render = "plot",
data = survey_data, variables = c("var1", "var2"))
)
which would then create a rmd file with this:
---
title: "Qualtrics Report Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
runtime: shiny
---
Page 1
=====================================
renderPlot( {
ggplot(data = survey_data, mapping = aes_string(x = var1,
y = var2)) +
geom_point() +
labs(x = get_label(get(var1, survey_data)),
y = get_label(get(var2, survey_data)))
}
)
I haven't gotten very far with trying to write these functions / implement this logic, because I'm not even sure if I'm thinking about it in the right way - is it possible to create rmarkdown chunks with functions like this?
I've looked at other posts 1 and 2 about child documents in knitr, but I don't really want every chunk to be the same, rather have the person be able to change certain aspects (e.g. type of plot, data, etc.).
Not sure if this will be useful to anyone else, but I ended up using whisker (https://github.com/edwindj/whisker), which can render strings into documents to construct an Rmd in the style of flexdashboard.
TLDR: Essentially I made functions that create strings of text matching the building blocks of flexdashboard. With whisker, you can pass in variables by encasing words in the string with two bracket parentheses and then assigning their values with a list of var_name = value for each variable in the string, e.g.
template <- "My name is {{name}}."
d <- list(name = "Emily")
cat(whisker.render(template, data = d))
print(d)
My name is Emily
I used a combination of this and the str_c from stringr to construct strings for different elements of the flexdashboard, allowing the user to input variables like title, variable for plots, etc. that then could be rendered into the string using whisker. Then, I joined all of those strings together and render it into an Rmd file. Honestly, I am not sure this is actually easier for people who don't know R to use, and I'll probably end up doing something different, but I wanted to share in case anyone is thinking about this.
Example: running the chunk below creates a file called "test_dashboard.Rmd" with the text format for a flexdashboard with a 1 input sidebar and a single page with one plot.
```
make_dashboard(title = "Test Dashboard",
sidebar = make_sidebar(sidebar_title = "here is the input",
input_type = "multi-select",
input_name = "Interesting Var #1"),
page1 = make_page(page_title = "Cool Plots!",
element_one = make_plot(plot_title = "this is my plot",
type = "bivariate",
vars = c("cool_var1",
"cool_var2"))),
fn = "test_dashboard")
```
OUTPUT:
```
---
title: Test Dashboard
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
runtime: shiny
---
\```{r setup, include=FALSE}
library(flexdashboard)
library(tidytext)
library(tidyverse)
library(janitor)
library(DT)
library(gghighlight)
library(knitr)
library(shiny)
library(qualtRics)
library(curl)
library(sjlabelled)
library(naniar)
library(scales)
library(lme4)
library(MASS)
library(snakecase)
\```
\```{r global, include=FALSE}
#setting global options for table scrolling and plot theme
options(DT.options = list(scrollY="100vh"))
theme_set(theme_minimal())
#this fetches all of your survey info
surveys <- all_surveys()
#this saves the survey responses into
docusign_survey <- fetch_survey(surveyID = surveys$id[1],
verbose = TRUE,
label = TRUE,
breakout_sets = TRUE,
force_request = TRUE)
#this saves the question text into a dataframe
questions <- survey_questions(surveyID = surveys$id[1])
rename_df <- rename_variables(docusign_survey)
#this renames all of the variables
docusign_survey <- docusign_survey %>%
rename_at(as.vector(rename_df$old_name), ~ as.vector(rename_df$new_labels))
#new variables
new_var <- rename_df$new_labels
#which are multi_select?
multi_select <- rename_df %>%
filter(ms == 1) %>%
dplyr::select(new_labels)
#relabel those NAs as No
docusign_survey <- docusign_survey %>%
purrr::modify_at(multi_select$new_labels, na_to_y)
\```
Sidebar {.sidebar}
=====================================
here is the input
\```{r}
selectInput("p_var_1", label = "Interesting Var #1",
choices = new_var,
multiple = TRUE)
\```
Cool Plots!
=====================================
Column {.tabset}
-------------------------------------
### this is my plot
\```{r}
renderPlot( {
make_bivariate_plot(docusign_survey, input$cool_var1, input$cool_var2)
})
\```
```
Functions
make_dashboard()
I saved the parts that will repeat every time, probably will want to make them editable for changes in scrolling, etc. but just trying to make proof of concept at the moment.
```
make_dashboard <- function(title, sidebar, page1, fn){
load("data/top_matter.rda")
load("data/libraries.rda")
load("data/main_chunk.rda")
initial_bit <- stringr::str_c(top_matter, libraries, main_chunk, sep = "\n\n")
intermediate <- stringr::str_c(initial_bit, sidebar, sep = "\n\n")
total <- stringr::str_c(intermediate, page1, sep = "\n\n")
data <- list(title = title)
out_fn <- paste0("./", fn, ".Rmd")
writeLines(whisker.render(total, data), con = out_fn)
}
```
make_sidebar()
```
make_sidebar <- function(sidebar_title, input_type, input_name){
top_sidebar <-
'Sidebar {.sidebar}
=====================================
'
sidebar_text <- str_c(top_sidebar, sidebar_title, sep = "\n\n")
if(input_type == "multi-select"){
ms <- "TRUE"
} else {
ms <- "FALSE"
}
input_one <- make_select_input(input_name, ms)
sidebar_total <- str_c(sidebar_text, "```{r}", input_one, "```", sep = "\n\n")
return(sidebar_total)
}
```
make_page()
```
make_page <- function(page_title, element_one){
top_page <-
'{{page_title}}
=====================================
Column {.tabset}
-------------------------------------'
add_element <- stringr::str_c(top_page, element_one, sep = "\n\n")
data <- list(page_title = page_title)
page <- whisker.render(add_element, data = data)
return(page)
}
```
make_plot()
```
make_plot <- function(plot_title, type = c("univariate", "bivariate"), vars){
top_plot_piece <-' {{plot_title}}
\```{r}
renderPlot( {
'
if(type == "univariate"){
plot_piece <-
'make_univariate_plot(docusign_survey, input${{vars}})
})
\```'
total_plot <- stringr::str_c(top_plot_piece, plot_piece, sep = "\n\n")
data <- list(plot_title = plot_title,
vars = vars)
plot_chunk <- whisker.render(total_plot, data = data)
} else{
plot_piece <-
'make_bivariate_plot(docusign_survey, input${{var_1}}, input${{var_2}})
})
\```'
total_plot <- stringr::str_c(top_plot_piece, plot_piece, sep = "\n\n")
data <- list(plot_title = plot_title,
var_1 = vars[1],
var_2 = vars[2])
plot_chunk <- whisker.render(total_plot, data = data)
}
return(plot_chunk)
}
```
This has plagued me for too long, I would appreciate help. I have been investing time into kable, but it hasn't quite worked out for me the way I would like. I am looking to create multi grouped rows as in the image
The code to do this is as follows:
collapse_rows_dt <- expand.grid( District = sprintf('District %s', c('1', '2')), City = sprintf('City %s', c('1', '2')), State = sprintf('State %s', c('a', 'b')), Country = sprintf('Country with a long name %s', c('A', 'B'))
)
collapse_rows_dt <- collapse_rows_dt[c("Country", "State", "City", "District")]
collapse_rows_dt$C1 = rnorm(nrow(collapse_rows_dt))
collapse_rows_dt$C2 = rnorm(nrow(collapse_rows_dt))
kbl(collapse_rows_dt, booktabs = T, align = "c", linesep = '') %>%
collapse_rows(1:3, row_group_label_position = 'stack')
The problem is that when I run this in R markdown I get the HTML version in the output (see below)
This obviously is not good enough. I CAN get the correct output (first image) if I knit to pdf, but that's it. If I try doing save_kable() it turns out in the HTML format as in the second image. Kniting to pdf every time is so impractical that I can't possible use kable anymore if I can't fix this. That is a big deal for me.
If I set format='latex' then nothing shows up inline and when I try to kable_save() I get this error message:
this is Xtex version 3....(tex live 2020/w32Tex) preloaded format=xlatex) restricted \write18 enabled.
Entering extended mode
Followed by a pop that informs me (R crashes)
R session aborted, r encoutered a fatal error
All HTML tables that don't require latex show up inline appropriately and will save as their actual image.
Relevant Up to Date Packages:
- library(webshot)
library(tinytex) (also tried without)
library(magick)
library(plyr)
library(tidyverse)
library(dplyr)
library(knitr)
library(skimr)
library(kableExtra)
Also:
Ghostscript 9.52 is current and set to environment
Miktext 2.9
Have Tried:
updating imageMagick via install.packages(magick
editing the policy.xls in ImageMagick to bypass a security feature ImageMagick security policy 'PDF' blocking conversion
Manually installing the following Latex packages
library(tinytex)tlmgr_install(pkgs = 'standalone')tlmgr_install(pkgs
= 'preview')tlmgr_install(pkgs = 'polyglossia')tlmgr_install(pkgs = 'xltxtra')tlmgr_install(pkgs = 'realscripts')
Setting Mixtex to environment path
If you want to knit and include the image produced via LaTeX and PDF, you can use kableExtra::as_image
---
output: html_document
---
```{r}
library(kableExtra)
library(magrittr)
collapse_rows_dt <- expand.grid( District = sprintf('District %s', c('1', '2')), City = sprintf('City %s', c('1', '2')), State = sprintf('State %s', c('a', 'b')), Country = sprintf('Country with a long name %s', c('A', 'B'))
)
collapse_rows_dt <- collapse_rows_dt[c("Country", "State", "City", "District")]
collapse_rows_dt$C1 = rnorm(nrow(collapse_rows_dt))
collapse_rows_dt$C2 = rnorm(nrow(collapse_rows_dt))
kbl(collapse_rows_dt, "latex", align="c", linesep="", booktabs = T) %>%
collapse_rows(1:3, row_group_label_position = 'stack') %>%
kable_styling(latex_options = c("striped", "scale_down")) %>%
as_image()
```
Apologies for the bad title, I wasn't sure how to best convey what my problem is.
To give some context, I want to create a personalized scorecard for each provider in our organization using Rmarkdown. I already figured out how to create an individual PDF for each provider ; however, I want to have a simple bar chart on everyone's report with the provider's position highlighted so that they can compare themselves to their peers. Below is what I have so far:
First I created the dataset:
############################## Create dataset and export #####################################
df = data.frame(
"Provider" = c("A","B","C","D"),
"Measure" = c(1.2,0.8,1.7,0.4)
)
write.csv(df, "pathway/df.csv")
Next I created an Rmarkdown file named "TEST" that calls in the dataset and includes a graph
###################### Create Rmarkdown file named "TEST" ####################################
---
output: pdf_document
---
```{r echo=FALSE}
df <- read.csv("pathway/df.csv", stringsAsFactors = FALSE)
name <- df$Provider[i]
Dear `r name`,
This is your personalized scorecard.
```{r}
ggplot() +
geom_bar(data=df, aes(x=reorder(Provider, -Measure), y=Measure,
fill = factor(ifelse(Provider == "A", "You","Your Peers"))),
stat = "identity") +
scale_fill_manual(name = "Provider", values=c("steelblue","lightgrey"))
Finally I created an R file with the for-loop to create as many PDFs as there are providers
################ Run R file with loop to make separate PDFs per Provider #####################
library(knitr)
library(rmarkdown)
#Read data
df <- read.csv("pathway/df.csv", stringsAsFactors = FALSE)
#Create loop
for (i in 1:nrow(df)){
rmarkdown::render(input = "pathway/TEST.Rmd",
output_format = "pdf_document",
output_file = paste("handout_", i, ".pdf", sep=''),
output_dir = "pathway/folder/")
}
In the code above for the ggplot2 graph I manually coded provider "A" to be highlighted in blue and the rest of the providers grey, but we have over 30 providers and I don't want to manually code for each one. If there is some way for Rmarkdown to automatically highlight each provider in blue and the rest grey for each of their PDF reports that would be amazing. Any help is much appreciated!
There were some errors in your code, so I give the correct files here.
The RMD file:
you have to submit parameters, in your case i. You also did this in name <- df$Provider[i] but i was not given. Also you have to load ggplot2 and set your chunks ob the right positions.
---
output: pdf_document
params:
i: 1
---
```{r echo=FALSE}
library(ggplot2)
df <- read.csv("df.csv", stringsAsFactors = FALSE)
name <- df$Provider[i]
```
Dear `r name`,
This is your personalized scorecard.
```{r}
ggplot() +
geom_bar(data=df, aes(x=reorder(Provider, -Measure), y=Measure,
fill = factor(ifelse(Provider == df$Provider[i], "You","Your Peers"))),
stat = "identity") +
scale_fill_manual(name = "Provider", values=c("steelblue","lightgrey"))
```
The R file loop
Here you also have to submit the parameter too.
library(knitr)
library(rmarkdown)
#Read data
df <- read.csv("pathway/df.csv", stringsAsFactors = FALSE)
#Create loop
for (i in 1:nrow(df)){
rmarkdown::render(input = "pathway/TEST.Rmd",
output_format = "pdf_document",
output_file = paste("handout_", i, ".pdf", sep=''),
output_dir = "pathway/folder/",
params = list(i = i)))}
Been learning how to use Drake today and managed to migrate my code but not my R markdown reports yet. This report compiles fine, and produces the expected output, but also gives this error which no amount of searching has shed light on.
I am using the r_make() command as recommended, and my plan so far reads:
plan_0 <- drake_plan(
raw_c_data = read_rds(
file_in("data/css_carib_data.rds")),
raw_c_fg = read_rds(
file_in("data/css_carib_fg.rds")),
c_data = clean_caribbean_fg(raw_c_data, raw_c_fg),
clean_c_fg = write_rds(
c_data,
file_out("data/clean_c_fg.rds"),
compress = "gz"),
c_maps = gen_maps(bbx_1, bbx_2, bbx_3, bbx_4, bbx_5),
c_maps_out = write_rds(
c_maps,
file_out("data/c_maps.rds"),
compress = "gz"),
c_base_report = rmarkdown::render(
knitr_in("R/0_prepare_data.Rmd"),
output_file = file_out("0_prepare_data.html"),
quiet = T)
)
That Rmd file starts with the following
---
title: "0: Data Description"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
require(drake)
require(tidyverse)
require(ggmap)
loadd(raw_c_fg)
loadd(clean_c_fg)
loadd(c_maps)
```
This document is a description of the data processed in `0_prepare_data.R` from the Caribbean region. The following table gives the counts of each classification within the aggregated functional groups.
```{r tables, echo = F}
raw_c_fg %>%
pull(fg) %>%
table() %>%
knitr::kable(col.names = c("Class", "Count"),
caption = "Counts of Each Functional Group")
```
I'm happy to attach as much more as required, but hopefully this is enough to see why I am getting this error?
Figured out what was going wrong, and it was the usual conflict between Rmd and Rproj/drake with relative locations. I had located the Rmd file within the R directory, but _drake.R was in the base directory, and so the differences in locating the output were causing drake to look in the wrong place.