-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathvector_transpose.R
146 lines (130 loc) · 6.46 KB
/
vector_transpose.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
140
141
142
143
144
145
146
#' @title Transpose a vector to a long form
#' @description Many vectors (indicators, multipliers) are create in the wide form to conform matrixes in
#' analytical functions. For printing it is more useful to have them in long form.
#' @details This is a wrapper around \code{\link[tidyr]{pivot_longer}} so you do not necessarily need to
#' import or load the entire \emph{tidyr} package.
#' @param data_table A matrix or vector that normally has a key column.
#' @param names_to Defaults to \code{'nace_r2'}.
#' @param values_to Defaults to \code{'value'}.
#' @param key_column_name The name of the first column. Defaults to \code{NULL} when it is not changed.
#' It should usually match the key column of the matrix or vector you would like to join the new
#' vector created with \code{vector_transpose_longer}.
#' @param .keep Keep the indicator identifier column? Defaults to \code{FALSE}.
#' @return A long form vector with a key column, and optionally the identifier of the indicator in
#' the first column.
#' @family iotables processing functions
#' @importFrom tidyr pivot_longer
#' @importFrom dplyr any_of
#' @examples
#' vector_transpose_longer(
#' data.frame(indicator = "my_inidcator",
#' agriculture = 0.0123,
#' manufacturing = 0.1436,
#' trade = 0.0921)
#' )
#' @export
vector_transpose_longer <- function( data_table,
names_to = "nace_r2",
values_to = "value",
key_column_name = NULL,
.keep = FALSE ) {
is_key_column_present(data_table)
key_column <- names(data_table)[1]
return_df <- data_table %>%
tidyr::pivot_longer(
-any_of(key_column),
names_to = names_to,
values_to = values_to
)
if (.keep) return_df else return_df[,-1]
}
#' @rdname vector_transpose_longer
vector_transpose <- function( data_table,
names_to = "nace_r2",
values_to = "value",
key_column_name = NULL,
.keep = FALSE ) {
.Deprecated(new= "vector_transpose_longer")
vector_transpose_longer(data_table, names_to, values_to, key_column_name, .keep)
}
#' @title Transpose a vector to wider format
#' @description Many vectors (indicators, multipliers) are create in the wide form to conform matrixes in
#' analytical functions. For binding it is more useful to have them in wide format.
#' @details This is a wrapper around \code{\link[tidyr]{pivot_wider}} so you do not necessarily need to
#' import or load the entire \emph{tidyr} package.
#' @inheritParams key_column_create
#' @param data_table A matrix or vector that normally has a key column. If the key column must be created
#' or replaced, used \code{key_column_name} and \code{key_column_values}.
#' @param names_from,values_from A pair of
#' arguments describing which column (or columns) to get the name of the
#' output column (`names_from`), and which column (or columns) to get the
#' cell values from (`values_from`).
#' @param key_column_values You can explicitly supply key column values. Defaults to \code{NULL} when the
#' key column values will be created from the long data.
#' @importFrom assertthat assert_that
#' @importFrom glue glue
#' @family iotables processing functions
#' @examples
#' vector_transpose_wider (data_table = germany_airpol[, -2],
#' names_from = 'induse',
#' values_from = 'value')
#'
#' vector_transpose_wider (data_table = germany_airpol[1:8, 3:4],
#' names_from = 'induse',
#' values_from = 'value',
#' key_column_values = "CO2_emission" )
#' @export
vector_transpose_wider <- function (data_table,
names_from,
values_from,
key_column_name = NULL,
key_column_values = NULL) {
if (is.null(key_column_name)) key_column_name <- names(data_table)[1]
assertthat::assert_that(names_from %in% names(data_table),
msg = glue("in vector_transpose_wider(data_table, names_from='{names_from}') '{names_from}' cannot be found in the data_table")
)
assertthat::assert_that(values_from %in% names(data_table),
msg = glue("in vector_transpose_wider(data_table, values_from='{values_from}') '{values_from}' cannot be found in the data_table")
)
if ( ncol(data_table)>=2 & is_key_column_present(data_table) & is.null(key_column_values) ) {
# No need to create a new key column
# See unit test with airpol_wide_1
pivot_wider(data_table,
names_from = names_from,
values_from = values_from)
} else if ( is_key_column_present(data_table) & !is.null(key_column_values) & names(data_table)[1] != names_from ) {
# The key column must be REPLACED
# See unit test with airpol_wide_3
bind_cols (
key_column_create(key_column_name, key_column_values),
pivot_wider(data_table %>% select(-1),
names_from = names_from,
values_from = values_from))
} else {
# The new key column will have to be added to the table
# See unit test with airpol_wide_2
bind_cols (
key_column_create(key_column_name, key_column_values),
pivot_wider(data_table,
names_from = names_from,
values_from = values_from ))
}
}
#' @title Create a key columnn
#' @description Create a key column for matching the dimensions of matrixes.
#' @details This function will likely be used with the creation of coefficients that need to be matched with
#' a matrix that has a key column.
#' @param key_column_name The name of the key column.
#' @param key_column_values The value(s) of the key column
#' @return A tibble with one column, named \code{key_column_name} and with values \code{key_column_values}.
#' @importFrom tibble tibble
#' @importFrom rlang set_names
#' @family iotables processing functions
#' @examples
#' key_column_create ("iotables_row", c("CO2_multiplier", "CH4_multiplier"))
#' @export
key_column_create <- function(key_column_name,
key_column_values = NULL ) {
tibble ( names = as.character(key_column_values) ) %>%
rlang::set_names (key_column_name)
}