How to I write an S3 extract method [ in r - r

I have a data frame called gfe_obj with structure as follows:
And I want to write an extract function such that when I run the code below, I get the corresponding output:
Currently, I have:
str(gfe_obj)
'[.gfe_obj' <- function(x,i) {
class(x) <- "gfe"
as.gfe_obj(x[i])
}
sub_gfe_obj <- gfe_obj[1:3]
str(sub_gfe_obj)
But when I run this code, I get Error in as.gfe_obj(x[i]) : could not find function "as.gfe_obj".
I referenced the method to write from here : How to implement extracting/subsetting ([, [<-, [[, [[<-) functions for custom S3 classes?
Thank you for your help.

I'm not sure what the exact structure of your gfe class is supposed to be, but assuming it is a list consisting of two objects (a 3D array called frames and a data frame called info with the same number of rows as the third dimension of frames, then your S3 method would be:
`[.gfe`<- function(x, i) {
x$frames <- x$frames[,,i]
x$info <- x$info[i,]
x
}
To test this, I need a mock class constructor and some dummy data:
gfe <- function(frames, info) {
structure(list(frames = frames, info = info), class = "gfe")
}
gfe_obj <- gfe(frames = array(1:90, dim = c(3, 3, 10)),
info = data.frame(x = 1:10, y = letters[1:10]))
str(gfe_obj)
#> List of 2
#> $ frames: int [1:3, 1:3, 1:10] 1 2 3 4 5 6 7 8 9 10 ...
#> $ info :'data.frame': 10 obs. of 2 variables:
#> ..$ x: int [1:10] 1 2 3 4 5 6 7 8 9 10
#> ..$ y: chr [1:10] "a" "b" "c" "d" ...
#> - attr(*, "class")= chr "gfe"
Now we can see the extractor method works as expected:
sub_gfe_obj <- gfe_obj[2:3]
str(sub_gfe_obj)
#> List of 2
#> $ frames: int [1:3, 1:3, 1:2] 10 11 12 13 14 15 16 17 18 19 ...
#> $ info :'data.frame': 2 obs. of 2 variables:
#> ..$ x: int [1:2] 2 3
#> ..$ y: chr [1:2] "b" "c"
#> - attr(*, "class")= chr "gfe"
Created on 2022-09-25 with reprex v2.0.2

Related

Exclude elements from a list of named numbers based on entries within a character list using purrr

My data has 1,000 entries and here is the str of the first 2 elements:
> str(my_boots[1:2])
List of 2
$ :List of 4
..$ result : Named num [1:10] 0.118 0.948 4.317 1.226 1.028 ...
.. ..- attr(*, "names")= chr [1:10] "(Intercept)" "pvi2" "freqchal" "sexexp" ...
..$ output : chr "list()"
..$ warnings: chr(0)
..$ messages: chr(0)
$ :List of 4
..$ result : Named num [1:10] 0.202 0.995 2.512 1.057 0.5 ...
.. ..- attr(*, "names")= chr [1:10] "(Intercept)" "pvi2" "freqchal" "sexexp" ...
..$ output : chr "list()"
..$ warnings: chr(0)
..$ messages: chr(0)
The fields of interest are $result and $warnings; I want to return a tibble with the columns based on the names within the named list result where warning == "" (where no warning).
I'm new to purrr but I was able to get most of the way there using map_dfr(my_boots[1:2],"result") - this returns a tibble with the column names from the named numbers list but I would like to only return the ones where the entry under warnings is blank.
I wasn't sure how to create this structure manually but was able to create a single element of my_boots:
test <- list(
list("warnings" = c("blah")),
list("result" = c("alpha" = 1.1, "beta" = 2.1, "theta" =3.1, "blah" = 4.1))
)
Also: I'm using the tidyverse - thank you.
Starting with some dummy data.
library(tidyverse)
l <- list(
list(
result = 1:10,
warnings = character(0)
),
list(
result = 2:20,
warnings = "warn"
),
list(
result = 3:30,
warnings = character(0)
),
list(
result = 4:40,
warnings = "warn"
)
)
Use keep to keep only elements without warnings. map("result") pulls the result element out of each list.
l %>%
keep(~is_empty(.$warnings)) %>%
map("result")
#> [[1]]
#> [1] 1 2 3 4 5 6 7 8 9 10
#>
#> [[2]]
#> [1] 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
#> [22] 24 25 26 27 28 29 30

How to get result of package function into a dataframe in r

I am at the learning stage of r.
I am using library(usdm) in r where I am using vifcor(vardata,th=0.4,maxobservations =50000) to find the not multicollinear variables. I need to get the result of vifcor(vardata,th=0.4,maxobservations =50000) into a structured dataframe for further analysis.
Data reading process I am using:
performdata <- read.csv('F:/DGDNDRV_FINAL/OutputTextFiles/data_blk.csv')
vardata <-performdata[,c(names(performdata[5:length(names(performdata))-2])]
Content of the csv file:
pointid grid_code Blocks_line_dst_CHT GrowthCenter_dst_CHT Roads_nationa_dst_CHT Roads_regiona_dst_CHT Settlements_CHT_line_dst_CHT Small_Hat_Bazar_dst_CHT Upazilla_lin_dst_CHT resp
1 6 150 4549.428711 15361.31836 3521.391846 318.9043884 3927.594727 480 1
2 6 127.2792206 4519.557617 15388.68457 3500.24292 342.0526123 3902.883545 480 1
3 2 161.5549469 4484.473145 15391.6377 3436.539063 335.4101868 3844.216553 540 1
My tries:
r<-vifcor(vardata,th=0.2,maxobservations =50000) returns
2 variables from the 6 input variables have collinearity problem:
Roads_regiona_dst_CHT GrowthCenter_dst_CHT
After excluding the collinear variables, the linear correlation coefficients ranges between:
min correlation ( Small_Hat_Bazar_dst_CHT ~ Roads_nationa_dst_CHT ): -0.04119076963
max correlation ( Small_Hat_Bazar_dst_CHT ~ Settlements_CHT_line_dst_CHT ): 0.1384278434
---------- VIFs of the remained variables --------
Variables VIF
1 Blocks_line_dst_CHT 1.026743892
2 Roads_nationa_dst_CHT 1.010556752
3 Settlements_CHT_line_dst_CHT 1.038307666
4 Small_Hat_Bazar_dst_CHT 1.026943711
class(r) returns
[1] "VIF"
attr(,"package")
[1] "usdm"
mode(r) returns "S4"
I need Roads_regiona_dst_CHT GrowthCenter_dst_CHT into a dataframe and VIFs of the remained variables into another dataframe!
But nothing worked!
Basically the resturned result is a S4 class and you can extract slots via the # operator:
library(usdm)
example(vifcor) # creates 'v2'
str(v2)
# Formal class 'VIF' [package "usdm"] with 4 slots
# ..# variables: chr [1:10] "Bio1" "Bio2" "Bio3" "Bio4" ...
# ..# excluded : chr [1:5] "Bio5" "Bio10" "Bio7" "Bio6" ...
# ..# corMatrix: num [1:5, 1:5] 1 0.0384 -0.3011 0.0746 0.7102 ...
# .. ..- attr(*, "dimnames")=List of 2
# .. .. ..$ : chr [1:5] "Bio1" "Bio2" "Bio3" "Bio8" ...
# .. .. ..$ : chr [1:5] "Bio1" "Bio2" "Bio3" "Bio8" ...
# ..# results :'data.frame': 5 obs. of 2 variables:
# .. ..$ Variables: Factor w/ 5 levels "Bio1","Bio2",..: 1 2 3 4 5
# .. ..$ VIF : num [1:5] 2.09 1.37 1.25 1.27 2.31
So you can extract the results and the excluded slot now via:
v2#excluded
# [1] "Bio5" "Bio10" "Bio7" "Bio6" "Bio4"
v2#results
# variables VIF
# 1 Bio1 2.086186
# 2 Bio2 1.370264
# 3 Bio3 1.253408
# 4 Bio8 1.267217
# 5 Bio9 2.309479
You should be able to use the below command to get the information in the slot 'results' into a data frame. You can then split the information out into separate data frames using traditional methods
df <- r#results
Note that r#results[1:2,2] would give you the VIF for the first two rows.

Get named variable from list of list

this is probably trivial but can someone help me with this?
I been using the apply to call a function that returns a list, as such
l <- apply(df, 1, manydo); manydo function returns a list list("a" = a, "b" = b)
the output l appears to be a list of list, because when I type str(l) it returns
List of 5
$ 1:List of 2
..$ a: Named num [1:36] 3.29 3.25 3.36 3.26 3.34 ...
.. ..- attr(*, "names")= chr [1:36] "V1" "V2" "V3" "V4" ...
..$ b: Named num [1:36] 0.659 0.65 0.672 0.652 0.669 ...
I tried to access it many ways such as
l[1][1]
or l[1]['a']
unlist(l[1][1]['a'])
but nothing works. What I want is to be able to get for example, the first element and 'a' variable?
in addition, if I just call the function directly say:
l <- manydo(c(1:36)) # I can access this
l['a'] # this works, so I'm confuse ;(
thanks!
[ returns a list containing the selected elements. [[ returns a single element (not wrapped in a list), so that's what you want to use here.
l <- list(list(a=1:10, b=10:22), list(), list(), list(), list())
str(l)
## List of 5
## $ :List of 2
## ..$ a: int [1:10] 1 2 3 4 5 6 7 8 9 10
## ..$ b: int [1:13] 10 11 12 13 14 15 16 17 18 19 ...
...
Now to retrieve a:
l[[1]][['a']]
[1] 1 2 3 4 5 6 7 8 9 10
l[[1]] is the list containing a. l[[1]][['a']] is the value of a itself.

creating special data objects in r

For some packages I can see special type of objects. For example I am getting following message when I try to print a dataset from a package.
multitrait
This is an object of class "cross".
It is too complex to print, so we provide just this summary.
RI strains via selfing
No. individuals: 162
......................and other summary information
is (multitrait)
[1] "riself"
I wonder how we can created such object. Are they special lists of dataframe, matrix of vector.
X <- c("A", "B", "C")
Y <- data.frame (A = 1:10, B = 21:30, C = 31:40)
myeq <- c("Y ~ X1 + Y1")
K <- 100
A = 1:20
B = B= 21:40
J <- as.matrix(A,B )
myl1 <- list(J, K)
Now my complex object:
mycomplexobject <- list(X, Y, myeq, K, J, myl1)
mycomplexobject
str(mycomplexobject)
List of 6
$ : chr [1:3] "A" "B" "C"
$ :'data.frame': 10 obs. of 3 variables:
..$ A: int [1:10] 1 2 3 4 5 6 7 8 9 10
..$ B: int [1:10] 21 22 23 24 25 26 27 28 29 30
..$ C: int [1:10] 31 32 33 34 35 36 37 38 39 40
$ : chr "Y ~ X1 + Y1"
$ : num 100
$ : int [1:20, 1] 1 2 3 4 5 6 7 8 9 10 ...
$ :List of 2
..$ : int [1:20, 1] 1 2 3 4 5 6 7 8 9 10 ...
..$ : num 100
is(mycomplexobject)
[1] "list" "vector"
Is there way to make special object and prevent printing whole list instead message like "it is complex to print" and provide summary instead ?
Just set the class of your object and provide a print method.
class(mycomplexobject) <- c("too_complex", class(mycomplexobject))
print.too_complex <- function(x) {
cat("Complex object of length", length(x), "\n")
}
mycomplexobject

How to bind two lists with same structure?

Introduction
I have two nested lists with the same structure that I'd like to combine (in the c() sense).
There might already exist a concept for what I mean by same structure in graph theory, or in computer science, for this relationship but I am not aware.
So here is my attempt to clarify what I mean by same structure:
Elements of a list at some level are either all named or none is named;
When we have named elements there are never duplicated names at that level;
Parent-child node relationships are the same for the two lists, when the nodes are named elements themselves.
So I am wondering if there is already a solution for this problem which I feel might be rather general and common...(?) Any solution involving:
Using base rapply;
Tidyverse solution with some combination of purrr functions;
Functions from the rlist package
would be great!
Example
foo and bar are two example lists with same structure.
wonderful is the desired list that results from combining foo and bar (done manually).
I hope it is clear enough!
# Input lists: foo and bar
foo <- list(a = list(a1 = 1:3, a2 = rep('a', 3)), b = list(b1 = list(b11 = c(4,5,6), b12 = rep('b', 3)), b2 = list(b21 = list(b31 = c(0, 1, 2)))), c = list(list(c21 = 1:3), list(c21 = 4:6), list(c21 = 7:9)))
bar <- list(a = list(a1 = 1:3, a2 = rep('z', 3)), b = list(b1 = list(b11 = c(-1,2,5), b12 = rep('b', 3)), b2 = list(b21 = list(b31 = -c(1,2,3)))), c = list(list(c21 = 3:1), list(c21 = 5:3)))
# wonderful: desired list (result from combining foo and bar)
wonderful <- list(
a = list(
a1 = c(foo$a$a1, bar$a$a1),
a2 = c(foo$a$a2, bar$a$a2)
),
b = list(
b1 = list(
b11 = c(foo$b$b1$b11, bar$b$b1$b11),
b12 = c(foo$b$b1$b12, bar$b$b1$b12)
),
b2 = list(
b21 = list(
b31 = c(foo$b$b2$b21$b31, bar$b$b2$b21$b31)
)
)
),
c = c(foo$c, bar$c)
)
str(foo)
#> List of 3
#> $ a:List of 2
#> ..$ a1: int [1:3] 1 2 3
#> ..$ a2: chr [1:3] "a" "a" "a"
#> $ b:List of 2
#> ..$ b1:List of 2
#> .. ..$ b11: num [1:3] 4 5 6
#> .. ..$ b12: chr [1:3] "b" "b" "b"
#> ..$ b2:List of 1
#> .. ..$ b21:List of 1
#> .. .. ..$ b31: num [1:3] 0 1 2
#> $ c:List of 3
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 1 2 3
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 4 5 6
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 7 8 9
str(bar)
#> List of 3
#> $ a:List of 2
#> ..$ a1: int [1:3] 1 2 3
#> ..$ a2: chr [1:3] "z" "z" "z"
#> $ b:List of 2
#> ..$ b1:List of 2
#> .. ..$ b11: num [1:3] -1 2 5
#> .. ..$ b12: chr [1:3] "b" "b" "b"
#> ..$ b2:List of 1
#> .. ..$ b21:List of 1
#> .. .. ..$ b31: num [1:3] -1 -2 -3
#> $ c:List of 2
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 3 2 1
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 5 4 3
str(wonderful)
#> List of 3
#> $ a:List of 2
#> ..$ a1: int [1:6] 1 2 3 1 2 3
#> ..$ a2: chr [1:6] "a" "a" "a" "z" ...
#> $ b:List of 2
#> ..$ b1:List of 2
#> .. ..$ b11: num [1:6] 4 5 6 -1 2 5
#> .. ..$ b12: chr [1:6] "b" "b" "b" "b" ...
#> ..$ b2:List of 1
#> .. ..$ b21:List of 1
#> .. .. ..$ b31: num [1:6] 0 1 2 -1 -2 -3
#> $ c:List of 5
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 1 2 3
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 4 5 6
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 7 8 9
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 3 2 1
#> ..$ :List of 1
#> .. ..$ c21: int [1:3] 5 4 3
Here's a go at it:
library(purrr)
rec_map <- function(fizz, buzz) {
if(is.atomic(fizz) | is.null(names(fizz))){
c(fizz, buzz)
} else {
imap(fizz,
~rec_map(fizz[[.y]], buzz[[.y]]))
}
}
temp <- rec_map(foo, bar)
all.equal(temp, wonderful)
#> [1] TRUE
I'm by no means a computer scientist, so take the solution with a grain of salt. I am not certain about the behavior desired when there are no names for one level, but then one level down there are names (e.g., foo$c). So I just combined the results (c()) if we encountered a level without names.
edit to take a number of lists:
prec_map <- function(...){
dots <- list(...)
first_el = dots[[1]]
if(is.atomic(first_el) | is.null(names(first_el))){
do.call(c, dots)
} else {
imap(first_el,
function(el, nme){
one_level_down <- map(dots, nme)
do.call(prec_map, one_level_down)
})
}
}
temp <- prec_map(foo, bar)
all.equal(temp, wonderful)
[1] TRUE
I haven't tested it out thoroughly, but light testing looks like it gets the job done.
list_merge does something close to the requirements:
library(purrr)
res <- list_merge(foo, !!! bar)
all.equal(wonderful, list_merge(foo, !!! bar))
# [1] "Component “c”: Length mismatch: comparison on first 3 components"
# [2] "Component “c”: Component 1: Component 1: Numeric: lengths (3, 6) differ"
# [3] "Component “c”: Component 2: Component 1: Numeric: lengths (3, 6) differ"
The only difference seems to be for elements that are unnamed lists (e.g. foo$c and bar$c), the elements of which are concatenated by position (foo$c[[1]] with bar$c[[1]], foo$c[[2]] with bar$c[[2]], and foo$c[[3]] left alone since there is no bar$c[[3]]... rather than c(foo$c, bar$c)).
And a parallel version could be:
plist_merge <- function(.l) {
reduce(.l, ~ list_merge(.x, !!! .y))
}
all.equal(
plist_merge(list(foo, bar)),
list_merge(foo, !!! bar)
)
# [1] TRUE
After thinking a bit more about this problem in general... and after some inspiration from dplyr's joins, here's three joins for lists for my own future reference:
lst_left_join
lst_right_join
lst_inner_join
library(purrr)
#
# Inspired by dplyr's joins: https://r4ds.had.co.nz/relational-data.html#inner-join
# Here's some (more or less equivalent) list joins
#
lst_left_join <- function(lst_x, lst_y) {
if(is.atomic(lst_x) || is.null(names(lst_x))){
c(lst_x, lst_y)
} else {
imap(lst_x, ~lst_left_join(lst_x[[.y]], lst_y[[.y]]))
}
}
plst_left_join <- function(.l) reduce(.l, lst_left_join)
lst_right_join <- function(lst_x, lst_y) {
if(is.atomic(lst_y) || is.null(names(lst_y))){
c(lst_x, lst_y)
} else {
imap(lst_y, ~lst_right_join(lst_x[[.y]], lst_y[[.y]]))
}
}
plst_right_join <- function(.l) reduce(.l, lst_right_join)
lst_inner_join <- function(lst_x, lst_y) {
if(is.atomic(lst_y) || is.null(names(lst_y))){
c(lst_x, lst_y)
} else {
common_names <- intersect(names(lst_x), names(lst_y))
names(common_names) <- common_names # so that map preserves names
map(common_names, ~lst_inner_join(lst_x[[.x]], lst_y[[.x]]))
}
}
plst_inner_join <- function(.l) reduce(.l, lst_inner_join)
# Input lists: foo and bar.
foo <- list(x1 = 1:2, x3 = 30+5:6)
bar <- list(x1 = 10+1:2, x2 = 10+3:4)
# Output lists: r1, r2 and r3.
r1 <- lst_left_join(foo, bar)
r2 <- lst_right_join(foo, bar)
r3 <- lst_inner_join(foo, bar)
str(r1)
#> List of 2
#> $ x1: num [1:4] 1 2 11 12
#> $ x3: num [1:2] 35 36
str(r2)
#> List of 2
#> $ x1: num [1:4] 1 2 11 12
#> $ x2: num [1:2] 13 14
str(r3)
#> List of 1
#> $ x1: num [1:4] 1 2 11 12

Resources