jsimpsno
Reputation: 460
purrr map_df output a new nested dataframe column
Is there a way to add an additional nested column that contains a new dataframe output from a function? Below is an example where i have written a function and now I'm trying to iterate over each row.
Here is the function, which works if i run this on a single set of data. (See a,b,c,d)
test data
a=759145
b=76619
c=257124
d=265261
spacing<- 880
distance <- c(spacing,spacing*2,spacing*3,spacing*4,spacing*5,spacing*6,spacing*7,spacing*8,spacing*9) # distance away from the road
function
parallel_spacing_fn<-function(a1,b1,c2,d2){
x <- c(a1,b1)
y <- c(c2 ,d2)
datalist = list()
datalist2 = list()
for (d in distance) {
# Given a vector (defined by 2 points) and the distance,
# calculate a new vector that is distance away from the original
segment.shift <- function(x, y, d){
# calculate vector
v <- c(x[2] - x[1],y[2] - y[1])
# normalize vector
v <- v/sqrt((v[1]**2 + v[2]**2))
# perpendicular unit vector
vnp <- c( -v[2], v[1] )
return(list(x = c( x[1] + d*vnp[1], x[2] + d*vnp[1]),
y = c( y[1] + d*vnp[2], y[2] + d*vnp[2])))
}
# allocate memory for the bike path
xn <- numeric( (length(x) - 1) * 2 )
yn <- numeric( (length(y) - 1) * 2 )
for ( i in 1:(length(x) - 1) ) {
xs <- c(x[i], x[i+1])
ys <- c(y[i], y[i+1])
new.s <- segment.shift( xs, ys, d )
xn[(i-1)*2+1] <- new.s$x[1] ; xn[(i-1)*2+2] <- new.s$x[2]
yn[(i-1)*2+1] <- new.s$y[1] ; yn[(i-1)*2+2] <- new.s$y[2]
}
dat1<-as_tibble()
dat1<-as.data.frame(xn)%>%mutate(id=row_number())%>%mutate(Dist_Col=paste(d,"left",sep="_"))
#datalist[[d]] <- dat1 # add it to your list
dat2<-as_tibble()
dat2<-as.data.frame(yn)%>%mutate(id=row_number())%>%mutate(Dist_Col=paste(d,"left",sep="_"))
#datalist2[[d]] <- dat2 # add it to your list
###Now do right side
# allocate memory for the bike path
xn <- numeric( (length(x) - 1) * 2 )
yn <- numeric( (length(y) - 1) * 2 )
for ( i in 1:(length(x) - 1) ) {
xs <- c(x[i], x[i+1])
ys <- c(y[i], y[i+1])
new.s <- segment.shift( xs, ys, -d )
xn[(i-1)*2+1] <- new.s$x[1] ; xn[(i-1)*2+2] <- new.s$x[2]
yn[(i-1)*2+1] <- new.s$y[1] ; yn[(i-1)*2+2] <- new.s$y[2]
}
dat3<-as_tibble()
dat3<-as.data.frame(xn)%>%mutate(id=row_number())%>%mutate(Dist_Col=paste(d,"right",sep="_"))
datcomb<- full_join(dat1,dat3)
datalist[[d]] <- datcomb # add it to your list
dat4<-as_tibble()
dat4<-as.data.frame(yn)%>%mutate(id=row_number())%>%mutate(Dist_Col=paste(d,"right",sep="_"))
dat2comb<- full_join(dat2,dat4)
datalist2[[d]] <- dat2comb # add it to your list
}
big_data = do.call(rbind, datalist)
big_data2 = do.call(rbind, datalist2)
comb_data<- full_join(big_data,big_data2)
}
x=parallel_spacing_fn(a,b,c,d)
Here is the nested dataframe i would like to iterate over. My intital attempt was to use PURR map_df, but now I'm wondering if i should write another for loop?
structure(list(OBJECTID_1 = c(170795, 158926, 170796, 170797,
74758, 170798, 74757, 71331, 158748, 158800, 171144, 167991,
170985, 159202, 167990), data = list(structure(list(X_1 = 791806.957864181,
X_2 = 785512.771698002, Y_1 = 233314.224607777, Y_2 = 229184.215067145), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
X_1 = 792533.074659662, X_2 = 783388.018236045, Y_1 = 230885.419496296,
Y_2 = 224878.340874981), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -1L)), structure(list(X_1 = 795052.843843351,
X_2 = 785643.485631476, Y_1 = 229406.40394036, Y_2 = 223245.75510431), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
X_1 = 796821.226335759, X_2 = 787145.416317165, Y_1 = 227462.665657252,
Y_2 = 221047.564227364), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -1L)), structure(list(X_1 = 795356.971998954,
X_2 = 791651.414871993, Y_1 = 237855.746923772, Y_2 = 233539.238149352), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
X_1 = 787145.416317165, X_2 = 796821.226335759, Y_1 = 221047.564227364,
Y_2 = 227462.665657252), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -1L)), structure(list(X_1 = 798885.441403441,
X_2 = 792816.47413827, Y_1 = 237907.774432991, Y_2 = 230870.388411334), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
X_1 = 801886.200413522, X_2 = 795052.843843351, Y_1 = 237384.986466147,
Y_2 = 229406.40394036), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -1L)), structure(list(X_1 = 782215.495007085,
X_2 = 778004.911567101, Y_1 = 229531.311160664, Y_2 = 226740.660699846), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
X_1 = 774111.10739776, X_2 = 779461.875017808, Y_1 = 221345.75680274,
Y_2 = 221361.262444083), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -1L)), structure(list(X_1 = 779461.875017808,
X_2 = 774111.10739776, Y_1 = 221361.262444083, Y_2 = 221345.75680274), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
X_1 = 779284.987142645, X_2 = 785357.019122782, Y_1 = 225436.143812854,
Y_2 = 229420.355663708), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -1L)), structure(list(X_1 = 785357.019122782,
X_2 = 779284.987142645, Y_1 = 229420.355663708, Y_2 = 225436.143812854), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
X_1 = 784672.158689655, X_2 = 784708.07793811, Y_1 = 221376.364048245,
Y_2 = 216070.684445299), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -1L)), structure(list(X_1 = 784708.07793811,
X_2 = 784672.158689655, Y_1 = 216070.684445299, Y_2 = 221376.364048245), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)))), row.names = c(NA,
-15L), groups = structure(list(OBJECTID_1 = c(71331, 74757, 74758,
158748, 158800, 158926, 159202, 167990, 167991, 170795, 170796,
170797, 170798, 170985, 171144), .rows = structure(list(8L, 7L,
5L, 9L, 10L, 2L, 14L, 15L, 12L, 1L, 3L, 4L, 6L, 13L, 11L), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = c(NA, 15L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"))
This is what i've tried with map_df
simplepolys_filtered_nest %>%
mutate(df2= ~map_df(.,parallel_spacing_fn(X_1,X_2,Y_1,Y_2)))
simplepolys_filtered_nest %>%
mutate(df2= ~map_dfr(.,parallel_spacing_fn(X_1,X_2,Y_1,Y_2)))
thanks for your help!
Upvotes: 0
Views: 385
Answers (1)
zoowalk
Reputation: 2134
Does this what you are looking for:
df %>%
unnest_wider(data) %>%
mutate(res=pmap(list(X_1, X_2, Y_1, Y_2), parallel_spacing_fn)) %>%
nest(X_1:Y_2)
# A tibble: 15 x 3
# Groups: OBJECTID_1 [15]
OBJECTID_1 res data
<dbl> <list> <list>
1 170795 <df[,4] [36 x 4]> <tibble [1 x 4]>
2 158926 <df[,4] [36 x 4]> <tibble [1 x 4]>
3 170796 <df[,4] [36 x 4]> <tibble [1 x 4]>
4 170797 <df[,4] [36 x 4]> <tibble [1 x 4]>
5 74758 <df[,4] [36 x 4]> <tibble [1 x 4]>
6 170798 <df[,4] [36 x 4]> <tibble [1 x 4]>
7 74757 <df[,4] [36 x 4]> <tibble [1 x 4]>
8 71331 <df[,4] [36 x 4]> <tibble [1 x 4]>
9 158748 <df[,4] [36 x 4]> <tibble [1 x 4]>
10 158800 <df[,4] [36 x 4]> <tibble [1 x 4]>
11 171144 <df[,4] [36 x 4]> <tibble [1 x 4]>
12 167991 <df[,4] [36 x 4]> <tibble [1 x 4]>
13 170985 <df[,4] [36 x 4]> <tibble [1 x 4]>
14 159202 <df[,4] [36 x 4]> <tibble [1 x 4]>
15 167990 <df[,4] [36 x 4]> <tibble [1 x 4]>
There is definitely a more elegant way to access the elements of the list column without unnesting it before apply the function, but it seemed clear to me this way.
Upvotes: 1
Related Questions
- Output separate dataframes in a list using purrr::map_dfr()
- Map function over nested columns
- Pretty-print a nested dataframe in R with purrr::map
- Translating a `for loop` into purrr using `map` function in r
- Issue applying purrr::map() inside nested dataframe
- How to reference a column in a nested dataframe (then use purrr::map)
- How to map a nested dataframe, and store multiple columns as output
- R nested map through columns
- joining dataframe to nested dataframes within purrr::map_*
- purrr::map_df with nested data.frame