Saltonov kosinus

5-6. januar 2022

Imejmo podatke o anketi zbrane v matriki (tabeli) A razsežnosti n × m

A[k,i] = odgovor anketiranca k na i-to vprašanje

Vprašanja so merjena v isti številski lestvici. Dopuščamo tudi vrednost NA (ni izmerjeno).

Običajni skalarni produkt vektorjev x in y je določen s predpisom x • y = ∑_i x_i . y_i . Velikost vektorja x je |x| = √ (x • x) .

Za dani vektor nenegativnih uteži w lahko vpeljemo uteženi skalarni produkt x ■ y = ∑_i w_i . x_i . y_i Velikost vektorja x je |x| = √ (x ■ x) .

Naj bo A matrika dvovrstnega omrežja in W = A • diag(√w) = [ √w_i . a_i,j ]. Potem velja A^T ■ A = W^T • W .

Saltonov indeks S(i,j) podobnosti vprašanj i in j je definiran kot kosinus med vektorjema/spremenljivkama A[.,i] in A[.,j] (Cosine similarity)

S(i,j) = cos(A[.,i], A[.,j]) = ∑(k ∈ 1:n : a[k,i] . a[k,j]) / √(∑(k ∈ 1:n : a[k,i]²) . ∑(k ∈ 1:n : a[k,j]²)) = x ■ y / (|x|.|y|)

Na splošno velja S(i,j) ∈ [-1,1] in S(i,i) = 1. S(x,a.x) = 1 za a > 0 .

Saltonov indeks lahko predelamo v različnost (za razvrščanje) na več načinov:

d(i,j) = (1 - S(i,j)) / 2

δ(i,j) = arccos(S(i,j)) / π

Iz matrike A izračunamo (projekcijo na vprašanja) kvadratno matriko ujemanja vprašanj (natančneje, odgovorov na vprašanja)

C = A^T • A

razsežnosti m × m. Njen člen

c[i,j] = ∑(k ∈ 1:n : a^T[i,k] • a[k,j]) = ∑(k ∈ 1:n : a[k,i] • a[k,j])

je enak skalarnemu produktu v števcu Saltonovega indeksa. Še več

c[i,i] = ∑(k ∈ 1:n : a[k,i] • a[k,i]) = ∑(k ∈ 1:n : a[k,i]²)

je enak izrazu, ki nastopa v imenovalcu. Torej lahko Saltonov indeks izrazimo s členi matrike ujemanja

S(i,j) = c[i,j] / √(c[i,i] • c[j,j])

Poglejmo si poseben primer, ko so možni le trije odgovori: Za, Proti in NA. Podatke takole prekodiramo: Za ↦ 1, Proti ↦ -1, NA ↦ 0. Naj A vsebuje prekodirane podatke. Tedaj iz obrazca za c[i,j] izhaja

c[i,j] = #(1,1|-1,-1) - #(1,-1|-1,1) = # skladnih odgovorov - # nasprotnih odgovorov

in

c[i,i] = # odgovorov na vprašanje i

Torej je S(i,j) enak skladnosti odgovorov deljeni (normalizirani) z geometrijsko sredino števil odgovorov na obe vprašanji.

Razmeroma enostavno lahko pokažemo, da velja

S(i,j) = 1 ⇔ a[.,i] = a[.,j]

S(i,j) = -1 ⇔ a[.,i] = -a[.,j]

https://github.com/bavla/NormNet/tree/main/data/natalija ; https://github.com/bavla/NormNet/tree/main/data/davis

> source("https://raw.githubusercontent.com/bavla/Rnet/master/R/Pajek.R")
> library(gplots)
> wdir <- "C:/Users/vlado/work2/koko"
> setwd(wdir)
> A <- read.csv("trust.csv",sep=",",header=TRUE)
> str(A)
> dim(A)
[1] 2052   44
> M <- as.matrix(A[,2:44])
> # nam <- paste("p",1:43,sep="")
> # --------------------------------------------------------------------
> # Names
> L <- read.csv("SIpol.nam",sep="",header=FALSE,skip=2,encoding="UTF-8")
> head(L)
> nam <- L$V2
> Encoding(nam) <- "UTF-8"
> colnames(M) <- nam
> # ----------------------------------------------------------------
> # positive coappearances
> P <- M
> P[is.na(P)] <- 0
> C <- crossprod(P)
> dim(C)
> matrix2net(C,Net="proj.net")
> disC <- as.dist(1/C,diag=FALSE,upper=FALSE)
> h <-hclust(disC,method="complete")
> plot(h,hang=-1,cex=1,main="Coappearance / Complete")
> heatmap.2(C,Rowv=as.dendrogram(h),Colv="Rowv",dendrogram="column",
+       scale="none",revC=TRUE,trace="none",density.info="none",
+       col=colorpanel(30,low="grey95",high="black"),na.color="yellow",      
+       main="Coappearance / Complete",cexRow=0.5,cexCol=0.5)
> D <- C
> diag(D) <- 0
> heatmap.2(D,Rowv=as.dendrogram(h),Colv="Rowv",dendrogram="column",
+       scale="none",revC=TRUE,trace="none",density.info="none",
+       col=colorpanel(30,low="grey95",high="black"),na.color="yellow",      
+       main="Coappearance / Complete, diag=0",cexRow=0.5,cexCol=0.5)
> # ----------------------------------------------------------------
> # Salton cosine of recoded data  (1 -> 1, NA -> 0, 0 -> -1) 
> R <- M
> R[R==0] <- -1
> R[is.na(R)] <- 0
> D <- crossprod(R)
> matrix2net(D,Net="recoded.net")
> d <- sqrt(diag(D))
> Cos <- diag(1/d) %*% D %*% diag(1/d)
> colnames(Cos) <- rownames(Cos) <- nam
> matrix2net(Cos,Net="cos.net")
> Dcos <- (1-Cos)/2
> diag(Dcos) <- 0
> disD <- as.dist(Dcos,diag=FALSE,upper=FALSE)
> t <-hclust(disD,method="complete")
> plot(t,hang=-1,cex=1,main="Salton / Complete")
> heatmap.2(Cos,Rowv=as.dendrogram(t),Colv="Rowv",dendrogram="column",
+       scale="none",revC=TRUE,col = bluered(100),na.color="yellow",
+       trace = "none", density.info = "none",
+       main="Salton / Complete",cexRow=0.5,cexCol=0.5)

