Generating Random Graphs According to Some Conditions - r

Consider the following points : 1,2,3,4,5,6,7,8,9,10
I can make a directed random graph from these numbers :
library(igraph)
from = sample(1:10, 10, replace=FALSE)
to = sample(1:10, 10, replace=FALSE)
graph_data = data.frame(from,to)
graph_data$id = as.factor(1:10)
graph <- graph.data.frame(graph_data, directed=T)
graph = simplify(graph)
V(graph)$color <- ifelse(graph_data$id == 1, "red", "orange")
plot(graph, layout=layout.circle, edge.arrow.size = 0.2)
I would like to make changes (i.e. "conditions") to the above graph so that:
None of the "nodes" are isolated (e.g. node # 6 is "isolated")
Each node can only have "incoming edge" and an "outgoing edge" (i.e. if you are on some "node" in this graph, if you keep following the arrows in the forward direction, you will eventually visit every other "node" exactly once and finally come back to the "node" you started from)
The "last node" (i.e. the "node" in the "to" column of the last row) is always connected to the "first node" (i.e. the "node" in the "from" column of the first row)
In this case, this means that :
from to
1 9 4
2 8 2
3 2 1
4 3 7
5 6 6
6 1 5
7 10 3
8 5 9
9 4 8
10 7 10
An additional row would need to be added so that "node 10" has to be connected to "node 9".
I can do this manually (e.g. graph_data[nrow(graph_data) + 1,] = c("10","9", "11", "orange)) but can someone please show me how to automatically add all these conditions to the random graph being generated?
Thank you!

That should solve your problem
library(tidyverse)
library(igraph)
set.seed(123)
n=15
data = tibble(d = paste(1:n))
relations = tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
)
graph = graph_from_data_frame(relations, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == "1", "red", "orange")
plot(graph, layout=layout.circle, edge.arrow.size = 0.2)
Update 1
library(tidyverse)
library(igraph)
set.seed(123)
n=15
data = tibble(d = paste(1:n))
relations = tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
)
graph = graph_from_data_frame(relations, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
plot(graph, layout=layout.circle, edge.arrow.size = 0.2)
Here you are

I think the following meets your requirements. If you generate from and to like this:
from <- sample(1:10, 10, replace = FALSE)
to <- from[c(2:10, 1)]
Then repeat the rest of your code, you get:
This produces a cyclical graph where the node labels are random numbers between one and 10.

Related

How to plot data from two data frames together as a stacked bar chart in R?

I have two dataframes called dbDateSubMSortNacional and dbDateSubMSortNacional, which contain a series of dates and values of covid infections for males and females in a certain region for the corresponding dates. I have plotted them individually as
contagiosH=barplot(dbDateSubHSortNacional$total[1:5], names.arg = dbDateSubHSortNacional$fecha[1:5], cex.names=0.759, , cex.axis=1, main = "Masculino", xlab="Fechas yy-mm-dd" , ylab="Número de contagios", col = rainbow(5), border = "white", ylim=c(0, 5000))
text(contagiosH, dbDateSubHSortNacional$total[1:5], dbDateSubHSortNacional$total[1:5])
contagiosM=barplot(dbDateSubMSortNacional$total[1:5], names.arg = dbDateSubMSortNacional$fecha[1:5], cex.names=0.759, , cex.axis=1, main = "Femenino", xlab="Fechas yy-mm-dd" , ylab="Número de contagios", col = rainbow(5), border = "white", ylim=c(0, 5000))
text(contagiosM, dbDateSubMSortNacional$total[1:5], dbDateSubMSortNacional$total[1:5])
I was wondering if it were possible to plot them as the graph in the attached figure.
I have managed to do it independently for a single dataframe called datosas
barplot(datos, beside=F, col=rainbow(5), legend.text = row.names(datos),
args.legend=list(title ="RRSS preferidas", x="top", inset=c(0, -0.45)))
I have tried to merge both approaches as
barplot(dbDateSubMSortNacional$total[1:5], dbDateSubHSortNacional$total[1:5], names.arg = dbDateSubMSortNacional$fecha[1:5], cex.names=0.759, , cex.axis=1, col = rainbow(5), border = "white", ylim=c(0, 4000))
Unfortunately, I get a single graph. Can someone please tell me how to achieve my goal?
EDIT: To generate a reproducible output, use
fecha <- c("2022-01-01","2022-01-02","2022-01-03", "2022-01-04", "2022-01-05", "2022-01-06", "2022-01-07")
total <- c(1, 3, 5, 7, 9, 11, 13)
dbDateSubMSortNacional <- data.frame(fecha, total);
total <- c(2, 4, 6, 8, 10, 12, 14)
dbDateSubHSortNacional <- data.frame(fecha, total);
Problem with the suggested solution by #jdobres:
Returns the error Error in cbind(total.2022 - 1 - 10, total.2022 - 1 - 11, total.2022 - : object 'total.2022' not found in
barplot(cbind(total.2022-01-10, total.2022-01-11, total.2022-01-04, total.2022-01-05, total.2022-01-12) ~ set, data = combined_wide, col = rainbow(5))
A dplyr and ggplot solution, followed by a base R barplot option:
library(dplyr, warn = FALSE)
library(tidyr)
library(ggplot2)
df1 <- bind_rows(dbDateSubHSortNacional, dbDateSubMSortNacional)
ggplot(df1)+
geom_col(aes(x = set, y = total, fill = fecha))
#get data into wide format:
df2 <-
df1 |>
pivot_wider(names_from = fecha, values_from = total)
barplot(cbind(`2022-01-10`, `2022-01-11`, `2022-01-04`,`2022-01-05`, `2022-01-12`, `2022-01-17`, `2021-12-19`)~set,
data = df2 ,
xlim = c(0,1),
width = 0.30,
col = rainbow(7),
xlab = "Sex",
ylab = "Frequency",
legend.text = colnames(df2)[-1],
args.legend = list(x = "topright"))
Created on 2022-10-15 with reprex v2.0.2
data
fecha <- c("2022-01-10","2022-01-11","2022-01-04","2022-01-05", "2022-01-12","2022-01-17", "2021-12-19")
total <- c(1, 3, 5, 7, 9, 11, 13)
dbDateSubMSortNacional <- data.frame(fecha, total)
total <- c(2, 4, 6, 8, 10, 12, 14)
dbDateSubHSortNacional <- data.frame(fecha, total);
dbDateSubHSortNacional$set <- 'H'
dbDateSubMSortNacional$set <- 'M'
First you will need to combine your two data frames into one:
dbDateSubHSortNacional$set <- 'H'
dbDateSubMSortNacional$set <- 'M'
combined <- rbind(dbDateSubHSortNacional, dbDateSubMSortNacional)
fecha total set
1 Monday 2 H
2 Tuesday 4 H
3 Wendesday 6 H
4 Thuersday 8 H
5 Friday 10 H
6 Saturday 12 H
7 Sunday 14 H
8 Monday 1 M
9 Tuesday 3 M
10 Wendesday 5 M
11 Thuersday 7 M
12 Friday 9 M
13 Saturday 11 M
14 Sunday 13 M
If you want to plot this data with barplot, it would be easier to first reshape the data to "wide" format:
combined_wide <- reshape(combined, direction = 'wide', idvar = 'set', timevar = 'fecha')
set total.Monday total.Tuesday total.Wendesday total.Thuersday total.Friday total.Saturday total.Sunday
1 H 2 4 6 8 10 12 14
8 M 1 3 5 7 9 11 13
And then the barplot command becomes:
barplot(cbind(total.Monday, total.Tuesday, total.Wendesday, total.Thuersday, total.Friday) ~ set, data = combined_wide, col = rainbow(5))
You could also use ggplot2 to create a similar plot, without having to widen the data set:
library(ggplot2)
ggplot(data = subset(combined, !(fecha %in% c('Saturday', 'Sunday'))), aes(x = set, y = total, fill = fecha)) +
geom_col()

igraph use of %>% as continuation

I am using igraph with R
trying to create a graph with labeled vertices.
THe igraph docs for "paths" give the example code
g <- make_empty_graph(directed = FALSE, n = 10) %>%
set_vertex_attr("name", value = letters[1:10])
plot(g) # labels the vertices with letters a through j
However
g <- make_empty_graph(directed = FALSE, n = 10)
set_vertex_attr(g, "name", value = letters[1:10])
plot(g) # now labels the vertices as numbers 1:10
Why?
The igraph docs for "set_vertex_attributs" use
set_vertex_attr(g, "name", value = letters[1:10])
to set vertex attributes.

Is dplyr's left_join correct way to attach a data.frame to a SpatialPolygonDataFrame in R?

Merging extra data (frames) to spatial objects in R can be tricky (as explained here, or here)
Searching for a solution on how to correctly do the job I found this SO question listing several methods. dplyr's left_join was not listed there. I spotted it being used in Robin's tutorial.
My question is - is this a correc method to use? Are there any use cases (different number of rows? different rows names? sorting? etc.) that this solution would fail?
Here is some reproducible code illustarting the methods I found / came across:
# libraries
library("spdep"); library("sp"); library("dplyr")
# sopatial data
c <- readShapePoly(system.file("etc/shapes/columbus.shp", package="spdep")[1])
m <- c#data
c#data <- subset(c#data, select = c("POLYID", "INC"))
c#data$INC2 <- c#data$INC
c#data$INC <- NULL
ex <- subset(c, c$POLYID <= 2) # polygons with messed up data in merged df
c <- subset(c, c$POLYID < 49) # remove one polygon from shape so that df has one poly too many
# messing up merge data
m <- subset(m, POLYID != 1) # exclude polygon
m <- subset(m, select = c("POLYID", "INC")) # only two vars
rownames(m) <- m$POLYID - 2 # change rownames
m$POLYID[m$POLYID == 2] <- 0 # wrong ID
m <- m[order(m$INC),] # different sort
m$POLYID2 <- m$POLYID # duplicated to check dplyr
# left_join solution
s1 <- c
s1#data <- left_join(s1#data, m)
plot(c)
plot(s1, col = "red", density = 40, angle = 0, add = TRUE)
plot(ex, col= NA, border = "green", add = TRUE)
View(s1#data)
# match solution
s2 <- c
s2#data = data.frame(s2#data, m[match(s2#data[,"POLYID"], m[,"POLYID"]),])
plot(c)
plot(s2, col = "red", density = 40, angle = 0, add = TRUE)
plot(ex, col= NA, border = "green", add = TRUE)
View(s2#data)
# sp solution
s3 <- c
s3 <- sp::merge(s3, m, by="POLYID")
plot(c)
plot(s3, col = "red", density = 40, angle = 0, add = TRUE)
plot(ex, col= NA, border = "green", add = TRUE)
View(s3#data)
# inner join solution
s4 <- c
s4#data <- inner_join(s4#data, m)
plot(c)
plot(s4, col = "red", density = 40, angle = 0, add = TRUE)
plot(ex, col= NA, border = "green", add = TRUE)
View(s4#data)
# rebuild solution???
s5 <- c
s5.df <- as(s5, "data.frame")
s5.df1 <- merge(s5.df, m, sort=FALSE, by.x="POLYID", by.y="POLYID", all.x=TRUE, all.y=TRUE)
s51 <- SpatialPolygonsDataFrame(as(s5, "SpatialPolygons"), data=s5.df1)
plot(c)
plot(s51, col = "red", density = 40, angle = 0, add = TRUE)
plot(ex, col= NA, border = "green", add = TRUE)
Left join seems to do the job. Same as sp::merge and match ( I do hope there is no messing up the order so for instance plotted polygons are associated with different vales after the merge?). None of the solutions actually removes two polygons withmissing data, but I presume this is correct behaviour in R?

How to plot a bipartite graph in R

How do I plot a network of type bipartite in R? Similar to this:
I have similar data but with weights for both genes and diseases and SARS. This network is an example. I have different kind of attributes. I followed a link here. But due to my little knowledge in this topic, I could not get much out of it. Thanks in advance for any help.
From the ?bipartite_graph help:
Bipartite graphs have a type vertex attribute in igraph, this is boolean and FALSE for the vertices of the first kind and TRUE for vertices of the second kind.
So you could do something like this (igraph 1.0.1):
library(igraph)
set.seed(123)
# generate random bipartite graph.
g <- sample_bipartite(10, 5, p=.4)
# check the type attribute:
V(g)$type
# define color and shape mappings.
col <- c("steelblue", "orange")
shape <- c("circle", "square")
plot(g,
vertex.color = col[as.numeric(V(g)$type)+1],
vertex.shape = shape[as.numeric(V(g)$type)+1]
)
Check also ?bipartite.
Using the example provided by the OP in the comments. Since the graph is multipartite and given the provided data format, I would first create a bipartite graph, then add the additional edges. Note that although the resulting graph returns TRUE for is_bipartite() the type argument is specified as numeric instead of logical and may not work properly with other bipartite functions.
set.seed(123)
V1 <- sample(LETTERS[1:10], size = 10, replace = TRUE)
V2 <- sample(1:10, size = 10, replace = TRUE)
d <- data.frame(V1 = V1, V2 = V2, weights = runif(10))
d
> d
V1 V2 weights
1 C 10 0.8895393
2 H 5 0.6928034
3 E 7 0.6405068
4 I 6 0.9942698
5 J 2 0.6557058
6 A 9 0.7085305
7 F 3 0.5440660
8 I 1 0.5941420
9 F 4 0.2891597
10 E 10 0.1471136
g <- graph_from_data_frame(d, directed = FALSE)
V(g)$label <- V(g)$name # set labels.
# create a graph connecting central node FOO to each V2.
e <- expand.grid(V2 = unique(d$V2), V2 = "FOO")
> e
V2 V2
1 10 FOO
2 5 FOO
3 7 FOO
4 6 FOO
5 2 FOO
6 9 FOO
7 3 FOO
8 1 FOO
9 4 FOO
g2 <- graph.data.frame(e, directed = FALSE)
# join the two graphs.
g <- g + g2
# set type.
V(g)$type <- 1
V(g)[name %in% 1:10]$type <- 2
V(g)[name %in% "FOO"]$type <- 3
V(g)$type
> V(g)$type
[1] 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 3
col <- c("steelblue", "orange", "green")
shape <- c("circle", "square", "circle")
library(rTRM) # Bioconductor package containing layout.concentric()
# the fist element in the list for concentric is the central node.
l <- layout.concentric(g, concentric = list("FOO", 1:10, LETTERS[1:10]))
plot(g,
layout = l,
vertex.color = col[V(g)$type],
vertex.shape = shape[V(g)$type],
edge.width = E(g)$weights * 5 # optional, plot edges width proportional to weights.
)
The function layout.concentric() is in (my) package rTRM, available from Bioconductor. It is really a simple implementation I wrote to do exactly what you want. I am not completely sure whether the latest igraph version has the same functionality though (it may be).
For the example you provided, I would recommend using the x and y attributes for visualizing a bipartite graph. E.g.:
V(g)$x <- c(1, 1, 1, 2, 2, 2, 2)
V(g)$y <- c(3, 2, 1, 3.5, 2.5, 1.5, 0.5)
V(g)$shape <- shape[as.numeric(V(g)$type) + 1]
V(g)$color <- c('red', 'blue', 'green', 'steelblue', 'steelblue', 'steelblue', 'steelblue')
E(g)$color <- 'gray'
E(g)$color[E(g)['A' %--% V(g)]] <- 'red'
E(g)$color[E(g)['B' %--% V(g)]] <- 'blue'
E(g)$color[E(g)['C' %--% V(g)]] <- 'green'
plot(g)
EDIT: added code to give the vertices and edges different colors for clarity.
Or you can use the multigraph package.
swomen <- read.dl(file = "http://moreno.ss.uci.edu/davis.dat")
bmgraph(swomen, layout = "force", seed = 1, cex = 3, tcex = .8, pch = c(19, 15), lwd = 2,
+ vcol = 2:3, ecol = 8, rot = 65)
that can produce the binomial projection of the two-mode data set

How do I concatenate one word with all elements of a list in R barplot title?

This is the code I'm currently running:
n <- 7
N <- 52
r <- 13
reps <- 1000000
deck <- rep(c('h','d','c','s'), each = r)
diamonds <- rep(NA, length.out = reps)
pos <- sample(x = 1:52, size = 7, replace = FALSE)
for(i in 1:reps) {
hand <- sample(x = deck, replace = FALSE)[pos]
diamonds[i] <- sum(ifelse(hand == 'd', 1, 0))
}
barplot(table(diamonds), col = 'red', xlab = '# of diamonds',
ylab = paste('frequency out of',reps,'trials'),
main = paste('Positions:',pos[1],pos[2],pos[3],pos[4],
pos[5],pos[6],pos[7]))
What I'd really like is to be able to give a title to the barplot with something like the following
barplot(..., main = paste('Positions:',pos))
and have the title say "Positions: p1 p2 p3 p4 p5 p6 p7", where p1,p2,...,p7 are the elements of pos.
For anyone that's interested, this code randomly chooses 7 positions from 52 and then counts the number of diamonds ('d') within those 7 positions after each shuffle of the deck for 1000000 shuffles. Then the empirical distribution of the number of diamonds within those 7 cards is plotted.
Use collapse in paste to collapse the multiple elements in a vector containing the base test and pos,
paste(c('Positions:', pos), collapse=" ")
Otherwise, when you paste "Positions:" to pos you get the former recycled to the length of pos.

Resources