How to make R datatable buttons save to specific location - r

I have been using the R Datatable package to display information for a team a work with and spit out html docs for them to use. We are trying to find a way to add comments for all to see on the data tables, so i made the columns editable however i can't find a way to get this information to everyone. I created a save button that would work however i can only get this to save to the downloads folder of whoever is clicking the button. Is there a way to save this file to a public location?
Or a better way to add comments on the DT.
Here is the code im currently using:
---
title: "Comments Test"
output: html_document
---
#### `r format(Sys.time(), "%B %d, %Y")`
```{r echo=FALSE, warning=FALSE}
library(DT)
df <- data.frame(matrix(rnorm(50), nrow=10))
df$Comments <- ""
datatable(df, extensions = c('FixedHeader',
'ColReorder', 'Buttons'),
options = list(
dom = 'Blfrtip',
buttons = list(list( extend = 'csv',
filename = '//public/comments/comments.csv',
text = 'Save')),
autoWidth = TRUE,
fixedHeader = TRUE,
colReorder = TRUE),
width = "965px", fillContainer = FALSE, escape = FALSE,
rownames = FALSE, autoHideNavigation = FALSE, editable = TRUE)
```
Thank You.

Related

Flexdashboard DT datatable not filling panel height

I have tried everything, but am stumped trying to get a DT datatable to fill the panel of a flexdashboard. It employs a scroller, but I cannot find any way to force the table to be the full height of the panel. In the image linked below, it is the table on the right that causes problems and seems to be related to the fact that it is in a loop (inputting a table per tab). When I exclude the loop and just do one table, it will fill the panel. I can play about with some scroller parameters to make it larger, but then it will not be full panel on every screen. I just want some way to make it auto-fill the tabbed panel size each time. Thanks in advance for your help.
flex image - see right panel
```
## XXX Detailed Reports {.tabset}
``` {r, echo=FALSE, warning=FALSE, results="asis"}
for (i in 1:length(c_list)){
cty=c("XXX","FFF","GGG","TTT","RRR","PPP","LLL","WWW","EEE")
cat("### ", cty[i], "\n")
cat("#### ",cty[i],paste("Week ",floor(yday(as.Date(format(Sys.Date() - wday(Sys.Date() + 1), "%d %B %Y"),"%d %B %Y"))/7)+1,sep="")," Other Text here", "\n")
x = data.frame(c_list[i]) %>% mutate_if(is.character, function(x) {Encoding(x) <- 'latin1'; return(x)}) # remove strange sysmbols
tb=x %>%
DT::datatable(
extensions = c("Buttons", "Responsive", "Scroller", "RowGroup"),
options = list(dom = 'Bfrtip',
buttons = c('excel', "csv"),
rowGroup = list(dataSrc = 0),
deferRender = TRUE,
#scrollY = 800,
#scroller = TRUE,
scrollCollapse = FALSE,
columnDefs = list(list(visible=FALSE, targets=c(0))),
paging=FALSE,
searching=FALSE,
info=FALSE),
selection = 'none',
rownames=F) %>%
formatStyle(columns = colnames(.$x$data), `font-size` = "12px")
print(htmltools::tagList(tb))
#cat("\n")
}
```

dfSummary() graphs are not printed in the HTML file

When using dfSummary() from the "summarytools" package in Rmarkdown -file, I get Graph -part of the summary printed as plain ASCII despite the st_options(plain.ascii = FALSE). The correct graphs are printed in the /tmp -folder, but are not displayed in the html-file.
{r Summary, results='asis', echo=FALSE}
st_options(bootstrap.css = FALSE,
plain.ascii = FALSE,
style = "rmarkdown",
dfSummary.silent = TRUE)
st_css()
dfSummary(df_data, tmp.img.dir = "/tmp", valid.col = FALSE, graph.magnif = 0.75)
Summary from the code above gets printed like this:
How can I get the proper graphs (which are in the tmp-folder nice and shiny) included in the HTML file?
How can I get the proper graphs (which are in the tmp-folder nice and shiny) included in the html file?
According to the Dominic's vignette - "Recommendations for Using summarytools With Rmarkdown":
For dfSummary(), grid is recommended.
So, you may try following, using print() function:
```{r Summary, results = "asis", cache = FALSE}
base::print(summarytools::dfSummary(df_data,
valid.col = FALSE, # drop Valid column if redundant
style = "grid", # set style to “grid”
plain.ascii = FALSE,
graph.magnif = 0.75, # zoom factor (max = 1) for bar plots and histograms
tmp.img.dir = "./tmp"),
dfSummary.silent = TRUE, # Suppresses messages about temporary files
bootstrap.css = FALSE)
```
Or, if you prefer to declare st_options() first:
```{r Summary2, results = 'asis', echo = FALSE}
st_options(bootstrap.css = FALSE,
dfSummary.silent = TRUE)
st_css()
dfSummary(df_data,
valid.col = FALSE,
style = "grid",
plain.ascii = FALSE,
graph.magnif = 0.75,
tmp.img.dir = "./tmp")
```
Let us know if this is helpful.
Just add style="grid":
dfSummary(df_data, style = "grid", tmp.img.dir = "/tmp",
valid.col = FALSE, graph.magnif = 0.75)
The documentation is not clear enough on this point, it'll be fixed in the next version.

Programmatically create a question_text with multiple answers in r learnr:tutorial

I have the following code with 4 correct answers. I want the students to input all 4 of them. Instead of defining 24 permutations of the answers, I want 4 field boxes that would only accept an answer once.
question_text(
"Input all paths:",
answer("ABEF", correct = TRUE),
answer("ABCDG", correct = TRUE),
answer("ABCDEF",correct = TRUE),
answer("ABDEF", correct = TRUE),
incorrect = "Direction from top to bottom of the plate",
allow_retry = TRUE,
trim = TRUE
)
EDIT
I tried this approach but I do not think I can set the answer as anything other than a single text:
library(gtools)
pat <- permutations(4, 4, c("ABEF","ABCDG","ABCDEF","ABDEF"))
question_text(
"Input all possible rupture paths:",
answer(pat, correct = TRUE),
allow_retry = TRUE,
trim = TRUE
)
Even if I set pat <- c("ABEF","ABCDG","ABCDEF","ABDEF") it does not run successfully. How can define multiple answers at the same time without writing them out.
I'm not sure about your desired output - however, please check the following.
Referring to:
How can define multiple answers at the same time without writing them
out.
You can use lapply to create the answers and do.call to pass the different arguments to question_text:
library(learnr)
do.call(question_text, c(
list("Input all paths:"),
lapply(c("ABEF", "ABCDG", "ABCDEF", "ABDEF"), answer, correct = TRUE),
list(
incorrect = "Direction from top to bottom of the plate",
allow_retry = TRUE,
trim = TRUE
)
))
as *.Rmd file:
---
title: "Tutorial"
output: learnr::tutorial
runtime: shiny_prerendered
---
```{r setup, include=FALSE}
library(learnr)
knitr::opts_chunk$set(echo = FALSE)
```
```{r two-plus-two, exercise=FALSE}
do.call(question_text, c(
list("Input all paths:"),
lapply(c("ABEF", "ABCDG", "ABCDEF", "ABDEF"), answer, correct = TRUE),
list(
incorrect = "Direction from top to bottom of the plate",
allow_retry = TRUE,
trim = TRUE
)
))
```
Regarding:
I want 4 field boxes that would only accept an answer once
Edit: Added an event handler to access to the answers provided by the user.
---
title: "Tutorial"
output: learnr::tutorial
runtime: shiny_prerendered
---
```{r setup, include=FALSE}
library(learnr)
knitr::opts_chunk$set(echo = FALSE)
questions <-
mapply(
FUN = question_text,
lapply(c("ABEF", "ABCDG", "ABCDEF", "ABDEF"), answer, correct = TRUE),
text = paste("Question", 1:4),
incorrect = paste("Incorrect", 1:4),
MoreArgs = list(allow_retry = TRUE,
trim = TRUE),
SIMPLIFY = FALSE
)
```
```{r q1, echo = FALSE}
do.call(quiz, c(list(caption = "Quiz 1"), questions))
```
```{r context="server-start"}
event_register_handler("question_submission", function(session, event, data) {
# names(data):
# "label" "question" "answer" "correct"
message("event: question_submission: ", data$answer)
})
```

Keep the format of numbers in Excel using Buttons extensions

I am using in Shiny Buttons extension to download figures in a Excel-File.
DTa <- data.table(
dataSum()[,1],
format(round((10^-6)*dataSum()[,-1],2),nsmall = 2,decimal.mark=",",big.mark=".")
)
DTa<- DT::datatable( DTa, extensions=c("Buttons"),options = list(paging = FALSE,
searching = FALSE,
dom = 'Bfrtip',
#buttons = c('copy','excel')
buttons = list(
list(
extend = 'excel',
text = "Save ",
title = 'KRB'
), list(
extend = 'copy', title = 'krb'
)
)
),
caption= paste("Stichtag:",
as.character(sub("([0-9]{2})([0-9]{2})([0-9]{4})KRB.csv", "\\1.\\2.\\3",input$date))))
In the first part above, I transform the figures in the German format, i.e., I set , as a decimal separator and . as a thousands separator. In the second part, I call the extensions Buttons of DT.
In Shiny, the figures look as follows:
Problem: After pressing the Save Button in Shiny, all figures with just , and without . have the wrong format.
For example, after saving 34,21 becomes 3.421! But 67.809,97 is correct!
How can I keep the format of the figures during the export or save process?
I don't know if it helps:
When I change into the debug mode and execute the second part DTa<- DT::datatable( DTa, extensions ... I see the following:
As one can see the figures in data are characters!
Is it possible to write a JavaScript function in my server.R to use the language.decimal option? There is an example here, however I cannot use it exactly.
Try this
DTa<- DT::datatable(DTa, extensions=c("Buttons"), options = list(paging = FALSE,
searching = FALSE,
dom = 'Bfrtip',
#buttons = c('copy','excel')
buttons = list(
list(
extend = 'excel',
text = "Save ",
title = 'KRB'
), list(
extend = 'copy', title = 'KRB'
)
)
),
caption= paste("Stichtag:",
as.character(sub("([0-9]{2})([0-9]{2})([0-9]{4})KRB.csv", "\\1.\\2.\\3",input$date)))
) %>% formatCurrency(-1,' ', digits = 2 , interval = 3, mark = ".", dec.mark = ",")

column_spec function in kableExtra in R doesn't work

I want co change column width in pdf with kable ( , 'latex') but the fucntion doesn't work. Anybody know why? here is my code:
table = knitr::kable(jeden, "latex" , row.names = F , align = "llrrrrrrrrrr" , escape = F, booktabs = F, caption = '1. Sprzedaz uslug i towarow razem')
kableExtra::column_spec(table, 1, width = "1cm", bold = TRUE, italic = TRUE)
It's not a bug but rather a relatively strange setting for align in knitr::kable(). In xtable you can put align in a string but for kable, you will have to provide a vector. In your case, if you put things like align = c(rep("l", 2), rep("r"), 2), you should be fine.
It seems that align breaks your column_spec, but only for LaTeX/PDF output.
Here are two minimal & reproducible examples.
PDF output
---
title: "Untitled"
output:
pdf_document: default
---
```{r}
library(knitr)
library(kableExtra)
x <- kable(head(mtcars[, 1:4]), "latex", row.names = F, align = "llrr")
column_spec(x, 1:2, width = "4cm", bold = TRUE, italic = TRUE)
```
If you remove align from the PDF RMarkdown document, column_spec works as expected.
HTML output
---
title: "Untitled"
output:
html_document: default
---
```{r}
library(knitr)
library(kableExtra)
x <- kable(head(mtcars[, 1:4]), "html", row.names = F, align = "llrr")
column_spec(x, 1:2, width = "4cm", bold = TRUE, italic = TRUE)
```
This seems like a bug to me, and I would suggest opening an issue on the kableExtra GitHub site. If you do, you should reference this post, and include a minimal & reproducible example (similar to what I did).

Resources