I'm using read_chunk function to read R code from external file. Sometimes I add comments for myself but I want to exclude those comments in my final document. I wonder how can the following pattern
###################################################
### code chunk number 1:
###################################################
can be excluded in read_chunk function.
###################################################
### code chunk number 1:
###################################################
## ---- Code1 ----
Some Code
###################################################
### code chunk number 2:
###################################################
## ---- Code2 ----
Some Code
###################################################
### code chunk number 3:
###################################################
## ---- Code3 ----
Some Code
###################################################
### The End
###################################################
Thanks in advance for your help.
I guess you can filter out the lines you don't want,
code <- "
###################################################
### code chunk number 1:
###################################################
## ---- Code1 ----
ls()
###################################################
### code chunk number 2:
###################################################
## ---- Code2 ----
ls()
###################################################
### code chunk number 3:
###################################################
## ---- Code3 ----
ls()
###################################################
### The End
###################################################
"
codelines <- readLines(textConnection(code))
# if the code is in file 'mycode.txt'
# codelines <- readLines('mycode.txt')
codelines <- codelines[!codelines == ""] # empty lines
keep <- !grepl("###", x=codelines) # comment lines
read_chunk(lines=paste(codelines[keep]))
knitr:::knit_code$get()
knitr:::knit_code$restore()
Related
Let's say I have this Apollo model (from http://www.apollochoicemodelling.com/files/examples/4%20Ranking%20and%20rating/OL.r)
# ################################################################# #
#### LOAD LIBRARY AND DEFINE CORE SETTINGS ####
# ################################################################# #
### Clear memory
rm(list = ls())
### Load Apollo library
library(apollo)
### Initialise code
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "OL",
modelDescr = "Ordered logit model fitted to attitudinal question in drug choice data",
indivID = "ID",
outputDirectory = "output"
)
# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
### Loading data from package
### if data is to be loaded from a file (e.g. called data.csv),
### the code would be: database = read.csv("data.csv",header=TRUE)
database = ?apollo_drugChoiceData
### for data dictionary, use ?apollo_drugChoiceData
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any that are kept fixed in estimation
apollo_beta = c(beta_reg_user = 0,
beta_university = 0,
beta_age_50 = 0,
tau_quality_1 =-2,
tau_quality_2 =-1,
tau_quality_3 = 1,
tau_quality_4 = 2)
### Vector with names (in quotes) of parameters to be kept fixed at their starting value in apollo_beta, use apollo_beta_fixed = c() if none
apollo_fixed = c()
# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #
apollo_inputs = apollo_validateInputs()
# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #
apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
### Attach inputs and detach after function exit
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
### Create list of probabilities P
P = list()
### Calculate probabilities using Ordered Logit model
ol_settings = list(outcomeOrdered = attitude_quality,
utility = beta_reg_user*regular_user + beta_university*university_educated + beta_age_50*over_50,
tau = list(tau_quality_1, tau_quality_2, tau_quality_3, tau_quality_4),
rows = (task==1))
P[["model"]] = apollo_ol(ol_settings, functionality)
### Take product across observation for same individual
P = apollo_panelProd(P, apollo_inputs, functionality)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### MODEL ESTIMATION ####
# ################################################################# #
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
# ################################################################# #
#### MODEL OUTPUTS ####
# ################################################################# #
# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO SCREEN) ----
# ----------------------------------------------------------------- #
apollo_modelOutput(model)
# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO FILE, using model name) ----
# ----------------------------------------------------------------- #
apollo_saveOutput(model)
However, since I need to make many version of the same model with a very small change, I would love to make it into a function. Say like this:
Apollofunction <- function(beta,variable){
# ################################################################# #
#### LOAD LIBRARY AND DEFINE CORE SETTINGS ####
# ################################################################# #
### Clear memory
rm(list = ls())
### Load Apollo library
library(apollo)
### Initialise code
apollo_initialise()
### Set core controls
apollo_control = list(
modelName = "OL",
modelDescr = "Ordered logit model fitted to attitudinal question in drug choice data",
indivID = "ID",
outputDirectory = "output"
)
# ################################################################# #
#### LOAD DATA AND APPLY ANY TRANSFORMATIONS ####
# ################################################################# #
### Loading data from package
### if data is to be loaded from a file (e.g. called data.csv),
### the code would be: database = read.csv("data.csv",header=TRUE)
database = ?apollo_drugChoiceData
### for data dictionary, use ?apollo_drugChoiceData
# ################################################################# #
#### DEFINE MODEL PARAMETERS ####
# ################################################################# #
### Vector of parameters, including any that are kept fixed in estimation
apollo_beta = c(beta = 0,
beta_university = 0,
beta_age_50 = 0,
tau_quality_1 =-2,
tau_quality_2 =-1,
tau_quality_3 = 1,
tau_quality_4 = 2)
### Vector with names (in quotes) of parameters to be kept fixed at their starting value in apollo_beta, use apollo_beta_fixed = c() if none
apollo_fixed = c()
# ################################################################# #
#### GROUP AND VALIDATE INPUTS ####
# ################################################################# #
apollo_inputs = apollo_validateInputs()
# ################################################################# #
#### DEFINE MODEL AND LIKELIHOOD FUNCTION ####
# ################################################################# #
apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
### Attach inputs and detach after function exit
apollo_attach(apollo_beta, apollo_inputs)
on.exit(apollo_detach(apollo_beta, apollo_inputs))
### Create list of probabilities P
P = list()
### Calculate probabilities using Ordered Logit model
ol_settings = list(outcomeOrdered = attitude_quality,
utility = beta*variable + beta_university*university_educated + beta_age_50*over_50,
tau = list(tau_quality_1, tau_quality_2, tau_quality_3, tau_quality_4),
rows = (task==1))
P[["model"]] = apollo_ol(ol_settings, functionality)
### Take product across observation for same individual
P = apollo_panelProd(P, apollo_inputs, functionality)
### Prepare and return outputs of function
P = apollo_prepareProb(P, apollo_inputs, functionality)
return(P)
}
# ################################################################# #
#### MODEL ESTIMATION ####
# ################################################################# #
model = apollo_estimate(apollo_beta, apollo_fixed, apollo_probabilities, apollo_inputs)
# ################################################################# #
#### MODEL OUTPUTS ####
# ################################################################# #
# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO SCREEN) ----
# ----------------------------------------------------------------- #
apollo_modelOutput(model)
# ----------------------------------------------------------------- #
#---- FORMATTED OUTPUT (TO FILE, using model name) ----
# ----------------------------------------------------------------- #
apollo_saveOutput(model)
}
Then I could be able to call this apollo function with multiple variations:
Apollofunction(beta_reg_user, regular_user)
Apollofunction(etc, etc)
However, when I then try to run the function, it gives me the error Error in apollo_validateInputs() : No variable called database found in user workspace (i.e. global environment).
I then tried to upload the database in the global environment and delete the rm(list = ls()), but then I just get this error: Error in apollo_validateInputs() : No variable called apollo_beta found in user workspace (i.e. global environment). - so there seems to be a problem with how the function interacts with the global environment. Any way to change that? Maybe it has something to do with the use of "="?
The data is available at the link for OL - the csv file. http://www.apollochoicemodelling.com/examples.html
At this moment i want to create a model from apollo packages. I import the data from .txt file and want to create appollo_fixed variable.Then, this error message occured. (The data was imported succesfully)
apollo_inputs = apollo_validateInputs()
Error in [.data.frame(database, , apollo_control$indivID) :
undefined columns selected
The code I use is shown here,
rm(list = ls())
### Load libraries
library(apollo)
### Initialise code
apollo_initialise()
### Set core controls
apollo_control = list(
modelName ="MNL",
modelDescr ="Simple MNL model on mode choice data",
indivID ="id")
# ####################################################### #
#### 2. Data loading ####
# ####################################################### #
mydata <- read.table("/Documents/Travelmode_Final_project.txt", header=TRUE)
database = mydata
rm(mydata)
# ####################################################### #
#### 3. Parameter definition ####
# ####################################################### #
### Vector of parameters, including any that are kept fixed during estimation
apollo_beta=c(shuttlebus=0,
citybus=0,
bike=0,
ubike=0,
motorbike=0,
car=0,
mrt=0,
taxi=0,
b_SB_TC=0,
b_SB_TT=0,
b_CB_TC=0,
b_CB_TT=0,
b_B_TC=0,
b_B_TT=0,
b_UB_TC = 0,
b_UB_TT=0,
b_M_TC=0,
b_M_TT=0,
b_C_TC=0,
b_C_TT=0,
b_MRT_TT=0,
b_MRT_TC=0,
b_T_TT=0,
b_T_TC=0)
apollo_fixed = c("shuttlebus")
# ####################################################### #
#### 4. Input validation ####
# ####################################################### #
apollo_inputs = apollo_validateInputs()
Is there any solution I may need to change to solve this error? Or any potential reasons that may cause this error?
I generate a standardized report using knitr. To document errors easier (the input data is not always what is expected), I need a log file amended with plus nice HTML formatting and figure embedding. A log file lists results until an error occurs, then ends.
The default of knitr, however, is to print the error message into the output and then continue with the next chunks. Alternatively, using knitr::opts_chunk$set(error = FALSE), one can abort the whole process when an error occurs, creating no markdown output at all.
But I want knitr to print until reaching an error, then stop.
I can stop early and generate a HTML output using knitr::knit_exit(), but I cannot use it as an error handler. See the two examples below. The first does as expected, but the second one is supposed to output the error message "Test" as the last chunk. How can I achieve this?
MWE 1: knit_exit()
knitr::knit(output = stdout(), text = "
```{r}
1 + 1
```
```{r}
knitr::knit_exit()
```
```{r}
2 + 2
```
")
## ```r
## 1 + 1
## ```
##
## ```
## ## [1] 2
## ```
##
##
## ```r
## knitr::knit_exit()
## ```
MWE 2: No error handling
options(error = knitr::knit_exit); knitr::knit(output = stdout(), text = "
```{r}
1 + 1
```
```{r}
stop('Test')
```
This text should not be in the output.
```{r}
2 + 2
```
")
## ```r
## 1 + 1
## ```
##
## ```
## ## [1] 2
## ```
##
##
## ```r
## stop('Test')
## ```
##
## ```
## Error in eval(expr, envir, enclos): Test
## ```
##
## This text should not be in the output.
##
##
## ```r
## 2 + 2
## ```
##
```
## [1] 4
```
That's correct, it does not work to directly use knitr::knit_exit() as an error handler. However, you can override the error output hook with it to achieve your desired outcome:
knitr::knit(
output = stdout(),
text = "
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, error = TRUE)
# override error output hook here
knitr::knit_hooks$set(error = function(x, options) {
knitr::knit_exit()
})
```
```{r}
1 + 1
```
```{r}
stop('Test')
```
This text should not be in the output.
```{r}
2 + 2
```
")
```
#>
#>
#>
#>
#> ```r
#> 1 + 1
#> #> [1] 2
#> ```
#>
#>
#> ```r
#> stop('Test')
#> ```
Created on 2022-10-24 with reprex v2.0.2
In addition to the accepted answer (which helped me a lot and you should upvote ;-) ) one might want the error message to be printed. In that case, the error hook can be used to signal knitr to quit but also save the error message, for example in a global variable. Then, the chunk hook can be used to print the error message in a last output block:
For that, use the following hooks
knitr::knit_hooks$set(error = function(x, options) {
ERROR <<- x
knitr::knit_exit()
})
knitr::knit_hooks$set(chunk = function(x, options){
if(exists('ERROR')) paste0(x,'```\n',ERROR,'```\n\n**Skript stopped with error**')
else x
})
Or, in the complete example:
knitr::knit(
output = stdout(),
text = "
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, error = TRUE)
# override error output hook here
knitr::knit_hooks$set(error = function(x, options) {
ERROR <<- x
knitr::knit_exit()
})
knitr::knit_hooks$set(chunk = function(x, options){
if(exists('ERROR')) paste0(x,'```\n',ERROR,'```\n\n**Skript stopped with error**')
else x
})
```
```{r}
1 + 1
```
```{r}
stop('Test')
```
This text should not be in the output.
```{r}
2 + 2
```
")
I'm trying to add an ASCII qr code to the signatura file (~/.signature).
The code is generated via qrencode, and in alpine it looks like this:
But after sending the email, for instance, in gmail it looks like this:
The signature file can be found here: signature file
Is it possible to fix this?
Use this:
############## ## ## ########## ##############
## ## #### #### ## ## ## ## ##
## ###### ## ## #### ######## ## ## ###### ##
## ###### ## ## #### ## #### ## ###### ##
## ###### ## #### ###### ###### ## ###### ##
## ## ## ## #### #### ###### ## ##
############## ## ## ## ## ## ## ## ##############
## ## ## #### ########
#### ## #### #### ## ## #### ###### ####
## ###### #### ## #### ## ##
###### ###### ## ## #### ######## ######
#### ## ## #### ## ## ## #### ####
#### #### #### #### #### ######## ## ####
## ## ## ## ## ###### ##
## ######## ######## #### ## ########
#### #### ## ############## ## ##
## ## #### ## ## ## #### ## ##
## ## ## ## ## ## ## ###### ## ##
## ## ## ## ## ## #### ## ####
###### #### ## #### #### ####
## ## #### ######## ## ########## ##
#### #### ## #### ## ######
############## ## ## #### #### ## ## ## ##
## ## ###### ## ## ## ## ##########
## ###### ## ## #### ###### ########## ##
## ###### ## #### ###### ## ## ########
## ###### ## ## ## ## ## ###### ##
## ## ## ###### ###### ######## ## ##
############## ## ###### ## #### ##########
Instead of:
############## ## ## ########## ##############
## ## #### #### ## ## ## ## ##
## ###### ## ## #### ######## ## ## ###### ##
## ###### ## ## #### ## #### ## ###### ##
## ###### ## #### ###### ###### ## ###### ##
## ## ## ## #### #### ###### ## ##
############## ## ## ## ## ## ## ## ##############
## ## ## #### ########
#### ## #### #### ## ## #### ###### ####
## ###### #### ## #### ## ##
###### ###### ## ## #### ######## ######
#### ## ## #### ## ## ## #### ####
#### #### #### #### #### ######## ## ####
## ## ## ## ## ###### ##
## ######## ######## #### ## ########
#### #### ## ############## ## ##
## ## #### ## ## ## #### ## ##
## ## ## ## ## ## ## ###### ## ##
## ## ## ## ## ## #### ## ####
###### #### ## #### #### ####
## ## #### ######## ## ########## ##
#### #### ## #### ## ######
############## ## ## #### #### ## ## ## ##
## ## ###### ## ## ## ## ##########
## ###### ## ## #### ###### ########## ##
## ###### ## #### ###### ## ## ########
## ###### ## ## ## ## ## ###### ##
## ## ## ###### ###### ######## ## ##
############## ## ###### ## #### ##########
The difference is that the regular space character used in the second qrcode was replaced with the unicode U+2007   in the first one, which is a different space character that happens to use the same space as #. As you can see it wasn't necessary even to blockquote them, their space was fixed by itself.
The problem here is that alpine sends text only emails (mime type text/plain) and gmail instead of showing it in a monospaced font, it shows it in Arial,Helvetica,sans-serif. If you open the "bad" email in any cli email client like Alpine it will be shown as "good", because cli are forced to use monoscpaced fonts by nature. Gmail has decided helvetica font family is better than monospaced, trading off this ability to handle better those "ascii art" emails.
Trying to force Alpine to send text/html emails by embedding HTML tags or trying to insert Content-Type: text/html; charset="UTF-8" in the message didn't work.
With this limitation, we still can take advantage of the great variety of symbols that unicode has to offer and choose a combination of black and white characters that solves this problem of having the same spacing for this font family Arial,Helvetica,sans-serif. By keeping your # as the black character in the QR Code and using U+2007   Figure Space your problem is solved.
If you want to try other black characters like this one █ to make your QR-code more solid, you can try, but then you need to find a equally-spaced space character, and also test if the vertical proportions are ok. It is also good to check for different environments - windows with x fonts installed, mac with y fonts installed and linux with z fonts installed may have different opnions about the fonts Arial, Helvetica and sans-serif and their respective spacings.
By default, Gmail client limits the width of your text. You can adjust your email's inline styles to prevent text wrapping:
<table style="width: 100%; max-width: 600px; white-space: nowrap">
...
<table>
You can use <pre> which preformatted text which is to be presented exactly as written in the HTML file. You can learn more about at https://developer.mozilla.org/en-US/docs/Web/HTML/Element/pre
Thanks.
I want to be able to pass a reactive data.table to my Rmarkdown document that will sort the table and print the top, say 5, sorted entries.
I keep running into "Error : x must be a data.frame or data.table" at setorderv. I suspect the reactive is upsetting the is.data.table checks.
How do I simply pass a copy of the data to the Rmd document? And remove the reactivity wrapper?
Here is a simplified example cobbled from reactivity and downloadHandler stock examples. I took at look at this on SO which suggested using observe but I am not sure how to implement this. Thanks I appreciate some help on this.
RMARKDOWN - SOtestreport.Rmd
---
title: "Top in Segment Report"
output: html_document
params:
n: 5
dt: NA
top.field: NA
---
```{r setup, echo = FALSE}
library(data.table)
library(knitr) # for kable
```
Data report as at: `r format(Sys.time(), "%a %b %d %Y %X")`
```{r, echo = FALSE}
table.str <- paste0("Showing Top ", params$n ," tables for these fields: ",
params$top.field)
# is this the best way of having dynamic labels?
```
`r table.str`
```{r, echo = FALSE}
# tried this
# test.dt <- copy(dt)
# normally a function GenerateTopTable with limit sort field etc.
setorderv(dt, params$top.field, -1) # -1 is descending. THIS IS WHERE IT CRASHES
out <- dt[1:params$n,]
```
```{r toptable, echo = FALSE}
kable(out, digits = 3)
```
app.R
# SO test report
# mini example based on https://shiny.rstudio.com/gallery/reactivity.html
library(shiny)
library(datasets)
server <- function(input, output) {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
output$caption <- renderText({
input$caption
})
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
# PROBLEM BIT WHERE I AM ADDING ON GALLERY EXAMPLE
# handler from https://stackoverflow.com/questions/37347463/generate-report-with-shiny-app-and
output$topreport <- downloadHandler(
filename = "topreport.html",
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "SOtestreport.Rmd")
file.copy("SOtestreport.Rmd", tempReport, overwrite = TRUE)
# Set up parameters to pass to Rmd document
# TRIED THIS TOO
# my.dt <- as.data.table(datasetInput())
my.dt <- datasetInput()
my.params <- list(n = input$obs,
dt = my.dt,
top.field = names(my.dt)[1])
rmarkdown::render(tempReport, output_file = file,
params = my.params,
envir = new.env(parent = globalenv())
)
}
)
I fixed this example - dt in Rmd was not prefaced with params$!
setorderv(params$dt, params$top.field, -1) # -1 is descending
out <- params$dt[1:params$n,]
I still looking for answers on whether this is the right approach above (in passing parameters in Shiny to RMarkdown apps).
I also want to point out to others that these answers were also useful:
use of ReactiveValues by #NicE https://stackoverflow.com/a/32295811/4606130
What's the difference between Reactive Value and Reactive Expression?
I also made use of copying the dataset to break the reactivity, i.e.
my.dt <- copy(params$dt)
#do this before passing into render params list
Another tip in RStudio is not to use the internal Viewer Pane but to run externally in the browser. This fixed where the temporary file was saved issues. You can choose to always Run Externally under Run App in image below: