#elementy analizy korespondencji w R

dane = read.csv2("dane_13_1.csv")

attach(dane)

dane

(n = length(dane[,1]))

head(dane, 10)

# Powody:

# P1 częste promocje,

# P2- produkty dobrej jakosci

# P3-bliska lokalizacja

# P4-godziny otwarcia,

# P5 -niskie ceny

# P6- duzy wybor towarow

# P7- łatwy dojazd

levels(powod) = c("Promocje", "Jakosc", "Blisko", "Godziny",

"Ceny", "Wybor", "Dojazd")

levels(powod)

library(RColorBrewer)

kolory = rev(brewer.pal(20,"Spectral"))

heatmap(tabela,scale="none", Colv=NA, Rowv=NA, col=kolory)

#PROBLEM:

#Czy istnieje zależność między wybranym sklepem a

#powodem dla którego jest on wybierany?

#Tabela kontygencji

tab=xtabs(~sklep+powod,data=dane)

tab

#lub:

(tabela = table(sklep, powod))

#Mapa ciepła

heatmap(tabela)

heatmap(tabela, scale="col")

library(RColorBrewer)

kolory = rev(brewer.pal(20,"Spectral"))

heatmap(tabela,scale="col", Colv=NA, Rowv=NA, col=kolory)

heatmap(tabela,scale="none", Colv=NA, Rowv=NA, col=kolory)

#odpowiedź: np. test chi^2 (są też inne testy)

chisq.test(tabela)

#Skoro są zależne - to drugie naturalne pytanie

#które kombinacje poziomów występują częściej

#Odpowiedź - analiza korespondencji

#1 - macierz korespondencji (częstości)

(P = tabela/n)

(liczba_w = nrow(P))

(liczba_k = ncol(P))

#2 - Masy wierszy i kolumn

(masa_w = rowSums(P))

(masa_k = colSums(P))

#teoretyczne częstości (w teście chi^2)

teor = outer(masa_w, masa_k, "*")

teor

#3 - standaryzowane reszty Pearsonowskie

(E = (P-teor)/teor^(1/2))

heatmap(E,scale="col", Colv=NA, Rowv=NA, col=kolory)

heatmap(E,scale="none", Colv=NA, Rowv=NA, col=kolory)

heatmap(E)

#Teraz "Mała" dygresja

#Rozkład SVD

#dekompozycja SVD (wartości osobliwe)

A = matrix(c(1,2,3,3,2,0), 2, 3)

A

eigen(A%*%t(A))

eigen(t(A)%*%A)

(x = svd(A))

D = diag(x$d)

D

x$u %*% D %*% t(x$v)

t(x$u) %*% A %*% x$v

D

?svd

#4 - dekompozycja macierzy C

(S = svd(E))

qr(E)

#standaryzowane współrzędne wierszy i kolumn

#dzielimy kolumny u i v przez pierwiastki z mas

diag(1/sqrt(masa_w))

diag(1/sqrt(masa_k))

S$u

(X = diag(1/sqrt(masa_w)) %*% S$u)

(Y = diag(1/sqrt(masa_k)) %*% S$v)

X

rbind(X[,1:2])

#juz jest wykres (dwuwymiarowy), ale kolor bialy

plot(rbind(X[,1:2], Y[,1:2]), col = "white", xlab = "", ylab = "", main = "")

#tak wygladaja sklepy:

text(X[,1:2], levels(sklep), col = "blue")

#a tak powody ich wyboru:

text(Y[,1:2], levels(powod), col = "red")

?text

#cały ten wykres nosi nazwę mapy percepcji

#to teraz dobra wiadomość

#jest do tego wszystkiego funkcja (ca w pakiecie ca)

library(ca)

#bardziej elegancka mapa percepcji

?plot.ca

plot(ca(tabela))

#Masy wierszy [kolumn] mogą być reprezentowane są przez wielkość symboli

plot(ca(tabela), mass=T) #Symbole punktów z uwzględnieniem ich mas

#Relatywne [absolutne] udziały punktów w wymiarach

#mogą być reprezentowane przez intensywność kolorów

plot(ca(tabela), mass=T, contrib = c("absolute","absolute"))

plot(ca(tabela), mass=T, contrib = c("relative","relative"))

#inercja całkowita (im większa, tym większe rozproszenie)

chisq.test(tabela)$stat/n

sum(ca(tabela)$rowinertia)

ca(tabela)$rowinertia

-----------------------------------------

#Analiza korespondencji w pakiecie R

ca(tabela)

summary(ca(tabela))

-----------------------------------------

#można dodać kolejne wymiary

summary(ca(tabela, nd =3))

#i nawet wykres dla nich narysować (choć już trochę nieczytelny)

plot3d(ca(tabela, nd =3))

detach(dane)