Repository navigation
Expand file tree
/
Copy pathTADACommunityHub.R
More file actions
196 lines (178 loc) · 6.35 KB
/
Copy pathTADACommunityHub.R
File metadata and controls
196 lines (178 loc) · 6.35 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
#' List Criteria and Methodologies Files Available in the TADACommunityHub
#'
#' Retrieves the complete listing of Criteria and Methodologies files from the
#' TADACommunityHub repository. The ATTAINS.OrganizationIdentifier or display_name
#' returned can be used as function inputs in the TADA_GetCriteriaFile() function to
#' retrieve a Criteria and Methodologies File.
#'
#' @return A data frame with four columns:
#' - ATTAINS.OrganizationIdentifier
#' - display_name
#' - file_name
#' - file_path
#'
#' @export
#'
#' @examples
#' criteriaFiles <- TADA_ListCriteriaFiles()
#'
# List available criteria files from another installed package's inst/extdata
TADA_ListCriteriaFiles <- function() {
# checks if the package is installed.
if (!requireNamespace("TADACommunityHub", quietly = TRUE)) {
stop(
"Package 'TADACommunityHub' is not installed. Please install it to use this function."
)
}
ext_dir <- system.file("extdata", package = "TADACommunityHub")
if (!nzchar(ext_dir) || !dir.exists(ext_dir)) {
stop("No extdata directory found in package 'TADACommunityHub'.")
}
# The "default_files.xlsx" used to map display names -> ATTAINS org IDs
default_path <- file.path(ext_dir, "default_files.xlsx")
default_df <- NULL
if (file.exists(default_path)) {
default_df <- openxlsx::read.xlsx(default_path)
} else {
warning(
"default_files.xlsx not found in 'TADACommunityHub/inst/extdata'; ",
"ATTAINS.OrganizationIdentifier mapping will be NA."
)
}
# Find all TADACommunityHub _criteria_crosswalk.xlsx files
xlsx_files <- list.files(
ext_dir,
pattern = "_criteria_crosswalk\\.xlsx$",
full.names = TRUE
)
# If no files return, return blank data frame and report issue.
if (length(xlsx_files) == 0) {
warning(
"No criteria crosswalk files found in ",
"TADACommunityHub",
"/inst/extdata. Please report issue to TADACommunityHub."
)
return(data.frame(
ATTAINS.OrganizationIdentifier = character(),
display_name = character(),
file_name = character(),
file_path = character(),
stringsAsFactors = FALSE
))
}
# Build the reference table
res <- lapply(xlsx_files, function(fp) {
fname <- basename(fp)
# Display name derived from filename
display_name <- gsub("_criteria_crosswalk\\.xlsx$", "", fname)
display_name <- gsub("_", " ", display_name)
display_name <- tools::toTitleCase(display_name)
data.frame(
display_name = display_name,
file_name = fname,
file_path = fp,
stringsAsFactors = FALSE
)
})
result <- do.call(rbind, res)
# Join ATTAINS org ID if default_files.xlsx is available
if (
!is.null(default_df) &&
all(
c("Display.Name", "ATTAINS.OrganizationIdentifier") %in%
names(default_df)
)
) {
result <- merge(
x = result,
y = default_df[, c("Display.Name", "ATTAINS.OrganizationIdentifier")],
by.x = "display_name",
by.y = "Display.Name",
all.x = TRUE,
sort = FALSE
)
# Reorder columns
result <- result[, c(
"ATTAINS.OrganizationIdentifier",
"display_name",
"file_name",
"file_path"
)]
} else {
# If the mapping isn't available, fill with NA column
result$ATTAINS.OrganizationIdentifier <- NA_character_
result <- result[, c(
"ATTAINS.OrganizationIdentifier",
"display_name",
"file_name",
"file_path"
)]
}
result
}
#' Load any Criteria and Methodologies File Available in the TADACommunityHub
#'
#' A function to load a Criteria and Methodologies file from the TADACommunityHub
#' as a data frame. The format of these files should match the format of a file
#' generated by TADA_DefineCriteriaMethodology().
#'
#' @param org_id Character string. The ATTAINS organization identifier.
#' Run TADA_ListCriteriaFiles() for a list of options. Users can enter either the
#' org_id or display_name into this function to retrieve a Criteria and Methods file.
#'
#' @param display_name Character string. The organization display name used for the
#' TADA Module 3 R Shiny App user interface (https://github.com/USEPA/TADAShinyAnalyze).
#' Run TADA_ListCriteriaFiles() for a list of options. Users can enter either the
#' org_id or display_name into this function to retrieve a Criteria and Methods file.
#'
#' @return A data frame containing the Criteria and Methodologies File retrieved
#' from the TADACommunityHub based on the user supplied org_id or display_name name.
#'
#' @export
#'
#' @examples
#' loadCriteria_MTDEQ <- TADA_GetCriteriaFile(org_id = "MTDEQ")
#' loadCriteria_Montana <- TADA_GetCriteriaFile(display_name = "Montana")
#'
# Load a selected criteria file (by org_id or display_name) from local inst/extdata
TADA_GetCriteriaFile <- function(org_id = NULL, display_name = NULL) {
# package name should not be modified
pkg = "TADACommunityHub"
ref <- TADA_ListCriteriaFiles()
# Only one of org_id or display_name should be populated
if (all(is.null(org_id), is.null(display_name))) {
stop("loadCriteria: You must provide either org_id or display_name.")
}
if (all(!is.null(org_id), !is.null(display_name))) {
stop("loadCriteria: Please provide only one of org_id or display_name.")
}
# Select file_path based on which identifier was provided
if (!is.null(display_name)) {
if (!display_name %in% ref$display_name) {
stop("loadCriteria: display_name not found (check spelling).")
}
file_path <- ref[ref$display_name == display_name, "file_path", drop = TRUE]
} else {
if (!org_id %in% ref$ATTAINS.OrganizationIdentifier) {
stop("loadCriteria: org_id not found (check value).")
}
file_path <- stats::na.omit(ref[
ref$ATTAINS.OrganizationIdentifier == org_id,
"file_path",
drop = TRUE
])
}
# If multiple matches, take the first but warn if this occurs (should not happen)
if (length(file_path) > 1) {
warning("Multiple matching files found; using the first.")
file_path <- file_path[1]
}
if (!nzchar(file_path) || !file.exists(file_path)) {
stop("Selected file could not be found on disk: ", file_path)
}
df <- openxlsx::read.xlsx(file_path)
# create a dummy reference to a TADACommunityHub function, Rmd checks will create a warning if no reference to any functions are made from an Imports package.
temp <- TADACommunityHub::validateATTAINSParam(df)
rm(temp)
return(df)
}