I am reading through excel file that has multiple sheets.
file_to_read <- "./file_name.xlsx"
# Get all names of sheets in the file
sheet_names <- readxl::excel_sheets(file_to_read)
# Loop through sheets
L <- lapply(sheet_names, function(x) {
all_cells <-
tidyxl::xlsx_cells(file_to_read, sheets = x)
})
L here has all the sheets. Now, I need to get the data from each sheet to combine all the columns and rows into one file. To be exact, I want to sum the matching columns and rows in the data into one file.
I will put simple example to make it clear.
For example, this table in one sheet,
df1 <- data.frame(x = 1:5, y = 2:6, z = 3:7)
rownames(df1) <- LETTERS[1:5]
df1
M x y z
A 1 2 3
B 2 3 4
C 3 4 5
D 4 5 6
E 5 6 7
The second table in the next sheet,
df2 <- data.frame(x = 1:5, y = 2:6, z = 3:7, w = 8:12)
rownames(df2) <- LETTERS[3:7]
df2
M x y z w
C 1 2 3 8
D 2 3 4 9
E 3 4 5 10
F 4 5 6 11
G 5 6 7 12
My goal is to combine (sum) the matched records in all 100 tables from one excel file to get one big tables that has the total sum of each value.
The final table should be like this:
M x y z w
A 1 2 3 0
B 2 3 4 0
C 4 6 8 8
D 6 8 10 9
E 8 10 12 10
F 4 5 6 11
G 5 6 7 12
Is there a way to achieve this in R? I am not an expert in R, but I wish if I could know how to read all sheets and do the sum Then save the output to a file.
Thank you
As you have stated that you have hundreds of sheets it is suggested that you should import all of these in one single list say my.list in R (as per this link or this readxl documentation suggested) and follow this strategy instead of binding every two dfs one by one
df1 <- read.table(text = 'M x y z
A 1 2 3
B 2 3 4
C 3 4 5
D 4 5 6
E 5 6 7', header = T)
df2 <- read.table(text = 'M x y z w
C 1 2 3 8
D 2 3 4 9
E 3 4 5 10
F 4 5 6 11
G 5 6 7 12', header = T)
library(tibble)
library(tidyverse)
my.list <- list(df1, df2)
map_dfr(my.list, ~.x)
#> M x y z w
#> 1 A 1 2 3 NA
#> 2 B 2 3 4 NA
#> 3 C 3 4 5 NA
#> 4 D 4 5 6 NA
#> 5 E 5 6 7 NA
#> 6 C 1 2 3 8
#> 7 D 2 3 4 9
#> 8 E 3 4 5 10
#> 9 F 4 5 6 11
#> 10 G 5 6 7 12
map_dfr(my.list , ~ .x) %>%
group_by(M) %>%
summarise(across(everything(), sum, na.rm = T))
#> # A tibble: 7 x 5
#> M x y z w
#> <chr> <int> <int> <int> <int>
#> 1 A 1 2 3 0
#> 2 B 2 3 4 0
#> 3 C 4 6 8 8
#> 4 D 6 8 10 9
#> 5 E 8 10 12 10
#> 6 F 4 5 6 11
#> 7 G 5 6 7 12
Created on 2021-05-26 by the reprex package (v2.0.0)
One approach that will work is these steps:
read each sheet into a list
convert each sheet into a long format
bind into a single data frame
sum and group by over that long data frame
cast back to tabular format
That should work for N sheets with any combination of row and column headers in those sheets. E.g.
file <- "D:\\Book1.xlsx"
sheet_names <- readxl::excel_sheets(file)
sheet_data <- lapply(sheet_names, function(sheet_name) {
readxl::read_xlsx(path = file, sheet = sheet_name)
})
# use pivot_longer on each sheet to make long data
long_sheet_data <- lapply(sheet_data, function(data) {
long <- tidyr::pivot_longer(
data = data,
cols = !M,
names_to = "col",
values_to = "val"
)
})
# combine into a single tibble
long_data = dplyr::bind_rows(long_sheet_data)
# sum up matching pairs of `M` and `col`
summarised <- long_data %>%
group_by(M, col) %>%
dplyr::summarise(agg = sum(val))
# convert to a tabular format
tabular <- summarised %>%
tidyr::pivot_wider(
names_from = col,
values_from = agg,
values_fill = 0
)
tabular
I get this output with a spreadsheet using your initial inputs:
> tabular
# A tibble: 7 x 5
# Groups: M [7]
M x y z w
<chr> <dbl> <dbl> <dbl> <dbl>
1 A 1 2 3 0
2 B 2 3 4 0
3 C 4 6 8 8
4 D 6 8 10 9
5 E 8 10 12 10
6 F 4 5 6 11
7 G 5 6 7 12
You could use dplyr and tidyr to get your desired result:
Let be
df <- data.frame(subject=c(rep("Mother", 2), rep("Child", 2)), modifier=c("chart2", "child", "tech", "unkn"), mother_chart2=1:4, mother_child=5:8, child_tech=9:12, child_unkn=13:16)
> df
subject modifier mother_chart2 mother_child child_tech child_unkn
1 Mother chart2 1 5 9 13
2 Mother child 2 6 10 14
3 Child tech 3 7 11 15
4 Child unkn 4 8 12 16
and
df2 <- data.frame(subject=c(rep("Mother", 2), rep("Child", 2)), modifier=c("chart", "child", "tech", "unkn"), mother_chart=101:104, mother_child=105:108, child_tech=109:112, child_unkn=113:116)
> df2
subject modifier mother_chart mother_child child_tech child_unkn
1 Mother chart 101 105 109 113
2 Mother child 102 106 110 114
3 Child tech 103 107 111 115
4 Child unkn 104 108 112 116
Then
library(dplyr)
library(tidyr)
df2_tmp <- df2 %>%
pivot_longer(col=-c("subject", "modifier"))
df %>%
pivot_longer(col=-c("subject", "modifier")) %>%
full_join(df2_tmp, by=c("subject", "modifier", "name")) %>%
mutate(across(starts_with("value"), ~ replace_na(., 0)),
sum = value.x + value.y) %>%
select(-value.x, -value.y) %>%
pivot_wider(names_from=name, values_from=sum, values_fill=0)
returns
# A tibble: 5 x 7
subject modifier mother_chart2 mother_child child_tech child_unkn mother_chart
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Mother chart2 1 5 9 13 0
2 Mother child 2 112 120 128 102
3 Child tech 3 114 122 130 103
4 Child unkn 4 116 124 132 104
5 Mother chart 0 105 109 113 101
Related
I am working with a dataframe in R. I have groups stated by column Group1. I need to create a new column named sampled where I need to fill with a specific value after using sample per group from 1 to each number of rows per group. Here is the data I have:
library(tidyverse)
#Data
dat <- data.frame(Group1=sample(letters[1:3],15,replace = T))
Then dat looks like this:
dat
Group1
1 b
2 a
3 a
4 c
5 c
6 c
7 a
8 b
9 c
10 b
11 a
12 b
13 c
14 c
15 c
In order to get the N per group, we do this:
#Code
dat %>%
arrange(Group1) %>%
group_by(Group1) %>%
mutate(N=n())
Which produces:
# A tibble: 15 x 2
# Groups: Group1 [3]
Group1 N
<chr> <int>
1 a 4
2 a 4
3 a 4
4 a 4
5 b 4
6 b 4
7 b 4
8 b 4
9 c 7
10 c 7
11 c 7
12 c 7
13 c 7
14 c 7
15 c 7
What I need to do is next. I have the N per group, so I have to create a sample of 3 numbers from 1:N. In the case of group a having N=4 it would be sample(1:4,3) which produces [1] 2 4 3. With this in the group a I need that rows belonging to sampled values must be filled with 999. So for first group we would have:
Group1 N sampled
<chr> <int> <int>
1 a 4 NA
2 a 4 999
3 a 4 999
4 a 4 999
And then the same for the rest of groups. In this way using sample we will have random values per group. Is that possible to do using dplyr or tidyverse. Many thanks!
You could try:
set.seed(3242)
library(dplyr)
dat %>%
arrange(Group1) %>%
add_count(Group1, name = 'N') %>%
group_by(Group1) %>%
mutate(
sampled = case_when(
row_number() %in% sample(1:n(), 3L) ~ 999L,
TRUE ~ NA_integer_
)
)
Output:
# A tibble: 15 × 3
# Groups: Group1 [3]
Group1 N sampled
<chr> <int> <int>
1 a 4 999
2 a 4 999
3 a 4 NA
4 a 4 999
5 b 4 999
6 b 4 999
7 b 4 999
8 b 4 NA
9 c 7 NA
10 c 7 999
11 c 7 NA
12 c 7 999
13 c 7 NA
14 c 7 NA
15 c 7 999
I've got 3 tibbles in a list that I would like to add a column, for each, with a different value. I found it struggling to do this apart from using the usual for loop (granted, for may well be the best solution in this use case, but I am curious if there's a clever solution).
library(tibble)
library(dplyr)
t1 <- tibble(a=1:10, b=2:11, c=3:12)
t2 <- tibble(a=1:10, b=2:11, c=3:12)
t3 <- tibble(a=1:10, b=2:11, c=3:12)
tlist <- list(t1, t2, t3)
names <- c("A", "B", "C")
The result I wanted to achieve would be the same as that we do dplyr::mutate on each tibble to add that extra column with values in names respectively; to illustrate:
t1 %>% mutate(name=names[1])
t2 %>% mutate(name=names[2])
t3 %>% mutate(name=names[3])
I've tried lapply, sapply, and mapply (and some combinations of either two of them), or purrr::map, I couldn't see a way of applying mutate action of a single value on a single tibble (i.e., one-to-one apply/map). Python has zip which sometimes creates a pair of values that we can easily access in apply functions, but we don't have that facility in R.
A piece of pusedo-ish code in R (which mimics what zip in Python would be like):
args <- pair(tlist, names)
add.col <- function(arg.pair) -> {
arg.pair[[1]] %>% mutate(name=arg.pair[[2]])
}
res <- args %>% lapply(add.col)
Note that apply functions do not take in Pair object (an utility from stats package).
It's very likely there's blind spot for me as I became increasingly obsessed with apply; is there a clever way to do this one-to-one mapping?
Use map2:
library(purrr)
library(dplyr)
map2(tlist, names,
~ .x %>%
mutate(name = .y))
Or in base R with Map:
Map(function(x, y) transform(x, name = y), tlist, names)
output:
[[1]]
# A tibble: 10 × 4
a b c name
<int> <int> <int> <chr>
1 1 2 3 A
2 2 3 4 A
3 3 4 5 A
4 4 5 6 A
5 5 6 7 A
6 6 7 8 A
7 7 8 9 A
8 8 9 10 A
9 9 10 11 A
10 10 11 12 A
[[2]]
# A tibble: 10 × 4
a b c name
<int> <int> <int> <chr>
1 1 2 3 B
2 2 3 4 B
3 3 4 5 B
4 4 5 6 B
5 5 6 7 B
6 6 7 8 B
7 7 8 9 B
8 8 9 10 B
9 9 10 11 B
10 10 11 12 B
[[3]]
# A tibble: 10 × 4
a b c name
<int> <int> <int> <chr>
1 1 2 3 C
2 2 3 4 C
3 3 4 5 C
4 4 5 6 C
5 5 6 7 C
6 6 7 8 C
7 7 8 9 C
8 8 9 10 C
9 9 10 11 C
10 10 11 12 C
mapply also works:
mapply(mutate, tlist, name=names, SIMPLIFY=F)
Using imap
library(purrr)
library(dplyr)
imap(setNames(tlist, names), ~ .x %>%
mutate(name = .y))
I have a vector and list of the same length. The list contains vectors of arbitrary lengths as such:
vec1 <- c("a", "b", "c")
list1 <- list(c(1, 3, 2),
c(4, 5, 8, 9),
c(5, 2))
What is the fastest, most effective way to create a dataframe such that the elements of vec1 are replicated the number of times corresponding to their index in list1?
Expected output:
# col1 col2
# 1 a 1
# 2 a 3
# 3 a 2
# 4 b 4
# 5 b 5
# 6 b 8
# 7 b 9
# 8 c 5
# 9 c 2
I have included a tidy solution as an answer, but I was wondering if there are other ways to approach this task.
In base R, set the names of the list with 'vec1' and use stack to return a two column data.frame
stack(setNames(list1, vec1))[2:1]
-output
ind values
1 a 1
2 a 3
3 a 2
4 b 4
5 b 5
6 b 8
7 b 9
8 c 5
9 c 2
If we want a tidyverse approach, use enframe
library(tibble)
library(dplyr)
library(tidyr)
list1 %>%
set_names(vec1) %>%
enframe(name = 'col1', value = 'col2') %>%
unnest(col2)
# A tibble: 9 × 2
col1 col2
<chr> <dbl>
1 a 1
2 a 3
3 a 2
4 b 4
5 b 5
6 b 8
7 b 9
8 c 5
9 c 2
This tidy solution replicates the vec1 elements according to the nested vector's lengths, then flattens both lists into a tibble.
library(purrr)
library(tibble)
tibble(col1 = flatten_chr(map2(vec1, map_int(list1, length), function(x, y) rep(x, times = y))),
col2 = flatten_dbl(list1))
# # A tibble: 9 × 2
# col1 col2
# <chr> <dbl>
# 1 a 1
# 2 a 3
# 3 a 2
# 4 b 4
# 5 b 5
# 6 b 8
# 7 b 9
# 8 c 5
# 9 c 2
A tidyr/tibble-approach could also be unnest_longer:
library(dplyr)
library(tidyr)
tibble(vec1, list1) |>
unnest_longer(list1)
Output:
# A tibble: 9 × 2
vec1 list1
<chr> <dbl>
1 a 1
2 a 3
3 a 2
4 b 4
5 b 5
6 b 8
7 b 9
8 c 5
9 c 2
Another possible solution, based on purrr::map2_dfr:
library(purrr)
map2_dfr(vec1, list1, ~ data.frame(col1 = .x, col2 =.y))
#> col1 col2
#> 1 a 1
#> 2 a 3
#> 3 a 2
#> 4 b 4
#> 5 b 5
#> 6 b 8
#> 7 b 9
#> 8 c 5
#> 9 c 2
I have a data frame as below:
df <- data.frame(
id = c(1:5),
a = c(3,10,4,0,15),
b = c(2,1,1,0,3),
c = c(12,3,0,3,1),
d = c(9,7,8,0,0),
e = c(1,2,0,2,2)
)
I need to add multiple columns of which names are given by a combination of a:c and 3:5. 3:5 is also used insum function:
df %>% mutate(
usa_3 = sum(1+3),
usa_4 = sum(1+4),
usa_5 = sum(1+5),
canada_3 = sum(1+3),
canada_4 = sum(1+4),
canada_5 = sum(1+5),
nz_3 = sum(1+3),
nz_4 = sum(1+4),
nz_5 = sum(1+5)
)
The result is really simple but I do not want to put similar codes repeatedly.
id a b c d e usa_3 usa_4 usa_5 canada_3 canada_4 canada_5 nz_3 nz_4 nz_5
1 1 3 2 12 9 1 4 5 6 4 5 6 4 5 6
2 2 10 1 3 7 2 4 5 6 4 5 6 4 5 6
3 3 4 1 0 8 0 4 5 6 4 5 6 4 5 6
4 4 0 0 3 0 2 4 5 6 4 5 6 4 5 6
5 5 15 3 1 0 2 4 5 6 4 5 6 4 5 6
The variables are alphabetical prefix and range of integers as postfix.
Postfix is also related to the sum funcion as 1+postfix.
In this case, they have 3 values for each so the result have 9 additional columns.
I do not prefer to define function outside the a bunch of codes and suppose map functino in purrr may help it.
Do you know how to make it work?
Especially it is difficult to give dynamic column name in pipe.
I found some similar questions but it does not match my need.
Multivariate mutate
How to use map from purrr with dplyr::mutate to create multiple new columns based on column pairs
===== ADDITIONAL INFO =====
Let me clarify some conditions of this issue.
Actually sum(1+3), sum(1+4)... part is replaced by as.factor(cutree(X,k=X)) where X is reuslt of cluster analysis and Y is a variable defined as 3:5 in the example. cutree() is a function to define in which part we cut a dendrogram stored in the result of cluster analysis.
As for the column names usa_3, usa_4 ... nz_5, country name is replaced by methods of cluster analysis such as ward, McQuitty, Median method, etc. (seven methods), and integers 3, 4, 5, are the parameter to define in which part I need to cut a dendrogram as explained.
As for an X in the functionas.factor(cutree(X,k=X)), results of cluster analysis also have several data frame which is corresponded to each method. I realized that another issue how to apply the function to each data frame (result of cluster analysis stored in different dataframe).
Actual scripts that I am using currently is something like this:
cluste_number <- original_df %>% mutate(
## Ward
ward_3=as.factor(cutree(clst.ward,k=3)),
ward_4=as.factor(cutree(clst.ward,k=4)),
ward_5=as.factor(cutree(clst.ward,k=5)),
ward_6=as.factor(cutree(clst.ward,k=6)),
## Single
sing_3=as.factor(cutree(clst.sing,k=3)),
sing_4=as.factor(cutree(clst.sing,k=4)),
sing_5=as.factor(cutree(clst.sing,k=5)),
sing_6=as.factor(cutree(clst.sing,k=6)))
It is sorry not to clarify the actual issue; howerver, due to this reason above, number of countries as usa, canada, nz and number of parameters as 1:3 do not match.
Also some suggestions using i + . does not meet the issue as a function as.factor(cutree(X,k=X)) is used in the actual operation.
Thank you for your support.
Not sure what you are up to, but maybe this helps to clarify the issue ..
library(tidyverse)
df <- data.frame(
id = c(1:5),
a = c(3,10,4,0,15),
b = c(2,1,1,0,3),
c = c(12,3,0,3,1),
d = c(9,7,8,0,0),
e = c(1,2,0,2,2)
)
ctry <- rep(c("usa", "ca", "nz"), each = 3)
nr <- rep(seq(3,5), times = 3)
df %>%
as_tibble() %>%
bind_cols(map_dfc(seq_along(ctry), ~1+nr[.x] %>%
rep(nrow(df))) %>%
set_names(str_c(ctry, nr, sep = "_")))
# A tibble: 5 x 15
id a b c d e usa_3 usa_4 usa_5 ca_3 ca_4 ca_5 nz_3 nz_4 nz_5
<int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 3 2 12 9 1 4 5 6 4 5 6 4 5 6
2 2 10 1 3 7 2 4 5 6 4 5 6 4 5 6
3 3 4 1 0 8 0 4 5 6 4 5 6 4 5 6
4 4 0 0 3 0 2 4 5 6 4 5 6 4 5 6
5 5 15 3 1 0 2 4 5 6 4 5 6 4 5 6
I'm not sure if I understand the spirit of the problem, but here is one way to generate a data frame with the column names and values you want.
You can change ~ function(i) i + . to be whatever function of i (the column being mutated) you want, and change either of the ns in setNames(n, n) to incorporate a different value into the function you're creating (first n) or change the names of the resulting columns (second n).
countries <- c('usa', 'canada', 'nz')
n <- 3:5
as.data.frame(matrix(1, nrow(df), length(n))) %>%
rename_all(~countries) %>%
mutate_all(map(setNames(n, n), ~ function(i) i + .)) %>%
select(-countries) %>%
bind_cols(df)
# usa_3 canada_3 nz_3 usa_4 canada_4 nz_4 usa_5 canada_5 nz_5 id a b c d e
# 1 4 4 4 5 5 5 6 6 6 1 3 2 12 9 1
# 2 4 4 4 5 5 5 6 6 6 2 10 1 3 7 2
# 3 4 4 4 5 5 5 6 6 6 3 4 1 0 8 0
# 4 4 4 4 5 5 5 6 6 6 4 0 0 3 0 2
# 5 4 4 4 5 5 5 6 6 6 5 15 3 1 0 2
Kinda of a dirty solution, but it does what you want. It combines two map_dfc functions.
library(dplyr)
library(purrr)
df <- tibble(id = c(1:5),
a = c(3,10,4,0,15),
b = c(2,1,1,0,3),
c = c(12,3,0,3,1),
d = c(9,7,8,0,0),
e = c(1,2,0,2,2))
create_postfix_cols <- function(df, country, n) {
# df = a dataframe
# country = suffix value (e.g. "canada")
# n = vector of postfix values (e.g. 3:5)
map2_dfc(.x = rep(country, length(n)),
.y = n,
~ tibble(col = rep(1 + .y, nrow(df))) %>%
set_names(paste(.x, .y, sep = "_")))
}
countries <- c("usa", "canada", "nz")
n <- 3:5
df %>%
bind_cols(map_dfc(.x = countries, ~create_postfix_cols(df, .x, n)))
# A tibble: 5 x 15
id a b c d e usa_3 usa_4 usa_5 canada_3 canada_4 canada_5
<int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 3 2 12 9 1 4 5 6 4 5 6
2 2 10 1 3 7 2 4 5 6 4 5 6
3 3 4 1 0 8 0 4 5 6 4 5 6
4 4 0 0 3 0 2 4 5 6 4 5 6
5 5 15 3 1 0 2 4 5 6 4 5 6
# ... with 3 more variables: nz_3 <dbl>, nz_4 <dbl>, nz_5 <dbl>
Here is a base R solution. You can rearrange columns if you would like, but this should get your started:
# Create column names using an index and country names
idx <- 3:5
countries <- c("usa", "canada", "nz")
new_columns <- unlist(lapply(countries, paste0, "_", idx))
# Adding new values using index & taking advantage of recycling
df[new_columns] <- sort(rep(1+idx, nrow(df)))
df
id a b c d e usa_3 usa_4 usa_5 canada_3 canada_4 canada_5 nz_3 nz_4 nz_5
1 1 3 2 12 9 1 4 5 6 4 5 6 4 5 6
2 2 10 1 3 7 2 4 5 6 4 5 6 4 5 6
3 3 4 1 0 8 0 4 5 6 4 5 6 4 5 6
4 4 0 0 3 0 2 4 5 6 4 5 6 4 5 6
5 5 15 3 1 0 2 4 5 6 4 5 6 4 5 6
Or, if you prefer:
# All in one long line
df[unlist(lapply(countries, paste0, "_", idx))] <- sort(rep(1+idx, nrow(df)))
This question already has answers here:
Reshaping multiple sets of measurement columns (wide format) into single columns (long format)
(8 answers)
Closed 4 years ago.
I am trying to write a function that will convert this data frame
library(dplyr)
library(rlang)
library(purrr)
df <- data.frame(obj=c(1,1,2,2,3,3,3,4,4,4),
S1=rep(c("a","b"),length.out=10),PR1=rep(c(3,7),length.out=10),
S2=rep(c("c","d"),length.out=10),PR2=rep(c(7,3),length.out=10))
obj S1 PR1 S2 PR2
1 1 a 3 c 7
2 1 b 7 d 3
3 2 a 3 c 7
4 2 b 7 d 3
5 3 a 3 c 7
6 3 b 7 d 3
7 3 a 3 c 7
8 4 b 7 d 3
9 4 a 3 c 7
10 4 b 7 d 3
In to this data frame
df %>% {bind_rows(select(., obj, S = S1, PR = PR1),
select(., obj, S = S2, PR = PR2))}
obj S PR
1 1 a 3
2 1 b 7
3 2 a 3
4 2 b 7
5 3 a 3
6 3 b 7
7 3 a 3
8 4 b 7
9 4 a 3
10 4 b 7
11 1 c 7
12 1 d 3
13 2 c 7
14 2 d 3
15 3 c 7
16 3 d 3
17 3 c 7
18 4 d 3
19 4 c 7
20 4 d 3
But I would like the function to be able to work with any number of columns. So it would also work if I had S1, S2, S3, S4 or if there was an additional category ie DS1, DS2. Ideally the function would take as arguments the patterns that determine which columns are stacked on top of each other, the number of sets of each column, the names of the output columns and the names of any variables that should also be kept.
This is my attempt at this function:
stack_col <- function(df, patterns, nums, cnames, keep){
keep <- enquo(keep)
build_exp <- function(x){
paste0("!!sym(cnames[[", x, "]]) := paste0(patterns[[", x, "]],num)") %>%
parse_expr()
}
exps <- map(1:length(patterns), ~expr(!!build_exp(.)))
sel_fun <- function(num){
df %>% select(!!keep,
!!!exps)
}
map(nums, sel_fun) %>% bind_rows()
}
I can get the sel_fun part to work for a fixed number of patterns like this
patterns <- c("S", "PR")
cnames <- c("Species", "PR")
keep <- quo(obj)
sel_fun <- function(num){
df %>% select(!!keep,
!!sym(cnames[[1]]) := paste0(patterns[[1]], num),
!!sym(cnames[[2]]) := paste0(patterns[[2]], num))
}
sel_fun(1)
But the dynamic version that I have tried does not work and gives this error:
Error: `:=` can only be used within a quasiquoted argument
Here is a function to get the expected output. Loop through the 'patterns' and the corresponding new column names ('cnames') using map2, gather into 'long' format, rename the 'val' column to the 'cnames' passed into the function, bind the columns (bind_cols) and select the columns of interest
stack_col <- function(dat, pat, cname, keep) {
purrr::map2(pat, cname, ~
dat %>%
dplyr::select(keep, matches(.x)) %>%
tidyr::gather(key, val, matches(.x)) %>%
dplyr::select(-key) %>%
dplyr::rename(!! .y := val)) %>%
dplyr::bind_cols(.) %>%
dplyr::select(keep, cname)
}
stack_col(df, patterns, cnames, 1)
# obj Species PR
#1 1 a 3
#2 1 b 7
#3 2 a 3
#4 2 b 7
#5 3 a 3
#6 3 b 7
#7 3 a 3
#8 4 b 7
#9 4 a 3
#10 4 b 7
#11 1 c 7
#12 1 d 3
#13 2 c 7
#14 2 d 3
#15 3 c 7
#16 3 d 3
#17 3 c 7
#18 4 d 3
#19 4 c 7
#20 4 d 3
Also, multiple patterns reshaping can be done with data.table::melt
library(data.table)
melt(setDT(df), measure = patterns("^S\\d+", "^PR\\d+"),
value.name = c("Species", "PR"))[, variable := NULL][]
This solves your problem, although it does not fix your function:
The idea is to use gather and spread on the columns which starts with the specific pattern. Therefore I create a regex which matches the column names and then first gather all of them, extract the group and the rename the groups with the cnames. Finally spread takes separates the new columns.
library(dplyr)
library(purrr)
library(tidyr)
library(stringr)
patterns <- c("S", "PR")
cnames <- c("Species", "PR")
names(cnames) <- patterns
complete_pattern <- str_c("^", str_c(patterns, collapse = "|^"))
df %>%
mutate(rownumber = 1:n()) %>%
gather(new_variable, value, matches(complete_pattern)) %>%
mutate(group = str_extract(new_variable, complete_pattern),
group = str_replace_all(group, cnames),
group_number = str_extract(new_variable, "\\d+")) %>%
select(-new_variable) %>%
spread(group, value)
# obj rownumber group_number PR Species
# 1 1 1 1 3 a
# 2 1 1 2 7 c
# 3 1 2 1 7 b
# 4 1 2 2 3 d
# 5 2 3 1 3 a
# 6 2 3 2 7 c
# 7 2 4 1 7 b
# 8 2 4 2 3 d
# 9 3 5 1 3 a
# 10 3 5 2 7 c
# 11 3 6 1 7 b
# 12 3 6 2 3 d
# 13 3 7 1 3 a
# 14 3 7 2 7 c
# 15 4 8 1 7 b
# 16 4 8 2 3 d
# 17 4 9 1 3 a
# 18 4 9 2 7 c
# 19 4 10 1 7 b
# 20 4 10 2 3 d