Running Community detection and visualising Output in VisNetwork - r

I am trying to run betweeness and closeness centrality using VISNETWORK package in R.
The nodes are computed for the degree and visualized using below code. Does anyone has idea of how can I compute the other centrality measures and plot using the Visnetwork.
Attaching the code below to compute degree and sample dataset on which i am trying to compute other centrality measures.
graph <- graph.data.frame(retweeter_poster, directed=T) ##retweeter_poster who_retweet and who_post twitter network
graph <- simplify(graph)
V(graph)$indegree <- centr_degree(graph, mode = "in")$res
nodes <- get.data.frame(graph, what="vertices")
nodes <- data.frame(id = nodes$name, title = nodes$name, group = nodes$indegree, indegree = nodes$indegree)
setnames(nodes, "indegree", "in-degree centrality")
nodes <- nodes[order(nodes$id, decreasing = F),]
edges <- get.data.frame(graph, what="edges")[1:2]
visNetwork(nodes, edges, height = "500px", width = "100%") %>%
visOptions(selectedBy = "in-degree centrality", highlightNearest = TRUE, nodesIdSelection = TRUE)%>%
visPhysics(stabilization = FALSE)
Source Target
futatun2228 nanauehara0812
Weltregierung jounger
soccelovexxxxx evian_moe
berlinerzeitung 13susang75
ot113 evian_arswest
ot113 evian_arswest
berlinerzeitung Letnapark
ot113 evian_arswest
sternde xXNero03
mkdirecto Ms_Kowalsky
ot113 evian_arswest
p90tr2 evian_9
sternde MARKENCHECKS
ot113 evian_arswest
ot113 evian_arswest
shoko_ayu_1008 evian_arswest
meikelobo Andreas__Nagel
mkdirecto markiteando
mkdirecto nilsonliscano
FlippinAlbanian LChanio
sternde WWinfos
HIFIMANJAPAN evian
berlinerzeitung daniel_makuch
faznet JrgenNaeve
berlinerzeitung BerlinerNYC
suarezphoto cebenna
SPIEGELONLINE Pahn2304Norbert
SPIEGEL_Top Kawajoerg
Klaus_Mueller Rechtalltaglich
an_evian #an_evian Emiliya1207
MDRaktuell MARKANTdjPOOL
salzburg_com PeterHeinzl
faznet ingouschner
derStandardat Liese_Mueller
faznet RhydanR
Klaus_Mueller KolbaPeter
SPIEGELONLINE OneStepBayond
Klaus_Mueller VanessFred
SPIEGELONLINE frankschroedter
SPIEGELONLINE bolounitlne
faznet Rudini48
berlinerzeitung Marina_Ilona
jzaaaa80 evian_812
HasnainKazim OneStepBayond
SPIEGELONLINE OneStepBayond
faznet JcM_mr
SPIEGELONLINE HasnainKazim
makaronn1gou evian_arswest
SPIEGELONLINE askourgias
SPIEGELONLINE CausesPetitions
faznet Nur_mal_so1
faznet Ghostdogcs

Related

Generate random points on osmnx graph

I have created a road network graph using osmnx library. now I want to generate some random points on the network but I don't have any idea how to do it. need some help :(
here is my code:
import geopandas as gpd
import osmnx as ox
top= gpd.GeoDataFrame(columns = ['name', 'geometry'], crs = 4326, geometry = 'geometry')
top.at[0, 'geometry'] = Point(100.40823730180041,14.207021554191956)
top.at[0, 'name'] = 'tl'
top.at[1, 'geometry'] = Point(100.74774714891429, 14.196946042603166)
top.at[1, 'name'] = 'tr'
bottom= gpd.GeoDataFrame(columns = ['name', 'geometry'], crs = 4326, geometry = 'geometry')
bottom.at[0, 'geometry'] = Point(100.38860578002853,13.612931284522707)
bottom.at[0, 'name'] = 'bl'
bottom.at[1, 'geometry'] = Point(100.7131032869639, 13.581503263247015)
bottom.at[1, 'name'] = 'br'
combined = top.append(bottom)
convex = combined.unary_union.convex_hull
graph_extent = convex.buffer(0.02)
graph = ox.graph_from_polygon(graph_extent, network_type = "drive")
Following are the steps of what I did:
I created two geodataframes top and bottom top define the extent of my road network
Then I combined them and used ox.graph_from_polygon to create a road network.
My road network looks something like this
roadNetwork
Now I want to generate some random points that should be on the links/edges of the network created.
The sample_points function does exactly that. See the OSMnx usage examples and documentation for usage: https://osmnx.readthedocs.io/en/stable/osmnx.html#osmnx.utils_geo.sample_points

