Reputation: 109
Appreciate any pointers to the below output that want. I know I need to do some form of recursion but sure how to do that exactly.
I have the following code
>> start of code
# BOM data
library("dplyr")
library(igraph)
text1 <- ("
matnr,comp
FG1,SA1
FG1,SA2
SA1,SA3
SA1,SA4
SA1,SA5
SA5,SA6
FG2,SA1
FG2,SA8
SA8,SA9
SA9,SA10
SA9,SA11")
df1 <- read.table(textConnection(text1), header = TRUE, stringsAsFactors=FALSE, strip.white = TRUE, sep=",")
head(df1)
net <- graph_from_data_frame(df1)
net
neighbors_FG1 <- neighbors(net, v=c("FG1"), mode=c("out"))
neighbors_FG1
neighbors_FG2 <- neighbors(net, v=c("FG2"), mode=c("out"))
neighbors_FG2
neighbors_SA1 <- neighbors(net, v=c("SA1"), mode=c("out"))
neighbors_SA1
>> end of code
I want to be able to produce a data frame like below. I would think that this will need some sort of recursion and I would like to get help with this. If you can even help me with how I can get to the output below, that will be great.
FG,level,material,Comp
FG1,1,FG1,SA1
FG1,1,FG1,SA2
FG1,2,SA1,SA3
FG1,2,SA1,SA4
FG1,2,SA1,SA5
FG1,3,SA5,SA6
FG2,1,FG2,SA1
FG2,1,FG2,SA8
FG2,2,SA8,SA9
Upvotes: 4
Views: 304
Reputation: 1219
A complement after executing the ThomasIsCoding answer (May 28, 2021 at 8:25)
FG3,SA6
and FG3,SA8
added to df1
(for the example below)
text2 <- "matnr,comp\n FG1,SA1\n FG1,SA2\n SA1,SA3\n SA1,SA4\n SA1,SA5\n SA5,SA6\n FG2,SA1\n FG2,SA8\n SA8,SA9\n SA9,SA10\n SA9,SA11\n FG3,SA6\n FG3,SA8"
df2 <- read.table(textConnection(text2), header = TRUE, stringsAsFactors=FALSE, strip.white = TRUE, sep=",")
net <- graph_from_data_frame(df2)
lapply()
: c("FG2","FG3")
(As you ask @ThomasIsCoding, even if the core of the anwser is yours :) Before I've read your answer, I've looking for an answer during a certain time )
gNew<- igraph::graph_from_data_frame(res %>% select(matnr,comp,lvl,FG), directed = TRUE)
In my real case, I have all datas for years, so maybe in my app I will replace the 1st parameter of vapply
names(V(net))[degree(net, mode = "in") == 0]
:
c("FG2","FG3")
, called by an UI for the interactive use case,with 1st param of lapply()
: c("FG2","FG3")
then gNew <- igraph::graph_from_data_frame(res
etc
plot(gNew, layout = layout_as_tree(gNew))
with 1st param of lapply()
: c("FG2","FG3")
then gNew <- igraph::graph_from_data_frame(res
etc
df_gNew <- igraph::as_data_frame(gNew, what ='both')
edges <- df_gNew[['edges']]
nodes <- df_gNew[['vertices']]
nodes <- (nodes
%>% rename (id = name)
%>% mutate (label = id)
)
(visNetwork::visNetwork(
nodes,
edges,
heigh="1000px",
width = "1000px")
%>% visNetwork::visEdges(arrows = "to")
%>% visNetwork::visHierarchicalLayout(
direction = "UD",
sortMethod="directed",
shakeTowards ="leaves")
)
Upvotes: 1
Reputation: 6663
Instead of neigborhood()
we can use igraph::ego()
to get a vector of nodes that
are reachable by from the nodes of interest. Combined with igraph::induced_subgraph()
and igraph::distances()
we can get all the information you
are looking for. See below how to assemble it all.
purrr
has map_dfr()
which works like lapply()
but it also executes bind_rows()
on the resulting list
.
library(purrr)
#>
#> Attaching package: 'purrr'
#> The following objects are masked from 'package:igraph':
#>
#> compose, simplify
We now create a vector of all the nodes we want to describe the neigborhood of.
FGs <- c("FG1", "FG2")
We feed that vector into map_dfr()
that executes the function defined in ~{...}
on each value in FGs
.
res <- map_dfr(FGs, ~{
# Inside the function we first extract the subgraph that is reachable by
# outgoing edges from our node of interest.
sub_g <- induced_subgraph(net,
ego(net,
order = diameter(net),
nodes=.x,
mode=c("out"))[[1]])
# We then calculate the distances from our node of interest to
# all other nodes, transform the distances to a data.frame/tibble and
# join it with the edgelist of the subgraph.
distances(sub_g, .x) %>%
t() %>%
as_tibble(rownames = "Comp") %>%
inner_join(as_data_frame(sub_g), by = c("Comp" = "to")) %>% # Join with edgelist
mutate(FG = .x) %>%
dplyr::select(FG, level = 2, material = from, Comp)
}) %>%
arrange(FG, level)
Result:
res
#> # A tibble: 15 x 4
#> FG level material Comp
#> <chr> <dbl> <chr> <chr>
#> 1 FG1 1 FG1 SA1
#> 2 FG1 1 FG1 SA2
#> 3 FG1 2 SA1 SA5
#> 4 FG1 2 SA1 SA3
#> 5 FG1 2 SA1 SA4
#> 6 FG1 3 SA5 SA6
#> 7 FG2 1 FG2 SA1
#> 8 FG2 1 FG2 SA8
#> 9 FG2 2 SA1 SA5
#> 10 FG2 2 SA8 SA9
#> 11 FG2 2 SA1 SA3
#> 12 FG2 2 SA1 SA4
#> 13 FG2 3 SA5 SA6
#> 14 FG2 3 SA9 SA10
#> 15 FG2 3 SA9 SA11
Upvotes: 1
Reputation: 102439
Here is an igraph
option
lst <- lapply(
names(V(net))[degree(net, mode = "in") == 0],
function(x) {
d <- Filter(
is.finite,
setNames(
c(distances(net, x, mode = "out") + 1),
names(V(net))
)
)
cbind(
FG = x,
merge(
setNames(get.data.frame(
induced_subgraph(
net,
names(d)
)
), c("matnr", "comp")),
setNames(
rev(stack(d)),
c("matnr", "lvl")
)
)
)
}
)
res <- `row.names<-`(
subset(
do.call(rbind, lst),
ave(seq_along(matnr), matnr, comp, lvl, FUN = seq_along) == 1
), NULL
)
which gives
> res
FG matnr comp lvl
1 FG1 FG1 SA1 1
2 FG1 FG1 SA2 1
3 FG1 SA1 SA3 2
4 FG1 SA1 SA4 2
5 FG1 SA1 SA5 2
6 FG1 SA5 SA6 3
7 FG2 FG2 SA1 1
8 FG2 FG2 SA8 1
9 FG2 SA8 SA9 2
10 FG2 SA9 SA10 3
11 FG2 SA9 SA11 3
Upvotes: 2
Reputation: 124
I use tidyverse
, igraph
and tidygraph
to solve this question:
net
so that it can be manipulated by the TidyGraph packagegr <- as_tbl_graph(net)
name_vector <- gr %>%
activate(nodes) %>%
as_tibble() %>%
as_vector()
start_node = 1 # The first node is FG1
temp <- gr %>%
activate(nodes) %>%
mutate(
# Get the nodes from which each node is visited in a breath first search
material = bfs_parent(root = start_node),
# Get the succession in which the nodes are visited in a depth first search
level = bfs_dist(root = start_node)) %>%
as_tibble() %>%
drop_na() %>%
rename(Comp = name)
temp <- temp %>%
mutate(FG = name_vector[start_node],
material = name_vector[material])
And that's the result:
> temp %>% arrange(level)
# A tibble: 6 x 4
Comp material level FG
<chr> <chr> <int> <chr>
1 SA1 FG1 1 FG1
2 SA2 FG1 1 FG1
3 SA5 SA1 2 FG1
4 SA3 SA1 2 FG1
5 SA4 SA1 2 FG1
6 SA6 SA5 3 FG1
Based on the code above, We found all the cases where start_node = 1
.
You can use loops to redefine the start_node
and combine these results together.
Upvotes: 1