Skip to content

Commit a16883a

Browse files
chapbchapb
committed
fix: improve user workflow through start_mill()
Refactor start_mill() with clearer prompts. Add support for .csv input. Begin deprecation of cedar_version.
1 parent 4ba38ca commit a16883a

12 files changed

Lines changed: 265 additions & 159 deletions

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ Description:
1313
License: GPL-3
1414
Encoding: UTF-8
1515
LazyData: true
16-
RoxygenNote: 7.1.2
16+
RoxygenNote: 7.2.3
1717
Imports:
1818
dplyr,
1919
readr,

‎NAMESPACE‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ export(build_chairs)
99
export(build_horse)
1010
export(build_table)
1111
export(check_grain)
12+
export(debark)
1213
export(dedupe_MA)
1314
export(do_MA)
1415
export(format_ma_results)
@@ -22,7 +23,6 @@ export(save_csv)
2223
export(start_mill)
2324
export(sub_mill)
2425
export(sweep_scraps)
25-
export(test_path_csv)
2626
export(trim_scraps)
2727
export(update_sawmill)
2828
importFrom(dplyr,bind_rows)

‎R/build_horse.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11

22

33
#' @title
4-
#' Calculate the significance of a factor
4+
#' Calculate the significance of a resistance outcome
55
#'
66
#' @description
77
#' \code{build_horse()} calculates the significance of the OR of a count or prevalence-based factor, using

‎R/debark.R‎

Lines changed: 92 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -15,13 +15,6 @@
1515
#' @param timber_path
1616
#' character: the file path to the raw timber
1717
#'
18-
#' @param cuts
19-
#' named vector: a mapping of the input raw timber names to their standardized column names,
20-
#' produced by \code{set_blade_depth()}
21-
#'
22-
#' @param col_data_types
23-
#' a vector containing the expected data type for each column in the raw timber (i.e. "text"),
24-
#' produced by \code{set_blade_depth()}
2518
#'
2619
#' @return
2720
#' A tibble of timber with standardized column names and additional columns
@@ -35,143 +28,150 @@
3528

3629

3730

