invoke_map has the difficulty on finding arguments - r

I am exploring the tidyverse package. So I am interested in how to get the following task down in the tidy way. One can easily circumvent the problem using *apply functions.
Consider the following data
tb <-
lapply(matrix(c("a", "b", "c")), function(x)
rep(x, 3)) %>% unlist %>% c(rep(c(1, 2, 3), 6)) %>% matrix(ncol = 3) %>%
as_tibble(.name_repair = ~ c("tag", "x1", "x2")) %>% type.convert()
# A tibble: 9 x 3
tag x1 x2
<fct> <int> <int>
1 a 1 1
2 a 2 2
3 a 3 3
4 b 1 1
5 b 2 2
6 b 3 3
7 c 1 1
8 c 2 2
9 c 3 3
I group them using nest() function and for each group I want to apply a different function from a list of functions f_1, f_2, f_3
f_1 <- function(x)
x[,1] + x[,2]
f_2 <- function(x)
x[,1] - x[,2]
f_3 <- function(x)
x[,1] * x[,2]
tb_func_attached <-
tb %>% group_by(tag) %>% nest() %>% mutate(func = c(f_0, f_1, f_2))
# A tibble: 3 x 3
tag data func
<fct> <list> <list>
1 a <tibble [3 x 2]> <fn>
2 b <tibble [3 x 2]> <fn>
3 c <tibble [3 x 2]> <fn>
I try to use invoke_map to apply the functions
tb_func_attached %>% {invoke_map(.$func, .$data)}
invoke_map(tb_func_attached$func, tb_func_attached$data)
But I get the error Error in (function (x) : unused arguments (x1 = 1:3, x2 = 1:3), while the following code runs
> tb_func_attached$func[[1]](tb_func_attached$data[[1]])
x1
1 2
2 4
3 6
> tb_func_attached$func[[2]](tb_func_attached$data[[2]])
x1
1 0
2 0
3 0
> tb_func_attached$func[[3]](tb_func_attached$data[[3]])
x1
1 1
2 4
3 9
But invoke_map still does not work.
So the question is, given a nested data tb_func_attached, how to apply the functions tb_func_attached$func 'rowwisely' to tb_func_attached$data?
And a side question, what is the reason for the retirement of invoke_map? It fits quitely well in the concept of vetorisation, IMHO.
Update:
The previous version dealt with single column data (tb has only tag and x1 columns) and #A. Suliman's comment provides a solution.
However when the data column in the nested tibble has a matrix structure, the code stops running again.

Use map2 to iterate over the list of functions first, and over the data column second. Like this:
tb_func_attached %>%
mutate(output = map2(func, data, ~ .x(.y))) %>%
unnest(data, output)
The output looks this way:
# A tibble: 9 x 4
tag x1 x2 x11
<fct> <int> <int> <int>
1 a 1 1 2
2 a 2 2 4
3 a 3 3 6
4 b 1 1 0
5 b 2 2 0
6 b 3 3 0
7 c 1 1 1
8 c 2 2 4
9 c 3 3 9

Related

Create a list column with ranges set by existing columns

I am trying to create a list column within a data frame, specifying the range using existing columns, something like:
# A tibble: 3 x 3
A B C
<dbl> <dbl> <list>
1 1 6 c(1, 2, 3, 4, 5, 6)
2 2 5 c(2, 3, 4, 5)
3 3 4 c(3, 4)
The catch is that it would need to be created as follows:
df %>% mutate(C = c(A:B))
I have a dataset containing integers entered as ranges, i.e someone has entered "7 to 26". I've separated the ranges into two columns A & B, or "start" and "end", and was hoping to use c(A:B) to create a list, but using dplyr I keep getting:
Warning messages:
1: In a:b : numerical expression has 3 elements: only the first used
2: In a:b : numerical expression has 3 elements: only the first used
Which gives:
# A tibble: 3 x 3
A B C
<dbl> <dbl> <list>
1 1 6 list(1:6)
2 2 5 list(1:6)
3 3 4 list(1:6)
Has anyone had a similar issue and found a workaround?
You can use map2() in purrr
library(dplyr)
df %>%
mutate(C = purrr::map2(A, B, seq))
or do rowwise() before mutate()
df %>%
rowwise() %>%
mutate(C = list(A:B)) %>%
ungroup()
Both methods give
# # A tibble: 3 x 3
# A B C
# <int> <int> <list>
# 1 1 6 <int [6]>
# 2 2 5 <int [4]>
# 3 3 4 <int [2]>
Data
df <- tibble::tibble(A = 1:3, B = 6:4)

Inter-Rater Reliabilty: Running multiple Cohen's Kappa simultaneously (using R)

I am trying to calculate cohen's kapa values for multiple teacher-segment permutations. In this exampe, there are six unique teacher-segment combinations. For example, teacher1-segement1 has two different raters, and would like to see the ICC of these two raters for that teacher1-segement1 (and all the other teacher-segment permuations).
I have a data set such as this.
full.data <- read_table2('Rater teacher segment subject1 subject2 subject3
A 1 1 1 4 1
B 1 1 3 4 3
B 2 2 2 3 2
C 2 2 1 4 1
D 3 1 4 4 4
E 3 1 4 3 4
D 4 2 3 3 3
A 4 2 4 3 4
B 5 2 4 3 4
A 5 2 5 3 5
D 6 1 5 3 5
E 6 1 5 3 5')
I know that if I wanted to get cohen's kapa for just one teacher-segment group, I would tranform the data such as this,
one.permuation<- read_table2('Rater RaterA-teacher1-segment1 RaterB-teacher1-segment1
subject1 1 3
subject2 4 4
subject3 1 3')
and then run,
library(irr)
print(icc(myRatings, model=“twoway”, type=“consistency”, unit=“average”))
Which would give me just ONE kapa value for that particular teacher-segment.
How would I get the values for all the teacher-segment permutations at once? (each group of teacher,segment, has a different observer)?
How do I present these 6 different Kapa values in a way that makes sense? I've never done something like this before; hoping to get some insight from experienced stat folks.
Although not shown here, raters have both an ordinal and nominal scale response (1-4 score) and [yes, No]. Should I be using a different kappa function for these different kinds of scales? From the "Psych" library documentation: "Cohen's kappa (Cohen, 1960) and weighted kappa (Cohen, 1968) may be used to find the agreement of two raters when using nominal scores."
Here is what I tried for you. You said that you want to calculate Cohen's Kappa values. So I decided to use cohen.kappa() in the psych package, rather than icc(), which I am not familiar with. I hope you do not mind that. They key thing was to transform your data in a way that you can run cohen.kappa() all together. Seeing your one.permuation, I tried to create a data frame that has teacher, segment, subject, and raters (A, B, C, D, and E) as columns. pivot_longer() and pivot_wider() handled this. Then, I needed to move numeric values to two columns (rowwise value sorting). I used Ananda Mahto's SOfun package. (Ananda is the author of splitstackshape package.) Then, I grpup the data by teacher and segment and created lists. For each list that contains a data frame, I converted the data frame to matrix and applied cohen.kappa() and obtained results with tidy(). Finally, I used unnest() to see the results.
library(tidyverse)
library(psych)
library(devtools)
install_github("mrdwab/SOfun")
library(SOfun)
library(broom)
pivot_longer(full.data, cols = subject1:subject3,
names_to = "subject", values_to = "rating_score") %>%
pivot_wider(id_cols = c("teacher", "segment", "subject"),
names_from = "Rater", values_from = "rating_score") %>%
as.matrix %>%
naLast(by = "row") %>%
as_tibble %>%
select(-c(subject, C:E)) %>%
type_convert() %>%
group_by(teacher, segment) %>%
nest() %>%
mutate(result = map(.x = data,
.f = function(x) cohen.kappa(as.matrix(x)) %>% tidy())) %>%
unnest(result)
# teacher segment data type estimate conf.low conf.high
# <dbl> <dbl> <list<df[,2]>> <chr> <dbl> <dbl> <dbl>
# 1 1 1 [3 x 2] unweighted 0.25 -0.0501 0.550
# 2 1 1 [3 x 2] weighted 0.571 -0.544 1
# 3 2 2 [3 x 2] unweighted 0 0 0
# 4 2 2 [3 x 2] weighted 0.571 -1 1
# 5 3 1 [3 x 2] unweighted 0 0 0
# 6 3 1 [3 x 2] weighted 0 0 0
# 7 4 2 [3 x 2] unweighted 0 0 0
# 8 4 2 [3 x 2] weighted 0 0 0
# 9 5 2 [3 x 2] unweighted 0.25 -0.0501 0.550
#10 5 2 [3 x 2] weighted 0.571 -0.544 1
#11 6 1 [3 x 2] unweighted 1 1 1
#12 6 1 [3 x 2] weighted 1 1 1
icc version
The data transformation is basically the same. You need to work a bit more when you run multiple stats. icc() returns icclist object. You want to create data frames from the object.
library(irr)
pivot_longer(full.data, cols = subject1:subject3,
names_to = "subject", values_to = "rating_score") %>%
pivot_wider(id_cols = c("teacher", "segment", "subject"),
names_from = "Rater", values_from = "rating_score") %>%
as.matrix %>%
naLast(by = "row") %>%
as_tibble %>%
select(-c(subject, C:E)) %>%
mutate_at(vars(A:B), .funs = list(~as.numeric(.))) %>%
group_by(teacher, segment) %>%
nest() %>%
mutate(result = map(.x = data,
.f = function(x) enframe(unlist(icc(x,
model = "twoway",
type = "consistency",
unit = "average"))) %>%
pivot_wider(names_from = "name",
values_from = "value"))) %>%
unnest(result)
teacher segment data subjects raters model type unit icc.name value r0 Fvalue df1 df2 p.value conf.level lbound ubound
<chr> <chr> <list<d> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 1 1 [3 x 2] 3 2 twow~ cons~ aver~ ICC(C,2) 0.75 0 4 2 2 0.2 0.95 -8.74~ 0.993~
2 2 2 [3 x 2] 3 2 twow~ cons~ aver~ ICC(C,2) 0.75 0 4 2 2 0.2 0.95 -8.75 0.993~
3 3 1 [3 x 2] 3 2 twow~ cons~ aver~ ICC(C,2) 4.99~ 0 1 2 2 0.5 0.95 -38 0.974~
4 4 2 [3 x 2] 3 2 twow~ cons~ aver~ ICC(C,2) -8.3~ 0 0.999~ 2 2 0.5 0.95 -38 0.974~
5 5 2 [3 x 2] 3 2 twow~ cons~ aver~ ICC(C,2) 0.88~ 0 8.999~ 2 2 0.1 0.95 -3.33~ 0.997~
6 6 1 [3 x 2] 3 2 twow~ cons~ aver~ ICC(C,2) 1 0 Inf 2 2 0 0.95 1 1

Mutate with a list column function in dplyr

I am trying to calculate the Jaccard similarity between a source vector and comparison vectors in a tibble.
First, create a tibble with a names_ field (vector of strings). Using dplyr's mutate, create names_vec, a list-column, where each row is now a vector (each element of vector is a letter).
Then, create a new tibble with column jaccard_sim that is supposed to calculate the Jaccard similarity.
source_vec <- c('a', 'b', 'c')
df_comp <- tibble(names_ = c("b d f", "u k g", "m o c"),
names_vec = strsplit(names_, ' '))
df_comp_jaccard <- df_comp %>%
dplyr::mutate(jaccard_sim = length(intersect(names_vec, source_vec))/length(union(names_vec, source_vec)))
All the values in jaccard_sim are zero. However, if we run something like this, we get the correct Jaccard similarity of 0.2 for the first entry:
a <- length(intersect(source_vec, df_comp[[1,2]]))
b <- length(union(source_vec, df_comp[[1,2]]))
a/b
You could simply add rowwise
df_comp_jaccard <- df_comp %>%
rowwise() %>%
dplyr::mutate(jaccard_sim = length(intersect(names_vec, source_vec))/
length(union(names_vec, source_vec)))
# A tibble: 3 x 3
names_ names_vec jaccard_sim
<chr> <list> <dbl>
1 b d f <chr [3]> 0.2
2 u k g <chr [3]> 0.0
3 m o c <chr [3]> 0.2
Using rowwise you get the intuitive behavior some would expect when using mutate : "do this operation for every row".
Not using rowwise means you take advantage of vectorized functions, which is much faster, that's why it's the default, but may yield unexpected results if you're not careful.
The impression that mutate (or other dplyr functions) works row-wise is an illusion due to the fact you're working with vectorized functions, in fact you're always juggling with full columns.
I'll illustrate with a couple of examples:
Sometimes the result is the same, with a vectorized function such as paste:
tibble(a=1:10,b=10:1) %>% mutate(X = paste(a,b,sep="_"))
tibble(a=1:10,b=10:1) %>% rowwise %>% mutate(X = paste(a,b,sep="_"))
# # A tibble: 5 x 3
# a b X
# <int> <int> <chr>
# 1 1 5 1_5
# 2 2 4 2_4
# 3 3 3 3_3
# 4 4 2 4_2
# 5 5 1 5_1
And sometimes it's different, with a function that is not vectorized, such as max:
tibble(a=1:5,b=5:1) %>% mutate(max(a,b))
# # A tibble: 5 x 3
# a b `max(a, b)`
# <int> <int> <int>
# 1 1 5 5
# 2 2 4 5
# 3 3 3 5
# 4 4 2 5
# 5 5 1 5
tibble(a=1:5,b=5:1) %>% rowwise %>% mutate(max(a,b))
# # A tibble: 5 x 3
# a b `max(a, b)`
# <int> <int> <int>
# 1 1 5 5
# 2 2 4 4
# 3 3 3 3
# 4 4 2 4
# 5 5 1 5
Note that in this case you shouldn't use rowwise in a real life situation, but pmax which is vectorized for this purpose:
tibble(a=1:5,b=5:1) %>% mutate(pmax(a,b))
# # A tibble: 5 x 3
# a b `pmax(a, b)`
# <int> <int> <int>
# 1 1 5 5
# 2 2 4 4
# 3 3 3 3
# 4 4 2 4
# 5 5 1 5
Intersect is such function, you fed this function one list column containing vectors and one other vector, these 2 objects have no intersection.
We can use map to loop through the list
library(tidyverse)
df_comp %>%
mutate(jaccard_sim = map_dbl(names_vec, ~length(intersect(.x,
source_vec))/length(union(.x, source_vec))))
# A tibble: 3 x 3
# names_ names_vec jaccard_sim
# <chr> <list> <dbl>
#1 b d f <chr [3]> 0.2
#2 u k g <chr [3]> 0.0
#3 m o c <chr [3]> 0.2
The map functions are optimized. Below are the system.time for a slightly bigger dataset
df_comp1 <- df_comp[rep(1:nrow(df_comp), 1e5),]
system.time({
df_comp1 %>%
rowwise() %>%
dplyr::mutate(jaccard_sim = length(intersect(names_vec, source_vec))/length(union(names_vec, source_vec)))
})
#user system elapsed
# 25.59 0.05 25.96
system.time({
df_comp1 %>%
mutate(jaccard_sim = map_dbl(names_vec, ~length(intersect(.x,
source_vec))/length(union(.x, source_vec))))
})
#user system elapsed
# 13.22 0.00 13.22

How to separate a column list of fixed size X to X different columns?

I have a tibble with one column being a list column, always having two numeric values named a and b (e.g. as a result of calling purrr:map to a function which returns a list), say:
df <- tibble(x = 1:3, y = list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6)))
df
# A tibble: 3 × 2
x y
<int> <list>
1 1 <list [2]>
2 2 <list [2]>
3 3 <list [2]>
How do I separate the list column y into two columns a and b, and get:
df_res <- tibble(x = 1:3, a = c(1,3,5), b = c(2,4,6))
df_res
# A tibble: 3 × 3
x a b
<int> <dbl> <dbl>
1 1 1 2
2 2 3 4
3 3 5 6
Looking for something like tidyr::separate to deal with a list instead of a string.
Using dplyr (current release: 0.7.0):
bind_cols(df[1], bind_rows(df$y))
# # A tibble: 3 x 3
# x a b
# <int> <dbl> <dbl>
# 1 1 1 2
# 2 2 3 4
# 3 3 5 6
edit based on OP's comment:
To embed this in a pipe and in case you have many non-list columns, we can try:
df %>% select(-y) %>% bind_cols(bind_rows(df$y))
We could also make use the map_df from purrr
library(tidyverse)
df %>%
summarise(x = list(x), new = list(map_df(.$y, bind_rows))) %>%
unnest
# A tibble: 3 x 3
# x a b
# <int> <dbl> <dbl>
#1 1 1 2
#2 2 3 4
#3 3 5 6

Size of nested vs. unested (tidy) data.frame?

This question uses a data.frame which contains list-columns (nested). It had me wondering why/if there's an advantage to working this way. I assumed you would want to minimize the amount of memory each table uses...But when I checked I was surprised:
Compare table sizes for nested vs. tidy format:
1. Generate nested/tidy versions of a 2-col and 5-col data.frame:
library(pryr)
library(dplyr)
library(tidyr)
library(ggvis)
n <- 1:1E6
df <- data_frame(id = n, vars = lapply(n, function(x) x <- sample(letters,sample(1:26,1))))
dfu <- df %>% unnest(vars)
df_morecols <- data_frame(id = n, other1 = n, other2 = n, other3 = n,
vars = lapply(n, function(x) x <- sample(letters,sample(1:26,1))))
dfu_morecols <- df_morecols %>% unnest(vars)
they look like:
head(df)
#> Source: local data frame [6 x 2]
#> id vars
#> 1 1 <chr[16]>
#> 2 2 <chr[4]>
#> 3 3 <chr[26]>
#> 4 4 <chr[9]>
#> 5 5 <chr[11]>
#> 6 6 <chr[18]>
head(dfu)
#> Source: local data frame [6 x 2]
#> id vars
#> 1 1 k
#> 2 1 d
#> 3 1 s
#> 4 1 j
#> 5 1 m
#> 6 1 t
head(df_morecols)
#> Source: local data frame [6 x 5]
#> id other1 other2 other3 vars
#> 1 1 1 1 1 <chr[4]>
#> 2 2 2 2 2 <chr[22]>
#> 3 3 3 3 3 <chr[24]>
#> 4 4 4 4 4 <chr[6]>
#> 5 5 5 5 5 <chr[15]>
#> 6 6 6 6 6 <chr[11]>
head(dfu_morecols)
#> Source: local data frame [6 x 5]
#> id other1 other2 other3 vars
#> 1 1 1 1 1 r
#> 2 1 1 1 1 p
#> 3 1 1 1 1 s
#> 4 1 1 1 1 w
#> 5 2 2 2 2 l
#> 6 2 2 2 2 j
2. Calculate object sizes and col sizes
from: lapply(list(df,dfu,df_morecols,dfu_morecols),object_size)
170 MB vs. 162 MB for nested vs. tidy 2-col df
170 MB vs. 324 MB for nested vs. tidy 5-col df
col_sizes <- sapply(c(df,dfu,df_morecols,dfu_morecols),object_size)
col_names <- names(col_sizes)
parent_obj <- c(rep(c('df','dfu'),each = 2),
rep(c('df_morecols','dfu_morecols'),each = 5))
res <- data_frame(parent_obj,col_names,col_sizes) %>%
unite(elementof, parent_obj,col_names, remove = F)
3. Plot columns sizes coloured by parent object:
res %>%
ggvis(y = ~elementof, x = ~0, x2 = ~col_sizes, fill = ~parent_obj) %>%
layer_rects(height = band())
Questions:
What explains the smaller footprint of the tidy 2-col df compared to the nested one?
Why doesn't this effect change for to the 5-col df?

Resources