Module 4:Gifi Mehtods of Scaling

library("MPsychoR")
data("ASTI")
st <- ASTI[ ,c(2,4,7,13,16,24,25)]
pg <- ASTI[ ,c(11,14,15,17,18,23)]
stpg <- data.frame(st = st, pg = pg)
pcafit <- prcomp(stpg, scale = TRUE)
library("Gifi")

package 㤼㸱Gifi㤼㸲 was built under R version 4.0.5

knotslin <- knotsGifi(stpg, type = "E")
prlin <- princals(stpg, knots = knotslin, degrees = 1)
prlin

Call:
princals(data = stpg, knots = knotslin, degrees = 1)

Loss value: 0.847 
Number of iterations: 25 

Eigenvalues: 2.608 1.371 

#Here it shows the loss value, the number of iterations the ALS algorithem needed to converge, and the two eigenvalues. It is important to note that using princals, it is the same as using a PCA, since it uses a linear method.

prord <- princals(stpg)
prord

Call:
princals(data = stpg)

Loss value: 0.841 
Number of iterations: 36 

Eigenvalues: 2.635 1.492 

#not much is gained, based on the loss value. It may be fine to treat using a metric scale level. It is fine to assume metric analysis.

plot(prord, plot.type = "transplot",
var.subset = c(1:2, 8:9), lwd = 2)

head(round(prord$objectscores, 3), 3)

      D1     D2
1 -0.954 -1.041
2 -0.574  0.524
3  0.814  1.044

head(stpg[,1:5])

head(round(prord$scoremat[,1:5], 3))

  st.ASTI2 st.ASTI4 st.ASTI7 st.ASTI13 st.ASTI16
1   -0.005   -0.027   -0.011    -0.006    -0.027
2   -0.005   -0.002   -0.011    -0.006    -0.006
3    0.015    0.014    0.028    -0.006     0.012
4   -0.005   -0.027   -0.011    -0.006    -0.027
5   -0.029   -0.027   -0.030    -0.006    -0.027
6    0.015   -0.027   -0.030     0.000    -0.006

#Here you can see that the orginal category scores have been replaced by new scores.

plot(prord, main = "ASTI Loadings Plot")

plot(prord, plot.type = "screeplot")

si <- rowSums(ASTI[ ,c(10, 19, 20, 21)])
pm <- rowSums(ASTI[ ,c(1, 5, 9, 22)])
na <- rowSums(ASTI[ ,c(3, 6, 8, 12)])
asti2 <- data.frame(stpg, si, pm, na)

knotsord <- knotsGifi(asti2[,1:13], type = "D")
knotslin <- knotsGifi(asti2[,14:16], type = "E")
knotslist <- c(knotsord, knotslin)

prordlin <- princals(asti2, knots = knotslist, degrees = 1,
ndim = 3)
colvec <- c(rep("gray", 13), rep("coral", 3))
plot(prordlin, col.loadings = colvec, plot.dim = c(1, 2))

#You can use Homals when you have a variables with MANY catergories (e.g. 10 or more). Here a monotone spline transformation may be appropriate.

library("MPsychoR")
library("Gifi")
data("WilPat")
WP6 <- WilPat[,c(32, 38, 41, 44, 45, 46, 47)]

homwp <- homals(WP6)
homwp

Call:
homals(data = WP6)

Loss value: 0.663 
Number of iterations: 22 

Eigenvalues: 2.901 1.818 

plot(homwp)

#Here you can see dimension 1 discriminates between 0 and 1, where 0 is disapproves and 1 approves. The counties are plotted in pink. India disapproves with most that USA approves. Hungary sits mostly in the “I don’t know” response, which is dimension 2.

WPmixed <- WilPat[,c(32, 38, 41, 44, 45, 46, 47:51)]
WPmixed$LibCons <- cut(WPmixed$LibCons, breaks = c(0,2,4,6,9), labels = 1:4)
WPmixed <- na.omit(WPmixed)
itknots <- knotsGifi(WPmixed[,1:6], "D") ## item knots (data)
cknots <- knotsGifi(WPmixed[,7], "D") ## country knots (data)
lcknots <- knotsGifi(WPmixed[,8], "D") ## lib-cons knots (data)
lrknots <- knotsGifi(WPmixed[,9], "Q", n = 2) ## left-right (terciles)
genknots <- knotsGifi(WPmixed[,10], "D") ## gender knots (data)
ageknots <- knotsGifi(WPmixed[,11], "E") ## age knots (empty)
knotlist <- c(itknots, cknots, lcknots, lrknots, genknots, ageknots)

#Fixed Homal Models, which are ordinal which are not? True/False, for degrees 1 = linear, 2 = quadratic, -1 is figure it out on its own

ordvec <- c(rep(FALSE, 6), FALSE, TRUE, TRUE, FALSE, TRUE)
degvec <- c(rep(-1, 7), 1, 2, -1, 1)

hommix <- homals(WPmixed, knots = knotlist, ordinal = ordvec,
degrees = degvec)
plot(hommix, "transplot", var.subset = 6:11)

#This shows the transformation plots. The black lines are transformations on the first dimension, the red are on the second.

prinwp1 <- princals(WP6, ordinal = FALSE)

#ploting the loadings

plot(x=prinwp1, main = "Nominal Princals Loadings")

#Relax the linear restriction using copies

prinwp2 <- princals(WP6, ordinal = FALSE, copies = 2)
prinwp2

Call:
princals(data = WP6, ordinal = FALSE, copies = 2)

Loss value: 0.663 
Number of iterations: 22 

Eigenvalues: 2.901 1.818 

#specifiying how many times to copy