## ---- echo = FALSE-------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "README-"
)
library("strcode")
## ------------------------------------------------------------------------
# ____________________________________________________________________________
# A title ####
## ------------------------------------------------------------------------
## ............................................................................
## A subtitle ####
## ------------------------------------------------------------------------
### .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
### One more ####
## ------------------------------------------------------------------------
## .................. #< 685c967d4e78477623b861d533d0937a ># ..................
## An anchored section ####
## ---- eval=FALSE---------------------------------------------------------
# #< 56f5139874167f4f5635b42c37fd6594 >#
# this_is_a_super_important_but_hard_to_describe_line_so_let_me_anchor_it
## ---- eval=FALSE---------------------------------------------------------
# sum_str(file_out = "strcode.Rmd",
# width = 40,
# granularity = 2,
# lowest_sep = FALSE,
# header = TRUE)
## ---- eval = FALSE-------------------------------------------------------
# Summarized structure of placeholder_code/example.R
#
# line level section
# 2 # _
# 3 # function test
# 6 ## -A: pre-processing
# 57 ## B: actual function
# 83 # ____________________________________
# 84 # function test2
# 87 ## A: pre-processing
# 138 ## B: actual function
# 169 ## test
## ------------------------------------------------------------------------
# ____________________________________________________________________________
# function test ####
test <- function(x) {
## ............................................................................
## A: pre-processing ####
### .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
### a: assertive tests ####
# x
if(missing(x) || is.null(x)){
x <- character()
}
assert(
# use check within assert
check_character(x),
check_factor(x),
check_numeric(x)
)
# levels
if(!missing(levels)){
assert(
check_character(levels),
check_integer(levels),
check_numeric(levels))
levels <- na.omit(levels)
}
# labels
if(!missing(labels)){
assert(
check_character(labels),
check_numeric(labels),
check_factor(labels)
)
}
### .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
### b: coercion / remove missing ####
x <- as.character(x)
uniq_x <- unique(na.omit(x), nmax = nmax)
### .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
### c: warnings ####
if(length(breaks) == 1) {
if(breaks > max(x) - min(x) + 1) {
stop("range too small for the number of breaks specified")
}
if(length(x) <= breaks) {
warning("breaks is a scalar not smaller than the length of x")
}
}
## ............................................................................
## B: actual function ####
variable < -paste("T", period, "nog_", sector, sep = "")
variable <- paste(variable, "==", 1, sep = "")
arg<-substitute(variable)
r<-eval(arg, idlist.data[[1]])
a<<-1
was_factor <- FALSE
if (is.factor(yes)) {
yes <- as.character(yes)
was_factor <- TRUE
}
if (is.factor(no)) {
no <- as.character(no)
was_factor <- TRUE
}
out <- ifelse(test, yes, no)
if(was_factor) {
cfactor(out)
} else {
out
}
## ............................................................................
}
# ____________________________________________________________________________
# function test2 ####
test2 <- function(x) {
## ............................................................................
## A: pre-processing ####
### .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
### a: assertive tests ####
# x
if(missing(x) || is.null(x)){
x <- character()
}
assert(
# use check within assert
check_character(x),
check_factor(x),
check_numeric(x)
)
# levels
if(!missing(levels)){
assert(
check_character(levels),
check_integer(levels),
check_numeric(levels))
levels <- na.omit(levels)
}
# labels
if(!missing(labels)){
assert(
check_character(labels),
check_numeric(labels),
check_factor(labels)
)
}
### .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
### b: coercion / remove missing ####
x <- as.character(x)
uniq_x <- unique(na.omit(x), nmax = nmax)
### .. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
### c: warnings ####
if(length(breaks) == 1) {
if(breaks > max(x) - min(x) + 1) {
stop("range too small for the number of breaks specified")
}
if(length(x) <= breaks) {
warning("breaks is a scalar not smaller than the length of x")
}
}
## ............................................................................
## B: actual function ####
variable < -paste("T", period, "nog_", sector, sep = "")
variable <- paste(variable, "==", 1, sep = "")
arg<-substitute(variable)
r<-eval(arg, idlist.data[[1]])
a<<-1
was_factor <- FALSE
if (is.factor(yes)) {
yes <- as.character(yes)
was_factor <- TRUE
}
if (is.factor(no)) {
no <- as.character(no)
was_factor <- TRUE
}
out <- ifelse(test, yes, no)
if(was_factor) {
cfactor(out)
} else {
out
}
## ............................................................................
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.