When I use kable_styling with latex_options = "striped", I noticed that every 5th row is different. It appears to be higher than the other rows. The output format is PDF.
---
title: "Title"
author: "myself"
date: "`r format(Sys.time(), '%e. %B %Y')`"
output: pdf_document
---
```{r}
df <- data.frame(list("one", "0.05 to 0.2", "0.02"))
df <- rbind(df, list("two", "30 to 40", "1"))
df <- rbind(df, list("three", "0.2 to 0.8", "0.1"))
df <- rbind(df, list("four", "30 to 35", "1"))
df <- rbind(df, list("five", "0.2 to 0.8", "0.1"))
df <- rbind(df, list("six", "occupancy", ""))
df <- rbind(df, list("seven", "true", ""))
df <- rbind(df, list("eight", "10", ""))
df <- rbind(df, list("nine", "", ""))
df <- rbind(df, list("ten", "abc", ""))
df <- rbind(df, list("eleven", "false", ""))
df <- rbind(df, list("twelve", "Monday", ""))
colnames(df) <- c("Variable", "Values", "Stepsize")
kbl(df, caption="independent Variables", booktabs=T, align = c("l", "c", "c")) %>%
kable_styling(latex_options = c("striped", "HOLD_position"))
```
Notice the two rows, six and ten:
Related
What function could help me to output data content to a Quarto-pub Docx output document?
I'm trying...
The yaml is:
---
title: "Docx Quarto output"
format:
docx:
toc: true
toc-depth: 2
number-sections: true
number-depth: 3
highlight-style: github
---
And the code:
```{r}
library(tidyverse)
text_data <- tribble(
~type, ~name, ~color,
"fruit", "apple", "red",
"vegetable", "cumcumber", "green",
"fruit", "banana", "yellow",
"grain", "rice", "white"
)
text_data %>%
split(.$type) %>%
map(~ cat('\n\n ##', .$name, '\n###', .$color))
```
What I would like to get is a Rmarkdown like:
# fruit
## apple
### red
## banana
### yellow
# vegetable
## cumcumber
### green
# grain
## rice
### white
You could try the following:
```{r}
#| results: asis
df <- text_data %>%
split(text_data$type) |>
map_dfr(~ .x |>
# little hack to avoid printing # fruit twice
mutate(string = ifelse(row_number() == 1, paste0(
"\n\n# ", type,
"\n\n## ", name,
"\n\n### ", color
),
paste0(
"\n\n## ", name,
"\n\n### ", color
)
)) |>
select(string))
cat(df$string)
```
Result:
The dashboard below has two tabs. Data is refreshed on changing the parameter. The first tab is refreshing properly with change in parameter. The second tab is not refreshed even though the parameter is used with reactive function. The code is very basic with the minimum functionality for testing and demo
The problem is of interaction hence these components are required. Also if you see..from following perspective. 1) data portion will setup the problem 2) 2 tabs are created to show the issue 3) tabs has minimum data displayed to show the failure of refresh...I can say this as I have removed the portion of code which was not directly linked with the problem.
library(quantmod)
library(shiny)
library(dplyr)
library(purrr)
library(stringr)
get_data <- function(symbols = c("AAPL", "MSFT", "META", "ORCL",
"TSLA", "GOOG")) {
syms <- getSymbols(symbols, from = "2020/01/01",
to = Sys.Date(), periodicity = "daily")
map_dfr(syms, function(sym) {
raw_data <- get(sym)
raw_data %>%
as_tibble() %>% # as_tibble will convert to tibble
set_names(c("OPEN", "HIGH", "LOW", "CLOSE", "VOLUME", "ADJUSTED")) %>%
mutate(SYMBOL = sym,
DATE = index(raw_data)) %>%
select(SYMBOL, DATE, OPEN, HIGH, LOW, CLOSE, VOLUME, ADJUSTED)
})}
if (!exists("df_all")) {df_all <- get_data()}
df_rep_data <- tribble(~ RunDate, ~ ListStocks,
"2020-01-06", "AAPL, GOOG, TSLA",
"2021-01-04", "ORCL",
"2022-01-04", "META, MSFT") %>%
mutate(RunDate = as.Date(RunDate))
make_table <- function(symbol, dat = df_all) {
dat %>%
filter(SYMBOL == symbol) %>%
select(DATE, OPEN, HIGH, LOW, CLOSE, VOLUME) %>%
slice(1:5)}
symb_ui <- function(id) {
ns <- NS(id)
tagList(
tags$h4(textOutput(ns("symbol"))),
tableOutput(ns("table"))
)}
symb_server <- function(id, get_symbol_name) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$symbol <- renderText(get_symbol_name())
output$table <- renderTable(make_table(get_symbol_name()))
})}
OneStock_ui <- function(id) {
ns <- NS(id)
tagList(
tags$h4(textOutput(ns("OneStocksymbol"))),
tableOutput(ns("OneStocktable"))
)}
OneStock_server <- function(id, get_symbol_date) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$OneStocksymbol <- renderText(get_symbol_date())
output$OneStocktable <- renderTable(make_table(get_symbol_date()))
})}
ui <- fluidPage(
tabsetPanel(
tabPanel(
selectInput("run_date", "Run Date", df_rep_data %>% pull(RunDate)),
tags$h2(textOutput("date_output")),
tags$h3(textOutput("lst_symb_output")),
uiOutput("symbols_output")),
tabPanel(
textInput("OneStockChart_input",'OneStockAnalysis', value = 'MSFT'),
uiOutput("OneStockAnalysis_output"))
))
server <- function(input, output, session) {
handler <- list()
get_syms <- list()
get_syms_onestock <- list()
handler_onestock <- list()
output$date_output <- renderText(req(input$run_date))
output$lst_symb_output <- renderText({
df_rep_data %>%
filter(RunDate == req(input$run_date)) %>%
pull(ListStocks)
})
output$symbols_output <- renderUI({
symbols <- df_rep_data %>%
filter(RunDate == req(input$run_date)) %>%
pull(ListStocks) %>%
str_split(fixed(", ")) %>%
unlist()
syms <- vector("list", length(symbols)) %>%
set_names(symbols)
for (sym in symbols) {
local({
my_sym <- sym
syms[[my_sym]] <<- symb_ui(my_sym)
get_syms[[my_sym]] <<- reactive(my_sym)
handler[[my_sym]] <<- symb_server(my_sym, get_syms[[my_sym]])
})
}
tagList(syms)
})
output$OneStockAnalysis_output <- renderUI({
symbols_onestock <- list(req(input$OneStockChart_input)) %>%
unlist()
syms_onestock <- vector("list", length(symbols_onestock)) %>%
set_names(symbols_onestock)
for (sym_onestock in symbols_onestock) {
local({
my_sym_onestock <- sym_onestock
syms_onestock[[my_sym_onestock]] <<- symb_ui(my_sym_onestock)
get_syms_onestock[[my_sym_onestock]] <<- reactive(my_sym_onestock)
handler_onestock[[my_sym_onestock]] <<- symb_server(my_sym_onestock, get_syms_onestock[[my_sym_onestock]])
})
}
tagList(syms_onestock)
})}
shinyApp(ui = ui, server = server)
I am creating a quarto powerpoint presentation and want to use a dataset to iterate over all the classes in a variable and do a plot for each class on a new slide. However, my plot doesn't seem to show up
---
title: "test_quarto_presentation"
format: pptx
editor: visual
---
## Quarto
Trying to iterate over each species and print the distributions on slides
```{r}
library(tidyverse)
```
```{r, results='asis'}
for (species in unique(iris$Species)){
cat(paste0('## ', species))
print("test")
print(iris %>%
filter(Species == "virginica") %>%
ggplot(aes(x = Petal.Length)) +
geom_histogram())}
```
Here is an option by producing the plots beforehand using purrr based on this discussion:
---
title: "test_quarto_presentation"
format: pptx
---
```{r, include=FALSE}
library(tidyverse)
spec_name <- unique(iris$Species)
make_hist <- function(spec) {
iris |>
filter(Species == spec) |>
ggplot(aes(x = Petal.Length)) +
geom_histogram()
}
list_hist <- map(spec_name, make_hist)
df <- tibble(spec = spec_name, plots = list_hist)
```
```{r}
#| output: asis
res <- pmap_chr(df, \(spec, plots) {
knitr::knit_child(text = c(
"## `r spec`",
"```{r}",
"#| echo: false",
"plots",
"```",
""), envir = environment(), quiet = TRUE)
})
cat(res, sep = '\n')
```
Output:
I'm trying to generate a Word document with figures. I use {officedown} and {officer} packages. I need to do it dynamically, in a loop since I don't know how many figures there will be. This is my Rmarkdown code:
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
```
```{r}
block_toc(seq_id = "fig")
```
```{r results='asis'}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- lapply(seq_len(length(ttp)), function(i) {
fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]],
external_img(src = tmps[[i]], width = 6, height = 5)
)
})
do.call(block_list, fpars)
```
The problem is when I generate the table of figures in the rendered document. It looks like this:
An entry is kept together with the image itself, I don't know why.
I save temporary png files to be able to use them inside fpar function. Using plot function directly inside fpar causes bad effects. Maybe there's another/better way?
I found this construction useful, but unfortunately it puts captions under the figures by default. My goal is figure captions behave more like table captions, i.e. a caption is above a figure.
```{r fig.cap=unlist(titles)}
plot(iris[1:10, 1:2])
```
How can I generate the plots with captions dynamically with {officedown} or {officer} packages?
The only issue is about the last lapply, you need to put the image in a separate paragraph, so a for loop will be easier to stack 2 paragraphs into a list instead of 1 for each iteration.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r}
ttp <- c(3, 7)
test_items <- c("item A", "item B", "item C")
fpars <- lapply(test_items, function(ti) {
fpar(
ftext("Application of "),
ftext(ti),
ftext(" Variable text - describe any test item-related effects"),
ftext(" (see "),
run_reference("fig:results1"),
ftext(")."),
fp_p = fp_par(padding.bottom = 12)
)
})
do.call(block_list, fpars)
```
```{r}
titles <- lapply(seq_len(length(ttp)), function(i) {
sprintf(
"My custom figure caption with %s, having %s side effects",
paste(test_items, collapse = ", "),
ttp[i]
)
})
```
```{r}
tmps <- lapply(seq_len(length(ttp)), function(i) {
tmp <- tempfile(fileext = ".png")
png(tmp, width = 6, height = 5, units = "in", res = 120)
plot(iris[sample(1:150, 30), i + 1:2])
dev.off()
return(tmp)
})
```
```{r}
fpars <- list()
for (i in seq_along(ttp)) {
fpars[[length(fpars)+1]] <- fpar(
run_autonum(
seq_id = "fig",
pre_label = "Figure ",
bkm = paste0("fig:results", i),
bkm_all = TRUE,
prop = fp_text(bold = TRUE, font.size = 12)
),
titles[[i]]
)
fpars[[length(fpars)+1]] <- fpar(
external_img(src = tmps[[i]], width = 6, height = 5)
)
}
do.call(block_list, fpars)
```
This is an answer for "how to do it with officer" from scratch.
But the following is much more simple. There is an option fig.topcaption that do the same thing.
---
output:
officedown::rdocx_document:
plots:
caption:
style: Table Caption
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
```
```{r}
library(dplyr)
library(flextable)
library(officer)
library(officedown)
```
```{r}
block_toc(seq_id = "fig")
```
```{r fig.cap = "miaou", fig.topcaption=TRUE}
plot(cars)
```
```{r fig.cap = "ouaf", fig.topcaption=TRUE}
plot(cars)
```
I am creating a data frame, that is dynamically created when the user inputs a search term, in order to do this i have an action button, and the data frame is created when the "go" button is pressed.
Once this is done i need to perform various data manipulations on the DF, and out put different graphs.
i am struggling to understand how i do the data manipulation in Shiny, i have some simplified example code below:
library(shiny)
library(sp)
library(stringr)
library(tidyr)
library(tidyverse)
library(tm)
library(ggplot2)
library(stringi)
library(plyr)
library(dplyr)
ui <- fluidPage(
fluidRow(
column( 4, titlePanel("Twitter Analytics")),
column( 3),
column( 4,
textInput("searchstring",
label = "",
value = "")),
column(1,
br(),
actionButton("action", "go"))
),
fluidRow(
column( 12, tabsetPanel(
tabPanel("one",
fluidRow(
column(3 ),
column(9, plotOutput("ttext"))
)
),
tabPanel("two"),
tabPanel("three")
)
)
)
)
server <- function(input, output) {
tweet <- eventReactive(input$action,{
num <- c(1,2,3,4,50)
text <- c("this is love love something", "this is not hate hate hate something", "#something islove rethched this not", " Shiny is love confusing me", "this is hate also somthing difficult")
letter<- c("a", "b", "c", "D", "e")
tweetdf <- data.frame(num, text, letter)
})
tdm <- if( is.null(tweetdf) ){return()}
else{
tweetdf$text <- tolower(tweetdf$text)
# tweetdf #UserName
tweetdf$text <- gsub("#\\w+", "", tweetdf$text)
#remove punctuation
tweetdf$text <- gsub("[[:punct:]]", "", tweetdf$text)
#remove links
tweetdf$text <- gsub("http\\w+", "", tweetdf$text)
# Remove tabs
tweetdf$text <- gsub("[ |\t]{2,}", "", tweetdf$text)
# Remove blank spaces at the beginning
tweetdf$text <- gsub("^ ", "", tweetdf$text)
# Remove blank spaces at the end
corpus <- iconv(tweetdf$text, to = "ASCII")
corpus <- Corpus(VectorSource(corpus))
corpus <- tm_map(corpus, removePunctuation)
corpus <- tm_map(corpus, removeNumbers)
cleanset <- tm_map(corpus, removeWords, stopwords('english'))
tdm <- TermDocumentMatrix(cleanset)
tdm <- as.matrix(tdm)
w <- rowSums(tdm)
}
output$ttext <- renderPlot({
library(RColorBrewer)
barplot(w)
})
output$wordCl <- renderPlot({
library(wordcloud2)
w <- data.frame(names(w), w)
colnames(w) <- c('word', 'freq')
wordcloud2(w,
color = 'random-dark',
size = 0.7,
shape = 'circle',
rotateRatio = 0.5,
minSize = 1)
})
}
shinyApp(ui, server)
i keep getting the error message that tweetdf does not exist, This should not exist, until the user has entered a search term and clicked "go"
What is the best way to approach this problem, is this even the right spot to do this
It tells you that tweetdf doest not exist because the result of eventReactive (tweetdf) is assign to the variable tweet, which makes tweet your actual reactive variable with the result of tweetdf in.
Also the problem in your code is that you mix classic variables with reactive variables.
You can access reactive variables by adding parenthesis at the end of the variable()
Here is a working example:
library(shiny)
library(sp)
library(stringr)
library(tidyr)
library(tidyverse)
library(tm)
library(ggplot2)
library(stringi)
library(plyr)
library(dplyr)
library(RColorBrewer)
library(wordcloud2)
ui <- fluidPage(
fluidRow(
column( 4, titlePanel("Twitter Analytics")),
column( 3),
column( 4,
textInput("searchstring",
label = "",
value = "")),
column(1,
br(),
actionButton("action", "go"))
),
fluidRow(
column( 12, tabsetPanel(
tabPanel("one",
fluidRow(
column(3 ),
column(9, plotOutput("ttext"))
)
# ,fluidRow(wordcloud2Output("wordCl"))
),
tabPanel("two"),
tabPanel("three")
)
)
)
)
server <- function(input, output) {
w <- eventReactive(input$action,{
num <- c(1,2,3,4,50)
text <- c("this is love love something", "this is not hate hate hate something", "#something islove rethched this not", " Shiny is love confusing me", "this is hate also somthing difficult")
letter<- c("a", "b", "c", "D", "e")
tweetdf <- data.frame(num, text, letter)
tdm <- if( is.null(tweetdf) ){return()} ## should not use return here as this is not a function
else{
print(tweetdf)
tweetdf$text <- tolower(tweetdf$text)
# tweetdf #UserName
tweetdf$text <- gsub("#\\w+", "", tweetdf$text)
#remove punctuation
tweetdf$text <- gsub("[[:punct:]]", "", tweetdf$text)
#remove links
tweetdf$text <- gsub("http\\w+", "", tweetdf$text)
# Remove tabs
tweetdf$text <- gsub("[ |\t]{2,}", "", tweetdf$text)
# Remove blank spaces at the beginning
tweetdf$text <- gsub("^ ", "", tweetdf$text)
# Remove blank spaces at the end
corpus <- iconv(tweetdf$text, to = "ASCII")
corpus <- Corpus(VectorSource(corpus))
corpus <- tm_map(corpus, removePunctuation)
corpus <- tm_map(corpus, removeNumbers)
cleanset <- tm_map(corpus, removeWords, stopwords('english'))
tdm <- TermDocumentMatrix(cleanset)
tdm <- as.matrix(tdm)
w <- rowSums(tdm)
}
})
output$ttext <- renderPlot({
barplot(w())
})
output$wordCl <- renderWordcloud2({
w <- data.frame(names(w()), w())
colnames(w) <- c('word', 'freq')
wordcloud2(w,
color = 'random-dark',
size = 0.7,
shape = 'circle',
rotateRatio = 0.5,
minSize = 1)
})
}
shinyApp(ui, server)