====== Slovenija 2023 / drugi poskus ======
* [[..:ostro|Oštro]]; [[vlado:work:tra:ostro:slo1|Prvi poskus]]; [[vlado:work:tra:ostro:slo3|Tretji poskus]]; [[vlado:work:tra:ostro:slo4|Četrti poskus]]
Na januarskih (2024) podatkih sem uporabil dosedaj razvito rešitev z nekaj izpopolnitvami:
* v datoteki dogodkov sem dodal številko zapisa R v izvornih podatkih, kar sem uporabil pri razlagi (funkcija **''explain''**) podobnosti med izbranima osebama
===== Pomožne funkcije ''trajector2.R'' =====
Na datoteki ''trajector2.R'' sem zbral pomožne funkcije:
* funkcija **''datum''** predela datumski podatek v število dni od 1. januarja 1970
* funkcija **''raw2events''** predela izvorne podatke v dogodkovno tabelo na datoteki CSV
* funkcija **''traj2Pajek''** predela dogodkovno tabelo v Pajkovo omrežje
* funkcija **''explain''** 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 [[https://github.com/bavla/TQ/tree/master/trajectories|GitHub/Bavla]].
===== Priprava Pajkovega omrežja =====
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
>
===== Analiza omrežja s Pajkom =====
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]
[[https://raw.githubusercontent.com/bavla/TQ/master/trajectories/sosedi.svg|sosedi.svg]] ali na [[https://github.com/bavla/TQ/blob/master/trajectories/README.md#sosedi|GitHub/Bavla]].
Priprava [[vlado:work:tra:ostro:slo1#pajek_-_matrix_presentation|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 [[https://raw.githubusercontent.com/bavla/TQ/master/trajectories/izobrazba.svg?sanitize=true|omrežja relacije izobraževanje]] (uteži so korenjene).
===== Razlaga podobnosti med osebama =====
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 [[.:PG|stran]].
Tu so še izpisi za [[.:lev|levico]].
===== Podobnost oseb =====
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:
* vse povezave (ne glede na vrsto rel) med izbranima osebama nadomestimo z eno povezavo, ki ima za utež vsoto uteži združenih povezav.
* iz omrežja najprej izločimo povezave izbranih vrst in na preostanku opravimo prej opisano skrčitev.
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:
* na podobnost vpliva natančnost in podrobnost opisa dogodkov posamezne osebe; uravnoteženost opisov.
* razmisliti bi bilo potrebno ali je mogoče smiselno zmanjšati vpliv vzporednega "nabiranja" časa (deležni (fractional) pristop iz biblimetrije?).
*