R цвет вершины играфа - PullRequest
Новая
       10

R цвет вершины играфа

0 голосов
/ 30 мая 2018

У меня есть база данных со всеми пользователями и их ролями, я создал таблицу, в которой есть usera, role, userb.я пытаюсь дать каждому пользователю цвет, основанный на их команде.

приведенный ниже код SQL можно использовать для создания аналогичного набора данных 

select concat('H',ABS(Checksum(NewID()) % 999999)) acentralacc, CONCAT('Role_',CHAR( FLOOR(65 + (RAND() * 25))))role,concat('H',ABS(Checksum(NewID()) % 999999))bcentralacc
select concat('H',ABS(Checksum(NewID()) % 999999)) centralaccountname, CONCAT('Team_',CHAR( FLOOR(65 + (RAND() * 25))))team

'

#get library's
install.packages("igraph")
library("igraph")

#edges (connection between users)
connStr <- "Driver={SQL Server};MyCon;Trusted_Connection=TRUE"
dsSqlServerData <- RxSqlServerData(sqlQuery = "SELECT top 100000 * FROM MyTable1", connectionString = connStr)
data <- rxDataStep(dsSqlServerData)
    head(data)
  acentralacc                   rol bcentralacc
1     H000062 ADDN_Basis_BBE_intern     H000079
2     H000062 ADDN_Basis_BBE_intern     H000082
3     H000062 ADDN_Basis_BBE_intern     H000092
4     H000062 ADDN_Basis_BBE_intern     H000170
5     H000062 ADDN_Basis_BBE_intern     H000197
6     H000062 ADDN_Basis_BBE_intern     H000233
data$rol <- 1
    head(data)
  acentralacc rol bcentralacc
1     H000062   1     H000079
2     H000062   1     H000082
3     H000062   1     H000092
4     H000062   1     H000170
5     H000062   1     H000197
6     H000062   1     H000233
data1 <- aggregate(data[,2],data[,-2],sum)
data1 <- data1[order(data1$acentralacc,data1$bcentralacc),]
    head(data1)
   acentralacc bcentralacc  x
1      H000062     H000062 58
9      H000062     H000067 15
17     H000062     H000071 17
25     H000062     H000073 13
33     H000062     H000077 11
41     H000062     H000079 13
#vertices (ID,node attributs)
connStr <- "Driver={SQL Server};MyCon;Trusted_Connection=TRUE"
dsSqlServerData <- RxSqlServerData(sqlQuery = "SELECT  distinct CentralAccount,isnull(Team,'No Team') Team FROM MyTable2", connectionString = connStr)
users <- rxDataStep(dsSqlServerData)
    head(users)
  CentralAccount                         Team
1        H000062        ICT Customer Services
2        H000067            Financieel Beheer
3        H000070       Acceptatie Team 2 Gent
4        H000071       Acceptatie Team 1 Gent
5        H000073 NL Ond UW & Risk Advice Auto
6        H000076                      Incasso
#parsing (converting) users team
users$Team <- iconv(users$Team, "ASCII", "UTF-8", sub="")
net <- graph_from_data_frame(d=data1, vertices=users, directed=T) 
#the following should be igraph
class(net) 
#removing graphical loops etc
net <- simplify(net, remove.multiple = F, remove.loops = T)
#creating color palet
pal2 <- rainbow(5, alpha=.5)
V(net)$color <- pal2[V(net)$Team]
plot(delete.vertices(simplify(net), degree(net)==0),vertex.size=5,vertex.label=NA,edge.arrow.size=.2)
legend("topleft", unique(c(V(net)$Team)), pch=21,col="#777777", pt.cex=2, cex=.8, bty="n", ncol=1)

В результате получается граф с белыми вершинами и легендой.

Я видел этот пост: Создание цветов на основе уникальных записей в другом списке в R

В результате следующий код 

colrs<- brewer.pal(length(unique(V(net)$Team)), "Accent")  
names(colrs) <- unique(V(net)$Team)
V(net)$color <- colrs[V(net)$Team]      
V(net)$color

и егогенерирует следующую ошибку

Предупреждающее сообщение: В brewer.pal (длина (уникальная (V (нетто) $ Team)), «Акцент»): n слишком большое, максимально допустимый для палитры Акцент равен 8Возвращая палитру, которую вы просили, с таким количеством цветов. Blockquote

Я нашел решение этой проблемы здесь;https://www.r -bloggers.com / как расширить цвет-палитра-с-ggplot-and-rcolorbrewer /

и это то, что я сделал 

install.packages("RColorBrewer")
library(RColorBrewer)

colourCount = length(unique(users$Team))
getPalette = colorRampPalette(brewer.pal(9, "Set1"))
colrs<- getPalette(colourCount)
names(colrs) <- unique(V(net)$Team)
V(net)$color <- colrs[V(net)$Team]  
V(net)$color

У меня есть цветной (но грязный) график, но моя легенда не изменила цвет, как мне это исправить.

Эта строка кода, добавленная в легенду, только окрашивает границу круга передэто и показывает странный цветной квадрат.fill=V(net)$color,col=V(net)$color

WeirdResult

ул (пользователи) 

'data.frame':   2481 obs. of  2 variables:
 $ CentralAccount: chr  "H000062" "H000067" "H000070" "H000071" ...
 $ Team          : chr  "ICT Customer Services" "Financieel Beheer" "Acceptatie Team 2 Gent" "Acceptatie Team 1 Gent" ...
...