In svmiller/stevedata: Steve's Toy Data for Teaching About a Variety of Methodological, Social, and Political Topics

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
options(rmarkdown.html_vignette.check_title = FALSE)

Here is a description of every data set in {stevedata}. The underlying code in the vignettes/ folder will show the code that formats this table.

library(stevedata)
library(knitr)
library(tibble)
library(tools)
#library(tidyverse)

alldata <- data(package = "stevedata")

getdescript <- function(package){
  db <- tools::Rd_db(package)
  descript <- lapply(db,function(x) {
    tags <- tools:::RdTags(x)
    if("\\description" %in% tags){
      out <- paste(unlist(x[which(tags=="\\description")]),collapse=" ")
    }
    else
      out <- NULL
    invisible(out)
  })
  gsub("\n","",unlist(descript))
}

descripts <- getdescript("stevedata")

object_name <- paste0("`",alldata$results[, "Item"],"`")
object_link <- paste0("[",object_name,"](http://svmiller.com/stevedata/reference/",alldata$results[, "Item"],".html)")


d <- alldata$results; 
names <- d[,'Item']

derp <- c()
for (i in 1:length(names)) {
    name <- names[i];
   # cat(name,':\n');
    x <- get(gsub('\\s.*','', name));
    xx <- sapply(x, class)
    xxx <- sapply(xx, paste, collapse = '-')
    aaa <- data.frame(xxxx = as.vector(xxx), o = 1)
    bbb <- aggregate(o ~ xxxx, aaa, function(x) c(n = length(x)))
    bbb$da <- paste0(bbb$x," (", bbb$o, ")")
    ccc <- paste(bbb$da, collapse="; ")
    #ccc <- tibble(x = as.vector(sapply(x, typeof))) %>% summarize(n = n(), .by=x) %>% mutate(da = paste0(x," (", n, ")")) %>% pull(da) %>% paste(.,  collapse="; ")
    #m <- paste(dim(as.matrix(x)),collapse=' ');
    m <- paste("<span style='font-size:90%'><br /><br />**Rows:**", nrow(x),
               "**Columns**:", ncol(x),".<br />",
               "**Column types**:",ccc, "</span>")
    #cat(m);
    derp <- c(derp, m)
    #return(derp)
};



tibble(`**Object Name**` = object_link,
       `**Description**` = paste(descripts, derp)) -> tibs

tibs <- tibs[order(tibs$`**Object Name**`), ]

kable(tibs, format="markdown")

svmiller/stevedata documentation built on April 3, 2025, 1:18 p.m.