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!
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.