@@ -70,7 +70,7 @@ calculate_geodesic_distances_ <- function(
7070 waypoint_ids <- unique(c(waypoint_ids , waypoint_milestone_percentages $ waypoint_id ))
7171 milestone_percentages <- bind_rows(
7272 milestone_percentages ,
73- waypoint_milestone_percentages % > % rename(cell_id = waypoint_id )
73+ waypoint_milestone_percentages | > rename(cell_id = waypoint_id )
7474 )
7575 }
7676
@@ -80,20 +80,19 @@ calculate_geodesic_distances_ <- function(
8080
8181 # rename milestones to avoid name conflicts between cells and milestones
8282 milestone_trafo_fun <- function (x ) paste0(" MILESTONE_" , x )
83- milestone_network <- milestone_network % > % mutate(from = milestone_trafo_fun(from ), to = milestone_trafo_fun(to ))
84- milestone_ids <- milestone_ids % > % milestone_trafo_fun()
85- milestone_percentages <- milestone_percentages % > % mutate(milestone_id = milestone_trafo_fun(milestone_id ))
86- divergence_regions <- divergence_regions % > % mutate(milestone_id = milestone_trafo_fun(milestone_id ))
83+ milestone_network <- milestone_network | > mutate(from = milestone_trafo_fun(from ), to = milestone_trafo_fun(to ))
84+ milestone_ids <- milestone_ids | > milestone_trafo_fun()
85+ milestone_percentages <- milestone_percentages | > mutate(milestone_id = milestone_trafo_fun(milestone_id ))
86+ divergence_regions <- divergence_regions | > mutate(milestone_id = milestone_trafo_fun(milestone_id ))
8787
8888 # add 'extra' divergences for transitions not in a divergence
8989 extra_divergences <-
90- milestone_network %> %
91- # filter(from != to) %>% # filter self edges
92- rowwise() %> %
93- mutate(in_divergence = divergence_regions %> % group_by(divergence_id ) %> % summarise(match = all(c(from , to ) %in% milestone_id )) %> % {any(. $ match )}) %> %
94- filter(! in_divergence ) %> %
95- do({tibble(divergence_id = paste0(. $ from , " __" , . $ to ), milestone_id = c(. $ from , . $ to ), is_start = c(T , F ))}) %> %
96- ungroup() %> %
90+ milestone_network | >
91+ # filter(from != to) |> # filter self edges
92+ rowwise() | >
93+ mutate(in_divergence = divergence_regions | > group_by(divergence_id ) | > summarise(match = all(c(from , to ) %in% milestone_id )) | > (\(x ) any(x $ match ))()) | >
94+ filter(! in_divergence ) | >
95+ reframe(tibble(divergence_id = paste0(from , " __" , to ), milestone_id = c(from , to ), is_start = c(TRUE , FALSE ))) | >
9796 distinct(divergence_id , milestone_id , .keep_all = TRUE )
9897
9998 divergence_regions <- bind_rows(
@@ -111,32 +110,32 @@ calculate_geodesic_distances_ <- function(
111110 # calculate cell-cell distances for pairs of cells that are in the same transition, i.e. an edge or a divergence region
112111 cell_in_tent_distances <-
113112 map_df(divergence_ids , function (did ) {
114- dir <- divergence_regions % > % filter(divergence_id == did )
115- mid <- dir % > % filter(is_start ) % > % . $ milestone_id
113+ dir <- divergence_regions | > filter(divergence_id == did )
114+ mid <- dir | > filter(is_start ) | > pull( milestone_id )
116115 tent <- dir $ milestone_id
117116
118117 tent_nomid <- setdiff(tent , mid )
119118 tent_distances <- igraph :: distances(mil_gr , v = mid , to = tent , mode = " out" , weights = igraph :: E(mil_gr )$ length )
120119
121120 relevant_pct <-
122- milestone_percentages % > %
123- group_by(cell_id ) % > %
124- filter(all(milestone_id %in% tent )) % > %
121+ milestone_percentages | >
122+ group_by(cell_id ) | >
123+ filter(all(milestone_id %in% tent )) | >
125124 ungroup()
126125
127126 if (nrow(relevant_pct ) < = 1 ) {
128127 return (NULL )
129128 }
130129
131130 scaled_dists <-
132- relevant_pct % > %
131+ relevant_pct | >
133132 mutate(dist = percentage * tent_distances [mid , milestone_id ])
134133
135134 pct_mat <-
136135 bind_rows(
137- scaled_dists % > % select(from = cell_id , to = milestone_id , length = dist ),
138- tent_distances % > % as.data.frame() % > % gather(from , length ) % > % mutate(to = from )
139- ) % > %
136+ scaled_dists | > select(from = cell_id , to = milestone_id , length = dist ),
137+ tent_distances | > as.data.frame() | > gather(from , length ) | > mutate(to = from )
138+ ) | >
140139 reshape2 :: acast(from ~ to , value.var = " length" , fill = 0 )
141140
142141 wp_cells <- rownames(pct_mat )[rownames(pct_mat ) %in% waypoint_ids ]
@@ -150,7 +149,7 @@ calculate_geodesic_distances_ <- function(
150149 if (! isFALSE(directed )) {
151150 # calculate the sign of the distance
152151 # distance is negative if the cell is closer to the beginning than the waypoint
153- begin <- dir % > % filter(is_start ) % > % pull(milestone_id )
152+ begin <- dir | > filter(is_start ) | > pull(milestone_id )
154153
155154 signs <- sign(- outer(distances [, begin ], distances [begin , ], " -" ))
156155 signs [is.na(signs )] <- 1 # when disconnected, sign will be NaN, so that distance remains + Inf
@@ -159,10 +158,10 @@ calculate_geodesic_distances_ <- function(
159158 distances <- distances * signs
160159 }
161160
162- distances <- distances % > %
163- as.matrix() % > %
164- reshape2 :: melt(varnames = c(" from" , " to" ), value.name = " length" ) % > %
165- mutate_at( c(" from" , " to" ), as.character ) % > %
161+ distances <- distances | >
162+ as.matrix() | >
163+ reshape2 :: melt(varnames = c(" from" , " to" ), value.name = " length" ) | >
164+ mutate(across( c(" from" , " to" ), as.character )) | >
166165 filter(from != to )
167166
168167 distances
@@ -181,26 +180,26 @@ calculate_geodesic_distances_ <- function(
181180 cell_in_tent_distances $ from2 ,
182181 cell_in_tent_distances $ to
183182 )
184- cell_in_tent_distances <- cell_in_tent_distances % > % select(- from2 )
183+ cell_in_tent_distances <- cell_in_tent_distances | > select(- from2 )
185184 cell_in_tent_distances $ length <- abs(cell_in_tent_distances $ length )
186185
187186 # add reverse edges if distance approx. zero
188187 # this is necessary because the direction will be taken into account
189188 cell_in_tent_distances <- bind_rows(
190189 cell_in_tent_distances ,
191- cell_in_tent_distances % > %
192- filter(length < = 1e-20 ) % > %
193- mutate(from2 = from , from = to , to = from2 ) % > %
190+ cell_in_tent_distances | >
191+ filter(length < = 1e-20 ) | >
192+ mutate(from2 = from , from = to , to = from2 ) | >
194193 select(- from2 )
195194 )
196195 }
197196
198197 # combine all networks into one graph
199198 gr <-
200- bind_rows(milestone_network , cell_in_tent_distances ) % > %
201- group_by(from , to ) % > %
202- summarise(length = min(length )) % > %
203- ungroup() % > %
199+ bind_rows(milestone_network , cell_in_tent_distances ) | >
200+ group_by(from , to ) | >
201+ summarise(length = min(length )) | >
202+ ungroup() | >
204203 igraph :: graph_from_data_frame(directed = directed , vertices = unique(c(milestone_ids , cell_ids_trajectory , waypoint_ids )))
205204
206205 # compute cell-to-cell distances across entire graph
@@ -209,7 +208,7 @@ calculate_geodesic_distances_ <- function(
209208 directed == " reverse" ~ " in" ,
210209 TRUE ~ " all"
211210 )
212- out <- gr % > %
211+ out <- gr | >
213212 igraph :: distances(
214213 v = waypoint_ids ,
215214 to = cell_ids_trajectory ,
0 commit comments