In bertcarnell/SOAs: Creation of Stratum Orthogonal Arrays

knitr::opts_chunk$set(echo = FALSE)
rd <- tools::parse_Rd(file.path("man", "SOAs-package.Rd"))
rd_html <- capture.output(tools::Rd2HTML(rd))

## Note:  These functions are internal to the tools package, but are not exposed
##    and are therefore not intended to be used and are subject to change.
##    for that reason, they are replicated here to ensure they stay consistent
##    with this document

## based on tools:::RdTags
rd_get_tags <- function(Rd)
{
  res <- lapply(Rd, attr, "Rd_tag")
  if (length(res)) 
      simplify2array(res, FALSE)
  else character()
}

## based on tools:::.Rd_get_metadata
rd_get_metadata <- function(x, tag)
{
  x <- x[rd_get_tags(x) == sprintf("\\%s", tag)]
  if (!length(x)) 
      character()
  else unique(trimws(vapply(x, paste, "", collapse = "\n")))
}

## might also want to capture html output for markdown.  This is more fragile
rd_html_get <- function(rd_html, from_h3, to_h3)
{
  #from_h3 <- "Details"
  #to_h3 <- "Author"
  ind_from <- grep(paste0("<h3>", from_h3), rd_html)
  ind_to <- grep(paste0("<h3>", to_h3), rd_html)
  if (length(ind_from) != 1 | length(ind_to) != 1 | all(ind_from == ind_to))
  {
    stop("from_h3 or to_h3 are not specified correctly")
  }
  return(rd_html[(ind_from + 1):(ind_to - 1)])
}

my_Rd_expr_doi <- function (x) 
{
    x <- tools:::.canonicalize_doi(x)
    sprintf("[doi: %s](https://doi.org/%s)", x, x)
}

SOAs

cat(rd_get_metadata(rd, "description"))

x <- rd_get_metadata(rd, "author")
x <- gsub("Author", "- **Author**", x)
x <- gsub("Contributor", "\n- **Contributor**", x)
cat(x)

cat("|Actions|Coverage|Website|\n")
cat("|:-----:|:------:|:-----:|\n")
cat(paste0("|", 
           "[![R-CMD-check](https://github.com/bertcarnell/SOAs/actions/workflows/r_cmd_check.yml/badge.svg)](https://github.com/bertcarnell/SOAs/actions/workflows/r_cmd_check.yml)",
           "[![pkgdown](https://github.com/bertcarnell/SOAs/actions/workflows/pkgdown.yaml/badge.svg)](https://github.com/bertcarnell/SOAs/actions/workflows/pkgdown.yaml)",
           "|",
           "[![Codecov test coverage](https://codecov.io/gh/bertcarnell/SOAs/branch/main/graph/badge.svg)](https://codecov.io/gh/bertcarnell/SOAs?branch=main)",
           "|",
           "[![](https://img.shields.io/badge/pkgdown-SOAs-blue.svg)](https://bertcarnell.github.io/SOAs/)",
           "|"))

Installation

You can install the released version of SOAs from CRAN with:

install.packages("SOAs")

You can also install the development version of SOAs from here with:

if (!require(devtools)) install.packages("devtools")
devtools::install_github("bertcarnell/SOAs")

Details

temp <- rd_html_get(rd_html, "Details", "Author") 

# change equations back to $ for eqn and $$ for deqn
#   Find <code class=\"reqn\"> and then the very next </code>

start_token <- '<code class="reqn">'
end_token <- '</code>'
deqn_start_token <- '<p style="text-align: center;"><code class="reqn">'
p_token <- '<p>'
p_end_token <- '</p>'
p_align_token <- '<p style="text-align: center;">'

ind_start <- grep(start_token, temp)
ind_deqn_start <- grep(deqn_start_token, temp)

for (i in 1:length(temp))
{
  ## /deqn
  if (i %in% ind_deqn_start)
  {
    temp[i] <- gsub(start_token, "\n$$", temp[i])
    if (!grepl(end_token, temp[i]))
      stop("closing </code> tag is not on the same line as the start for an equation")
    temp[i] <- gsub(end_token, "$$\n", temp[i])
  }
  ## /eqn
  if (i %in% setdiff(ind_start, ind_deqn_start))
  {
    temp[i] <- gsub(start_token, "$", temp[i])
    if (!grepl(end_token, temp[i]))
      stop("closing </code> tag is not on the same line as the start for an equation")
    temp[i] <- gsub(end_token, "$", temp[i])
  }
}

## <p> tags
temp <- gsub(p_token, "\n", temp)
temp <- gsub(p_end_token, "\n", temp)
temp <- gsub(p_align_token, "\n", temp)

cat(temp)

References

temp <- rd_html_get(rd_html, "References", "See") 
for (i in seq_along(temp))
{
  if (grepl("[\\]+Sexpr[[]results=rd,stage=build[]][{].+[}]", temp[i]))
  {
    m <- regexpr("[\\]+Sexpr[[]results=rd,stage=build[]][{].+[}]", temp[i])
    text1 <- substring(temp[i], 1, m-1)
    code <- substring(temp[i], m, m + attr(m, "match.length"))
    if (m + attr(m, "match.length") >= nchar(temp[i]))
    {
      text2 <- ""
    } else
    {
      text2 <- substring(temp[i], m + attr(m,"match.length") + 1, nchar(temp[i]))
    }
    code <- gsub(".*[{]", "", code)
    code <- gsub("[}].*", "", code)
    code <- gsub("tools:::Rd_expr_doi", "my_Rd_expr_doi", code)
    temp[i] <- paste(text1, eval(parse(text=code)), text2)
  }
}

# this is a fix for Issue 19 - https://github.com/bertcarnell/SOAs/issues/19
line_found <- grep("[_]II", temp)
posit_found <- gregexpr("[_]II", temp[line_found])
temp2 <- temp
# temp2[line_found] <- paste0(substring(temp[line_found], 1, posit_found[[1]][2]-1),
#                             "&#95;",
#                             substring(temp[line_found], posit_found[[1]][2]+1, nchar(temp[line_found])))
temp2[line_found] <- gsub("[>]http", ">`http", temp[line_found])
temp2[line_found] <- gsub("pdf[<]", "pdf`<", temp2[line_found])

cat(temp2)