1
#' Label a variable
2
#'
3
#' @param .var Quoted variable name
4
#' @param variable_label Quoted variable label
5
#'
6
#' @return Labelled variable
7
#' @seealso \code{\link{extract_variable_label}} \code{\link{ff_relabel}}
8
#' @export
9
#' @examples
10
#' colon_s$sex.factor %>%
11
#'   ff_label("Sex") %>%
12
#'   str()
13
ff_label <- function(.var, variable_label){
14 1
	attr(.var, "label") = variable_label
15 1
	return(.var)
16
}
17

18
#' @rdname ff_label
19
#' @export
20
finalfit_label <- ff_label
21

22
#' Extract variable labels from dataframe
23
#'
24
#' Variable labels can be created using \code{\link{ff_label}}. Some functions
25
#' strip variable labels (variable attributes), e.g. \code{forcats::fct_recode}.
26
#' Use this function to create a vector of variable labels from a data frame.
27
#' Then use \code{\link{ff_relabel}} to relabel variables in data frame.
28
#'
29
#' @param .data Dataframe containing labelled variables.
30
#'
31
#' @export
32
#' @examples
33
#' colon_s %>%
34
#'   extract_variable_label
35
extract_variable_label = function(.data){
36 1
	if(any(class(.data) %in% c("tbl_df", "tbl"))) .data = data.frame(.data)
37 1
	sapply(colnames(.data), function(x){
38 1
		label = attr(.data[,x], "label")
39 1
		ifelse(is.null(label), x, label)
40
	})
41
}
42

43
#' Relabel variables in a data frame
44
#'
45
#' Variable labels can be created using \code{\link{ff_label}}. Some functions
46
#' strip variable labels (variable attributes), e.g. \code{forcats::fct_recode}.
47
#' Use this function to create a vector of variable labels from a data frame.
48
#' Then use \code{\link{ff_relabel}} to relabel variables in data frame.
49
#'
50
#' @param .data Data frame to be relabelled
51
#' @param .labels Vector of variable labels (usually created using
52
#'   \code{\link{extract_variable_label}}) of same length as \code{.data}.
53
#'
54
#' @export
55
#'
56
#' @examples
57
#' # Label variable
58
#' colon_s$sex.factor %>%
59
#'   ff_label("Sex") %>%
60
#'   str()
61
#'
62
#' # Make factor level "Unknown" NA
63
#' colon_s %>%
64
#'   dplyr::mutate_if(is.factor, forcats::fct_recode, 
65
#'   NULL = "Unknown") %>% 
66
#'   str()
67
#' 
68
#' # Reset data
69
#' data(colon_s)
70
#' 
71
#' # Extract variable labels
72
#' vlabels = colon_s %>% extract_variable_label()
73
#'
74
#' # Run function where labels are lost
75
#' colon_s %>%
76
#'   dplyr::mutate_if(is.factor, forcats::fct_recode, 
77
#'   NULL = "Unknown") %>% 
78
#'   str()
79
#' 
80
#' # Relabel
81
#' colon_s %<>% ff_relabel(vlabels)
82
#' colon_s %>% str()
83
#'   
84
ff_relabel <- function(.data, .labels){
85
	# Keep only labels for variables in data
86 1
	.labels = .labels[names(.labels) %in% names(.data)]
87 1
	relabel_one <- function(.){
88 1
		var <- as.character(match.call()[[2L]])
89 1
		label = .labels[[var]]
90 1
		ff_label(., label)
91
	}
92 1
	.data %>% 
93 1
		dplyr::mutate_at(names(.labels), relabel_one) # Apply only to variables for which labels
94
}
95
#' @rdname ff_relabel
96
#' @export
97
#' 
98
finalfit_relabel <- ff_relabel
99

100

101

102

103
#' Relabel variables from data frame after tidyverse functions
104
#'
105
#' @param .data Data frame or tibble after applicaton of label stripping functions. 
106
#' @param .df Original data frame which contains labels. 
107
#'
108
#' @return Data frame or tibble
109
#' @export
110
#'
111
ff_relabel_df <- function(.data, .df){
112 0
	.labels = extract_variable_label(.df)
113 0
	.labels = .labels[names(.labels) %in% names(.data)]
114 0
	relabel_one <- function(.) {
115 0
		var <- as.character(match.call()[[2L]])
116 0
		label = .labels[[var]]
117 0
		ff_label(., label)
118
	}
119 0
	.data %>% 
120 0
		dplyr::mutate_at(names(.labels), relabel_one) # Apply only to variables for which labels
121
}
122
#' @rdname ff_relabel_df
123
#' @export
124
#' 
125
finalfit_relabel_df <- ff_relabel_df
126

127

128

129
#' Remove variable labels.
130
#'
131
#' @param .data Data frame
132
#'
133
#' @return The original data frame with variable label attributes removed.
134
#' @export
135
#' @keywords internal
136
#'
137
#' @examples
138
#' colon_s %>%
139
#'   remove_labels()
140
remove_labels = function(.data){
141 1
	attr_label_null <- function(x){
142 1
		attr(x, "label") <- NULL
143 1
		return(x)
144
	}
145
	
146 1
	suppressWarnings( # All these irritiating bind_row warnings
147 1
	.data %>% 
148 1
		purrr::map_df(attr_label_null)
149
	)
150
}
151

152

153

154
#' Labels to column names
155
#'
156
#' @param .data 
157
#'
158
#' @return Data frame or tibble
159
#' @export
160
#'
161
#' @examples
162
#' library(dplyr)
163
#' colon_s %>% 
164
#'   select(sex.factor) %>% 
165
#'   labels_to_column()
166
labels_to_column <- function(.data){
167 0
	.labels = extract_variable_label(.data)
168 0
	.labels2 = names(.labels)
169 0
	names(.labels2) = .labels
170 0
	.data %>% 
171 0
		dplyr::rename(.labels2)
172
}

Read our documentation on viewing source code .

Loading