Add round feedback arrow to horizontal graph in Graphviz / DiagrammR

I like to add a feedback arrow to a Graphviz graph, where the ordinary "flow" remains horizontal, but the feedback should be round, like the manually added blue arrow below.
Here is what I tried so far. I use the DiagrammR package for the R language but a suggestion for plain or python Graphviz or would of course also be helpful.
library("DiagrammeR")
grViz("digraph feedback {
graph [rankdir = 'LR']
node [shape = box]
Population
node [shape = circle]
Source Sink
node [shape = none]
Source -> Growth -> Population -> Death -> Sink
Population -> Growth [constraint = false]
Death -> Population [constraint = false]
}")
You can try using the headport and tailport options and indicate "north" for both of these (for Population and Growth).
The headport is the cardinal direction for where the arrowhead meets the node.
The tailport is the cardinal direction for where the tail is emitted from the node.
library("DiagrammeR")
grViz("digraph feedback {
graph [rankdir = 'LR']
node [shape = box]
Population
node [shape = circle]
Source Sink
node [shape = none]
Source -> Growth -> Population -> Death -> Sink
Population -> Growth [tailport = 'n', headport = 'n', constraint = false]
}")
Output

R: Modifying Graphs

I posted a comment/reply to another stackoverflow post over here : R: Understanding Graph relating to graphs in R.
If you create some data corresponding to movies and actors (in which movies can not be connected to other movies directly, and actors can not be connected to other actors directly), you write some R code to check if your graph is bipartite:
library(igraph)
film_data <- data.frame(
"movie" = c("movie_1", "movie_1", "movie_1", "movie_2", "movie_2", "movie_2", "movie_3", "movie_3", "movie_3", "movie_4", "movie_4", "movie_4", "movie_4", "movie_5", "movie_5", "movie_5", "movie_6", "movie_6"),
"actor" = c("actor_1", "actor_2", "actor_3", "actor_2", "actor_3", "actor_4", "actor_1", "actor_5", "actor_6", "actor_2", "actor_7", "actor_1", "actor_8", "actor_5", "actor_9", "actor_3", "actor_2", "actor_8")
)
#create directed graph
graph <- graph.data.frame(film_data, directed=F)
graph <- simplify(graph)
plot(graph)
V(graph)$type <- V(graph)$name %in% film_data[,1]
is.bipartite(graph)
[1] TRUE
However, you can "purposefully sabotage" this graph by adding a link between two actors (actor_2 and actor_3) so that the graph is no longer bipartite:
film_data <- data.frame(
"movie" = c("movie_1", "movie_1", "movie_1", "movie_2", "movie_2", "movie_2", "movie_3", "movie_3", "movie_3", "movie_4", "movie_4", "movie_4", "movie_4", "movie_5", "movie_5", "movie_5", "movie_6", "movie_6", "actor_2"),
"actor" = c("actor_1", "actor_2", "actor_3", "actor_2", "actor_3", "actor_4", "actor_1", "actor_5", "actor_6", "actor_2", "actor_7", "actor_1", "actor_8", "actor_5", "actor_9", "actor_3", "actor_2", "actor_8", "actor_3")
)
#create directed graph
graph <- graph.data.frame(film_data, directed=F)
graph <- simplify(graph)
plot(graph)
But R will still say that this graph is bipartite:
V(graph)$type <- V(graph)$name %in% film_data[,1]
is.bipartite(graph)
[1] TRUE
You can further sabotage this graph by adding an extra link between two movies:
film_data <- data.frame(
"movie" = c("movie_1", "movie_1", "movie_1", "movie_2", "movie_2", "movie_2", "movie_3", "movie_3", "movie_3", "movie_4", "movie_4", "movie_4", "movie_4", "movie_5", "movie_5", "movie_5", "movie_6", "movie_6", "actor_2", "movie_1"),
"actor" = c("actor_1", "actor_2", "actor_3", "actor_2", "actor_3", "actor_4", "actor_1", "actor_5", "actor_6", "actor_2", "actor_7", "actor_1", "actor_8", "actor_5", "actor_9", "actor_3", "actor_2", "actor_8", "actor_3", "movie_2")
)
#create directed graph
graph <- graph.data.frame(film_data, directed=F)
graph <- simplify(graph)
plot(graph)
But R will still call it bipartite:
V(graph)$type <- V(graph)$name %in% film_data[,1]
is.bipartite(graph)
[1] TRUE
Does anyone know if I am doing something wrong? Are these last two graphs actually bipartite? Or am I applying the code incorrectly?
Just to clarify: Are all undirected graphs cyclic? If you have a undirected graph with just one type of node, it it necessarily bipartite?
Thanks
Indeed, the graph you created is not bipartite: the part 'actors' has adjacent vertices.
The function is.bipartite() (or its name) is highly misleading. It only tells you if the graph has the required vertex attribute called type. It doesn't check the other characteristics of what makes a graph bipartite. Source: ?is.bipartite

