Na januarskih (2024) podatkih sem uporabil dosedaj razvito rešitev z nekaj izpopolnitvami:
explain) podobnosti med izbranima osebama
Na datoteki trajector2.R sem zbral pomožne funkcije:
datum predela datumski podatek v število dni od 1. januarja 1970raw2events predela izvorne podatke v dogodkovno tabelo na datoteki CSVtraj2Pajek predela dogodkovno tabelo v Pajkovo omrežjeexplain pojasni podobnosti med izbranima osebama# trajectoR
# Vladimir Batagelj, December 2023 / January 2024
# Network of time interval intersections / equal part_of_cv and institution_si
datum <- function(d,m,y) {
dd <- ifelse(d!="",d,ifelse(is.na(m),paste("01/01/",y,sep=""),
paste("01/",m,"/",y,sep="")))
di <- as.integer(as.Date(dd,format="%d/%m/%Y",origin="1970-01-01"))
if(is.na(di)) {OK <<- FALSE
di <- as.integer(as.Date(dd,format="%m/%d/%Y",origin="1970-01-01"))}
return(di)
}
raw2events <- function(D,CSV="events.csv"){
csv <- file(CSV,"w",encoding="UTF-8")
cat("R ID s f S T\n",file=csv)
n <- nrow(D); OK <- TRUE
for(i in 1:n){
ID <- D$person_name[i]; rel <- tolower(D$part_of_cv[i])
test <- trimws(tolower(D$institution_si[i]))
ds <- D$start_day[i]; ms <- D$start_month[i]; ys <- D$start_year[i]
sd <- datum(ds,ms,ys)
if(!OK) {cat(i,":",ID,ds,ms,ys,rel,'*** wrong date\n')
flush.console(); OK <- TRUE}
de <- D$end_day[i]; me <- D$end_month[i]; ye <- D$end_year[i]
ed <- if(ye==2100) datum("01/01/2024",NA,2024) else datum(de,me,ye)
if(!OK) {cat(i,":",ID,de,me,ye,rel,'*** wrong date\n')
flush.console(); OK <- TRUE}
cat(i,' "',ID,'" ',sd,' ',ed,' "',rel,'" "',test,'"\n',sep='',file=csv)
}
close(csv)
}
traj2Pajek <- function(E,kMax,Net){
I <- order(E$s,E$f)
n <- length(I); k <- 0; r <- 0
cn <- rep(0,kMax); cs <- rep("",kMax)
N <- data.frame(u=cs,v=cs,s=cn,f=cn,rel=cs)
cat("% traj2Pajek",date(),"\nevents",n,"\n")
for(p in 1:(n-1)){i <- I[p]; tm <- E$f[i]
cat("."); if(p%%50==0) {cat(p,k,date(),"\n")}; flush.console()
for(q in (p+1):n){j <- I[q]; r <- r+1
if(E$s[j]>tm) break
if(E$S[i]==E$S[j]) if(E$T[i]==E$T[j]) {
fm <- min(E$f[i],E$f[j]); sM <- max(E$s[i],E$s[j]); T <- fm-sM
if(T>0){k <- k+1; if(k>kMax) stop("kMax too small")
N[k,] <- list(u=E$ID[i],v=E$ID[j],s=sM,f=fm,rel=E$S[i])}
}
}
}
cat("\n",date(),"\ndensity R =",2*r/n/(n-1)," tests =",r,
"\ndensity E =",2*k/n/(n-1)," edges =",k,"\n"); flush.console()
N <- N[1:k,]; sf <- as.matrix(N[,c("s","f")])
uvrwt2net(N$u,N$v,w=N$f-N$s,r=N$rel,t=sf,directed=FALSE,Net=Net)
cat("% finished",date(),"\n")
}
explain <- function(E,p1,p2,kMax=500){
i12 <- c(which(E$ID == p1),which(E$ID == p2))
C <- E[i12,]; n <- nrow(C); I <- order(C$s,C$f); k <- 0; r <- 0
cn <- rep(0,kMax); cs <- rep("",kMax)
N <- data.frame(u=cs,v=cs,s=cn,f=cn,rel=cs,d=cn,Ru=cs,Rv=cs)
for(p in 1:(n-1)){i <- I[p]; tm <- C$f[i]
# cat(p,k,date(),"\n"); flush.console()
for(q in (p+1):n){j <- I[q]; r <- r+1
if(C$s[j]>tm) break
# if(C$R[i]!=C$R[j])
if(C$S[i]==C$S[j]) if(C$T[i]==C$T[j]) {
fm <- min(C$f[i],C$f[j]); sM <- max(C$s[i],C$s[j]); T <- fm-sM
if(T>0){k <- k+1; if(k>kMax) stop("kMax too small")
N[k,] <- list(u=C$ID[i],v=C$ID[j],s=sM,f=fm,rel=C$S[i],d=T,
Ru=C$R[i],Rv=C$R[j])}
}
}
}
tA <- sum(N$d); tS <- sum(N[N$u!=N$v,"d"])
cat(p1,":",p2,"\n",date(),"\n density R =",2*r/n/(n-1),
" tests =",r,"\n density E =",2*k/n/(n-1)," edges =",k,
"\n time all =",tA," time strict =",tS,"\n")
return(N[1:k,])
}
Datoteka trajector2.R je dostopna na GitHub/Bavla.
Z uporabo teh funkcij je priprava Pajkovega omrežja razmeroma preprosta:
> wdir <- "C:/Users/vlado/docs/papers/2024/Trajectories/Ostro"
> setwd(wdir)
> source("https://raw.githubusercontent.com/bavla/TQ/master/trajectories/trajector2.R")
> source("https://raw.githubusercontent.com/bavla/Rnet/master/R/Pajek.R")
> P <- read.csv("./ostro_osebe.csv",sep=",",head=TRUE)
> head(P)
> D <- read.csv("./ostro_podatki.csv",sep=",",head=TRUE)
> head(D)
> inst <- factor(D$institution_si)
> Linst <- levels(inst)
> length(Linst)
[1] 1144
> raw2events(D,CSV="Slo.csv")
> E <- read.csv("Slo.csv",sep="")
> traj2Pajek(E,500000,"./Slo.net")
% traj2Pajek Fri Jan 12 05:03:41 2024
events 2645
..................................................50 8 Fri Jan 12 05:03:41 2024
..................................................100 22 Fri Jan 12 05:03:42 2024
..................................................150 66 Fri Jan 12 05:03:43 2024
...
..................................................2500 2416 Fri Jan 12 05:04:27 2024
..................................................2550 2429 Fri Jan 12 05:04:27 2024
..................................................2600 2451 Fri Jan 12 05:04:27 2024
............................................
Fri Jan 12 05:04:28 2024
density R = 0.2254995 tests = 788502
density E = 0.0007018066 edges = 2454
% finished Fri Jan 12 05:04:28 2024
>
Dobljeni omrežni datoteki NET v izbranem znakovnem urejevalniku (Textpad, EmEditor, …) dodamo na začetku datoteke UTF-8 BOM - tako Pajek pravilno prepozna naše črke ČŠŽ in tudi ostale znake v pisavi Unicode.
Network/Create new network/Transform/Remove/loops Network/Multiple .../Change ... [1-*,1,All][yes] network Info button Network/Create new network/Transform/Remove/Multiple lines/Sum values Network/Info/Line values Network/Create new network/Transform/Line values/Abs+sqrt File/Network/Change label [All] Network/Create new network/Transform/Edges -> arcs [yes] File/Network/Change label [All directed] Network/Create new network/Transform/Remove/all arcs ... except/k with highest ...[1] Network/Create partition/Components/Weak [1] Draw/Network+First partition Layout/Energy/Kamada-Kawai/Separate components manually improve the picture set Options and Export/Options Export/2D/SVG/General [sosedi.svg]
sosedi.svg ali na GitHub/Bavla.
Priprava matričnega prikaza v Pajku. Na datoteki slo2.nam so okrajšana imena oseb v kodi ASCII (brez ČŠŽĆčšžćüá) - izvoz prikaza drevesa razvrstitve in matričnega prikaza v EPS ne podpirata kode Unicode. Pri matriki je izpisanih le prvih 10 znakov imena.
Tu je še prikaz omrežja relacije izobraževanje (uteži so korenjene).
Ker so se mi pri analizi omrežja (zaradi napake - pozabil sem nadomestiti večkratne povezave z eno samo) pojavile “čudne” povezave, se je pokazala potreba po “razlagi” podobnosti med izbranima osebama. Ponuja jo funkcija explain.
Tu je razlaga podobnosti med Danijelom Krivcem in Natašo Sukič.
> p1 <- "Danijel Krivec"; p2 <- "Nataša Sukič"
> N <- explain(E,p1,p2)
Danijel Krivec : Nataša Sukič
Fri Jan 12 05:24:40 2024
density R = 0.3468468 tests = 231
density E = 0.01801802 edges = 12
time all = 31744 time strict = 3744
> N
u v s f rel d Ru Rv
1 Nataša Sukič Danijel Krivec 5752 9496 izobraževanje 3744 2340 1532
2 Nataša Sukič Nataša Sukič 6209 17532 delovne izkušnje 11323 2342 2341
3 Nataša Sukič Nataša Sukič 10227 11323 delovne izkušnje 1096 2342 2344
4 Nataša Sukič Nataša Sukič 12418 17532 delovne izkušnje 5114 2342 2348
5 Nataša Sukič Nataša Sukič 10227 11323 delovne izkušnje 1096 2341 2344
6 Nataša Sukič Nataša Sukič 12418 17532 delovne izkušnje 5114 2341 2348
7 Danijel Krivec Danijel Krivec 10592 12040 delovne izkušnje 1448 1536 1535
8 Danijel Krivec Danijel Krivec 12040 13483 delovne izkušnje 1443 1535 1538
9 Nataša Sukič Nataša Sukič 16318 16348 strankarska pozicija 30 2359 2351
10 Nataša Sukič Nataša Sukič 17823 17853 strankarska pozicija 30 2359 2357
11 Nataša Sukič Nataša Sukič 19285 19316 strankarska pozicija 31 2359 2358
12 Danijel Krivec Danijel Krivec 17353 18628 prostočasne aktivnosti 1275 1542 1543
> N[N$u != N$v,]
u v s f rel d Ru Rv
1 Nataša Sukič Danijel Krivec 5752 9496 izobraževanje 3744 2340 1532
Najbolj podobna sta si Igor Papič in Robert Golob. Razlaga njune podobnosti zahteva svojo stran.
Tu so še izpisi za levico.
Med osebama u in v obstaja povezava vrste rel=S, če obstajata dogodka Ru in Rv vrste rel taka, da imata njuni časovni obdobji neprazen presek in se ujemata v T. Dolžina tega preseka v dnevih je utež povezave. Med danima osebama se tako lahko ustvari več povezav - dobimo omrežje z vzporednimi povezavami, ki ga lahko na več načinov pretvorimo v enostavno uteženo omrežje:
Uteži v tako dobljenem enostavnem omrežju merijo podobnost med osebama: večje kot je skupno število dni soprisotnosti, bolj sta si osebi podobni.
Tako 4+4=8 dogodkov
R ID s f S T 1074 Robert Golob 2002-10-01 2007-08-31 delovne izkušnje ul fakulteta za elektrotehniko 1089 Robert Golob 2004-07-01 2007-06-30 delovne izkušnje ul fakulteta za elektrotehniko 1090 Robert Golob 2004-12-01 2007-11-30 delovne izkušnje ul fakulteta za elektrotehniko 1091 Robert Golob 2005-01-01 2007-12-31 delovne izkušnje ul fakulteta za elektrotehniko 98 Igor Papič 2005-09-01 2008-08-31 delovne izkušnje ul fakulteta za elektrotehniko 90 Igor Papič 2005-11-01 2008-10-31 delovne izkušnje ul fakulteta za elektrotehniko 97 Igor Papič 2006-06-01 2008-05-31 delovne izkušnje ul fakulteta za elektrotehniko 74 Igor Papič 2007-04-01 2022-05-30 delovne izkušnje ul fakulteta za elektrotehniko
ustvari 4*4=16 povezav
u v s f rel d Ru Rv 95 Robert Golob Igor Papič 2005-09-01 2007-08-31 delovne izkušnje 729 1074 98 96 Robert Golob Igor Papič 2005-11-01 2007-08-31 delovne izkušnje 668 1074 90 97 Robert Golob Igor Papič 2006-06-01 2007-08-31 delovne izkušnje 456 1074 97 98 Robert Golob Igor Papič 2007-04-01 2007-08-31 delovne izkušnje 152 1074 74 101 Robert Golob Igor Papič 2005-09-01 2007-06-30 delovne izkušnje 667 1089 98 102 Robert Golob Igor Papič 2005-11-01 2007-06-30 delovne izkušnje 606 1089 90 103 Robert Golob Igor Papič 2006-06-01 2007-06-30 delovne izkušnje 394 1089 97 104 Robert Golob Igor Papič 2007-04-01 2007-06-30 delovne izkušnje 90 1089 74 106 Robert Golob Igor Papič 2005-09-01 2007-11-30 delovne izkušnje 820 1090 98 107 Robert Golob Igor Papič 2005-11-01 2007-11-30 delovne izkušnje 759 1090 90 108 Robert Golob Igor Papič 2006-06-01 2007-11-30 delovne izkušnje 547 1090 97 109 Robert Golob Igor Papič 2007-04-01 2007-11-30 delovne izkušnje 243 1090 74 112 Robert Golob Igor Papič 2005-09-01 2007-12-31 delovne izkušnje 851 1091 98 113 Robert Golob Igor Papič 2005-11-01 2007-12-31 delovne izkušnje 790 1091 90 114 Robert Golob Igor Papič 2006-06-01 2007-12-31 delovne izkušnje 578 1091 97 115 Robert Golob Igor Papič 2007-04-01 2007-12-31 delovne izkušnje 274 1091 74
To privede do vzporednega “nabiranja” časa. Tako je skupni čas soprisotnosti za Papiča in Goloba 108236 dni = > 108236/365 = 296.537 let.
Vprašanja: