/
align_names.R
139 lines (103 loc) · 4.09 KB
/
align_names.R
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
align_name_char <- function(x) {
if(tolower(x) %in% names(hydroloom_name_map))
return(hydroloom_name_map[[tolower(x)]])
x
}
#' @title Align Names to Hydroloom Convention
#' @description this function aligns the attribute names in x
#' with those used in hydroloom. See \link{hydroloom_names} for how
#' to add more attribute name mappings if the attributes in your data
#' are not supported.
#'
#' See \link{hydroloom_name_definitions} for definitions of the names
#' used in hydroloom.
#'
#' @inheritParams add_levelpaths
#' @returns data.frame renamed to match hydroloom as possible.
#' @export
#' @examples
#' x <- sf::read_sf(system.file("extdata/new_hope.gpkg", package = "hydroloom"))
#'
#' names(x)
#'
#' x <- align_names(x)
#'
#' names(x)
#'
align_names <- function(x) {
orig_names <- names(x)
names(x) <- tolower(names(x))
replace_names <- get("hydroloom_name_map", envir = hydroloom_env)
good_names <- get("good_names", envir = hydroloom_env)
replace_names <- replace_names[names(replace_names) %in% names(x)]
change_names <- replace_names[!names(replace_names) == unname(replace_names)]
change_names <- change_names[which(change_names %in% names(x))]
if(length(change_names) > 0) {
names(change_names) <- orig_names[which(tolower(orig_names) == names(change_names))]
stop(paste("Problem aligning names.", paste(names(change_names), collapse = ", "),
"conflicts with hydroloom name", paste(unname(change_names), collapse = ", "),
"can't proceed converting to hy object."))
}
if(any(duplicated(replace_names))) {
if("permanent_identifier" %in% names(replace_names)) {
replace_names <- replace_names[!names(replace_names) == "permanent_identifier"]
message("defaulting to comid rather than permanent_identifier")
}
}
if(any(duplicated(replace_names))) {
doop <- replace_names[duplicated(replace_names)]
all_doop <- replace_names[replace_names %in% doop]
warning(paste0("Duplicate names found when aligning with hydroloom conventions \n using ",
names(doop), " from ", paste(names(all_doop), collapse = ", ")))
remove <- all_doop[!names(all_doop) %in% names(doop)]
replace_names <- replace_names[!names(replace_names) %in% names(remove)]
}
x <- rename(x, any_of(setNames(names(replace_names), unname(replace_names))))
switch_back <- !names(x) %in% good_names
names(x)[switch_back] <- orig_names[switch_back]
x
}
#' Hydroloom Name Definitions
#' @description A names character vector containing definitions of all
#' attributes used in the hydroloom package.
#' @name hydroloom_name_definitions
#' @returns named character vector with `hydroloom_names` class to support custom print method
#' @export
#' @examples
#' hydroloom_name_definitions
hydroloom_name_definitions
#' @title Get or Set Hydroloom Names
#' @description Retrieve hydroloom name mapping from hydroloom
#' environment. Hydroloom uses a specific set of attribute names within
#' the package and includes mappings from names used in some data sources.
#' This function will return those names and can be used to set additional
#' name mappings.
#'
#' NOTE: these values will reset when R is restarted. Add desired settings
#' to a project or user .Rprofile to make long term additions.
#'
#' @param x named character vector of additional names to add to the
#' hydroloom environment. If not specified, no names will be added and
#' the current value stored in the hydroloom environment will be returned.
#' @param clear logical if TRUE, all names will be removed and replaced with
#' x.
#' @returns named character vector containing hydroloom names with registered attribute name mappings in `names`.
#' @export
#' @examples
#'
#' hydroloom_names()
#'
hydroloom_names <- function(x = NULL, clear = FALSE) {
hl <- get("hydroloom_name_map", envir = hydroloom_env)
if(!is.null(x) & is.null(names(x))) stop("input must be named")
if(clear) {
hl <- c()
assign("hydroloom_name_map", hl, envir = hydroloom_env)
}
if(is.null(x)) {
return(hl)
}
hl <- c(hl, x)
assign("hydroloom_name_map", hl, envir = hydroloom_env)
hl
}