[GRASS-SVN] r74424 - grass-addons/grass7/raster/r.connectivity/r.connectivity.network

svn_grass at osgeo.org svn_grass at osgeo.org
Wed Apr 24 14:59:34 PDT 2019


Author: sbl
Date: 2019-04-24 14:59:34 -0700 (Wed, 24 Apr 2019)
New Revision: 74424

Modified:
   grass-addons/grass7/raster/r.connectivity/r.connectivity.network/r.connectivity.network.py
Log:
make community measures optional

Modified: grass-addons/grass7/raster/r.connectivity/r.connectivity.network/r.connectivity.network.py
===================================================================
--- grass-addons/grass7/raster/r.connectivity/r.connectivity.network/r.connectivity.network.py	2019-04-24 20:41:37 UTC (rev 74423)
+++ grass-addons/grass7/raster/r.connectivity/r.connectivity.network/r.connectivity.network.py	2019-04-24 21:59:34 UTC (rev 74424)
@@ -134,7 +134,7 @@
 #%end
 
 #%option
-#% key: cl_thres
+#% key: cl_thresh
 #% type: integer
 #% description: Number of community levels to be traced in edge betweenness community
 #% guisection: Settings
@@ -292,7 +292,7 @@
     else:
         grass.fatal('Option "connectivity_cutoff" is not given as a number.')
     lnbh_cutoff = options['lnbh_cutoff']
-    cl_thresh = options['cl_thres']
+    cl_thresh = options['cl_thresh']
 
     cd_cutoff = connectivity_cutoff
 
@@ -535,7 +535,7 @@
 cd_cutoff <- {cd_cutoff}
 connectivity_cutoff <- {connectivity_cutoff}
 lnbh_cutoff <- {lnbh_cutoff}
-cl_thres <- {cl_thresh}
+cl_thresh <- {cl_thresh}
 db <- "{database}"
 db_driver <- "{driver}"
 db_schema <- "{schema}"
@@ -965,6 +965,7 @@
 E(g_ud_d_cd)$cf_eb_udc <- edge.betweenness(g_ud_d_cd, e=E(g_ud_d_cd), directed=FALSE, weights=E(g_ud_d_cd)$cf_inv_u)
 E(g_ud_d_cd)$cf_leb_udc <- hist(unlist(mclapply(mc.cores={0}, 1:length(V(g_ud_d_cd)), function(x) get.shortest.paths(g_ud_d_cd, x,  V(g_ud_d_cd)[grep(TRUE, path_lengths_cd[x,]<(lnbh_cutoff*connectivity_cutoff))], weights=E(g_ud_d_cd)$cf_inv_u, output=c("epath"))$epath)), breaks=0:(length(E(g_ud_d_cd))), plot=FALSE)$counts/2
 
+if (cl_thresh > 0) {{
 #########################################################################
 #######Calculate edge betweenness community on the undirected graph
 ##weighted by competing potential flow
@@ -980,11 +981,11 @@
 V(g)$cf_iebc_me <- ebc$membership
 
 com_struct <- as.character(cutat(ebc, cl_no_d))
-for (i in (cl_no_d+1):(cl_no_d+cl_thres)) {{
+for (i in (cl_no_d+1):(cl_no_d+cl_thresh)) {{
 com_struct <- paste(com_struct, cutat(ebc, i), sep=';')
 }}
 V(g)$cf_iebc_cs <- as.character(com_struct)
-V(g)$cf_iebc_cl <- cutat(ebc, (cl_no_d+cl_thres))
+V(g)$cf_iebc_cl <- cutat(ebc, (cl_no_d+cl_thresh))
 
 cf_iebc_u_mod <- modularity(ebc)
 com_no_u <- length(ebc)
@@ -1012,7 +1013,7 @@
 ebc_con_id_u[n] <- E(del_eb_g)$con_id_u[idx]
 ebc_rank[n] <- n
 ebc_clust[n] <- clusters(del_eb_g)$no
-if((ebc_clust[n]-cl_no_d)<(cl_no_d+cl_thres)) {{if(n>1) {{if(ebc_clust[n]>ebc_clust[n-1]) V(g_ud)$cf_ebc_cs <- paste(V(g_ud)$cf_ebc_cs, clusters(del_eb_g)$membership, sep=";")}}}}
+if((ebc_clust[n]-cl_no_d)<(cl_no_d+cl_thresh)) {{if(n>1) {{if(ebc_clust[n]>ebc_clust[n-1]) V(g_ud)$cf_ebc_cs <- paste(V(g_ud)$cf_ebc_cs, clusters(del_eb_g)$membership, sep=";")}}}}
 ebc_value[n] <- E(del_eb_g)$cf_eb_ud[idx]
 ##Delete edge with highest edge betweenness value
 del_eb_g <- delete.edges(del_eb_g, E(del_eb_g)[idx])
@@ -1019,7 +1020,7 @@
 n <- n+1
 }}
 
-V(g_ud)$cf_ebc_cl <- unlist(mclapply(mc.cores={0}, 1:length(V(g_ud)), function(x) strsplit(V(g_ud)$cf_ebc_cs, ";")[[x]][(cl_no_d+cl_thres)]))
+V(g_ud)$cf_ebc_cl <- unlist(mclapply(mc.cores={0}, 1:length(V(g_ud)), function(x) strsplit(V(g_ud)$cf_ebc_cs, ";")[[x]][(cl_no_d+cl_thresh)]))
 
 #ebc_df <- merge(data.frame(con_id=E(g)$con_id, con_id_u=E(g)$con_id_u), data.frame(con_id_u=ebc_con_id_u, ebc_rank=ebc_rank, ebc_clust=ebc_clust, ebc_value=ebc_value), all.x=TRUE)
 idx <- sort.int(ebc_con_id_u, index.return=TRUE)$ix
@@ -1028,6 +1029,19 @@
 E(g_ud)$cf_ebc_c <- ebc_clust[idx]
 
 E(g_ud)$cf_ebc_vi <- strftime(Sys.time()+E(g_ud)$cf_ebc_r)
+
+#########################################################################
+###Calculate community connectors (based on community structure from ebc)
+com_membership <- data.frame(patch_id=V(g_ud_d_cd)$patch_id, com=V(g_ud)$cf_ebc_cl)
+com_pc_pre <- merge(merge(data.frame(id=1:length(E(g)), from_p=E(g)$from_p, to_p=E(g)$to_p), com_membership, by.x="from_p", by.y="patch_id"),  com_membership, by.x="to_p", by.y="patch_id")[order(merge(merge(data.frame(id=1:length(E(g)), from_p=E(g)$from_p, to_p=E(g)$to_p), com_membership, by.x="from_p", by.y="patch_id"),  com_membership, by.x="to_p", by.y="patch_id")$id) ,]
+E(g)$cf_ebc_cc <- ifelse(com_pc_pre$com.x==com_pc_pre$com.y,0,1)
+
+
+}} else {{
+if (verbose) {{
+cat("Skipping comunity algorithms...\n")
+}}
+}}
 ########################################################################
 ######Calculate cluster membership
 V(g_ud_d)$cl_ud <- clusters(g_ud_d)$membership