Jaccardovo podobnost lahko posplošimo na lestvico (Za, Proti, NA) takole:

S prekodiranjem ustvarimo matriki Ap = A(Za ↦ 1, Proti ↦ 0, NA ↦ 0) in An = A(Za ↦ 0, Proti ↦ 1, NA ↦ 0) ter izračunamo matriko ujemanja

C = Ap^T • Ap + An^T • An

s členi

c[i,j] = #(1,1|-1,-1) = # skladnih odgovorov

in

c[i,i] = # odgovorov na vprašanje i

ter od tu Jaccardova podobnost

J(i,j) = c[i,j] / (c[i,i] + c[j,j] - c[i,j])

in Jaccardova različnost d_J(i,j) = 1 - J(i,j) (domnevam, da je razdalja).

Poskusil 6. januar 2022

> # --------------------------------------------------------------------
> # Jaccard
> # positive  (1 -> 1, NA -> 0, 0 -> 0) 
> Ap <- M
> Ap[is.na(Ap)] <- 0
> # negative  (1 -> 0, NA -> 0, 0 -> -1) 
> An <- M
> An[An==0] <- -1
> An[is.na(An)] <- 0
> An[An==1] <- 0
> U <- crossprod(Ap)+crossprod(An)
> sort(diag(U))
> m <- nrow(U)
> E <- matrix(1,nrow=m,ncol=m)
> J <- U / (diag(diag(U)) %*% E + E %*% diag(diag(U)) - U)
> matrix2net(J,Net="Jaccard.net")
> disJ <- as.dist(1-J,diag=FALSE,upper=FALSE)
> g <-hclust(disJ,method="complete")
> plot(g,hang=-1,cex=1,main="Jaccard / Complete")
> heatmap.2(J,Rowv=as.dendrogram(g),Colv="Rowv",dendrogram="column",
+       scale="none",revC=TRUE,trace="none",density.info="none",
+       col=colorpanel(30,low="grey95",high="black"),na.color="yellow",      
+       main="Jaccard / Complete",cexRow=0.5,cexCol=0.5)

Rezultati so podobni Saltonskim.

> A <- read.csv("trust_w_feb.csv",sep=",",header=TRUE)
> M <- as.matrix(A[,2:45])
> w <- as.vector(A[,46])
> L <- read.csv("SIpolFeb.nam",sep="",header=FALSE,skip=2,encoding="UTF-8")
> nam <- L$V2
> Encoding(nam) <- "UTF-8"
> colnames(M) <- nam
> P <- M
> P[M==0] <- -1
> P[M==2] <- 0
> W <- P*sqrt(w)
> D <- crossprod(W)
> matrix2net(D,Net="recoded.net")
> d <- sqrt(diag(D))
> Cos <- diag(1/d) %*% D %*% diag(1/d)
> colnames(Cos) <- rownames(Cos) <- nam
> matrix2net(Cos,Net="cos.net")
> Dcos <- (1-Cos)/2
> diag(Dcos) <- 0
> disD <- as.dist(Dcos,diag=FALSE,upper=FALSE)
> t <-hclust(disD,method="complete")
> plot(t,hang=-1,cex=1,main="Salton / weighted / Complete")
> heatmap.2(Cos,Rowv=as.dendrogram(t),Colv="Rowv",dendrogram="column",
+       scale="none",revC=TRUE,col = bluered(100),na.color="yellow",
+       trace = "none", density.info = "none",
+       main="Salton / Complete",cexRow=0.5,cexCol=0.5)
> s <-hclust(disD,method="ward")
> plot(s,hang=-1,cex=1,main="Salton / weighted / Ward")
> z <-hclust(disD,method="single")
> plot(z,hang=-1,cex=1,main="Salton / weighted / Single")

Variacije na Jaccarda

Zanimivo bi bilo poskusiti tudi deležni pristop pri katerem bi člene vsake vrstice matrike A delili s številom členov različnih od NA v njej. Za mero podobnosti vzamemo kar matriko ujemanj

C = A^T • A

kjer je A tako normalizirana matrika.

Vsak anketiranec ima vrednost 1, ki jo enakomerno porazdeli po svojih odgovorih.