LESSON- CATEGORICAL ANALYSIS
KP
2025-01-15
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
##### Lesson CATEGORICAL ANALYSES #####
### Φόρτωμα αρχείου από ερωτηματολόγιο
setwd("G:/DATA/CATEGORICAL")
###### 1.2 εισαγωγή του αρχείου excel
# φορτωμα βιβλιοθήκης για διάβασμα αρχείου Excel
library(readxl)
## φόρτωση του αρχείου Excel
zante <- read_xlsx("ZANTE_ECOTOURISM.xlsx", col_names = TRUE)
##ονόματα πεδίων (επικεφαλίδες των στηλών)
labels (zante)## [[1]]
## [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12"
## [13] "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24"
## [25] "25" "26" "27" "28" "29" "30" "31" "32" "33" "34" "35" "36"
## [37] "37" "38" "39" "40" "41" "42" "43" "44" "45" "46" "47" "48"
## [49] "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60"
## [61] "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72"
## [73] "73" "74" "75" "76" "77" "78" "79" "80" "81" "82" "83" "84"
## [85] "85" "86" "87" "88" "89" "90" "91" "92" "93" "94" "95" "96"
## [97] "97" "98" "99" "100" "101" "102" "103" "104" "105" "106" "107" "108"
## [109] "109" "110" "111" "112" "113" "114" "115" "116" "117" "118" "119" "120"
## [121] "121" "122" "123" "124" "125" "126" "127" "128" "129" "130" "131" "132"
## [133] "133" "134" "135" "136" "137" "138" "139" "140" "141" "142" "143" "144"
## [145] "145" "146" "147" "148" "149" "150" "151" "152" "153" "154" "155" "156"
## [157] "157" "158" "159" "160" "161" "162" "163" "164" "165" "166" "167" "168"
## [169] "169" "170" "171" "172" "173" "174" "175" "176" "177" "178" "179" "180"
## [181] "181" "182" "183" "184" "185" "186" "187" "188" "189" "190" "191"
##
## [[2]]
## [1] "Column1" "Groups"
## [3] "GENDER" "AGE"
## [5] "Education level" "INCOME"
## [7] "Prostasia_proteraiotita" "Perivallon > Oikonomia"
## [9] "Metra with cost of locals" "Metra with local acceptance"
## [11] "Tourismos for all locals"## αφαίρεση της 1ης στηλής
zante2 <- zante [,-1]
labels(zante2)## [[1]]
## [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12"
## [13] "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24"
## [25] "25" "26" "27" "28" "29" "30" "31" "32" "33" "34" "35" "36"
## [37] "37" "38" "39" "40" "41" "42" "43" "44" "45" "46" "47" "48"
## [49] "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60"
## [61] "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72"
## [73] "73" "74" "75" "76" "77" "78" "79" "80" "81" "82" "83" "84"
## [85] "85" "86" "87" "88" "89" "90" "91" "92" "93" "94" "95" "96"
## [97] "97" "98" "99" "100" "101" "102" "103" "104" "105" "106" "107" "108"
## [109] "109" "110" "111" "112" "113" "114" "115" "116" "117" "118" "119" "120"
## [121] "121" "122" "123" "124" "125" "126" "127" "128" "129" "130" "131" "132"
## [133] "133" "134" "135" "136" "137" "138" "139" "140" "141" "142" "143" "144"
## [145] "145" "146" "147" "148" "149" "150" "151" "152" "153" "154" "155" "156"
## [157] "157" "158" "159" "160" "161" "162" "163" "164" "165" "166" "167" "168"
## [169] "169" "170" "171" "172" "173" "174" "175" "176" "177" "178" "179" "180"
## [181] "181" "182" "183" "184" "185" "186" "187" "188" "189" "190" "191"
##
## [[2]]
## [1] "Groups" "GENDER"
## [3] "AGE" "Education level"
## [5] "INCOME" "Prostasia_proteraiotita"
## [7] "Perivallon > Oikonomia" "Metra with cost of locals"
## [9] "Metra with local acceptance" "Tourismos for all locals"## δημιουργία αντικειμένων
group <- zante$Groups
age <- zante$AGE
gender <- zante$GENDER
edu <- zante$`Education level`
inc <- zante$INCOME
## δημουργία data.frame
ecotour <- data.frame(group, age, gender, edu, inc)
###### ENOTHTA 1: Creating a contingency table ###########
### 1.1. Δημιουργία πίνακα
## με την εντολή table (ισχύει για 2 μεταβλητές)
group.edu <- table(group, edu)
group.edu## edu
## group deuterova metapty panepist protova technolo
## ektos parkou 17 1 8 3 19
## ektos parkou oreina 24 0 2 11 8
## entos parkou 22 0 5 9 12
## epixirisis 25 0 12 2 11## υπολογισμός εγγραφών ανά μεταβλητή
margin.table(group.edu,1) # αριθμός ανά ομάδα## group
## ektos parkou ektos parkou oreina entos parkou epixirisis
## 48 45 48 50margin.table(group.edu,2) # αριθμός ανά εκπαίδευση## edu
## deuterova metapty panepist protova technolo
## 88 1 27 25 50### 1.2 Proportions table (Δημιουργια πίνακα ποσοστού συμμετοχής)
prop.gr.edu <- prop.table(group.edu)
prop.gr.edu## edu
## group deuterova metapty panepist protova
## ektos parkou 0.089005236 0.005235602 0.041884817 0.015706806
## ektos parkou oreina 0.125654450 0.000000000 0.010471204 0.057591623
## entos parkou 0.115183246 0.000000000 0.026178010 0.047120419
## epixirisis 0.130890052 0.000000000 0.062827225 0.010471204
## edu
## group technolo
## ektos parkou 0.099476440
## ektos parkou oreina 0.041884817
## entos parkou 0.062827225
## epixirisis 0.057591623## Εκτύπωση table με λιγότερα δεκαδικά
print(round(prop.gr.edu, 3))## edu
## group deuterova metapty panepist protova technolo
## ektos parkou 0.089 0.005 0.042 0.016 0.099
## ektos parkou oreina 0.126 0.000 0.010 0.058 0.042
## entos parkou 0.115 0.000 0.026 0.047 0.063
## epixirisis 0.131 0.000 0.063 0.010 0.058## Δημιουργία αντικειμένου με λιγότερα δεκαδικά
prop.gr.edu3 <- (round(prop.gr.edu, 3))
prop.gr.edu3## edu
## group deuterova metapty panepist protova technolo
## ektos parkou 0.089 0.005 0.042 0.016 0.099
## ektos parkou oreina 0.126 0.000 0.010 0.058 0.042
## entos parkou 0.115 0.000 0.026 0.047 0.063
## epixirisis 0.131 0.000 0.063 0.010 0.058### 1.3 υπολογισμός της τιμής κάθε κελιού σε έναν πίνακα ως ποσοστό όλων των τιμών
# proportions συνολικά για όλο το δείγμα
prop.table(group.edu)## edu
## group deuterova metapty panepist protova
## ektos parkou 0.089005236 0.005235602 0.041884817 0.015706806
## ektos parkou oreina 0.125654450 0.000000000 0.010471204 0.057591623
## entos parkou 0.115183246 0.000000000 0.026178010 0.047120419
## epixirisis 0.130890052 0.000000000 0.062827225 0.010471204
## edu
## group technolo
## ektos parkou 0.099476440
## ektos parkou oreina 0.041884817
## entos parkou 0.062827225
## epixirisis 0.057591623# proportions edu ανά group
## πόσοι στην ομάδα επιχειρήσεις είχαν edu
## άθροιση ποσοστών οριζόντια
prop.table(group.edu,1)## edu
## group deuterova metapty panepist protova technolo
## ektos parkou 0.35416667 0.02083333 0.16666667 0.06250000 0.39583333
## ektos parkou oreina 0.53333333 0.00000000 0.04444444 0.24444444 0.17777778
## entos parkou 0.45833333 0.00000000 0.10416667 0.18750000 0.25000000
## epixirisis 0.50000000 0.00000000 0.24000000 0.04000000 0.22000000prop.oma <- prop.table(group.edu,1)
prop.oma3 <- (round(prop.oma, 3))
prop.oma3## edu
## group deuterova metapty panepist protova technolo
## ektos parkou 0.354 0.021 0.167 0.062 0.396
## ektos parkou oreina 0.533 0.000 0.044 0.244 0.178
## entos parkou 0.458 0.000 0.104 0.188 0.250
## epixirisis 0.500 0.000 0.240 0.040 0.220## πόσοι ανά edu ανήκουν σε ένα group
## π.χ. όλοι με μεταπτυχιακό είναι εκτός πάρκου
## το 44% από ΠΕ ειναι από επιχειρήσεις
## άθροιση γραμμών κάθετα
prop.table(group.edu,2)## edu
## group deuterova metapty panepist protova technolo
## ektos parkou 0.19318182 1.00000000 0.29629630 0.12000000 0.38000000
## ektos parkou oreina 0.27272727 0.00000000 0.07407407 0.44000000 0.16000000
## entos parkou 0.25000000 0.00000000 0.18518519 0.36000000 0.24000000
## epixirisis 0.28409091 0.00000000 0.44444444 0.08000000 0.22000000prop.edu <- prop.table(group.edu,2)
prop.edu3 <- (round(prop.edu, 3))
prop.edu3## edu
## group deuterova metapty panepist protova technolo
## ektos parkou 0.193 1.000 0.296 0.120 0.380
## ektos parkou oreina 0.273 0.000 0.074 0.440 0.160
## entos parkou 0.250 0.000 0.185 0.360 0.240
## epixirisis 0.284 0.000 0.444 0.080 0.220######## ENOTHTA the chi-square #################
### 2.1: Applying the chi-square test function
chi.gr.edu <- chisq.test(group.edu)## Warning in chisq.test(group.edu): Chi-squared approximation may be incorrect# Viewing the result
print(chi.gr.edu)##
## Pearson's Chi-squared test
##
## data: group.edu
## X-squared = 27.31, df = 12, p-value = 0.006971### 2.2: Applying the chi-square test function
## μέσω ftable για δύο μεταβλητές
## (με 3 μεταβλητές λειτουργεί ως contingency table )
# Φόρτωση του πίνακα από το table
ftable (group.edu)## edu deuterova metapty panepist protova technolo
## group
## ektos parkou 17 1 8 3 19
## ektos parkou oreina 24 0 2 11 8
## entos parkou 22 0 5 9 12
## epixirisis 25 0 12 2 11# σύνοψη
summary(group.edu)## Number of cases in table: 191
## Number of factors: 2
## Test for independence of all factors:
## Chisq = 27.31, df = 12, p-value = 0.006971
## Chi-squared approximation may be incorrect## νέος πίνακας
age.edu <- table(age,edu)
ftable (age.edu)## edu deuterova metapty panepist protova technolo
## age
## <18 4 0 0 5 0
## >60 9 0 0 13 5
## 19-30 15 0 8 1 15
## 31-45 28 1 11 2 21
## 46-50 32 0 8 4 9summary (age.edu)## Number of cases in table: 191
## Number of factors: 2
## Test for independence of all factors:
## Chisq = 67.79, df = 16, p-value = 2.425e-08
## Chi-squared approximation may be incorrect###### ΕΝΟΤΗΤΑ 3 - Cramer's V measure of association ############
library (lsr) # για Cramer
## Cramér's V (sometimes referred to as Cramér's phi) is a measure of association
## between two nominal variables, giving a value between 0 and +1 (inclusive).
cramersV(group.edu)## Warning in stats::chisq.test(...): Chi-squared approximation may be incorrect## [1] 0.2183144###### ΕΝΟΤΗΤΑ 4 - ΑΠΕΙΚΟΝΙΣΕΙΣ ############
### 4.1. Απεικονιση ως ραβδογράμματα
## 4.1.1. μέσω productplots
#install.packages("productplots")
library(productplots)
library(ggplot2)
prodplot (ecotour,~ group + edu) + aes(fill=group)
prodplot (ecotour,~ group + edu, stacked(direction = "h")) + aes(fill=group)
prodplot (ecotour,~ group + edu, mosaic(direction = "h")) + aes(fill=group)
## 4.1.2 μέσω PlotXtabs
# Για PloXTabs graphs
#install.packages("CGPfunctions") ## graphs
library (CGPfunctions)
library (ggplot2)
PlotXTabs(ecotour, group, edu)## Plotted dataset ecotour variables group by edu
## Διμεταβλητά διαγράμματα ράβδων (στηλών) με στατιστικούς ελέγχους
## πλοτάριαμα της διαφοροποίησης; εκπαίδευσης ανά ομάδα
## 1o group & 2o edu
PlotXTabs2(ecotour, group, edu, title = "Τίτλος διαγράμματος")
## με δυνατότητα αλλαγής των λεζάντων (συνεργασία με ggplot)
PlotXTabs2(ecotour, group, edu, title = "Τίτλος διαγράμματος",legend.title="text",
xlab ="όνομα χ άξονα",ylab ="όνομα Y άξονα" ) +
scale_x_discrete(labels=c('label1', 'label2', 'label3', "label4"))+
scale_fill_discrete(labels=c('label1', 'label2', 'label3',
"label4", "label5"))## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## πλοτάριαμα της διαφοροποίησης; ομάδα ανά εκπαίδευση
## 1o edu & 2o group
PlotXTabs2(ecotour, edu, group)
## πλοτάριαμα της διαφοροποίησης; φύλο ανά ομάδα
## 1o gender & 2o group
PlotXTabs2(ecotour, gender, group)
## πλοτάριαμα της διαφοροποίησης; φύλο ανά εκπαίδευση
## 1o gender & 2o edu
PlotXTabs2(ecotour, gender, edu)
## πλοτάρισμα συγκεκριμένων ομάδων
library (dplyr) # για φιλτράρισμα πληροφορίας##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# επιλογή δύο ομάδες από τις τέσσερις
new.table1 <- ecotour %>% filter(group == "entos parkou" | group == "ektos parkou")
PlotXTabs2(new.table1, edu, group)
PlotXTabs2(new.table1, gender, group)
# επιλογή δύο ομάδες από τις τέσσερις
new.table2 <- ecotour %>%filter(group == "entos parkou" | group == "epixirisis")
PlotXTabs2(new.table2, edu, group)
PlotXTabs2(new.table2, gender, group)
##### END OF CODE ######Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.