====== 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?). *