Do linked OpenMDAO phases in a trajectory need to have the same transcription?

I have two phases, one much shorter than the other, but it looks like I have to make the transcription the same for both- same number of nodes and polynomial order for each one, other wise I get a numpy mismatched array size / broadcasting error. Is there a way around this?
You do not need to have the same transcription for both.
Here is an example of setting up a very simple cannonball problem with two phases. The first phase is Radau, the second phase is GaussLabotto. Both use the same ODE, but different orders, numbers of segments, and compression setting.
import numpy as np
from scipy.interpolate import interp1d
import openmdao.api as om
from openmdao.components.interp_util.interp import InterpND
import dymos as dm
from dymos.models.atmosphere.atmos_1976 import USatm1976Data
# CREATE an atmosphere interpolant
english_to_metric_rho = om.unit_conversion('slug/ft**3', 'kg/m**3')[0]
english_to_metric_alt = om.unit_conversion('ft', 'm')[0]
rho_interp = interp1d(np.array(USatm1976Data.alt*english_to_metric_alt, dtype=complex),
np.array(USatm1976Data.rho*english_to_metric_rho, dtype=complex), kind='linear')
GRAVITY = 9.80665
class CannonballODE(om.ExplicitComponent):
def initialize(self):
self.options.declare('num_nodes', types=int)
def setup(self):
nn = self.options['num_nodes']
# static parameters
self.add_input('radius', units='m')
self.add_input('density', units='kg/m**3')
self.add_input('CD', units=None)
self.add_input('alt', units='m', shape=nn)
self.add_input('v', units='m/s', shape=nn)
self.add_input('gam', units='rad', shape=nn)
self.add_output('v_dot', shape=(nn,), units='m/s**2')
self.add_output('gam_dot', shape=(nn,), units='rad/s')
self.add_output('h_dot', shape=(nn,), units='m/s')
self.add_output('r_dot', shape=(nn,), units='m/s')
self.add_output('ke', shape=(nn,), units='J')
self.add_output('mass', shape=1, units='kg')
self.declare_partials('*', '*', method='cs')
def compute(self, inputs, outputs):
CD = inputs['CD']
gam = inputs['gam']
v = inputs['v']
alt = inputs['alt']
radius = inputs['radius']
dens = inputs['density']
m = (4/3.)*dens*np.pi*radius**3
S = np.pi*radius**2
if np.iscomplexobj(alt):
rho = rho_interp(inputs['alt'])
else:
rho = rho_interp(inputs['alt']).real
q = 0.5*rho*inputs['v']**2
qS = q * S
D = qS * CD
cgam = np.cos(gam)
sgam = np.sin(gam)
mv = m*v
outputs['v_dot'] = - D/m-GRAVITY*sgam
outputs['gam_dot'] = -(GRAVITY/v)*cgam
outputs['h_dot'] = v*sgam
outputs['r_dot'] = v*cgam
outputs['ke'] = 0.5*m*v**2
if __name__ == "__main__":
p = om.Problem()
p.driver = om.pyOptSparseDriver()
p.driver.options['optimizer'] = 'SLSQP'
p.driver.declare_coloring()
traj = p.model.add_subsystem('traj', dm.Trajectory())
# constants across the whole trajectory
traj.add_parameter('radius', units='m', val=0.01, dynamic=False)
traj.add_parameter('density', units='kg/m**3', dynamic=False)
p.model.add_design_var('traj.parameters:radius', lower=0.01, upper=0.10, ref0=0.01, ref=0.10)
transcription = dm.Radau(num_segments=5, order=3, compressed=True)
ascent = dm.Phase(transcription=transcription, ode_class=CannonballODE)
traj.add_phase('ascent', ascent)
ascent.add_state('r', units='m', rate_source='r_dot')
ascent.add_state('h', units='m', rate_source='h_dot')
ascent.add_state('gam', units='rad', rate_source='gam_dot')
ascent.add_state('v', units='m/s', rate_source='v_dot')
# All initial states except flight path angle are fixed
# Final flight path angle is fixed (we will set it to zero so that the phase ends at apogee)
ascent.set_time_options(fix_initial=True, duration_bounds=(1, 100), duration_ref=100, units='s')
ascent.set_state_options('r', fix_initial=True, fix_final=False)
ascent.set_state_options('h', fix_initial=True, fix_final=False)
ascent.set_state_options('gam', fix_initial=False, fix_final=True)
ascent.set_state_options('v', fix_initial=False, fix_final=False)
ascent.add_parameter('radius', units='m', dynamic=False)
ascent.add_parameter('density', units='kg/m**3', dynamic=False)
ascent.add_parameter('CD', val=0.5, dynamic=False)
# Limit the muzzle energy
ascent.add_boundary_constraint('ke', loc='initial', units='J',
upper=400000, lower=0, ref=100000)
# Second Phase (descent)
transcription = dm.GaussLobatto(num_segments=2, order=5, compressed=False)
descent = dm.Phase(transcription=transcription, ode_class=CannonballODE)
traj.add_phase('descent', descent )
# All initial states and time are free (they will be linked to the final states of ascent.
# Final altitude is fixed (we will set it to zero so that the phase ends at ground impact)
descent.set_time_options(initial_bounds=(.5, 100), duration_bounds=(.5, 100),
duration_ref=100, units='s')
descent.add_state('r', units='m', rate_source='r_dot')
descent.add_state('h', units='m', rate_source='h_dot')
descent.add_state('gam', units='rad', rate_source='gam_dot')
descent.add_state('v', units='m/s', rate_source='v_dot',)
descent.set_state_options('r', )
descent.set_state_options('h', fix_initial=False, fix_final=True)
descent.set_state_options('gam', fix_initial=False, fix_final=False)
descent.set_state_options('v', fix_initial=False, fix_final=False)
descent.add_parameter('radius', units='m', dynamic=False)
descent.add_parameter('density', units='kg/m**3', dynamic=False)
descent.add_parameter('CD', val=0.5, dynamic=False)
# Link Phases (link time and all state variables)
traj.link_phases(phases=['ascent', 'descent'], vars=['*'])
descent.add_objective('r', loc='final', scaler=-1.0)
# Finish Problem Setup
p.setup()
# Set Initial Guesses
p.set_val('traj.parameters:radius', 0.05, units='m')
p.set_val('traj.parameters:density', 7.87, units='g/cm**3')
# initial guesses
p.set_val('traj.ascent.t_initial', 0.0)
p.set_val('traj.ascent.t_duration', 10.0)
p.set_val('traj.ascent.states:r', ascent.interpolate(ys=[0, 100], nodes='state_input'))
p.set_val('traj.ascent.states:h', ascent.interpolate(ys=[0, 100], nodes='state_input'))
p.set_val('traj.ascent.states:v', ascent.interpolate(ys=[200, 150], nodes='state_input'))
p.set_val('traj.ascent.states:gam', ascent.interpolate(ys=[25, 0], nodes='state_input'),
units='deg')
# more intitial guesses
p.set_val('traj.descent.t_initial', 10.0)
p.set_val('traj.descent.t_duration', 10.0)
p.set_val('traj.descent.states:r', descent.interpolate(ys=[100, 200], nodes='state_input'))
p.set_val('traj.descent.states:h', descent.interpolate(ys=[100, 0], nodes='state_input'))
p.set_val('traj.descent.states:v', descent.interpolate(ys=[150, 200], nodes='state_input'))
p.set_val('traj.descent.states:gam', descent.interpolate(ys=[0, -45], nodes='state_input'),
units='deg')
dm.run_problem(p, simulate=True, make_plots=True)
# p.list_problem_vars(print_arrays=True)