38-
# This function reads the XLSX. Then, it converts cols to standard. Then it sees which are missing.
31+
debark <- function(timber_path){
3932

40-
test_path_csv <- "C:/Users/test/timber.csv"
41-
test_path_xls <- "C:/Users/test/timber.xls"
42-
test_path_xlsx <- "C:/Users/test/timber.xlsx"
33+
# CHECK: File Type Supported ------------------------------------------------
4334

35+
# Get file extension (lower case for later string comparisons).
36+
timber_file_ext <- tolower(tools::file_ext(timber_path))
4437

45-
# timber_path <- here::here("timber_test.xlsx")
38+
# Set supported extensions.
39+
supported_file_exts <- c("csv", "xls", "xlsx")
4640

41+
# Abort run if timber file extension is not supported.
42+
if (! timber_file_ext %in% supported_file_exts) {
43+
errmsg <- glue::glue("'.{timber_file_ext}' files are not supported by",
44+
"sawmill. Please specify one of the following file types:",
45+
paste(supported_file_exts, collapse = ", "),
46+
".")
47+
rlang::abort(message = errmsg)
48+
}
4749

50+
# This abort was previously doubled; asses impact of refactor.
51+
# rlang::abort(message = errmsg, rlang::abort(message = errmsg))
4852

49-
debark2 <- function(timber_path){
5053

51-
# Check file type compatibility.
52-
# Future use for import of CSV.
53-
timber_file_type <- get_supported_file_type(timber_path)
5454

55-
# Read in timber without column specification.
56-
timber_in <- readxl::read_excel(timber_path)
57-
timber_in_col_names <- colnames(timber_in)
55+
# READ: Raw Timber Specifications -------------------------------------------
56+
# The raw timber format (column names and data types) is specified in an
57+
# external file ("raw_timber_specs.csv"). This file is sparse; read with
58+
# column specifications to avoid guessing.
5859

5960
# Column types for reading raw_timber_specs
60-
raw_timber_specs_col_types <- readr::cols(timber_col_name = readr::col_character(),
61-
timber_col_required = readr::col_logical(),
62-
sawmill_col_name = readr::col_character(),
63-
col_spec_csv = readr::col_character(),
64-
col_spec_xlsx = readr::col_character(),
65-
timber_obj_name = readr::col_character(),
66-
timber_field_name = readr::col_character(),
67-
timber_field_name_r = readr::col_character())
61+
raw_timber_specs_col_types <- readr::cols(
62+
timber_col_name = readr::col_character(),
63+
timber_col_required = readr::col_logical(),
64+
sawmill_col_name = readr::col_character(),
65+
col_spec_csv = readr::col_character(),
66+
col_spec_xlsx = readr::col_character(),
67+
timber_obj_name = readr::col_character(),
68+
timber_field_name = readr::col_character(),
69+
timber_field_name_r = readr::col_character())
6870

6971
# Read raw_timber_specs
70-
raw_timber_specs <- readr::read_csv(file = system.file("raw_timber_specs.csv", package = "sawmill"),
72+
raw_timber_specs <- readr::read_csv(file = system.file("raw_timber_specs.csv",
73+
package = "sawmill"),
7174
col_types = raw_timber_specs_col_types)
7275

73-
# Get the names of required columns.
74-
raw_timber_req_col_names <- raw_timber_specs$timber_col_name[raw_timber_specs$timber_col_required]
75-
76-
# Are required columns present in the input timber?
77-
raw_timber_req_cols_here <- raw_timber_req_col_names %in% timber_in_col_names
78-
79-
# If any required columns are missing, abort.
80-
if(any(!raw_timber_req_cols_here)){
81-
rlang::abort(message = glue::glue("Column '{raw_timber_req_col_names[!raw_timber_req_cols_here]}' is missing or improperly named."))
82-
}
83-
84-
# Create a column specification for raw timber.
85-
raw_timber_colspec <- rlang::set_names(raw_timber_specs$col_spec_xlsx, raw_timber_specs$timber_col_name)
8676

87-
# Create a column specification for the input timber. Default = "guess".
88-
timber_in_colspec <- rlang::set_names(rep("guess", length(timber_in_col_names)), timber_in_col_names)
8977

90-
# Replace the column specification for the input timber for the required fields in raw timber.
91-
timber_in_colspec[intersect(names(raw_timber_colspec), names(timber_in_colspec))] <- raw_timber_colspec[intersect(names(raw_timber_colspec), names(timber_in_colspec))]
92-
93-
# Re-read the timber with column specification.
94-
timber_in <- readxl::read_excel(timber_path, col_types = timber_in_colspec)
95-
96-
97-
# Get the old column names (sawmill).
98-
raw_timber_req_col_names_old <- raw_timber_specs$sawmill_col_name[raw_timber_specs$timber_col_required]
99-
100-
# Map the old names onto the new names.
101-
names(raw_timber_req_col_names) <- raw_timber_req_col_names_old
78+
# CHECK: Required Columns Exist ---------------------------------------------
79+
# Check if requisite columns exist, abort if requisite columns are missing.
10280

103-
# Rename required columns.
104-
timber_in <- rename(timber_in, raw_timber_req_col_names)
81+
# Get the names of required columns.
82+
raw_timber_req_col_names <- raw_timber_specs$timber_col_name[raw_timber_specs$timber_col_required]
10583

106-
if(!"exclude_sawmill" %in% timber_in_col_names){timber_in$exclude_sawmill <- FALSE}
107-
if(!"exclude_sawmill_reason" %in% timber_in_col_names){timber_in$exclude_sawmill_reason <- NA}
84+
# Read the header of the raw timber to get passed column names.
85+
if (timber_file_ext == 'csv') {
10886

109-
return(timber_in)
87+
timber_passed_col_names <- names(readr::read_csv(file = timber_path,
88+
n_max = 0,
89+
show_col_types = FALSE))
11090

111-
}
91+
} else if (timber_file_ext %in% c("xls", "xlsx")) {
11292

93+
timber_passed_col_names <- names(readxl::read_excel(path = timber_path,
94+
n_max = 0))
11395

114-
get_supported_file_type <- function(path){
96+
}
11597

116-
extn <- tools::file_ext(path)
117-
errmsg <- glue::glue("Filetype '.{extn}' is not supported. Please use .xlsx.")
98+
# Are required columns present?
99+
raw_timber_req_cols_here <- raw_timber_req_col_names %in% timber_passed_col_names
118100

119-
ifelse(extn %in% c("xls", "xlsx"), "xlsx",
120-
ifelse(extn == "csv", rlang::abort(message = errmsg, rlang::abort(message = errmsg))))
101+
# Abort run if required columns are missing.
102+
if(any(!raw_timber_req_cols_here)){
103+
rlang::abort(message = glue::glue("Columns '{raw_timber_req_col_names[!raw_timber_req_cols_here]}' is missing or improperly named."))
104+
}
121105

122-
}
123106

124-
#get_supported_file_type(test_path_xlsx)
125-
#get_supported_file_type(test_path_csv)
126107

127-
#timber_col_name timber_col_required sawmill_col_name col_spec_csv col_spec_xlsx
108+
# READ: Timber --------------------------------------------------------------
109+
# Create a named vector of column specifications for known columns.
110+
# Timber may contain unknown columns; create a named vector of default (guess)
111+
# specifications for passed timber. Then, replace guess for known columns.
128112

113+
if (timber_file_ext == 'csv') {
129114

115+
# Create a named vector of column specifications (CSV) for raw timber.
116+
raw_timber_colspec <- rlang::set_names(raw_timber_specs$col_spec_csv,
117+
raw_timber_specs$timber_col_name)
130118

119+
# Create a column specification for the input timber. Default = "?".
120+
timber_in_colspec <- rlang::set_names(rep("?", length(timber_passed_col_names)),
121+
timber_passed_col_names)
131122

123+
# Replace the column specification for the input timber for the required fields in raw timber.
124+
timber_in_colspec[intersect(names(raw_timber_colspec), names(timber_in_colspec))] <- raw_timber_colspec[intersect(names(raw_timber_colspec), names(timber_in_colspec))]
132125

126+
# Re-read the timber with column specification.
127+
timber_in <- readr::read_csv(file = timber_path,
128+
col_types = timber_in_colspec,
129+
show_col_types = FALSE)
133130

131+
} else if (timber_file_ext %in% c("xls", "xlsx")) {
134132

133+
# Create a named vector of column specifications (XLS/X) for raw timber.
134+
raw_timber_colspec <- rlang::set_names(raw_timber_specs$col_spec_xlsx,
135+
raw_timber_specs$timber_col_name)
135136

136-
debark <- function(timber_path, cuts, col_data_types){
137+
# Create a column specification for the input timber. Default = "guess".
138+
timber_in_colspec <- rlang::set_names(rep("guess", length(timber_passed_col_names)),
139+
timber_passed_col_names)
137140

138-
raw_timber <- readxl::read_excel(timber_path)
141+
# Replace the column specification for the input timber for the required fields in raw timber.
142+
timber_in_colspec[intersect(names(raw_timber_colspec), names(timber_in_colspec))] <- raw_timber_colspec[intersect(names(raw_timber_colspec), names(timber_in_colspec))]
139143

140-
# Screen for missing columns (report which ones are missing)
141-
missing <- setdiff(as.vector(cuts), names(raw_timber))
144+
# Re-read the timber with column specification.
145+
timber_in <- readxl::read_excel(path = timber_path,
146+
col_types = timber_in_colspec)
142147

143-
if(length(missing)>0) {
144-
stop(paste('ERROR: The following requisite columns are missing from your timber: ',
145-
paste(missing, collapse = ", ")
146-
)
147-
)
148148
}
149149

150-
# Screen for cells that do not match the expected data type for their column(s)
151150

152-
sub_mill(log_warnings(raw_timber <- readxl::read_excel(timber_path, col_types = col_data_types)), "log_warnings")
153151

154-
tryCatch(raw_timber <- readxl::read_excel(timber_path, col_types = col_data_types),
155-
warning = function(w) {
156-
sub_mill(handle_col_warnings(), "handle_col_warnings")
157-
})
152+
# Remap Names ---------------------------------------------------------------
158153

154+
# Get the old column names (sawmill).
155+
raw_timber_req_col_names_old <- raw_timber_specs$sawmill_col_name[raw_timber_specs$timber_col_required]
159156

160-
timber <- dplyr::rename(raw_timber, cuts)
157+
# Map the old names onto the new names.
158+
names(raw_timber_req_col_names) <- raw_timber_req_col_names_old
161159

160+
# Rename required columns.
161+
timber_in <- dplyr::rename(timber_in, dplyr::all_of(raw_timber_req_col_names))
162162

163-
# Add exclude_sawmill and exclude_sawmill_reason columns to indicate factors
164-
# to omit from further processing.
165163

166-
timber$exclude_sawmill <- FALSE
167-
timber$exclude_sawmill_reason <- NA
168164

169-
return(timber)
165+
# Add Extra Columns ---------------------------------------------------------
170166

171-
}
167+
if(!"ID_meta" %in% timber_passed_col_names){timber_in$ID_meta <- NA_integer_}
168+
if(!"exclude_sawmill" %in% timber_passed_col_names){timber_in$exclude_sawmill <- FALSE}
169+
if(!"exclude_sawmill_reason" %in% timber_passed_col_names){timber_in$exclude_sawmill_reason <- NA}
172170

173171

174172

173+
return(timber_in)
175174

175+
}
176176

177177

‎R/mill.R‎

Lines changed: 56 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -52,25 +52,62 @@
5252

5353

5454

55-
mill <- function(timber_path, cedar_version, low_cell_threshold = 0, low_cell_correction = 0.5, insensible_p_lo = 99, insensible_p_hi = 101, log_base = exp(1)){
56-
57-
sub_mill(timber1 <- debark2(timber_path = timber_path), "debark")
58-
sub_mill(timber2 <- check_grain(timber = timber1), "check_grain")
59-
sub_mill(timber4 <- build_table(timber = timber2,
60-
low_cell_correction = low_cell_correction,
61-
low_cell_threshold = low_cell_threshold), "build_table")
62-
sub_mill(timber5 <- polish_table(timber = timber4,
63-
cedar_version = cedar_version,
64-
insensible_p_lo = insensible_p_lo,
65-
insensible_p_hi = insensible_p_hi), "polish_table")
66-
sub_mill(timber6 <- add_CI(timber = timber5), "add_CI")
67-
sub_mill(timber7 <- build_chairs(timber = timber6, log_base = log_base), "build_chairs")
68-
sub_mill(timber8 <- build_horse(timber = timber7), "build_horse")
69-
sub_mill(timber9 <- do_MA(timber = timber8, log_base = log_base, cedar_version = cedar_version), "do_MA")
70-
sub_mill(timber10 <- add_URL(timber = timber9), "add_URL")
71-
sub_mill(timber11 <- add_HTMLink(timber = timber10), "add_HTMLink")
72-
sub_mill(timber12 <- add_ident(timber = timber11, cedar_version = cedar_version), "add_ident")
73-
sub_mill(planks <- reorder_fields(timber = timber12, cedar_version = cedar_version), "reorder_fields")
55+
mill <- function(timber_path, cedar_version = 2, low_cell_threshold = 0, low_cell_correction = 0.5, insensible_p_lo = 99, insensible_p_hi = 101, log_base = exp(1)){
56+
57+
sub_mill(timber1 <- debark(timber_path = timber_path),
58+
"Debark: read timber and rename columns.")
59+
60+
61+
sub_mill(timber2 <- check_grain(timber = timber1),
62+
"Check Grain: detect fields that specify each outcome.")
63+
64+
65+
sub_mill(timber4 <- build_table(timber = timber2,
66+
low_cell_correction = low_cell_correction,
67+
low_cell_threshold = low_cell_threshold),
68+
"Build Table: complete contingency tables for count and prevalence-based outcomes.")
69+
70+
71+
sub_mill(timber5 <- polish_table(timber = timber4,
72+
cedar_version = cedar_version,
73+
insensible_p_lo = insensible_p_lo,
74+
insensible_p_hi = insensible_p_hi),
75+
"Polish Table: check for logical inconsistencies in completed contingency tables.")
76+
77+
78+
sub_mill(timber6 <- add_CI(timber = timber5),
79+
"Add CI: set the confidence level (if not provided).")
80+
81+
82+
sub_mill(timber7 <- build_chairs(timber = timber6,
83+
log_base = log_base),
84+
"Build Chair: calculate the odds ratio (OR) and the SE(log(OR)) for each outcome.")
85+
86+
87+
sub_mill(timber8 <- build_horse(timber = timber7),
88+
"Build Horse: calculate the significance of the OR for count and prevalence-based outcomes.")
89+
90+
91+
sub_mill(timber9 <- do_MA(timber = timber8,
92+
log_base = log_base,
93+
cedar_version = cedar_version),
94+
"Do MA: run any meta-analyses specified by the user.")
95+
96+
97+
sub_mill(timber10 <- add_URL(timber = timber9),
98+
"Add URL: create a URL from identifiers (e.g., DOI).")
99+
100+
101+
sub_mill(timber11 <- add_HTMLink(timber = timber10),
102+
"Add a HTML Link: create an <a> object from each URL.")
103+
104+
105+
sub_mill(timber12 <- add_ident(timber = timber11, cedar_version = cedar_version),
106+
"Add an ANA Identifier: add a suggested ID for objects in Analytica.")
107+
108+
109+
sub_mill(planks <- reorder_fields(timber = timber12, cedar_version = cedar_version),
110+
"Reorder Fields: reorder processed timber output columns.")
74111

75112
return(planks)
76113

0 commit comments

Comments
 (0)