# testaukseen 7.11.2020 virheilmoituksia varten arvo TRUE
options(tinytex.verbose = TRUE)
# 18.10.2020
library(rgl)
library(ca)
library(haven)
library(dplyr)
library(knitr)
library(tidyverse)
library(lubridate)
library(rmarkdown)
library(ggplot2)
library(furniture)
library(scales) # G_1_2 - kuva
library(reshape2) # G_1_2 - kuva
library(printr) #19.5.18 taulukoiden ja matriisien tulostukseen
library(bookdown)
library(tinytex)
library(assertthat)
# eval = FALSE 24.11.2020
# automatically create a bib database for R packages
knitr::write_bib(c(
.packages(), 'bookdown', 'knitr', 'rmarkdown'
), 'packages.bib')
# include FALSE: ei koodia eikä tulostusta dokumenttiin - poistettava turhia
# välitulostuksia (18.10.2020)
# Aineiston rajaamisen kolme vaihetta (10.2018)
#
# TIEDOSTOJEN NIMEÄMINEN
#
# R-datatiedostot .data - tarkenteella ovat osajoukkoja koko ISSP-datasta ISSP2012.data
# R-datatiedostot .dat - tarkenteella: mukana alkuperäisten muuttujien muunnoksia
# (yleensä as_factor), alkuperäisissä muuttujissa mukana SPSS-tiedoston metadata.
#
# Luokittelumuuttujan tyyppi on datan lukemisen jälkeen yleensä merkkijono (char)
# ja haven_labelled.
#
# Muutetaan R-datassa ordinaali- tai nominaaliasteikon muuttujat haven-paketin
# as_factor - funktiolla faktoreiksi. R:n faktorityypin muuttujille voidaan tarvittaessa
# määritellä järjestys, toistaiseksi niin ei tehdä (25.9.2018).
#
# Muunnetun muuttujan rinnalla säilytetään SPSS-tiedostosta luettu muuttja, metatiedot säilyvät
# alkuperäisessä.
#
# R-datatiedostot joiden nimen loppuosa on muotoa *esim1.dat: käytetään analyyseissä
#
# 1. VALITAAN MAAT (25) -> ISSP2012jh1a.data. Muuttujat koodilohkossa datasel_vars1
#
# kolme maa-muuttujaa datassa. V3 erottelee joidenkin maiden alueita, V4 on koko
# maan koodi ja C_ALPHAN on maan kaksimerkkinen tunnus.
#
# V3 - Country/ Sample ISO 3166 Code (see V4 for codes for whole nation states)
# V3 erot valituissa maissa
# 5601 BE-FLA-Belgium/ Flanders
# 5602 BE-WAL-Belgium/ Wallonia
# 5603 BE-BRU-Belgium/ Brussels
# 27601 DE-W-Germany-West
# 27602 DE-E-Germany-East
# 62001 PT-Portugal 2012: first fieldwork round (main sample)
# 62002 PT-Portugal 2012: second fieldwork round (complementary sample)
# Myös tämä on erikoinen, näyttää olevan vakio kun V4 = 826:
# 82601 GB-GBN-Great Britain
# Portugalissa ainestoa täydennettiin, koska siinä oli puutteita. Jako ei siis ole oleellinen,
# mutta muuut ovat. Tähdellä merkityt maat valitaan johdattelevaan esimerkkiin.
#
# Maat (25)
#
# 36 AU-Australia
# 40 AT-Austria
# 56 BE-Belgium*
# 100 BG-Bulgaria*
# 124 CA-Canada
# 191 HR-Croatia
# 203 CZ-Czech Republic
# 208 DK-Denmark*
# 246 FI-Finland*
# 250 FR-France
# 276 DE-Germany*
# 348 HU-Hungary*
# 352 IS-Iceland
# 372 IE-Ireland
# 428 LV-Latvia
# 440 LT-Lithuania
# 528 NL-Netherlands
# 578 NO-Norway
# 616 PL-Poland
# 620 PT-Portugal
# 643 RU-Russia
# 703 SK-Slovakia
# 705 SI-Slovenia
# 752 SE-Sweden
# 756 CH-Switzerland
# 826 GB-Great Britain and/or United Kingdom - jätetään pois jotta saadaan TOPBOT
# -muuttuja mukaan (top-bottom self-placement) .(9.10.18)
# 840 US-United States - jätetään pois, jotta saadaan TOPBOT-muuttuja mukaan.(10.10.18)
#
# Belgian ja Saksan alueet:
# V3
# 5601 BE-FLA-Belgium/ Flanders
# 5602 BE-WAL-Belgium/ Wallonia
# 5603 BE-BRU-Belgium/ Brussels
# 27601 DE-W-Germany-West
# 27602 DE-E-Germany-East
#
# Unkari (348) toistaiseksi mukana, mutta joissain kysymyksissä myös Unkarilla on
# poikkeavia vastausvaihtoehtoja(HU_V18, HU_V19,HU_V20). Jos näitä muuttujia käytetään,
# Unkari on parempi jättää pois.
#
#
# (25.4.2018) user_na
# haven-paketin read_spss - funktiolla voi r-tiedostoon lukea myös SPSS:n sallimat kolme
# (yleensä 7, 8, 9) tarkempaa koodia puuttuvalle tiedolle.
# "If TRUE variables with user defined missing will be read into labelled_spss objects.
# If FALSE, the default, user-defined missings will be converted to NA"
# https://www.rdocumentation.org/packages/haven/versions/1.1.0/topics/read_spss
#
ISSP2012jh.data <- read_spss("data/ZA5900_v4-0-0.sav") #luetaan alkuperäinen data R- dataksi (df).
#str(ISSP2012jh.data)
incl_countries25 <- c(36, 40, 56,100, 124, 191, 203, 208, 246, 250, 276, 348, 352,
372, 428, 440, 528, 578, 616, 620, 643, 703, 705, 752, 756)
#str(ISSP2012jh.data)
#str(ISSP2012jh.data) #61754 obs. of 420 variables - kaikki
ISSP2012jh1a.data <- filter(ISSP2012jh.data, V4 %in% incl_countries25)
#head(ISSP2012jh1a.data)
#str(ISSP2012jh1a.data) #34271 obs. of 420 variables, Espanja ja Iso-Britannia
# pois (9.10.2018)
# str(ISSP2012jh1a.data) # 32969 obs. of 420 variable, Espanja Iso-Britannia,
# USA pois (10.10.2018)
#
# names() # muuttujen nimet
# Maakohtaiset muuttujat (kun on poikettu ISSP2012 - vastausvaihtoehdoista tms.)
# on aineistossa eroteltu maatunnus-etuliitteellä (esimerkiksi ES_V7).
# Demografisissa ja muissa taustamuuttujissa suuri osa tiedoista on kerätty maa-
# kohtaisilla lomakkeilla. Vertailukelpoiset muuttujat on konstruoitu niistä.
# Muuttujia on 420, vain osa yhteisiä kaikille maille.
# include FALSE: ei koodia eikä tulostusta dokumenttiin - poistettava turhia
# välitulostuksia (18.10.2020)
# 2. VALITAAN MUUTTUJAT -> ISSP2012jh1b.data. Maat valittu koodilohkossa datasel_country1
#
#
# Muuttujat on luokiteltu dokumentissa ZA5900_overview.pdf
# https://zacat.gesis.org/webview/index.jsp?object=http://zacat.gesis.org/obj/fStudy/ZA5900
# Study Description -> Other Study Description -> Related Materials
#
#
# METADATA
metavars1 <- c("V1", "V2", "DOI")
#MAA - maakoodit ja maan kahden merkin tunnus
countryvars1 <- c("V3","V4","C_ALPHAN")
# SUBSTANSSIMUUTTUJAT - Attitudes towards family and gender roles (9)
#
# Yhdeksän kysymystä (lyhennetyt versiot, englanniksi), vastausvaihtoehdot Q1-Q2
#
# 1 = täysin samaa mieltä, 2 = samaa mieltä, 3 = ei samaa eikä eri mieltä,
# 4 = eri mieltä, 5 = täysin eri mieltä
#
# Q1a Working mother can have warm relation with child
# Q1b Pre-school child suffers through working mother
# Q1c Family life suffers through working mother
# Q1d Women’s preference: home and children
# Q1e Being housewife is satisfying
#
# Q2a Both should contribute to household income
# Q2b Men’s job is earn money, women’s job household
#
# Q3a Should women work: Child under school age
# Q3b Should women work: Youngest kid at school
# 1= kokopäivätyö, 2 = osa-aikatyö, 3 = pysyä kotona, 8 = en osaa sanoa
# (can't choose), 9 = no answer
#
# Kysymysten Q3a ja Q3b eos-vastaus ei ole sama kuin "en samaa enkä eri mieltä"
# (ns. neutraali # vaihtoehto), mutta kieltäytymisiä jne. (koodi 9) on aika
# vähän. Kolmessa # maassa ne on yhdistety:
# (8 Can't choose, CA:can't choose+no answer, KR:don't know+refused, NL:don't know).
# Kun SPSS-tiedostosta ei ole tuotu puuttuvan tiedon tarkempaa luokittelua,
# erottelua ei voi tehdä.
#
substvars1 <- c("V5","V6","V7","V8","V9","V10","V11","V12","V13") # 9 muuttujaa
# Nämä yhteiset muuttujat pois (maaspesifien muuttujien lisäksi) :
#
# "V14","V15","V16", "V17","V18","HU_V18","V19","HU_V19","V20","HU_V20","V21",
# "V28","V29","V30","V31","V32","V33",# "V34", "V35", "V36", "V37", "V38", "V39",
# "V40", "V41", "V42", "V43", "V44", "V45", "V46", "V47", "V48", "V49", "V50",
# "V51", "V52", "V53", "V54", "V55", "V56", "V57", "V58", "V59", "V60", "V61",
# "V62", "V63", "V64", "V65", "V65a","V66", "V67"
#
#
# DEMOGRAFISET JA MUUT TAUSTAMUUTTUJAT (8)
#
# AGE, SEX
#
# DEGREE - Highest completed degree of education: Categories for international
# comparison. Slightly re-arranged subset of ISCED-97
#
# 0 No formal education
# 1 Primary school (elementary school)
# 2 Lower secondary (secondary completed does not allow entry to university:
# obligatory school)
# 3 Upper secondary (programs that allow entry to university or programs that
# allow to entry other ISCED level 3 programs - designed to prepare students for
# direct entry into the labour market)
# 4 Post secondary, non-tertiary (other upper secondary programs toward labour
# market or technical formation)
# 5 Lower level tertiary, first stage (also technical schools at a tertiary level)
# 6 Upper level tertiary (Master, Dr.)
# 9 No answer, CH: don't know
# HUOM! R-factor - muunnoksessa koodaus on 1-7
#
# MAINSTAT - main status: Which of the following best describes your current situation?
#
# 1 In paid work
# 2 Unemployed and looking for a job, HR: incl never had a job
# 3 In education
# 4 Apprentice or trainee
# 5 Permanently sick or disabled
# 6 Retired
# 7 Domestic work
# 8 In compulsory military service or community service
# 9 Other
# 99 No answer
# Armeijassa tai yhdyskuntapalvelussa muutamia, muutamissa maissa.Kategoriassa 9
# on hieman väkeä. Yhdistetään 8 ja 9. Huom! Esim Puolassa ei yhtään eläkeläistä
# eikä kategoriaa 9, Saksassa ei ketään kategoriassa 9.
#
# TOPBOT - Top-Bottom self-placement (10 pt scale)
#
# "In our society, there are groups which tend to be towards the top and groups
# which tend to be towards the bottom. Below is a scale that runs
# from the top to the bottom. Where would you put yourself on this scale?"
# Eri maissa hieman erilaisia kysymyksiä.
#
# HHCHILDR - How many children in household: children between [school age] and
# 17 years of age
#
# 0 No children
# 1 One child
# 2 2 children
# 21 21 children
# 96 NAP (Code 0 in HOMPOP)
# 97 Refused
# 99 No answer
#
# Voisi koodata dummymuuttujaksi lapsia (1) - ei lapsia (0).
# Ranskan datassa on erittäin iso osa puuttuvia tietoja (yli 20 %), Sama tilanne
# myös muissa perheen kokoon liittyvissä kysymyksissä. Myös Austarlialla aika
# paljon puuttuvia vastauksia.
#
# MARITAL - Legal partnership status
#
# What is your current legal marital status?
# The aim of this variable is to measure the current 'legal' marital status '.
# PARTLIV - muuttujassa on 'de facto' - tilanteen tieto parisuhteesta
#
# 1 Married
# 2 Civil partnership
# 3 Separated from spouse/ civil partner (still legally married/ still legally
# in a civil partnership)
# 4 Divorced from spouse/ legally separated from civil partner
# 5 Widowed/ civil partner died
# 6 Never married/ never in a civil partnership, single
# 7 Refused
# 8 Don't know
# 9 No answer
#
# URBRURAL - Place of living: urban - rural
#
# 1 A big city
# 2 The suburbs or outskirts of a big city
# 3 A town or a small city
# 4 A country village
# 5 A farm or home in the country
# 7 Other answer
# 9 No answer
# 1 ja 2 vaihtelevat aika paljon maittain, parempi laskea yhteen. Unkarista puuttuu
# jostain syystä kokonaan vaihtoehto 5. Vaihotehdon 7 on valinnut vain 4
# vastaajaa Ranskasta.
#
bgvars1 <- c( "SEX","AGE","DEGREE", "MAINSTAT", "TOPBOT",
"HHCHILDR", "MARITAL", "URBRURAL")
#Valitaan muuttujat
jhvars1 <- c(metavars1,countryvars1, substvars1,bgvars1)
#jhvars1
ISSP2012jh1b.data <- select(ISSP2012jh1a.data, all_of(jhvars1))
# laaja aineisto - mukana havainnot joissa puuttuvia tietoja
# str(ISSP2012jh1b.data) #32969 obs. of 23 variables
#
# SUBSTANSSIMUUTTUJAT
#
# $ V5 : 'haven_labelled' num 5 1 2 2 1 NA 2 4 2 2 ...
# ..- attr(*, "label")= chr "Q1a Working mom: warm relationship with children
# as a not working mom"
# ..- attr(*, "labels")= Named num 0 1 2 3 4 5 8 9
#
# ISSP2012jh1b.data$V5 näyttää tarkemmin rakenteen
#
# glimpse(ISSP2012jh1b.data)
# Poistetaan havainnot, joissa ikä (AGE) tai sukupuolitieto puuttuu (5.7.2019)
ISSP2012jh1c.data <- filter(ISSP2012jh1b.data, (!is.na(SEX) & !is.na(AGE)))
# str(ISSP2012jh1c.data) # 32823 obs. of 23 variables, 32969-32823 = 146
# TARKISTUS 8.6.20 dplyr 1.0.0-päivitys: havaintojen ja muuttujien määrä ok.
# VAIHE 1 - muuttujat joissa ei ole puuttuvia tietoja
# vaihe 1.1 haven_labelled ja chr -> as_factor
ISSP2012jh1d.dat <- ISSP2012jh1c.data %>%
mutate(maa = as_factor(C_ALPHAN), # ei puuttuvia, ei tyhjiä leveleitä
maa3 = as_factor(V3), # maakoodi, jossa aluejako joillan mailla
sp1 = as_factor(SEX), # ei puuttuvia, tyhjä level "no answer" 999
)
# C_ALPHAN - maa - maa3 tarkistuksia
# V3
# "Pulma" on järjestys. C_ALPHAN ("chr") on aakkosjärjestyksessä, kun luodaan
# maa = as_factor(C_ALPHAN) järjestys muuttuu (esiintymisjärjestys datassa?)
# maa3 muunnetaan maakoodista (haven_labelled' num), jonka
# str(ISSP2012jh1d.dat$maa) #Country Prefix ISO 3166 Code - alphanumeric
# attributes(ISSP2012jh1d.dat$maa) # ei tyhiä levels-arvoja, 25 levels
# ISSP2012jh1d.dat$maa %>% fct_unique()
# ISSP2012jh1d.dat$maa %>% fct_count() # summary kertoo samat tiedot (20.2.20)
# sum(is.na(ISSP2012jh1d.dat$maa)) # ei puuttuvia tietoja
# ISSP2012jh1d.dat$maa %>% summary() # mukana vain valitut 25 maata
# str(ISSP2012jh1d.dat$maa3) #"Country/ Sample ISO 3166 Code
#(see V4 for codes for whole nation states)"
# 29 levels
# str(ISSP2012jh1d.dat$V3)
# attributes(ISSP2012jh1d.dat$maa3) # ei tyhiä levels-arvoja, 29 levels
# sum(is.na(ISSP2012jh1d.dat$maa3)) # nolla ei ole puuttuva tieto! (3.2.20)
# ISSP2012jh1d.dat$maa3 %>% fct_unique()
# ISSP2012jh1d.dat$maa3 %>% fct_count()
# Vain näissä on jaettu maan havainnot (3.2.20)
#
# [38] BE-FLA-Belgium/ Flanders
# [39] BE-WAL-Belgium/ Wallonia
# [40] BE-BRU-Belgium/ Brussels
# [41] DE-W-Germany-West
# [42] DE-E-Germany-East
# [43] PT-Portugal 2012: first fieldwork round (main sample)
# [44] PT-Portugal 2012: second fieldwork round (complementary sample)
# ISSP2012jh1d.dat$maa3 %>% fct_count() #miksi ei tulosta mitään? (3.2.2020)
# ISSP2012jh1d.dat$maa3 %>% summary()
# ISSP2012jh1d.dat$maa3 %>% fct_unique()
# maa3: 25 maata, havaintojen määrä. Poisjätetyissä havaintoja 0.
# glimpse(ISSP2012jh1d.dat$maa3)
# head(ISSP2012jh1d.dat$maa3)
# length(levels(ISSP2012jh1d.dat$maa3))
# C_ALPHAN alkuperäinen järjestys, maa aakkosjärjestyssä (2.2.20)
#
# Huom1: Myös merkkijonomuuttujaa C_ALPHAN tarvitaan jatkossa.
#
# Huom2: kun dataa rajataan, on tarkistettava ja tarvittaessa poistettava
# "tyhjät" R-factor - muuttujan "maa" luokat (3.2.2020)
# vaihe 1.2 tyhjät luokat (levels) pois faktoreista
ISSP2012jh1d.dat <- ISSP2012jh1d.dat %>%
mutate(sp = fct_drop(sp1),
maa3 = fct_drop(maa3)
)
# maa3 - tarkistuksia
# str(ISSP2012jh1d.dat$maa3) # 29 levels
# attributes(ISSP2012jh1d.dat$maa3)
#sum(is.na(ISSP2012jh1d.dat$maa3)) # nolla ei ole puuttuva tieto! (3.2.20)
# ISSP2012jh1d.dat$maa3 %>% summary()
# ISSP2012jh1d.dat$maa3 %>% fct_unique()
# ISSP2012jh1d.dat$maa3 %>% fct_count()
#
# str(ISSP2012jh1d.dat$C_ALPHAN)
# attributes(ISSP2012jh1d.dat$C_ALPHAN)
# TESTAUKSIA
#
# ISSP2012jh1d.dat %>% tableX(C_ALPHAN, maa)
# ISSP2012jh1d.dat %>% tableX(C_ALPHAN, maa3)
# ISSP2012jh1d.dat %>% tableX(maa, maa3)
# ISSP2012jh1d.dat %>% tableX(V3, maa3)
# sp, sp1, SEX - tarkistuksia
#
# ISSP2012jh1d.dat$sp %>% fct_count()
# ISSP2012jh1d.dat$sp %>% fct_count()
# ISSP2012jh1d.dat %>% tableX(SEX,sp1)
# ISSP2012jh1d.dat %>% tableX(SEX,sp)
# ISSP2012jh1d.dat %>% tableX(sp1,sp)
# vaihe 1.3 uudet "faktorilabelit"
ISSP2012jh1d.dat <- ISSP2012jh1d.dat %>%
mutate(sp =
fct_recode(sp,
"m" = "Male",
"f" = "Female")
)
# Tarkistuksia
# ISSP2012jh1d.dat$sp %>% fct_unique()
# ISSP2012jh1d.dat$sp %>% fct_count()
# ISSP2012jh1d.dat$sp %>% summary()
# AGE -> ika
ISSP2012jh1d.dat$ika <- ISSP2012jh1d.dat$AGE
# Tarkistuksia
attributes(ISSP2012jh1d.dat$ika) # tyhjä level "No answer"
# str(ISSP2012jh1d.dat$ika)
ISSP2012jh1d.dat$ika %>% summary()
ISSP2012jh1d.dat %>%
tableC(AGE, ika,cor_type = "pearson", na.rm = FALSE, rounding = 5,
output = "text", booktabs = TRUE, caption = NULL, align = NULL,
float = "htb") %>% kable()
# Ikäjakauma - ei tarvita (18.10.2020)
#
# ISSP2012jh1d.dat$ika %>% hist(main = "ISSP 2012: vastaajan ikä")
# Substanssi- ja taustamuuttujat R-faktoreiksi
ISSP2012jh1d.dat <- ISSP2012jh1d.dat %>%
mutate(Q1a1 = as_factor(V5), #labels
Q1b1 = as_factor(V6),
Q1c1 = as_factor(V7),
Q1d1 = as_factor(V8),
Q1e1 = as_factor(V9),
Q2a1 = as_factor(V10),
Q2b1 = as_factor(V11),
Q3a1 = as_factor(V12), #labels = vastQ3_labels (W,w,H)
Q3b1 = as_factor(V13), #labels = vastQ3_labels
edu1 = as_factor(DEGREE),
msta1 = as_factor(MAINSTAT),
sosta1 = as_factor(TOPBOT),
nchild1 = as_factor(HHCHILDR),
lifsta1 = as_factor(MARITAL),
urbru1 = as_factor(URBRURAL)
)
# Muuttujat Q1a1...urbru1 ovat apumuuttujia, joissa on periaatteessa kaikki SPSS-
# tiedostosta siirtyvä metatieto. Poikkeus on SPSS:n kolme tarkentavaa koodia
# puuttuvalle tiedolle, ne saisi mukaan read_spss - parametrin avulla (user_na=TRUE)
#
# Tarkistusksia
# ISSP2012jh1d.dat %>% summary()
# ISSP2012jh1d.dat %>%
# select(Q1a1, Q1b1, Q1c1,Q1d1,Q1e1, Q2a1, Q2b1, Q3a1,Q3b1) %>%
# summary()
#
# ISSP2012jh1d.dat %>%
# select(edu1,msta1, sosta1, nchild1, lifsta1, urbru1) %>%
# summary()
# Substanssimuuttujat - ristiintaulukoinnit riittävät (6.2.20)
# ISSP2012jh1d.dat$Q1a1 %>% fct_count()
# ISSP2012jh1d.dat$Q1b1 %>% fct_count()
# ISSP2012jh1d.dat$Q1c1 %>% fct_count()
# ISSP2012jh1d.dat$Q1d1 %>% fct_count()
# ISSP2012jh1d.dat$Q1e1 %>% fct_count()
# ISSP2012jh1d.dat$Q2a1 %>% fct_count()
# ISSP2012jh1d.dat$Q2b1 %>% fct_count()
# ISSP2012jh1d.dat$Q3a1 %>% fct_count()
#ISSP2012jh1d.dat$Q3b1 %>% fct_count()
# Taustamuuttujat - ristiintaulukoinnit riittävät (6.2.20)
# ISSP2012jh1d.dat$edu1 %>% fct_count()
# ISSP2012jh1d.dat$msta1 %>% fct_count()
# ISSP2012jh1d.dat$sosta1 %>% fct_count()
# ISSP2012jh1d.dat$nchild1 %>% fct_count()
# ISSP2012jh1d.dat$lifsta1 %>% fct_count()
# ISSP2012jh1d.dat$urbru1 %>% fct_count()
# Poistetaan tyhjät luokat muuttujista
ISSP2012jh1d.dat <- ISSP2012jh1d.dat %>%
mutate(Q1a = fct_drop(Q1a1),
Q1b = fct_drop(Q1b1),
Q1c = fct_drop(Q1c1),
Q1d = fct_drop(Q1d1),
Q1e = fct_drop(Q1e1),
Q2a = fct_drop(Q2a1),
Q2b = fct_drop(Q2b1),
Q3a = fct_drop(Q3a1),
Q3b = fct_drop(Q3b1),
edu = fct_drop(edu1),
msta = fct_drop(msta1),
sosta = fct_drop(sosta1),
nchild = fct_drop(nchild1),
lifsta = fct_drop(lifsta1),
urbru = fct_drop(urbru1)
)
# Tarkistuksia 1
# ISSP2012jh1d.dat %>% summary()
# ISSP2012jh1d.dat %>%
# select(Q1a, Q1b, Q1c, Q1d, Q1e,Q2a,Q2b,Q3a, Q3b) %>%
# str()
#ISSP2012jh1d.dat %>%
# select(Q1a1, Q1b1, Q1c1, Q1d1, Q1e1,Q2a1,Q2b1,Q3a1, Q3b1) %>%
# str()
#ISSP2012jh1d.dat %>%
# select(edu, msta, sosta, nchild,lifsta, urbru) %>%
# str()
#ISSP2012jh1d.dat %>%
# select(edu1, msta1, sosta1, nchild1,lifsta1, urbru1) %>%
# str()
# Tarkistuksia 2 - ristiintaulukointeja
# Substanssimuuttujat
# ISSP2012jh1d.dat %>% tableX(Q1a,Q1a1)
# ISSP2012jh1d.dat %>% tableX(Q1b,Q1b1)
# ISSP2012jh1d.dat %>% tableX(Q1c,Q1c1)
# ISSP2012jh1d.dat %>% tableX(Q1d,Q1d1)
# ISSP2012jh1d.dat %>% tableX(Q1e,Q1e1)
# ISSP2012jh1d.dat %>% tableX(Q2a,Q2a1)
# ISSP2012jh1d.dat %>% tableX(Q2b,Q2b1)
# ISSP2012jh1d.dat %>% tableX(Q3a,Q3a1)
# ISSP2012jh1d.dat %>% tableX(Q3b,Q3b1)
# Taustamuuttujat
# ISSP2012jh1d.dat %>% tableX(edu,edu1)
# ISSP2012jh1d.dat %>% tableX(msta,msta1)
# ISSP2012jh1d.dat %>% tableX(sosta,sosta1)
# ISSP2012jh1d.dat %>% tableX(nchild,nchild1)
# ISSP2012jh1d.dat %>% tableX(lifsta,lifsta1)
# ISSP2012jh1d.dat %>% tableX(urbru,urbru1)
# Uusi muuttuja, jossa NA-arvot ovat mukana muuttujan uutena luokkana. Muuttujat
# nimetään Q1a -> Q1am.
ISSP2012jh1d.dat <- ISSP2012jh1d.dat %>%
mutate(Q1am = fct_explicit_na(Q1a, na_level = "missing"),
Q1bm = fct_explicit_na(Q1b, na_level = "missing"),
Q1cm = fct_explicit_na(Q1c, na_level = "missing"),
Q1dm = fct_explicit_na(Q1d, na_level = "missing"),
Q1em = fct_explicit_na(Q1e, na_level = "missing"),
Q2am = fct_explicit_na(Q2a, na_level = "missing"),
Q2bm = fct_explicit_na(Q2b, na_level = "missing"),
Q3am = fct_explicit_na(Q3a, na_level = "missing"),
Q3bm = fct_explicit_na(Q3b, na_level = "missing"),
edum = fct_explicit_na(edu, na_level = "missing"),
mstam = fct_explicit_na(msta, na_level = "missing"),
sostam = fct_explicit_na(sosta, na_level = "missing"),
nchildm = fct_explicit_na(nchild, na_level = "missing"),
lifstam = fct_explicit_na(lifsta, na_level = "missing"),
urbrum = fct_explicit_na(urbru, na_level = "missing"),
)
# Tarkistuksia 3
# ISSP2012jh1d.dat %>%
# select(Q1am, Q1bm, Q1cm, Q1dm, Q1em, Q2am, Q2bm, Q3am, Q3bm) %>%
# summary()
#
#ISSP2012jh1d.dat %>%
# select(edum,mstam, sostam,nchildm,lifstam, urbrum) %>%
# summary()
#
#ISSP2012jh1d.dat %>%
# select(Q1am, Q1bm, Q1cm, Q1dm, Q1em, Q2am, Q2bm, Q3am, Q3bm) %>%
# str()
#
#ISSP2012jh1d.dat %>%
# select(edum,mstam, sostam,nchildm,lifstam, urbrum) %>%
# str()
# Taustamuuttuja, puuttuva tieto mukana - ristiintaulkointeja
# ISSP2012jh1d.dat$edum %>% fct_count()
# ISSP2012jh1d.dat$mstam %>% fct_count()
# ISSP2012jh1d.dat$sostam %>% fct_count()
# ISSP2012jh1d.dat$nchildm %>% fct_count()
# ISSP2012jh1d.dat$lifstam %>% fct_count()
# ISSP2012jh1d.dat$urbrum %>% fct_count()
# Substanssimuuttujat, puuttuva tieto mukana - ristiintaulkointeja
# ISSP2012jh1d.dat$Q1am %>% fct_count()
# ISSP2012jh1d.dat$Q1bm %>% fct_count()
# ISSP2012jh1d.dat$Q1cm %>% fct_count()
# ISSP2012jh1d.dat$Q1dm %>% fct_count()
# ISSP2012jh1d.dat$Q1em %>% fct_count()
# ISSP2012jh1d.dat$Q2am %>% fct_count()
# ISSP2012jh1d.dat$Q2bm %>% fct_count()
# ISSP2012jh1d.dat$Q3am %>% fct_count()
# ISSP2012jh1d.dat$Q3bm %>% fct_count()
# Vaihe 2.4.1
# Q1a - Q1e,Q2a, Q2b Viisi vastausvaihtoehtoa - ei eksplisiittistä NA-tietoa("missing")
# Q3a - Q3b kolme vastausvaihtoehtoa
ISSP2012jh1d.dat <- ISSP2012jh1d.dat %>%
mutate(Q1a = fct_recode(Q1a,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E"= "Strongly disagree"),
Q1b = fct_recode(Q1b,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree"),
Q1c = fct_recode(Q1c,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree"),
Q1d = fct_recode(Q1d,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree"),
Q1e = fct_recode(Q1e,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree"),
Q2a = fct_recode(Q2a,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree" ),
Q2b = fct_recode(Q2b,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree"),
Q3a = fct_recode(Q3a,
"W" = "Work full-time",
"w" = "Work part-time",
"H" = "Stay at home" ),
Q3b = fct_recode(Q3b,
"W" = "Work full-time",
"w" = "Work part-time",
"H" = "Stay at home" )
)
# Tarkistuksia 1
# ISSP2012jh1d.dat %>%
# select(Q1a, Q1b, Q1c, Q1d, Q1e, Q2a, Q2b, Q3a, Q3b) %>%
# summary()
# Vaihe 2.4.2 - muuttujassa eksplisiittinen NA-tieto
ISSP2012jh1d.dat <- ISSP2012jh1d.dat %>%
mutate(Q1am = fct_recode(Q1am,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree",
"P" = "missing"),
Q1bm = fct_recode(Q1bm,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree",
"P" = "missing"),
Q1cm = fct_recode(Q1cm,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree",
"P" = "missing"),
Q1dm = fct_recode(Q1dm,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree",
"P" = "missing"),
Q1em = fct_recode(Q1em,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree",
"P" = "missing"),
Q2am = fct_recode(Q2am,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree",
"P" = "missing"),
Q2bm = fct_recode(Q2bm,
"S" = "Strongly agree",
"s" = "Agree",
"?" = "Neither agree nor disagree",
"e" = "Disagree",
"E" = "Strongly disagree",
"P" = "missing"),
Q3am = fct_recode(Q3am,
"W" = "Work full-time",
"w" = "Work part-time",
"H" = "Stay at home",
"P" = "missing"),
Q3bm = fct_recode(Q3bm,
"W" = "Work full-time",
"w" = "Work part-time",
"H" = "Stay at home",
"P" = "missing")
)
# Tarkistuksia 4
# ISSP2012jh1d.dat %>%
# select(Q1am, Q1bm, Q1cm, Q1dm, Q1em, Q2am, Q2bm, Q3am, Q3bm) %>%
# summary()
# Tarkistuksia 5
# Substanssimuuttuja
# ISSP2012jh1d.dat %>%
# tableX(Q1a,Q1am)
#
# ISSP2012jh1d.dat %>%
# tableX(Q1b,Q1bm)
#
# ISSP2012jh1d.dat %>%
# tableX(Q1c,Q1cm)
#
# ISSP2012jh1d.dat %>%
# tableX(Q1d,Q1dm)
#
# ISSP2012jh1d.dat %>%
# tableX(Q1e,Q1em)
#
# ISSP2012jh1d.dat %>%
# tableX(Q2a,Q2am)
#
# ISSP2012jh1d.dat %>%
# tableX(Q2b,Q2bm)
#
# ISSP2012jh1d.dat %>%
# tableX(Q3a,Q3am)
#
# ISSP2012jh1d.dat %>%
# tableX(Q3b,Q3bm)
#
# ISSP2012jh1d.dat %>%
# tableX(Q3am,Q3a)
#
# ISSP2012jh1d.dat$Q3a %>% levels()
# ISSP2012jh1d.dat$Q3am %>% levels()
# Taustamuuttujat - ristiintaulukointeja
# ISSP2012jh1d.dat %>%
# tableX(edu, edum)
# ISSP2012jh1d.dat %>%
# tableX(msta, mstam)
# ISSP2012jh1d.dat %>%
# tableX(sosta, sostam)
# ISSP2012jh1d.dat %>%
# tableX(nchild,nchildm)
# ISSP2012jh1d.dat %>%
# tableX(lifsta, lifstam)
# ISSP2012jh1d.dat %>%
# tableX(urbru, urbrum)
# (16.9.2020) Testaus uusille muuttujille
# Koodilohkoissa on jo testattu taulukoimalla muuttujia. Tässä varmistetaan, että
# muuttujat pysyvät sellaisina millaisiksi ne on luotu.
# ika - onpas hankala testata !
# Min. 1st Qu. Median Mean 3rd Qu. Max.
# 15.00 36.00 50.00 49.52 63.00 102.00
# ikatest <- ISSP2012jh1d.dat$ika %>% summary()
# ikatest <- ikatest[2,]
#validate_that(are_equal(ikatest, c(15, 36, 50, 49.5, 63, 102)))
#str(ISSP2012jh1d.dat)
#ISSP2012jh1d.dat %>%
# substanssimuuttujat 1
# Q1a, Q1b, Q1c, Q1d, Q1e, Q2a, Q2b, Q3a, Q3b (r. 423->)
validate_that(length(levels(ISSP2012jh1d.dat$Q1a)) == 5)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1a),
c("S", "s", "?", "e", "E")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1b)) == 5)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1b),
c("S", "s", "?", "e", "E")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1c)) == 5)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1c),
c("S", "s", "?", "e", "E")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1d)) == 5)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1d),
c("S", "s", "?", "e", "E")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1e)) == 5)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1e),
c("S", "s", "?", "e", "E")))
validate_that(length(levels(ISSP2012jh1d.dat$Q2a)) == 5)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q2a),
c("S", "s", "?", "e", "E")))
validate_that(length(levels(ISSP2012jh1d.dat$Q2b)) == 5)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q2b),
c("S", "s", "?", "e", "E")))
# substanssimuuttujat 2
validate_that(length(levels(ISSP2012jh1d.dat$Q3a)) == 3)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q3a),
c("W", "w", "H")))
validate_that(length(levels(ISSP2012jh1d.dat$Q3b)) == 3)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q3b),
c("W", "w", "H")))
# substanssimuuttujat, puuttuva tieto muuttujan arvona
# Q1am, Q1bm, Q1cm, Q1dm, Q1em, Q2am, Q2bm, Q3am, Q3bm
validate_that(length(levels(ISSP2012jh1d.dat$Q1am)) == 6)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1am),
c("S", "s", "?", "e", "E", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1bm)) == 6)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1bm),
c("S", "s", "?", "e", "E", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1cm)) == 6)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1cm),
c("S", "s", "?", "e", "E", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1dm)) == 6)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1dm),
c("S", "s", "?", "e", "E", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q1em)) == 6)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q1em),
c("S", "s", "?", "e", "E", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q2am)) == 6)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q2am),
c("S", "s", "?", "e", "E", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q2bm)) == 6)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q2bm),
c("S", "s", "?", "e", "E", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q3am)) == 4)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q3am),
c("W", "w", "H", "P")))
validate_that(length(levels(ISSP2012jh1d.dat$Q3bm)) == 4)
validate_that(are_equal(levels(ISSP2012jh1d.dat$Q3bm),
c("W", "w", "H", "P")))
# taustamuuttujat puuttuvilla tiedoilla ja ilman
# testataan vain tasojen määrä, ei labeleita jotka ovat
# alkuperäisestä datasta.
# edu, edum Huom! Koulutustasoluokitus alkuperäisessä
# datassa 0-6 (ei muodollista koulusta - korkeampi kolmas aste (maisteri, tohtori)
# R-faktorissa 1-7
validate_that(length(levels(ISSP2012jh1d.dat$edu)) == 7)
validate_that(length(levels(ISSP2012jh1d.dat$edum)) == 8)
# msta, mstam
validate_that(length(levels(ISSP2012jh1d.dat$msta)) == 9)
validate_that(length(levels(ISSP2012jh1d.dat$mstam)) == 10)
# sosta, sostam
validate_that(length(levels(ISSP2012jh1d.dat$sosta)) == 10)
validate_that(length(levels(ISSP2012jh1d.dat$sostam)) == 11)
# nchild, ncildm
validate_that(length(levels(ISSP2012jh1d.dat$nchild)) == 11)
validate_that(length(levels(ISSP2012jh1d.dat$nchildm)) == 12)
# lifsta, lifstam
validate_that(length(levels(ISSP2012jh1d.dat$lifsta)) == 6)
validate_that(length(levels(ISSP2012jh1d.dat$lifstam)) == 7)
# urbru, urbrum
validate_that(length(levels(ISSP2012jh1d.dat$urbru)) == 5)
validate_that(length(levels(ISSP2012jh1d.dat$urbrum)) == 6)
issp_docname <- c("Variable Report", "Study Monitoring Report","Basic Questionnaire",
"Contents of ISSP 2012 module", "Questionnaire Development")
issp_docdesc <- c("Perusdokumentti, muuttujien kuvaukset ja taulukot",
"tiedokeruun toteutus eri maissa",
"Maittain sovellettava kyselylomake", "substanssikysymykset taulukkona",
"kyselylomakkeen laatiminen")
issp_docfile <- c("ZA5900_cdb.pdf", "ZA5900_mr.pdf", "ZA5900_bq.pdf","ZA5900_overview.pdf",
"ssoar-2014-scholz_et_al-ISSP_2012_Family_and_Changing.pdf")
col_isspdocs <- c("dokumentti","sisältö","tiedosto")
ISSPdocsT.tbl <- tibble(issp_docname, issp_docdesc, issp_docfile)
colnames(ISSPdocsT.tbl) <- col_isspdocs
knitr::kable(ISSPdocsT.tbl, booktab = TRUE,
caption = ' ISSP 2012: tärkeimmät dokumentit')
# Muuttuja taulukkona - karkea tapa
# HUOM! Taulkot ovat hankalia, kun tulostus halutaan pdf- ja html- formaattiin
# Kysymyste pitkät versiot on siksi esitetty suomenkielisen lomakkeen kuvana.
tabVarnames <- c(substvars1,bgvars1) # muuttujanimet muuttujille
# Kysymysten lyhyet versiot englanniksi
tabVarDesc <- c("Q1a Working mother can have warm relation with child ",
"Q1b Pre-school child suffers through working mother",
"Q1c Family life suffers through working mother",
"Q1d Women’s preference: home and children",
"Q1e Being housewife is satisfying",
"Q2a Both should contribute to household income",
"Q2b Men’s job is earn money, women’s job household",
"Q3a Should women work: Child under school age",
"Q3b Should women work: Youngest kid at school",
"Respondents age ",
"Respondents gender",
"Highest completed degree of education: Categories for international comparison",
"Main status: work, unemployed, in education...",
"Top-Bottom self-placement (10 pt scale)",
"How many children in household: children between [school age] and 17 years of age",
"Legal partnership status: married, civil partership...",
"Place of living: urban - rural"
)
#tabVarDesc
# Taulukko
# luodaan df - varoitus: data_frame() is deprecated, use tibble” (4.2.20),
# vaihdetaan tibbleen (21.2.20)
# jhVarTable1.df <- data_frame(tabVarnames,tabVarDesc) OLD
jhVarTable1.tbl <- tibble(tabVarnames,tabVarDesc)
cols_jhVarTable1 <- c("muuttuja","kysymyksen tunnus, lyhennetty kysymys")
colnames(jhVarTable1.tbl) <- cols_jhVarTable1
#str(jhVarTable1.tbl)
# Lyhyet kysymykset englanniksi
knitr::kable(jhVarTable1.tbl, booktab = TRUE,
caption = "ISSP2012:Työelämä ja perhearvot - kysymykset")
knitr::include_graphics('img/substvar_fi_Q1Q2.png')
# UUSI DATA 30.1.20
#
# LUETAAN DATA G1_1_data2.Rmd - tiedostossa, luodaan faktorimuuttujat
# G1_1_data_fct1.Rmd-tiedostossa -> ISSP2012jh1d.dat (df)
# 23 muuttujaa (9 substanssimuuttujaa, 8 taustamuuttujaa, 3 maa-muuttujaa, 3 metadatamuuttujaa)
# 25 maata.
# Poistettu 146 havaintoa, joilla SEX tai AGE puuttuu
# Johdattelevassa esimerkissä kuusi maata, kaksi taustamuuttujaa ja yksi kysymys
# (V6/Q1b)
# Kuusi maata
countries_esim1 <- c(56, 100, 208, 246, 276, 348) #BE,BG,DK,FI,DE,HU
ISSP2012esim3.dat <- filter(ISSP2012jh1d.dat, V4 %in% countries_esim1)
# str(ISSP2012esim3.dat) - pitkä listaus pois (24.2.20)
#neljä maamuuttujaa, kysymys Q1b, ikä ja sukupuoli
vars_esim1 <- c("C_ALPHAN", "V3", "maa","maa3", "Q1b", "sp", "ika")
ISSP2012esim2.dat <- select(ISSP2012esim3.dat, all_of(vars_esim1))
str(ISSP2012esim2.dat) # 8542 obs. of 7 variables, ja sama 8.6.2020
# C_ALPHAN: chr, maa: Factor w/ 25
# Poistetaan havainnot, joilla Q1b - muuttujassa puuttuva tieto 'NA'
# sum(is.na(ISSP2012esim2.dat$Q1b)) = 399
ISSP2012esim1.dat <- filter(ISSP2012esim2.dat, !is.na(Q1b))
#str(ISSP2012esim1.dat) # 8143 obs. of 6 variable
# Tarkistuksia (3.2.20)
#
#fct_count(ISSP2012esim1.dat$sp)
#fct_count(ISSP2012esim1.dat$Q1b)
#fct_count(ISSP2012esim1.dat$maa)
#fct_count(ISSP2012esim1.dat$maa3)
#
#summary(ISSP2012esim1.dat$sp)
#sp: 3799 + 4344 = 8143
#summary(ISSP2012esim1.dat$Q1b)
# S s ? e E
# 810 + 1935 + 1367 + 2125 + 1906 = 8143
#
# EDELLINEN DATA - havaintojen määrät samat kuin uudella datalla (31.1.20)
#
# 8557 obs. ennen kuin sexagemissing poistettiin, nyt 8542, 8557-8542 = 15
#
# Poistetaan havainnot joissa puuttuva tieto muuttujassa V6 (Q1b) n = 399
# 8542-399 = 8143
# Tyhjät "faktorilabelit" on poistettava
ISSP2012esim1.dat <- ISSP2012esim1.dat %>%
mutate(maa = fct_drop(maa),
maa3 = fct_drop(maa3)
)
#summary(ISSP2012esim1.dat$maa)
#summary(ISSP2012esim1.dat$maa3)
#
# str(ISSP2012esim1.dat$maa)
# attributes(ISSP2012esim1.dat$maa)
#
# str(ISSP2012esim1.dat$maa3)
# attributes(ISSP2012esim1.dat$maa3)
#
#ISSP2012esim1.dat %>% tableX(maa, Q1b, type = "count")
#fct_count(ISSP2012esim1.dat$Q1b)
# fct_count(ISSP2012esim1.dat$sp)
# fct_unique(ISSP2012esim1.dat$maa)
# fct_count(ISSP2012esim1.dat$maa)
#ISSP2012esim1.dat %>% tableX(maa, C_ALPHAN, type = "count")
#
# maa3 - siistitään "faktorilabelit" kaksikirjaimisiksi
#
# ISO 3166 Code V3 - maiden jaot
# 5601 BE-FLA-Belgium/ Flanders
# 5602 BE-WAL-Belgium/ Wallonia
# 5603 BE-BRU-Belgium/ Brussels
# 27601 DE-W-Germany-West
# 27602 DE-E-Germany-East
# Tähän pitäisi päästä
# levels = c("100","208","246","348","5601","5602","5603","27601","27602"),
# labels = c("BG","DK","FI","HU","bF","bW","bB","dW","dE"))
# levels(ISSP2012esim1.dat$maa3)
ISSP2012esim1.dat <- ISSP2012esim1.dat %>%
mutate(maa3 =
fct_recode(maa3,
"BG" = "BG-Bulgaria",
"DK" = "DK-Denmark",
"FI" = "FI-Finland",
"HU" = "HU-Hungary",
"bF" = "BE-FLA-Belgium/ Flanders",
"bW" = "BE-WAL-Belgium/ Wallonia",
"bB" = "BE-BRU-Belgium/ Brussels",
"dW" = "DE-W-Germany-West",
"dE" = "DE-E-Germany-East")
)
# tarkistuksia
#levels(ISSP2012esim1.dat$maa3)
# str(ISSP2012esim1.dat$maa3) # 9 levels
#summary(ISSP2012esim1.dat$maa3)
#
# TÄSSÄ TOISTOA! (4.2.20)
# Muutetaan muuttujien "maa" ja "maa3" arvojen (levels) järjestys samaksi kuin
# alkuperäisen muuttujan C_ALPHAN. Helpomi verrata aikaisempiin tuloksiin.
# "alkuperäinen" maa talteen
ISSP2012esim1.dat$maa2 <- ISSP2012esim1.dat$maa
ISSP2012esim1.dat <- ISSP2012esim1.dat %>%
mutate(maa =
fct_relevel(maa,
"BE",
"BG",
"DE",
"DK",
"FI",
"HU"))
ISSP2012esim1.dat <- ISSP2012esim1.dat %>%
mutate(maa3 =
fct_relevel(maa3,
"bF",
"bW",
"bB",
"BG",
"dW",
"dE",
"DK",
"FI",
"HU"))
# Tarkistus
#ISSP2012esim1.dat %>% tableX(maa2,maa, type = "count")
# "alkuperäinen" maa talteenISSP2012esim1.dat %>% tableX(maa,C_ALPHAN, type = "count")
# "alkuperäinen" maa talteenstr(ISSP2012esim1.dat)
# Taulukoita (31.1.2020) ja tarkistuksia
#
# toinen maa-muuttuja, jossa Saksan ja Belgian jako
# V3
# 5601 BE-FLA-Belgium/ Flanders
# 5602 BE-WAL-Belgium/ Wallonia
# 5603 BE-BRU-Belgium/ Brussels
# 27601 DE-W-Germany-West
# 27602 DE-E-Germany-East
# Tarkastuksia
# assert_that ehkä tarpeeton - expect_equivalet testaa levelien
# järjestyksen ja määrän (20.2.20)
validate_that(length(levels(ISSP2012esim1.dat$sp)) == 2)
validate_that(are_equal(levels(ISSP2012esim1.dat$sp),
c("m", "f")))
validate_that(length(levels(ISSP2012esim1.dat$maa)) == 6)
validate_that(are_equal(levels(ISSP2012esim1.dat$maa),
c("BE", "BG", "DE", "DK", "FI", "HU")))
validate_that(length(levels(ISSP2012esim1.dat$maa3)) == 9)
validate_that(are_equal(levels(ISSP2012esim1.dat$maa3),
c("bF","bW","bB", "BG","dW","dE","DK", "FI", "HU")))
validate_that(length(levels(ISSP2012esim1.dat$Q1b)) == 5)
validate_that(are_equal(levels(ISSP2012esim1.dat$Q1b),
c("S", "s", "?", "e", "E")))
# testthat - paketti - pois käytöstä 16.9.20
# expect_ ei anna ok-ilmoitusta, ainoastaan virheilmoituksen? (11.4.20)
# expect_equivalent(levels(ISSP2012esim1.dat$maa),
# c("BE", "BG", "DE", "DK", "FI", "HU"))
# expect_equivalent(levels(ISSP2012esim1.dat$maa3),
# c("bF","bW","bB", "BG","dW","dE","DK", "FI", "HU"))
# expect_equivalent(levels(ISSP2012esim1.dat$sp), c("m", "f"))
# expect_equivalent(levels(ISSP2012esim1.dat$Q1b),
# c("S", "s", "?", "e", "E"))
#
# ISSP2012esim1.dat %>% tableX(maa,ika,type = "row_perc")
#
# Riviprofiilit
#
# ISSP2012esim1.dat %>% tableX(maa,ika,type = "row_perc")
# ISSP2012esim1.dat %>% tableX(maa,sp ,type = "row_perc")
#
#
# Kysymyksen Q1b vastaukset
#
#ISSP2012esim1.dat %>% tableX(maa,Q1b,type = "row_perc")
#
#ISSP2012esim1.dat %>% tableX(maa3,Q1b,type = "row_perc")
#
# str(ISSP2012esim1.dat) # 8143 obs. of 7 variable,
# sama kuin vanhassa Galku-koodissa.
#
# str(ISSP2012esim1.dat) # 8143 obs. of 7 variable,
# sama kuin vanhassa Galku-koodissa.
taulu2 <- ISSP2012esim1.dat %>% tableX(maa, Q1b, type = "cell_perc")
knitr::kable(taulu2,digits = 2, booktabs = TRUE,
caption = "Kysymyksen Q1b vastaukset, suhteelliset frekvenssit")
taulu3 <- ISSP2012esim1.dat %>% tableX(maa,Q1b,type = "row_perc")
knitr::kable(taulu3,digits = 2, booktabs = TRUE,
caption = "Kysymyksen Q1b vastaukset, riviprosentit")
taulu4 <- ISSP2012esim1.dat %>% tableX(maa,Q1b,type = "col_perc")
knitr::kable(taulu4,digits = 2, booktabs = TRUE,
caption = "Kysymyksen Q1b vastaukset, sarakeprosentit")
# CA tässä, jotta saadaan rivi- ja sarakeprofiilikuvat
# Lasketaan samalla CA-ratkaisu riviprofiilitaulkolle (maille samat painot)
simpleCA1 <- ca(~maa + Q1b,ISSP2012esim1.dat)
# Maiden järjestys kääntää kuvan (1.2.20) - esimerkki on
# vähän kuriositeetti. Kartta voi tietysti "flipata" koordintaattien suhteen ainakin
# neljällä tavalla (? 180 astetta molempien akseleiden ympäri molempiin suuntiin?)
# (18.2.20). Tämän maa2-muuttujaa käyttävän kuvan voi jättää pois (8.4.20)
# simpleCA2 <- ca(~maa2 + Q1b,ISSP2012esim1.dat)
# Oikeastaan maiden vertailussa pitäisi niiden massat skaalata yhtä suuriksi, tässä
# pikainen kokeilu (20.2.20)
# Riviprosentit taulukoksi, nimet sarakkeille ja riveille (ei kovin robustia...)
johdesim1_rowproc.tab <- simpleCA1$N / rowSums(simpleCA1$N)
colnames(johdesim1_rowproc.tab) <- c("S" ,"s" ,"?","e", "E")
rownames(johdesim1_rowproc.tab) <- c("BE", "BG", "DE", "DK", "FI", "HU")
# Miten tibblenä? Ei toimi, ei maa-muuttujaa ollenkaan
# johdesim1_rowproc.tbl <- as_tibble(johdesim1_rowproc.tab)
# str(johdesim1_rowproc.tbl)
# TARKISTUKSIA (20.2.20)
# johdesim1_rowproc.tab
# rowSums(johdesim1_rowproc.tab)
# str(johdesim1_rowproc.tab)
simpleCA3 <- ca(johdesim1_rowproc.tab)
# Kartta piirretään koodilohkossa simpleCAmap1, r. 773 noin.
# Riviprosentit tarkistusta varten
# S s ? e E
#BE 9.49 22.40 21.76 27.42 18.93
#BG 12.81 42.89 22.26 20.63 1.41
#DE 9.63 21.88 11.55 31.39 25.55
#DK 5.04 17.15 10.95 16.71 50.14
#FI 4.23 16.94 13.42 38.11 27.30
#HU 21.97 28.89 22.57 19.06 7.52
#
# Ja datan saa leikepöydän kautta, jos on tarve pikatarkistuksiin
# read <- read.table("clipboard")
#mutkikas kuvan piirto - sarakeprofiilit vertailussa
#ggplot vaatii df-rakenteen ja 'long data' - muotoon
##https://stackoverflow.com/questions/9563368/create-stacked-barplot
# -where-each-stack-is-scaled-to-sum-to
# Pitkä https-linkki kahdella rivillä
#
# käytetään ca - tuloksia
apu1 <- (simpleCA1$N)
colnames(apu1) <- c("S", "s", "?", "e", "E")
rownames(apu1) <- c("BE", "BG", "DE", "DK", "FI", "HU")
apu1_df <- as.data.frame(apu1)
#lasketan rivien reunajakauma
apu1_df$ka_sarake <- rowSums(apu1_df)
#muokataan 'long data' - muotoon
apu1b_df <- melt(cbind(apu1_df, ind = rownames(apu1_df)), id.vars = c('ind'))
p <- ggplot(apu1b_df, aes(x = variable, y = value, fill = ind)) +
geom_bar(position = "fill", stat = "identity") +
scale_y_continuous(name = " ",labels = percent_format())
p <- p + labs(fill = "maa")
p + scale_x_discrete(name = "Q1b - vastauskategoriat")
# apu1_df
# apu1b_df
# riviprofiilit ja keskiarvorivi - 18.9.2018
apu2_df <- as.data.frame(apu1)
apu2_df <- rbind(apu2_df, ka_rivi = colSums(apu2_df))
#apu2_df
#str(apu2_df)
## typeof(apu2_df) # what is it?
## class(apu2_df) # what is it? (sorry)
## storage.mode(apu2_df) # what is it? (very sorry)
## length(apu2_df) # how long is it? What about two dimensional
## objects?
# attributes(apu2_df)
# temp1 <- cbind(apu2_df, ind = rownames(apu2_df))
# temp1
##muokataan 'long data' - muotoon
apu2b_df <- melt(cbind(apu2_df, ind = rownames(apu2_df)), id.vars = c('ind'))
# str(apu2b_df)
# glimpse(apu2b_df)
#
#ggplot(apu2b_df, aes(x = value, y = ind, fill = variable)) +
# geom_bar(position = "fill", stat ="identity") +
# #coord_flip() +
# scale_x_continuous(labels = percent_format())
#versio2 toimii (18.9.2018)
p <- ggplot(apu2b_df, aes(x = ind, y = value, fill = variable)) +
geom_bar(position = "fill", stat = "identity") +
coord_flip() +
scale_y_continuous(name = " ",labels = percent_format())
p <- p + labs(fill = "Q1b")
p + scale_x_discrete(name = " ")
# simpleCA1 luotu aikaisemmin profiilikuvia varten koodilohkossa EkaCA
# HUOM! xlab ja ylab, prosenttiosuudet ensin katsottu ja sitten kirjoitettu
# tässä. Vertaa scree-plot - tietoon!
#par(cex = 1)
plot(simpleCA1, map = "symmetric", mass = c(TRUE,TRUE),
xlab = "Dimensio 1: moderni/liberaali - perinteinen/konservatiivinen (76%)",
ylab = "Dimensio 2: maltillinen/epävarma - radikaali/jyrkkä/varma (15.1%)",
main = "symmetrinen kartta 1",
sub = "Maiden massat eri suuruisia (otoskoko), pisteiden koko suhteessa massaan")
# jatkossa plot - main on kuvan tyyppi (symmetrinen, kontribuutio jne),
# koodilohkon fig.cap "ylimmän tason" otsikko.
# Akseleiden tekstit (Dimensio 1....jne) asetettu käsin, ikävä kyllä myös
# selitetyn inertian osuus. CA-kartoissa tämä on niin oleellinen asia,
# että akselien nimet voi muutttaa vasta esitysgrafiikassa, ei data-analyysissä.
# Dim1 ja Dim2 kuuluvat kuviin.
# par(cex = 1) - asetus ennen plot-komenota muuttaa valitettavasti "kaiken" kokoa.
# Antaa olla, kun on graafista data-analyysiä. Selkeys tärkeämpää kuin ulkoasu.
# asymmetrinen kartta - rivit pc ja sarakkeet sc
# sarakkeet vektorikuvina
# par(cex = 0.7)
plot(simpleCA1, map = "rowprincipal",
arrows = c(FALSE,TRUE),
main = "asymmetrinen kartta 1"
)
knitr::include_graphics('img/simpleCAasymmTulk2.png')
#par(cex = 0.6)
plot(simpleCA1, map = "rowgreen",
contrib = c("absolute", "absolute"),
mass = c(TRUE,TRUE),
arrows = c(FALSE, TRUE),
main = "kontribuutiokartta 1 - pisteen koko suhteessa massaan",
sub = "sarakevektorin ja rivipisteiden värin tummuus = absoluuttinen kontribuutio")
#par(cex = 0.7)
plot(simpleCA1, map = "rowgreen",
contrib = c("relative", "relative"),
mass = c(TRUE,TRUE),
arrows = c(FALSE, TRUE),
main = "kontribuutiokartta 2 - pisteen koko suhteessa massaan",
sub = "sarakevektorin ja pisteen värin tummuus = suhteellinen kontribuutio")
# Sama kartta - maiden massat vakiotu - simpleCA3 luotu koodilohkossa EkaCA
# CA:n lähtötietona riviprofiilit
#par(cex = 0.8)
plot(simpleCA3, map = "symmetric", mass = c(TRUE,TRUE),
main = "symmetrinen kartta 2 ",
sub = "Maidet massat vakioitu (riviprofiilidata)")
plot(simpleCA3, map = "rowgreen",
contrib = c("absolute", "absolute"),
mass = c(TRUE,TRUE),
arrows = c(FALSE, TRUE),
main = "kontribuutiokartta 3",
sub = "sarakevektorin ja rivipisteiden värin tummuus = absoluuttinen kontribuutio, riviprofiilidata")
# riviprofiilitaulukko aiheuttaa virheen PDF-tulostuksessa, JH_capaper.Rmd
# tiedoston voi kuitenkin renderöidä knit-napilla RStudiossa pdf-tiedostoksi.
BeDealueTable <- ISSP2012esim1.dat %>% tableX(maa3, Q1b, type = "row_perc")
knitr::kable(BeDealueTable , digits = 2, booktabs = TRUE,
caption = "Q1b vastaukset, Saksan ja Belgian alueet")
# Belgian ja Saksan aluejako maa3-muuttujassa
# str(ISSP2012esim1.dat$maa3)
# attributes(ISSP2012esim1.dat$maa3)
suppoint1_df1 <- select(ISSP2012esim1.dat, maa3,Q1b)
# Taulukoksi jotta saadaan lisättyä Saksan ja Belgian maa-profiilit täydentäviksi
# pisteiksi.
suppoint1_tab1 <- table(suppoint1_df1$maa3, suppoint1_df1$Q1b)
# tarkistus 1
# suppoint1_tab1
# Maaprofiilit lisäpisteiksi
suppoint2_df <- filter(ISSP2012esim1.dat, (maa == "BE" | maa == "DE"))
suppoint2_df <- select(suppoint2_df, maa, Q1b)
# Poistetaan maa-faktroin tyhjät luokat (14.11.2020)
suppoint2_df <- suppoint2_df %>%
mutate(maa = fct_drop(maa)
)
#glimpse(suppoint2_df)
suppoint2_tab1 <- table(suppoint2_df$maa, suppoint2_df$Q1b)
# tarkistus 1
# suppoint2_tab1
# lisätään rivit maa3-muuttujan taulukkoon
suppoint1_tab1 <- rbind(suppoint1_tab1, suppoint2_tab1)
# suppoint1_tab1
# suppoint1_tab2 <- read_rds("suppoint1tab1.rds") - testaus joka siirsi virheen 07-rmd-tiedostoon. Sama virheilmoitustyyppi.
suppointCA2 <- ca(suppoint1_tab1[,1:5], suprow = 10:11)
# Sama kartta ilman täydentäviä pisteitä
suppointCA2b <- ca(suppoint1_tab1[1:9,1:5])
# par(cex = 0.6)
plot(suppointCA2, main = "Symmetrinen kartta 1 ",
# mass = c(TRUE, TRUE),
# contrib = c(TRUE, FALSE),
sub = "Täydentävät pisteet DE ja BE" )
plot(suppointCA2b, main = "kontribuutiokartta 1 - absoluuttiset kontribuutiot",
map = "rowgreen",
arrows = c(FALSE, TRUE),
mass = c(TRUE, TRUE),
contrib = c("absolute","absolute"),
sub = "Massat: pisteiden ja symbolien koko " )
print(suppointCA2)
summary(suppointCA2)
suppointCA3 <- ca(~maa3 + Q1b,ISSP2012esim1.dat, nd = 3)
# summary(suppointCA3)
# Error in rsc %*% diag(sv) : non-conformable arguments
# outo juttu, ei toimi! - TÄMÄ POISTETAAN
plot(suppointCA3, dim = c(1,2),
main = "Kolmen dimension ratkaisu",
sub = "symmetrinen kartta - 1. ja 2. dimensio")
plot(suppointCA3, dim = c(1,3),
main = "Kolmen dimension ratkaisu 1",
sub = "symmetrinen kartta - 1. ja 3. dimensio")
plot(suppointCA3, dim = c(2,3),
main = "Kolmen dimension ratkaisu 2",
sub = "symmetrinen kartta - 2. ja 3. dimensio")
knitr::include_graphics('img/3dSymMap_1.PNG')
knitr::include_graphics('img/3dSymMap_2.PNG')
# Iän ja sukupuolen vuorovaikutusmuuttujia
#
# Uusi R-data: ISSP2012esim1b.dat2esim1b)
#
# Ikäluokat age_cat
# AGE 1=15-25, 2 =26-35, 3=36-45, 4=46-55, 5=56-65, 6= 66 and older
#
# summary(ISSP2012esim1.dat$AGE)
# hist(ISSP2012esim1.dat$ika)
ISSP2012esim1b.dat <- mutate(ISSP2012esim1.dat,
age_cat = ifelse(ika %in% 15:25, "1",
ifelse(ika %in% 26:35, "2",
ifelse(ika %in% 36:45, "3",
ifelse(ika %in% 46:55, "4",
ifelse(ika %in% 56:65, "5", "6"))))))
ISSP2012esim1b.dat <- ISSP2012esim1b.dat %>%
mutate(age_cat = as_factor(age_cat)) # järjestys omituinen!(4.2.20)
# Tarkistuksia
# str(ISSP2012esim2.dat$age_cat)
# levels(ISSP2012esim2.dat$age_cat)
# ISSP2012esim2.dat$age_cat %>% summary()
# Järjestetään ikäluokat uudelleen
ISSP2012esim1b.dat <- ISSP2012esim1b.dat %>%
mutate(age_cat =
fct_relevel(age_cat,
"1",
"2",
"3",
"4",
"5",
"6")
)
# Tarkistuksia
# Iso taulukko, voi tarkistaa että muunnos ok.
# test6 %>% tableX(AGE, age_cat, type = "count")
# taulu42 <- ISSP2012esim2.dat %>% tableX(maa,age_cat,type = "count")
# kable(taulu42,digits = 2, caption = "Ikäluokka age_cat")
#
# Taulukoita (4.2.20)
#ISSP2012esim1b.dat %>%
# tableX(maa,age_cat,type = "count") %>%
# kable(digits = 2, caption = "Ikäluokka age_cat")
#
#ISSP2012esim1b.dat %>%
# tableX(maa,age_cat,type = "row_perc") %>%
# kable(digits = 2, caption = "age_cat: suhteelliset frekvenssit")
# ga - ikäluokka ja sukupuoli
ISSP2012esim1b.dat <- mutate(ISSP2012esim1b.dat,
ga = case_when((age_cat == "1")&(sp == "m") ~ "m1",
(age_cat == "2")&(sp == "m") ~ "m2",
(age_cat == "3")&(sp == "m") ~ "m3",
(age_cat == "4")&(sp == "m") ~ "m4",
(age_cat == "5")&(sp == "m") ~ "m5",
(age_cat == "6")&(sp == "m") ~ "m6",
(age_cat == "1")&(sp == "f") ~ "f1",
(age_cat == "2")&(sp == "f") ~ "f2",
(age_cat == "3")&(sp == "f") ~ "f3",
(age_cat == "4")&(sp == "f") ~ "f4",
(age_cat == "4")&(sp == "f") ~ "f4",
(age_cat == "5")&(sp == "f") ~ "f5",
(age_cat == "6")&(sp == "f") ~ "f6",
TRUE ~ "missing"
))
#ISSP2012esim1.dat %>% tableX(ga,ga2) # tarkistus
# muuttujien tarkistuksia 19.9.2018
# str(ISSP2012esim1b.dat$ga) # chr-muuttuja, mutta toimii (4.2.20)
#Tulostetaan taulukkoina ga - muuttuja
#ISSP2012esim1b.dat %>% tableX(maa,ga,type = "count") %>%
#kable(digits = 2, caption = "Ikäluokka ja sukupuoli ga")
#ISSP2012esim1b.dat %>% tableX(maa,ga,type = "row_perc") %>%
#kable(digits = 2, caption = "ga: suhteelliset frekvenssit")
gaTestCA1 <- ca(~ga + Q1b,ISSP2012esim1b.dat)
# Maapisteiden pääkoordinaatit janojen piirtämiseen
gaTestCA1.rpc <- gaTestCA1$rowcoord %*% diag(gaTestCA1$sv)
# par(cex = 0.6)
plot(gaTestCA1, main = "symmetrinen kartta, m = mies, f = nainen",
sub = "1=15-25, 2 =26-35, 3=36-45, 4=46-55, 5=56-65, 6= 66 tai vanhempi ")
# naiset
lines(gaTestCA1.rpc[1:6,1],gaTestCA1.rpc[1:6,2])
#miehet
lines(gaTestCA1.rpc[7:12,1],gaTestCA1.rpc[7:12,2], col = "red")
summary(gaTestCA1)
ISSP2012esim1b.dat <- mutate(ISSP2012esim1b.dat,
maaga = paste(maa, ga, sep = ""))
# tarkistus, muunnos ok
# ISSP2012esim1b.dat %>% tableX(maa, maaga)
# head(ISSP2012esim2.dat)
# str(ISSP2012esim2.dat)
maagaCA1 <- ca(~maaga + Q1b,ISSP2012esim1b.dat)
par(cex = 0.5)
plot(maagaCA1, main = "symmetrinen kartta 1" )
# print(maagaCA1)
summary(maagaCA1)
# Osajoukon CA: Tanska, Saksa ja Suomi
maagaCA2sub2 <- ca(~maaga + Q1b,ISSP2012esim1b.dat,subsetrow = 25:60)
par(cex = 0.8)
plot(maagaCA2sub2, main = "Q1b: Lapsi kärsii jos äiti käy töissä",
sub = "symmetrinen kartta - osajoukko Tanska, Saksa ja Suomi)"
)
par(cex = 0.6)
plot(maagaCA2sub2, map = "rowgreen",
mass = c(TRUE, TRUE),
contrib =c("relative", "absolute"),
arrows = c(FALSE, TRUE),
main = "Kontribuutiokartta: sarakkeiden(abs.) ja rivien(rel.) värisävy",
sub = "massat = pisteiden koko"
)
# ca-tulosobjekti maagaCA2sub2, DK DE FI
maagaLinesDKDEFI <- cacoord(maagaCA2sub2, type = "symmetric")
maagaLinesDKDEFI <- maagaLinesDKDEFI$rows[ , 1:2]
# maagaLinesDKDEFI # tarkistus
par(cex = 0.6)
plot(maagaCA2sub2,
sub = "symmetrinen kartta - Tanska, Saksa ja Suomi (subset ca)")
lines(maagaLinesDKDEFI[1:6,1],maagaLinesDKDEFI[1:6,2], col="blue") #DEf
lines(maagaLinesDKDEFI[7:12,1],maagaLinesDKDEFI[7:12,2], col="red") #DEm
lines(maagaLinesDKDEFI[13:18,1],maagaLinesDKDEFI[13:18,2], col="blue") #DKf
lines(maagaLinesDKDEFI[19:24,1],maagaLinesDKDEFI[19:24,2], col="red") #DKm
lines(maagaLinesDKDEFI[25:30,1],maagaLinesDKDEFI[25:30,2], col="blue") #FIf
lines(maagaLinesDKDEFI[31:36,1],maagaLinesDKDEFI[31:36,2], col="red") #FIm
# Tarkastetaan numeeriset tulokset
summary(maagaCA2sub2)
# Jos suhteeelinen inertia kaikilla rivelillä sama
# 1000/36 = 28
# Belgia, Bulgaria ja Unkari analysoidaan tiiviisti
# Belgia on vähän välitapaus Bulgarian ja Unkarin ja kolmen ensimmäisen maan
# kanssa. Kokeiluja voi tehdä neljällä maaryhmällä, kuvan lukukelpoisuus
# ratkaisee.
#BGHUsubset <- c(13:24,61:72)
#BEDEDKFIsubset <- c(1:12, 25:36, 37:48, 49:60)
#DEDKFIsubset <- c(25:36, 37:48, 49:60)
BEBGHUsubset <- c(1:12,13:24,61:72)
maagaCA2sub3 <- ca(~maaga + Q1b,ISSP2012esim1b.dat,subsetrow = BEBGHUsubset)
par(cex = 0.6)
plot(maagaCA2sub3,
mass = c(TRUE, TRUE),
contrib =c("relative", "absolute"),
arrows = c(FALSE, FALSE),
main = "symmetrinen kartta: sarakkeiden ja rivien suhteelliset kontribuutiot värisävynä ",
sub = "massat = pisteiden koko"
)
par(cex = 0.6)
plot(maagaCA2sub3, map = "rowgreen",
mass = c(TRUE, TRUE),
contrib =c("relative", "absolute"),
arrows = c(FALSE, TRUE),
main = "Kontribuutiokartta: sarakkeiden(abs.) ja rivien(abs.) värisävy",
sub = "massat = pisteiden koko"
)
# Vilkaistaa numeerisia tuloksia, kopioidaan tekstiin jos on tarpeen
# maagaCA2sub3
summary(maagaCA2sub3)
# kahden osaratkaisun kokonaisinertia
# 0.143551 + 0.119602 = 0.263153
# koko datalla 0.263154
knitr::include_graphics('img/stacked1.png')
# Data
ISSP2012Concat1jh.dat <- select(ISSP2012esim1b.dat, Q1b, maa,sp, age_cat)
# mjca-funktiota -> Burt-matriisi
Concat1jh.Burt <- mjca(ISSP2012Concat1jh.dat, ps="")$Burt
# Burt-matriisi symmetrinen
#dim(Concat1jh.Burt)
# 19 x 19
#rownames(Concat1jh.Burt)
#[1] "Q1bS" "Q1bs" "Q1b?" "Q1be" "Q1bE" "maaBE" "maaBG" "maaDE" "maaDK"
#[10] "maaFI" "maaHU" "spm" "spf" "age_cat1" "age_cat2" "age_cat3" "age_cat4" "age_cat5"
#[19] "age_cat6"
# maat - vastaukset
ISSP2012Concat2jh.dat <- Concat1jh.Burt[6:11, 1:5]
# ISSP2012Concat2jh.dat
# sukupuoli ja vastaukset
ISSP2012Concat2jh.dat <- rbind(ISSP2012Concat2jh.dat, Concat1jh.Burt[12:13 ,1:5])
# ISSP2012Concat2jh.dat
# ikäluokka ja vastaukset
ISSP2012Concat2jh.dat <- rbind(ISSP2012Concat2jh.dat, Concat1jh.Burt[14:19 ,1:5])
# ISSP2012Concat2jh.dat
Concat1jh.CA1 <- ca(ISSP2012Concat2jh.dat)
# Käännetään kuva x-akselin ympäri
Concat1jh.CA1$rowcoord[, 2] <- -Concat1jh.CA1$rowcoord[, 2]
Concat1jh.CA1$colcoord[, 2] <- -Concat1jh.CA1$colcoord[, 2]
# Siistitään muuttujien nimet
Concat1jh.CA1$colnames <- c("S", "s", "?", "e", "E")
Concat1jh.CA1$rownames <- c("BE", "BG", "DE", "DK", "FI", "HU", "m", "f",
"a1", "a2", "a3", "a4", "a5", "a6")
# pisteiden kasautumien haittaa haittaa tulkintaa
par(cex = 0.6)
plot(Concat1jh.CA1,
main = "Pinottu taulukko - symmetrinen kartta",
sub = "ikäluokat a1-a6, m = miehet, f = naiset"
)
summary(Concat1jh.CA1)
# 14 riviä, inertiakontribuution keskiarvo
# 1000/14 = 71
par(cex = 0.6)
plot(Concat1jh.CA1, map = "rowgreen",
#mass = c(TRUE, TRUE) ei oikein erotu kuvassa
contrib =c("relative", "absolute"),
arrows = c(FALSE, TRUE),
main = "Pinottu taulukko, kontribuutiokartta (sarakkeet absoluutinen, rivit suhteellinen)",
sub = "taustamuuttujat a1-a6 ikäluokat, m = miehet, f = naiset"
)
# Tätä dataa ei käytetä - pelkät kysymykset
# str(ISSP2012jh1d.dat) - luotu skripteissä G1_1_data2.Rmd ja G1_1_data_fct1.Rmd
# Tarkistukset näkyvät Galkussa - tässä ei tulosteta
# Kommentoidaan pois tarkistuksia (14.11.2020)
#Valitaan muuttujat joissa puuttuva tieto on koodattu muuttujan arvoksi
MCAvars1 <- c("Q1am","Q1bm", "Q1cm", "Q1dm","Q1em","Q2am","Q2bm","edum",
"sostam", "urbrum", "maa", "ika", "sp" )
MCAdata1jh.dat <- ISSP2012jh1d.dat %>% select(all_of(MCAvars1))
#dim(MCAdata1jh.dat)
# names(MCAdata1jh.dat)
# luodaan ikaluokka-muuttuja ja ikäluokka-sukupuoli - muuttuja
#age_cat
#ikä 1=15-25, 2 =26-35, 3=36-45, 4=46-55, 5=56-65, 6= 66 and older
MCAdata1jh.dat <- mutate(MCAdata1jh.dat, age_cat = ifelse(ika %in% 15:25, "1",
ifelse(ika %in% 26:35, "2",
ifelse(ika %in% 36:45, "3",
ifelse(ika %in% 46:55, "4",
ifelse(ika %in% 56:65, "5", "6"))))))
# str(MCAdata1jh.dat$age_cat)
MCAdata1jh.dat <- MCAdata1jh.dat %>%
mutate(age_cat = as_factor(age_cat))
#tarkastuksia - outo järjestys
#levels(MCAdata1jh.dat$age_cat)
# str(MCAdata1jh.dat$age_cat)
MCAdata1jh.dat<- MCAdata1jh.dat %>%
mutate(age_cat = fct_relevel(age_cat,
"1",
"2",
"3",
"4",
"5",
"6"))
# Tarkistuksia(16.10.20)
#MCAdata1jh.dat %>%
# tableX(maa,age_cat,type = "count") #%>%
# #kable(digits = 2, caption = "Ikäluokka age_cat")
#MCAdata1jh.dat %>%
# tableX(maa,age_cat,type = "row_perc") #%>%
# #kable(digits = 2, caption = "age_cat: suhteelliset frekvenssit")
# Ikäluokka-sukupuoli - muuttuja
MCAdata1jh.dat <- mutate(MCAdata1jh.dat,
ga = case_when((age_cat == "1")&(sp == "m") ~ "m1",
(age_cat == "2")&(sp == "m") ~ "m2",
(age_cat == "3")&(sp == "m") ~ "m3",
(age_cat == "4")&(sp == "m") ~ "m4",
(age_cat == "5")&(sp == "m") ~ "m5",
(age_cat == "6")&(sp == "m") ~ "m6",
(age_cat == "1")&(sp == "f") ~ "f1",
(age_cat == "2")&(sp == "f") ~ "f2",
(age_cat == "3")&(sp == "f") ~ "f3",
(age_cat == "4")&(sp == "f") ~ "f4",
(age_cat == "4")&(sp == "f") ~ "f4",
(age_cat == "5")&(sp == "f") ~ "f5",
(age_cat == "6")&(sp == "f") ~ "f6",
TRUE ~ "missing"
))
#Sosiaalinen status: oma arvio "Top-Bottom self-placement"
#str(ISSP2012jh1d.dat$sosta)
#str(ISSP2012jh1d.dat$urbru)
#str(ISSP2012jh1d.dat$edu)
#Koulutustaso
#str(ISSP2012jh1d.dat$edu)
#Asuipaikka
#str(ISSP2012jh1d.dat$urbru)
# Muunnetaan faktorimuuttujia, mahdollisimman lyhyet tunnisteet kategorioille
MCAdata1jh.dat <- MCAdata1jh.dat %>%
mutate(E = fct_recode(edum,
"1" = "No formal education",
"2" = "Primary school (elementary school)",
"3" = "Lower secondary (secondary completed does not allow entry to university: obligatory school)",
"4" = "Upper secondary (programs that allows entry to university",
"5" = "Post secondary, non-tertiary (other upper secondary programs toward labour market or technical formation)",
"6" = "Lower level tertiary, first stage (also technical schools at a tertiary level)",
"7" = "Upper level tertiary (Master, Dr.)",
"P" = "missing"),
S = fct_recode(sostam,
"1" = "Lowest, Bottom, 01",
"2" = "02",
"3" = "03",
"4" = "04",
"5" = "05",
"6" = "06",
"7" = "07",
"8" = "08",
"9" = "09",
"10"= "Highest, Top, 10",
"P" = "missing"),
U = fct_recode(urbrum,
"1" = "A big city",
"2" = "The suburbs or outskirts of a big city",
"3" = "A town or a small city",
"4" = "A country village",
"5" = "A farm or home in the country",
"P" = "missing")
)
#names(MCAdata1jh.dat)
#dim(MCAdata1jh.dat)
#MCAdata1jh.dat$E %>% levels()
#MCAdata1jh.dat$S %>% levels()
#MCAdata1jh.dat$U %>% levels()
#MCAdata1jh.dat$age_cat %>% levels()
#str(MCAdata1jh.dat$ga) # toimiikohan - chr-muuttuja? (16.10.20)
MCAdata1jh.dat <- MCAdata1jh.dat %>%
mutate(gaf = as_factor(ga))
#str(MCAdata1jh.dat$gaf)
#levels(MCAdata1jh.dat$gaf) # järjestyksellä ei liene väliä? (16.10.20)
# gaf ja ga: sama järjestys
MCAdata1jh.dat <- MCAdata1jh.dat %>%
mutate(gaf = fct_relevel(gaf,
"f1",
"f2",
"f3",
"f4",
"f5",
"f6",
"m1",
"m2",
"m3",
"m4",
"m5",
"m6"))
# Lopuksi substanssimuuttutien nimet lyhyiksi
MCAdata1jh.dat <- MCAdata1jh.dat %>% mutate(a1 = Q1am,
b1 = Q1bm,
c1 = Q1cm,
d1 = Q1dm,
e1 = Q1em,
a2 = Q2am,
b2 = Q2bm)
# Tarkistustuksia datalle
# MCAdata1jh.dat %>% tableX (a1, Q1am)
# MCAdata1jh.dat %>% tableX (b1, Q1bm)
# MCAdata1jh.dat %>% tableX (c1, Q1cm)
# MCAdata1jh.dat %>% tableX (d1, Q1dm)
# MCAdata1jh.dat %>% tableX (e1, Q1em)
# MCAdata1jh.dat %>% tableX (a2, Q2am)
# MCAdata1jh.dat %>% tableX (b2, Q2bm)
# MCAdata1jh.dat %>% tableX(gaf, ga)
# Perustietoja - TÄSSÄ UUSI PDF-VIRHEILMOITUS 7.11.2020
# Ei tulosteta - kommentoidaan pois
#MCAdata1jh.dat %>% tableX (maa,a1, type = "row_perc")
#MCAdata1jh.dat %>% tableX (maa,b1, type = "row_perc")
#MCAdata1jh.dat %>% tableX (maa,c1, type = "row_perc")
#MCAdata1jh.dat %>% tableX (maa,d1, type = "row_perc")
#MCAdata1jh.dat %>% tableX (maa,e1, type = "row_perc")
#MCAdata1jh.dat %>% tableX (maa,a2,type = "row_perc")
#MCAdata1jh.dat %>% tableX (maa,b2,type = "row_perc")
#MCAdata1jh.dat %>% tableX(gaf, ga,type = "row_perc")
#MCAdata1jh.dat %>% tableX(maa, age_cat,type = "row_perc")
#MCAdata1jh.dat %>% tableX(maa, gaf,type = "row_perc")
#MCAdata1jh.dat %>% tableX(maa, S, type = "row_perc")
#MCAdata1jh.dat %>% tableX(maa, U, type = "row_perc")
#MCAdata1jh.dat %>% tableX(maa, E, type = "row_perc")
#Puuttuvien tietojen yleiskuva
# Puuttuvat tiedot aineistossa - viite datan dokumentointiin jossa taulukot.
# Vaihtelee maittain ja muuttujittain, paljon.
# Koko data (G1_1_data2.Rmd - skriptissä valitut muuttujat ja 25 maata)
#
#sum(!complete.cases(ISSP2012jh1d.dat)) = 9455
#dim(ISSP2012jh1d.dat) = 32823
#9455/32823 = 0.2880602
# Puuttuvat tiedot valitussa MCA-aineistossa
#missingMCAvars1 <- c("Q1a","Q1b", "Q1c", "Q1d","Q1e","Q2a","Q2b","edu",
# "sosta", "urbru", "maa", "ika", "sp" )
#missingTestMCA1.dat <- ISSP2012jh1d.dat %>% select(all_of(missingMCAvars1))
#sum(!complete.cases(missingTestMCA1.dat)) = 6101
#dim(missingTestMCA1.dat) = 32823
#6101/32823 = 0.1858758 Puuttellisten havaintojen osuus.
#Pelkät kysymykset
#missingMCAvars2 <- c("Q1a","Q1b", "Q1c", "Q1d","Q1e","Q2a","Q2b")
#missingTestMCA2.dat <- ISSP2012jh1d.dat %>% select(all_of(missingMCAvars2))
#sum(!complete.cases(missingTestMCA2.dat))
# puuttuvia tietoja 4554
# 4553/32823 = 0.1387137
# Valitaan data
mcaDat11jh.dat <- MCAdata1jh.dat %>% select(a1,b1,c1, d1, e1,a2,b2)
# dim(mcaDat11jh.dat)
#glimpse(mcaDat11jh.dat)
Qmuuttujat1.mca <- mjca(mcaDat11jh.dat, ps="")
# ps="" muuttujan ja sen kategorian eroitinmerkki
par(cex = 0.6)
plot.mjca(Qmuuttujat1.mca, labels = c(1,2),
main = "Symmetrinen kartta",
sub = "Kysymykset Q1a, Q1b, Q1c, Q1d, Q1e, Q2a, Q2b, vastaukset S-s-?-e-E-P "
)
par(cex=0.6)
plot.mjca(Qmuuttujat1.mca, what = c("all","all"),labels = c(0,2),
col = c("lightblue", "red"),
main = "Symmetrinen kartta",
sub = "Kysymykset Q1a, Q1b, Q1c, Q1d, Q1e, Q2a, Q2b,vastaukset S-s-?-e-E-P, havainnot (n = 32 823)"
)
#subsetcat viittaa muuttujan luokkien indeksiin
eiPvastaukset <- (1:42)[-c(6,12,18,24,30,36,42)]
# eiPvastaukset
# puuttuva tieto on kuudes kategoria kaikilla kysymyksillä
# 1 2 3 4 5 7 8 9 10 11 13 14 15 16 17 19 20 21 22 23 25 26 27 28 29 31
# 32 33 34 35 37 38 39 40 41
#mcaDat11jh.dat[1:5,]
Qmuuttujat2.mca <- mjca(mcaDat11jh.dat, ps="", subsetcat=eiPvastaukset)
# subsetcat viittaa muuttujan luokkien indeksiin
eiPvastaukset <- (1:42)[-c(6,12,18,24,30,36,42)]
# eiPvastaukset
# puuttuva tieto on kuudes kategora kaikilla kysymyksillä
# 1 2 3 4 5 7 8 9 10 11 13 14 15 16 17 19 20 21 22 23 25 26 27 28 29 31
# 32 33 34 35 37 38 39 40 41
# mcaDat11jh.dat[1:5,]
Qmuuttujat2.mca <- mjca(mcaDat11jh.dat, ps="", subsetcat=eiPvastaukset)
# Kontribuutiokartta on tarpeeksi selkeä, muutujien tunnukset erottuvat.
# Jätetään tämä kuva pois (25.11.20)
#
#plot.mjca(Qmuuttujat2.mca,
# main="Seitsemän kysymystä, viisi vastausvaihtoehtoa",
# sub = "subset: ei puuttuvien vastausten kategorioita(*P)")
# jätettään symmetrinen kartta pois, asymmetrinen on parempi (25.11.20)
plot.mjca(Qmuuttujat2.mca,
what = c("all","all"),labels = c(0,2),
col = c("lightblue", "red"),
main="Seitsemän kysymystä, viisi vastausvaihtoehtoa",
sub = "subset: ei puuttuvien vastausten kategoriaa (*P)")
plot.mjca(Qmuuttujat2.mca, map = "rowprincipal",
what = c("all","all"),labels = c(0,2),
col = c("lightblue", "red"),
main="Asymmetrinen kartta - osajoukko: ei puuttuvia vastauksia",
sub = "Kysymykset Q1a, Q1b, Q1c, Q1d, Q1e, Q2a, Q2b, vastaukset S-s-?-e-E")
# pois 25.11.2020
summary(Qmuuttujat2.mca)
# Pois 25.11.2020
Qmuuttujat2d3 <- mjca(mcaDat11jh.dat, ps="", nd = 3,subsetcat=eiPvastaukset)
summary(Qmuuttujat2d3)
knitr::include_graphics('img/CAquality.png')
knitr::include_graphics('img/BookdownProc.png')
# pois out.width='50%',
sessionInfo()
# echo = FALSE toistaiseksi.
#Testataan koodilohkojen listausta, näyttää toimivan mutta vaatii vielä säätämistä.
#Ohje löytyi [Yihui Xienin blogista](https://yihui.name/en/2018/09/code-appendix/)
#(luettu 26.10.2018).