@@ -1039,12 +1053,6 @@
 cl_pc_pre <- merge(merge(data.frame(id=1:length(E(g)), from_p=E(g)$from_p, to_p=E(g)$to_p), cl_membership, by.x="from_p", by.y="patch_id"),  cl_membership, by.x="to_p", by.y="patch_id")[order(merge(merge(data.frame(id=1:length(E(g)), from_p=E(g)$from_p, to_p=E(g)$to_p), cl_membership, by.x="from_p", by.y="patch_id"),  cl_membership, by.x="to_p", by.y="patch_id")$id) ,]
 E(g)$cl_pc <- ifelse(cl_pc_pre$cl.x==cl_pc_pre$cl.y,0,1)
 
-#########################################################################
-###Calculate community connectors (based on community structure from ebc)
-com_membership <- data.frame(patch_id=V(g_ud_d_cd)$patch_id, com=V(g_ud)$cf_ebc_cl)
-com_pc_pre <- merge(merge(data.frame(id=1:length(E(g)), from_p=E(g)$from_p, to_p=E(g)$to_p), com_membership, by.x="from_p", by.y="patch_id"),  com_membership, by.x="to_p", by.y="patch_id")[order(merge(merge(data.frame(id=1:length(E(g)), from_p=E(g)$from_p, to_p=E(g)$to_p), com_membership, by.x="from_p", by.y="patch_id"),  com_membership, by.x="to_p", by.y="patch_id")$id) ,]
-E(g)$cf_ebc_cc <- ifelse(com_pc_pre$com.x==com_pc_pre$com.y,0,1)
-
 if (verbose) {{
 cat("Starting analysis on vertex level...\n")
 }}
@@ -1205,7 +1213,10 @@
 c("Diameter of the graph with only edges shorter cost distance threshold", diam_d_cd),
 c("Density of the entire graph (directed)", density),
 c("Density of the entire graph (undirected)", density_u),
-c("Density of the graph with only direct edges (undirected)", density_ud),
+c("Density of the graph with only direct edges (undirected)", density_ud))
+
+if (cl_thresh > 0) {{
+grml <- rbind(grml,
 c("Density of the graph with only edges shorter cost distance threshold",  density_udc),
 c("Modularity (from iebc) of the entire graph (undirected) weighted by cf", cf_iebc_u_mod),
 c("Number of communities (at maximum modularity score (from iebc)) of the entire (undirected) graph weighted by cf", com_no_u),
@@ -1212,6 +1223,7 @@
 c("com_sizes_u", toString(com_sizes_u, sep=',')),
 c("com_sizes_u_names", toString(com_sizes_u_names, sep=','))
 )
+}}
 
 network_overview_measures <- data.frame(
     measure=grml[,1],



More information about the grass-commit mailing list