如何在地图上绘制网络的重叠度最低

本文介绍了如何在地图上绘制网络的重叠度最低的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 我有一些作者与他们的城市或国家的从属关系。我想知道是否有可能在地图上绘制合作者网络（图1），并将这些网络与国家的坐标进行比较。请考虑来自同一个国家的多位作者。 。这是为数十位作者设计的。缩放选项是可取的。赏金承诺+50为未来工作的答案。 库（RefManageR）库（网络）库（ggnet） library（ggplot2） library（sna） refs5< - read.table（text = row bibtype year volume number pages title journal作者 Bennett_1995文章1995 76 113--176被子植物\植物学年鉴\Bennett Md，Leitch Ij \ Bennett_1997文章1997 80 2 169- -196估计。\植物学年鉴\Bennett MD，Leitch IJ \ Bennett_1998 1998年文章82 SUPPL.A 121--134杂草。\植物学年鉴 \\Bennett MD，Leitch IJ，Hanson L \ Bennett_2000第2000条82 SUPPL.A 121--134杂草。\植物学年鉴\Bennett MD，某人IJ \ Leitch_2001文章2001 83 SUPPL.A 121--134杂草。 \\植物学年鉴\Leitch IJ，某人IJ \ New_2002文章2002 84 SUPPL.A 121--134杂草。 \植物学年鉴\New IJ，Else IJ \，header = TRUE，stringsAsFactors = FALSE） rownames（refs5）< - refs5 [，1] refs5 citations< - as.BibEntry（refs5） authors< - lapply（citations，function（x）as。 character（toupper（x $ author））） unique.authors< -unique（unlist（authors）） coauth.table< - matrix（nrow = length（unique.authors），$ b $ （b）ncol = length（unique.authors）， dimnames = list（unique.authors，unique.authors），0） for（i in 1：length（citations））{ paper .auth< - unlist（authors [[i]]） coauth.table [paper.auth，paper.auth]< - coauth.table [paper.auth，paper.auth] + 1 } coauth.table< - coauth.table [rowSums（coauth.table）> 0，colSums（coauth.table）> 0] diag（coauth.table）< - 0 coauthors< -coauth.table bip = network（coauthors， matrix.type =adjacency， ignore.eval = FALSE， names.eval =权重） authorcountry< - read.table（text = author国家 1 \LEITCH IJ \阿根廷 2 \HANSON L \美国 3 \BENNETT MD \巴西 4 \某人IJ\巴西 5 \ NEW IJ \巴西 6 \ELSE IJ \巴西，header = TRUE，fill = TRUE，stringsAsFactors = FALSE） 匹配 bip％v％Country=匹配 colorsmanual< -c（red，darkgray， （匹配） gdata< - ggnet2（bip，color =Country，palette = colorsmanual，legend.position =right ，label = TRUE， alpha = 0.9，label.size = 3，edge.size =权重， size =degree，size.legend =Degree Centrality）+ theme .box =horizo​​ntal） gdata 换句话说，将作者，行和气泡的名称添加到地图中。请注意，有些作者可能来自同一个城市或国家，不应该重叠。 图2答案相关 下面是我的方法，我从网络对象中提取图形属性，并使用 ggplot2 和 map 包。 首先我重新创建示例数据 图书馆（tidyverse）图书馆（sna）图书馆（地图）库（ggrepel） set.seed（1） coauthors< - 矩阵（c（0,3,1,1,3,0,1,0， 1,1,0,0,1,0,0,0）， nrow = 4，ncol = 4， dimnames = list（c（'BENNETT MD'，'LEITCH IJ'，' HANSON L'，'SOMEONE ELSE'），c（'BENNETT MD'，'LEITCH IJ'，'HANSON L'，'其他人'））） coords< - data_frame （ country = c（'Argentina'，'Brazil'，'USA'）， coord_lon = c（-63.61667，-51.92528，-95.71289）， coord_lat = c（-38.41610 ，-14.23500,37.09024）） authorcountry author = c（'LEITCH IJ'，'HANSON L'，'BENNETT MD ，'有人'）， country = c（'Argentina'，'USA'，'Brazil'，'Brazil'）） 现在我使用 snp 函数 network ＃生成网络 bip matrix.type =adjacency， ignore.eval = FALSE， names.eval =权重） ＃带有ggnet2中心性的图形 gdata alpha = 0.9，label.size = 3，edge.size =权重， size =degree，size.legend =Degree Centrality）+ theme（legend.box =horizo​​ntal） 从网络对象我们可以提取每条边的值，并从ggnet2对象中获得节点的中心度，如下所示： ＃合并数据作者< - ＃获取aut hor数字 data_frame（ id = seq（1，nrow（coauthors））， author = sapply（bip $ val，function（x）x $ vertex.names））％> ％ left_join（ authorcountry，y ='author'）％>％ left_join（ coords， by ='country'）％ >％＃避免两个作者之间重叠的抖动点 mutate（ coord_lon = jitter（coord_lon，factor = 1）， coord_lat = jitter（coord_lat，factor = 1 ）） ＃从网络获取边 networkdata< - sapply（bip $ mel，function（x）c（'id_inl'= x $ inl，'id_outl'= x $ outl，'weight'= x $ atl $ weights））％>％t％>％as_data_frame dt< - networkdata％>％ left_join （author，by = c（'id_inl'='id'））％>％ left_join（authors，by = c（'id_outl'='id'），suffix = c（'。from'， '.to'））％>％ left_join（gdata $ data％>％select（label，size），by = c（'author.from'='label'））％>％ mutate（edge_id = seq（1，nrow（。））， from_author = author.from， from_coord_lon = coord_lon.from， from_coord_lat = coord_lat.from， from_country = country.from， from_size = size， to_author = author.to， to_coord_lon = coord_lon.to， to_coord_lat = coord_lat.to， to_country = country。 to）％>％ select（edge_id，starts_with（'from'），starts_with（'to'），weight） 现在看起来应该是这样： dt ＃A tibble：8× 11 edge_id from_author from_coord_lon from_coord_lat from_country from_size to_author to_coord_lon < int> < CHR> < DBL> < DBL> < CHR> < DBL> < CHR> < DBL> 1 1 BENNETT MD -51.12756 -16.992729巴西6 LEITCH IJ -65.02949 2 2 BENNETT MD -51.12756 -16.992729巴西6 HANSON L -96.37907 3 3 BENNETT MD -51.12756 -16.992729巴西6 SOMEONE ELSE -52.54160 4 4 LEITCH IJ -65.02949 -35.214117阿根廷4 BENNETT MD -51.12756 5 5 LEITCH IJ -65.02949 -35.214117阿根廷4 HANSON L -96.37907 6 6 HANSON L -96.37907 36.252312 USA 4 BENNETT MD -51.12756 7 7 HANSON L -96.37907 36.252312美国4 LEITCH IJ -65.02949 8 8其他人-52.54160 -9.551913巴西2 BENNETT MD -51.12756 ＃...还有3个变量：to_coord_lat< dbl>，to_country< chr>，weight< dbl> 现在开始在地图上绘制这些数据： world_map< - map_data（'world'） myMap< - ggplot（）+ ＃绘图map geom_map（data = world_map，map = world_map，aes（map_id = region）， color ='gray85'， fill ='gray93'）+ xlim（c（-120，-20）） + ylim（c（-50,50））+ ＃绘制边缘 geom_segment（data = dt， alpha = 0.5， color =dodgerblue1， aes（x = from_coord_lon，y = from_coord_lat， xend = to_coord_lon，yend = to_coord_lat， size = weight））+ scale_size（range = c（1,3））+ ＃绘图节点 geom_point（data = dt， aes（x = from_coord_lon，y = from_coord_lat， size = from_size， color = from_country）） + ＃绘制名称 geom_text_repel（data = dt ％>％ select（from_author， from_coord_lon， from_coord_lat）％>％ unique， color ='dodgerblue1'， aes（ x = from_coord_lon，y = from_coord_lat，label = from_author））+ coord_equal（）+ theme_bw（） 显然，您可以通过 ggplot2 语法以常规方式更改颜色和设计。请注意，您还可以使用 geom_curve 和箭头唯美性以获得与超级链接中相似的情节在上面的评论中。 I have some authors with their city or country of affiliation. I would like to know if it is possible to plot the coauthors' networks (figure 1), on the map, having the coordinates of the countries. Please consider multiple authors from the same country. [EDIT: Several networks could be generated as in the example and should not show avoidable overlaps]. This is intended for dozens of authors. A zooming option is desirable. Bounty promise +50 for working future answer.library(RefManageR)library(network)library(ggnet)library(ggplot2)library(sna)refs5 <- read.table(text=" row bibtype year volume number pages title journal author Bennett_1995 article 1995 76 <NA> 113--176 angiosperms. \"Annals of Botany\" \"Bennett Md, Leitch Ij\" Bennett_1997 article 1997 80 2 169--196 estimates. \"Annals of Botany\" \"Bennett MD, Leitch IJ\" Bennett_1998 article 1998 82 SUPPL.A 121--134 weeds. \"Annals of Botany\" \"Bennett MD, Leitch IJ, Hanson L\" Bennett_2000 article 2000 82 SUPPL.A 121--134 weeds. \"Annals of Botany\" \"Bennett MD, Someone IJ\" Leitch_2001 article 2001 83 SUPPL.A 121--134 weeds. \"Annals of Botany\" \"Leitch IJ, Someone IJ\" New_2002 article 2002 84 SUPPL.A 121--134 weeds. \"Annals of Botany\" \"New IJ, Else IJ\"" , header=TRUE,stringsAsFactors=FALSE)rownames(refs5) <- refs5[,1]refs5<-refs5[,2:9]citations <- as.BibEntry(refs5)authors <- lapply(citations, function(x) as.character(toupper(x$author)))unique.authors<-unique(unlist(authors))coauth.table <- matrix(nrow=length(unique.authors), ncol = length(unique.authors), dimnames = list(unique.authors, unique.authors), 0)for(i in 1:length(citations)){ paper.auth <- unlist(authors[[i]]) coauth.table[paper.auth,paper.auth] <- coauth.table[paper.auth,paper.auth] + 1}coauth.table <- coauth.table[rowSums(coauth.table)>0, colSums(coauth.table)>0]diag(coauth.table) <- 0coauthors<-coauth.tablebip = network(coauthors, matrix.type = "adjacency", ignore.eval = FALSE, names.eval = "weights")authorcountry <- read.table(text=" author country1 \"LEITCH IJ\" Argentina2 \"HANSON L\" USA3 \"BENNETT MD\" Brazil4 \"SOMEONE IJ\" Brazil5 \"NEW IJ\" Brazil6 \"ELSE IJ\" Brazil",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)matched<- authorcountry$country[match(unique.authors, authorcountry$author)]bip %v% "Country" = matchedcolorsmanual<-c("red","darkgray","gainsboro")names(colorsmanual) <- unique(matched)gdata<- ggnet2(bip, color = "Country", palette = colorsmanual, legend.position = "right",label = TRUE, alpha = 0.9, label.size = 3, edge.size="weights", size="degree", size.legend="Degree Centrality") + theme(legend.box = "horizontal")gdataIn other words, adding the names of authors, lines and bubbles to the map. Note, several authors maybe from the same city, or country and should not overlap.Figure 1 NetworkEDIT: The current answer overlaps two non-related networks. authors "ELSE" and "NEW" need to be apart from others as in figure 1.Figure 2 answer related 解决方案 Are you looking for a solution using exactly the packages you used, or would you be happy to use suite of other packages? Below is my approach, in which I extract the graph properties from the network object and plot them on a map using the ggplot2 and map package.First I recreate the example data you gave.library(tidyverse)library(sna)library(maps)library(ggrepel)set.seed(1)coauthors <- matrix( c(0,3,1,1,3,0,1,0,1,1,0,0,1,0,0,0), nrow = 4, ncol = 4, dimnames = list(c('BENNETT MD', 'LEITCH IJ', 'HANSON L', 'SOMEONE ELSE'), c('BENNETT MD', 'LEITCH IJ', 'HANSON L', 'SOMEONE ELSE')))coords <- data_frame( country = c('Argentina', 'Brazil', 'USA'), coord_lon = c(-63.61667, -51.92528, -95.71289), coord_lat = c(-38.41610, -14.23500, 37.09024))authorcountry <- data_frame( author = c('LEITCH IJ', 'HANSON L', 'BENNETT MD', 'SOMEONE ELSE'), country = c('Argentina', 'USA', 'Brazil', 'Brazil'))Now I generate the graph object using the snp function network# Generate networkbip <- network(coauthors, matrix.type = "adjacency", ignore.eval = FALSE, names.eval = "weights")# Graph with ggnet2 for centralitygdata <- ggnet2(bip, color = "Country", legend.position = "right",label = TRUE, alpha = 0.9, label.size = 3, edge.size="weights", size="degree", size.legend="Degree Centrality") + theme(legend.box = "horizontal")From the network object we can extract the values of each edge, and from the ggnet2 object we can get degree of centrality for nodes as below:# Combine dataauthors <- # Get author numbers data_frame( id = seq(1, nrow(coauthors)), author = sapply(bip$val, function(x) x$vertex.names)) %>% left_join( authorcountry, by = 'author') %>% left_join( coords, by = 'country') %>% # Jittering points to avoid overlap between two authors mutate( coord_lon = jitter(coord_lon, factor = 1), coord_lat = jitter(coord_lat, factor = 1))# Get edges from networknetworkdata <- sapply(bip$mel, function(x) c('id_inl' = x$inl, 'id_outl' = x$outl, 'weight' = x$atl$weights)) %>% t %>% as_data_framedt <- networkdata %>% left_join(authors, by = c('id_inl' = 'id')) %>% left_join(authors, by = c('id_outl' = 'id'), suffix = c('.from', '.to')) %>% left_join(gdata$data %>% select(label, size), by = c('author.from' = 'label')) %>% mutate(edge_id = seq(1, nrow(.)), from_author = author.from, from_coord_lon = coord_lon.from, from_coord_lat = coord_lat.from, from_country = country.from, from_size = size, to_author = author.to, to_coord_lon = coord_lon.to, to_coord_lat = coord_lat.to, to_country = country.to) %>% select(edge_id, starts_with('from'), starts_with('to'), weight)Should look like this now:dt# A tibble: 8 × 11 edge_id from_author from_coord_lon from_coord_lat from_country from_size to_author to_coord_lon <int> <chr> <dbl> <dbl> <chr> <dbl> <chr> <dbl>1 1 BENNETT MD -51.12756 -16.992729 Brazil 6 LEITCH IJ -65.029492 2 BENNETT MD -51.12756 -16.992729 Brazil 6 HANSON L -96.379073 3 BENNETT MD -51.12756 -16.992729 Brazil 6 SOMEONE ELSE -52.541604 4 LEITCH IJ -65.02949 -35.214117 Argentina 4 BENNETT MD -51.127565 5 LEITCH IJ -65.02949 -35.214117 Argentina 4 HANSON L -96.379076 6 HANSON L -96.37907 36.252312 USA 4 BENNETT MD -51.127567 7 HANSON L -96.37907 36.252312 USA 4 LEITCH IJ -65.029498 8 SOMEONE ELSE -52.54160 -9.551913 Brazil 2 BENNETT MD -51.12756# ... with 3 more variables: to_coord_lat <dbl>, to_country <chr>, weight <dbl>Now moving on to plotting this data on a map:world_map <- map_data('world') myMap <- ggplot() + # Plot map geom_map(data = world_map, map = world_map, aes(map_id = region), color = 'gray85', fill = 'gray93') + xlim(c(-120, -20)) + ylim(c(-50, 50)) + # Plot edges geom_segment(data = dt, alpha = 0.5, color = "dodgerblue1", aes(x = from_coord_lon, y = from_coord_lat, xend = to_coord_lon, yend = to_coord_lat, size = weight)) + scale_size(range = c(1,3)) + # Plot nodes geom_point(data = dt, aes(x = from_coord_lon, y = from_coord_lat, size = from_size, colour = from_country)) + # Plot names geom_text_repel(data = dt %>% select(from_author, from_coord_lon, from_coord_lat) %>% unique, colour = 'dodgerblue1', aes(x = from_coord_lon, y = from_coord_lat, label = from_author)) + coord_equal() + theme_bw()Obviously you can change the colour and design in the usual way with ggplot2 grammar. Notice that you could also use geom_curve and the arrow aesthetic to get a plot similar to the one in the uber post linked in the comments above. 这篇关于如何在地图上绘制网络的重叠度最低的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！