Combine different grViz into a single plot

I would like to combine different DiagrammeR plots into a single figure. The plots are generated as the following example:
library(DiagrammeR)
pDia <- grViz("
digraph boxes_and_circles {
# a 'graph' statement
graph [overlap = true, fontsize = 10]
# several 'node' statements
node [shape = box,
fontname = Helvetica]
A; B; C; D; E; F
node [shape = circle,
fixedsize = true,
width = 0.9] // sets as circles
1; 2; 3; 4; 5; 6; 7; 8
# several 'edge' statements
A->1 B->2 B->3 B->4 C->A
1->D E->A 2->4 1->5 1->F
E->6 4->6 5->7 6->7 3->8
}
")
pDia
Therefore, I would like to combine plots like pDia, class "grViz" "htmlwidget", into a single image with labels such A, B and so on. I tried to export a svg file of the plot with the exportSVG function. Thus, would be possible to use the magick package to import and deal with different plots of such a class (i.e. "grViz" "htmlwidget"). However, this function is not available in the newer version of the DiagrammeR package. Any ideas to combine these plots in a figure that could be exported to a figure file such as pdf or tiff?
Perhaps one of the following approaches will suit your needs.
You can add additional/disconnected graphs by just adding them to the same digraph call. For example, we can add two other graphs (U -> V -> W and X -> Y -> Z) to the right of your graph by just adding the nodes & edges after the other graph; you just need to make sure the nodes are named differently from the nodes in the preceding graphs. This can however, lead to large complicated scripts and may not suit your workflow.
library(DiagrammeR)
pDia <- grViz("
digraph boxes_and_circles {
# your existing graph here
# 2nd graph
U -> V -> W;
# 3rd graph
X -> Y -> Z;
}")
Given that you are wanting a static output it is probably easier just to go straight to graphviz. One way to combine graphs is by adding them as images to existing nodes. For example, if you have two graphs saved as png (other formats):
cat(file="so-65040221.dot",
"
digraph boxes_and_circles {
graph [overlap = true, fontsize = 10]
node [shape = box, fontname = Helvetica]
A; B; C; D; E; F
node [shape = circle, fixedsize = true, width = 0.9]
1; 2; 3; 4; 5; 6; 7; 8
A->1 B->2 B->3 B->4 C->A
1->D E->A 2->4 1->5 1->F
E->6 4->6 5->7 6->7 3->8
}")
# This will write out two pngs. We will use these as examples for us to combine
system("dot -Tpng -Gdpi=300 so-65040221.dot -o so-65040221A.png -o so-65040221B.png")
Then create a new graph to read in the pngs and add them to the nodes
cat(file="so-65040221-combine.dot",
'graph {
node [shape=none]
a [label="", image="so-65040221A.png"];
b [label="", image="so-65040221B.png"];
}')
We execute this and output to pdf with
system("dot -Tpdf so-65040221-combine.dot > so-65040221-combine.pdf")
# or output tiff etc
# system("dot -Ttif so-65040221-combine.dot > so-65040221-combine.tiff")
You can then arrange multiple graphs by how you arrange the nodes in the combined script.

Resources