Skip to content

Instantly share code, notes, and snippets.

@dill
Created March 19, 2021 10:40
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dill/04b6e1f65b83c816311a36c9eed0d2c4 to your computer and use it in GitHub Desktop.
Save dill/04b6e1f65b83c816311a36c9eed0d2c4 to your computer and use it in GitHub Desktop.
Assess consistency of argument and function word separators in a package
# find bad variable/function names in a package
library(stringr)
# retrieve args and functions exported by a package
get_pkgdat <- function(pkgname){
contents <- objects(paste0("package:", pkgname))
fns <- Filter(function(x) is.function(eval(parse(text=x))), contents)
args <- lapply(fns, function(x){
ff <- names(formals(x))
ff <- ff[ff != "..."]
ff <- ff[grepl("[._]", ff)]
ff
})
names(args) <- fns
args
}
# collect some data
data_collect <- function(pkg){
# load package
library(pkg, character.only=TRUE)
# get exported arguments and functions
pkginfo <- get_pkgdat(pkg)
fns <- names(pkginfo)
vars <- unlist(pkginfo)
fn_dots <- str_count(fns, "\\.") > 0
fn_underscores <- str_count(fns, "_") > 0
fn_both <- fn_dots & fn_underscores
var_dots <- str_count(vars, "\\.") > 0
var_underscores <- str_count(vars, "_") > 0
var_both <- var_dots & var_underscores
data.frame(name = pkg,
fn_dots = sum(fn_dots),
fn_underscores = sum(fn_underscores),
fn_both = sum(fn_both),
var_dots = sum(var_dots),
var_underscores = sum(var_underscores),
var_both = sum(var_both))
}
# run and print
tab <- t(sapply(c("dsm", "mrds", "Distance", "readdst"), data_collect))
knitr::kable(tab)
# process and evaluate what is "wrong" based on which what we
# don't want
eval_virtue <- function(pkginfo, bad_fnames, bad_anames){
badf <- names(pkginfo)[unlist(lapply(names(pkginfo),
grepl, pattern=bad_fnames))]
bada <- lapply(pkginfo, function(x, bad_anames){
x[unlist(lapply(x, grepl, pattern=bad_anames))]
}, bad_anames=bad_anames)
# little cheat here since 0=FALSE
bada <- Filter(length, bada)
if(length(badf)>0){
cat("Bad function names:\n")
lapply(badf, function(x) cat(paste0("- `", x, "`\n")))
cat("\n\n")
}
if(length(bada)>0){
cat("Functions with bad arg names:\n")
for(i in 1:length(bada)){
cat(paste0("- `", names(bada)[i], "`\n"))
lapply(bada[[i]], function(x) cat(paste0(" - `", x, "`\n")))
}
cat("\n\n")
}
}
# settings 1st entry is function, second is args
# these are what we don't want
pkgs <- list(c("dsm", "\\.", "_"),
c("mrds", "\\_", "\\_"),
c("Distance", "_", "_"),
c("readdst", "\\.", "\\."))
ff<-function(x){
library(x[1], character.only=TRUE)
cat("Package:", x[1], "\n\n")
pkginfo <- get_pkgdat(x[1])
eval_virtue(pkginfo, x[2], x[3])
}
lapply(pkgs,ff)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment