Μεταβάσεις σε περισσότερα βήματα

Ας επανέλθουμε στη μελέτη των μεταβάσεων από την κοινωνική τάξη του πατέρα στην κοινωνική τάξη του γιου που μελετήσαμε αλλού.

EA <- c(0.388, 0.107, 0.035, 0.021, 0.009, 0.000, 0.000)
MA <- c(0.146, 0.267, 0.101, 0.039, 0.024, 0.013, 0.008)
PA <- c(0.202, 0.227, 0.188, 0.112, 0.075, 0.041, 0.036)
PH <- c(0.062, 0.120, 0.191, 0.212, 0.123, 0.088, 0.083)
EH <- c(0.140, 0.206, 0.357, 0.430, 0.473, 0.391, 0.364)
IH <- c(0.047, 0.053, 0.067, 0.124, 0.171, 0.312, 0.235)
AH <- c(0.015, 0.020, 0.061, 0.062, 0.125, 0.155, 0.274)
pin_met <- data.frame(EA, MA, PA, PH, EH, IH, AH)
rownames(pin_met) <- colnames(pin_met)
pin_met

      EA    MA    PA    PH    EH    IH    AH
EA 0.388 0.146 0.202 0.062 0.140 0.047 0.015
MA 0.107 0.267 0.227 0.120 0.206 0.053 0.020
PA 0.035 0.101 0.188 0.191 0.357 0.067 0.061
PH 0.021 0.039 0.112 0.212 0.430 0.124 0.062
EH 0.009 0.024 0.075 0.123 0.473 0.171 0.125
IH 0.000 0.013 0.041 0.088 0.391 0.312 0.155
AH 0.000 0.008 0.036 0.083 0.364 0.235 0.274

Τι γίνεται αν μας ενδιαφέρει η πιθανότητα να είναι ο εγγονός μιας τάδε κοινωνικής τάξης, δεδομένου ότι ο παππούς του ήταν μιας δείνα κοινωνικής τάξης; Στο ερώτημα αυτό θα μας βοηθήσει η συνάρτηση pinakas_metabasisΒ() μέσα στην οποία θα εκχωρήσουμε τα δεδομένα μας, αλλά και το πλήθος των βημάτων. Έτσι, αν ενδιαφερόμαστε για την πιθανότητα ο παππούς να ήταν μάνατζερ ή ανώτερο στέλεχος (MA), αλλά ο εγγονός να προέκυψε ειδικευμένος χειρώνακτος ή απλός μη χειρώνακτας (EH), τότε θέλουμε να κάνουμε δύο βήματα: ένα από τον παππού στον πατέρα, κι ένα από τον πατέρα στον γιο.

Η συνάρτηση αυτή για να φτιαχτεί απαιτεί το πακέτο expm, πέραν του πακέτου corrplot, οπότε γράφουμε αρχικά:

if(!require(corrplot)){
    install.packages("corrplot")
    library(corrplot)
}
if(!require(expm)){
    install.packages("expm")
    library(expm)
}

Και ακολούθως ορίζουμε την pinakas_metabasisΒ():

pinakas_metabasisΒ <- function(dedomena, bima, arxi = NULL, telos = NULL) {
  dedomenaM <- as.matrix(dedomena)
  dedomenaM <- dedomenaM%^%bima
  eyros <- c(arxi, telos)
  corrplot(dedomenaM, is.corr = FALSE, method="color", col.lim = eyros, addCoef.col = 'black')
}

Οπότε γράφουμε:

pinakas_metabasisΒ(pin_met, 2)

Έτσι έχουμε τον πίνακα μετάβασης από τη γενιά του παππού στη γενιά του εγγονού.

Βλέπουμε πλέον ότι, αν ο παππούς ήταν μάνατζερ ή ανώτερο στέλεχος (MA), τότε ο εγγονός θα ήταν ειδικευμένος χειρώνακτας ή απλός μη χειρώνακτας (EH) με πιθανότητα 0.33. Αν συνέβαινε το ανάποδο, δηλαδή ο παππούς ήταν ειδικευμένος χειρώνακτας ή απλός μη χειρώνακτας (EH), τότε ο εγγονός θα μπορούσε να είναι μάνατζερ ή ανώτερο στέλεχος (MA) με πιθανότητα πολύ μικρότερη, δηλαδή 0.03.

Και πάλι τα χρωματικά όρια μπορούμε να τα προσδιορίσουμε βάσει της αρεσκείας μας. Εδώ θα τα βάλουμε πάλι μεταξύ του 0 και του 0.5, ώστε να μην είναι πλέον μεταξύ του 0.01 και του 0.42.

pinakas_metabasisΒ(pin_met, 2, 0, 0.5)

Συνολικά γράψαμε τον κώδικα:

EA <- c(0.388, 0.107, 0.035, 0.021, 0.009, 0.000, 0.000)
MA <- c(0.146, 0.267, 0.101, 0.039, 0.024, 0.013, 0.008)
PA <- c(0.202, 0.227, 0.188, 0.112, 0.075, 0.041, 0.036)
PH <- c(0.062, 0.120, 0.191, 0.212, 0.123, 0.088, 0.083)
EH <- c(0.140, 0.206, 0.357, 0.430, 0.473, 0.391, 0.364)
IH <- c(0.047, 0.053, 0.067, 0.124, 0.171, 0.312, 0.235)
AH <- c(0.015, 0.020, 0.061, 0.062, 0.125, 0.155, 0.274)
pin_met <- data.frame(EA, MA, PA, PH, EH, IH, AH)
rownames(pin_met) <- colnames(pin_met)
pin_met
if(!require(corrplot)){
    install.packages("corrplot")
    library(corrplot)
}
if(!require(expm)){
    install.packages("expm")
    library(expm)
}
pinakas_metabasisΒ <- function(dedomena, bima, arxi = NULL, telos = NULL) {
  dedomenaM <- as.matrix(dedomena)
  dedomenaM <- dedomenaM%^%bima
  eyros <- c(arxi, telos)
  corrplot(dedomenaM, is.corr = FALSE, method="color", col.lim = eyros, addCoef.col = 'black')
}
pinakas_metabasisΒ(pin_met, 2)
pinakas_metabasisΒ(pin_met, 2, 0, 0.5)