+ Näytä koodi- Piilota koodi
# Luetaan sisaan vaalikoneen tiedot HS:n tiedostosta koneen kovalevylta
vaalikone <- read.table(file="http://fi.opasnet.org/fi_wiki/images/c/c2/HS-vaalikone2011.csv", sep=";", header=FALSE)
# Nimetaan sarakkeet
colnames(vaalikone) <- c("Vaalipiiri","Puolue","Sukunimi","Etunimi","Ika","Sukupuoli","Sitoutumaton","Maakunta","Koulutustaso","Esittelyteksti",
+ "Kunnanvaltuutettu","Kansanedustaja","Europarlamentaarikko","Ammatti","Kotisivu","RSS.syote","Tuloerot","Merkitys1",
+ "Kommentti1","Homoadoptio","Merkitys2","Kommentti2","Ydinvoimalupa","Merkitys3","Kommentti3","Lapsilisa","Merkitys4",
+ "Kommentti4","Hoivatakuu","Merkitys5","Kommentti5","Vanhuuselake","Merkitys6","Kommentti6","Tyourat","Merkitys7","Kommentti7",
+ "Taitettu.indeksi","Merkitys8","Kommentti8","Saastoehdotukset","Merkitys9","Kommentti9","Tukipaketti","Merkitys10",
+ "Kommentti10","Transaktiovero","Merkitys11","Kommentti11","Veronkorotus","Merkitys12","Kommentti12","Verotukileikkaus",
+ "Merkitys13","Kommentti13","Asuntokorkojen.verovahennysoikeus","Merkitys14","Kommentti14","Metsamaan.kiinteistovero",
+ "Merkitys15","Kommentti15","Asevelvollisuus","Merkitys16","Kommentti16","Nato-jasenyys","Merkitys17","Kommentti17",
+ "Kiinan.ihmisoikeudet","Merkitys18","Kommentti18","Ulkomaalaisten.maanomistus","Merkitys19","Kommentti19",
+ "Kehitysyhteistyomaararahat","Merkitys20","Kommentti20","Facebook.kaverit","Merkitys21","Kommentti21","Aselaki",
+ "Merkitys22","Kommentti22","Pakkoruotsi","Merkitys23","Kommentti23","Suvivirsi","Merkitys24","Kommentti24",
+ "Maahanmuuttopolitiikka","Merkitys25","Kommentti25","Saimaannorppa","Merkitys26","Kommentti26","Kuntien ulkoistus",
+ "Merkitys27","Kommentti27","Kuntien.maara","Merkitys28","Kommentti28","Paakaupunkiseutu","Merkitys29","Kommentti29",
+ "Kuntien.verotasaus","Merkitys30","Kommentti30","Hallituspuolueet","Merkitys31","Kommentti31")
# Muodostetaan vektori kaikkien hyväksytyiksi tulleiden ehdokkaiden järjestysnumerot
# Muodostetaan yllaolevista vektori:
b<-c(80, 84, 88, 92, 98, 108, 112, 126, 134, 138, 139, 140, 146,
154, 163, 176, 177, 187, 189, 192, 196, 216, 224, 243, 245, 255,
257, 258, 260, 261, 268, 273, 282, 284, 288, 290, 298, 299, 301,
302, 433, 436, 444, 453, 456, 457, 466, 469, 471, 476, 478, 479,
491, 493, 500, 532, 535, 536, 542, 546, 551, 556, 561, 562, 571,
599, 601, 624, 626, 636, 637, 642, 645, 650, 651, 816, 817, 824,
845, 846, 867, 868, 871, 879, 882, 898, 920, 923, 924, 925, 939,
942, 943, 948, 978, 982, 986, 993, 1027, 1036, 1041, 1046, 1048, 1050,
1053, 1062, 1071, 1089, 1092, 1101, 1102, 1253, 1297, 1370, 1371, 1394, 1395,
1492, 1497, 1498, 1499, 1501, 1502, 1521, 1527, 1533, 1535, 1542, 1549, 1552,
1554, 1561, 1570, 1575, 1579, 1582, 1599, 1601, 1606, 1621, 1630, 1634, 1635,
1645, 1647, 1655, 1670, 1676, 1684, 1693, 1694, 1706, 1707, 1712, 1719, 1720,
1852, 1898, 1917, 1920, 1928, 1931, 1961, 1965, 1968, 1982, 2040, 2055, 2071,
2077, 2100, 2115, 2116, 2167, 2211, 2259, 2264, 2280, 2284)
# Poimitaan valituksi tulleet kansanedustajat kaikista ehdokkaista:
valitut <- vaalikone[b,]
# Erotetaan puoluekannan ilmaiseva sarake omaksi vektorikseen:
puoluesarake <- valitut[[2]]
# Poimitaan puoluekohtaiset vastaukset eri muuttujiin.
# PUOLUE (KOK)
apuA <- as.numeric(puoluesarake %in% c("KOK"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaKOK <- apuC[apuC !=0]; paikkaKOK
valitutKOK <- valitut[paikkaKOK, ]
# PUOLUE (PS)
apuA <- as.numeric(puoluesarake %in% c("PS"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaPS <- apuC[apuC !=0]; paikkaPS
valitutPS <- valitut[paikkaPS, ]
# PUOLUE (RKP)
apuA <- as.numeric(puoluesarake %in% c("RKP"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaRKP <- apuC[apuC !=0]; paikkaRKP
valitutRKP <- valitut[paikkaRKP, ]
# PUOLUE (KESK)
apuA <- as.numeric(puoluesarake %in% c("KESK"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaKESK <- apuC[apuC !=0]; paikkaKESK
valitutKESK <- valitut[paikkaKESK, ]
# PUOLUE (KD)
apuA <- as.numeric(puoluesarake %in% c("KD"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaKD <- apuC[apuC !=0]; paikkaKD
valitutKD <- valitut[paikkaKD, ]
# PUOLUE (SDP)
apuA <- as.numeric(puoluesarake %in% c("SDP"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaSDP <- apuC[apuC !=0]; paikkaSDP
valitutSDP <- valitut[paikkaSDP, ]
# PUOLUE (VAS)
apuA <- as.numeric(puoluesarake %in% c("VAS"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaVAS <- apuC[apuC !=0]; paikkaVAS
valitutVAS <- valitut[paikkaVAS, ]
# PUOLUE (VIHR)
apuA <- as.numeric(puoluesarake %in% c("VIHR"))
apuB <- 1:179; apuC <- apuA*apuB; paikkaVIHR <- apuC[apuC !=0]; paikkaVIHR
valitutVIHR <- valitut[paikkaVIHR, ]
# Seuraava muodostaa puolueelle KOK tuloslistan, joka koostuu eri pisteytetyista
# vaihtoehdoista jokaiselle 31 kysymykselle (muuttuja y)
# PUOLUE (KOK)
tulosKOK <- list(1:30)
for(y in 1:30) {an<-list(1:40); for(x in 1:length(levels(valitutKOK[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutKOK[[14+3*y]]==levels(valitutKOK[[14+3*y]])[x]))}; tulosKOK[[y]] <- as.numeric(an)}
# PUOLUE (PS)
tulosPS <- list(1:30)
for(y in 1:31) {an<-list(1:40); for(x in 1:length(levels(valitutPS[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutPS[[14+3*y]]==levels(valitutPS[[14+3*y]])[x]))}; tulosPS[[y]] <- as.numeric(an)}
# PUOLUE (RKP)
tulosRKP <- list(1:30)
for(y in 1:31) {an<-list(1:40); for(x in 1:length(levels(valitutRKP[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutRKP[[14+3*y]]==levels(valitutRKP[[14+3*y]])[x]))}; tulosRKP[[y]] <- as.numeric(an)}
# PUOLUE (KESK)
tulosKESK <- list(1:30)
for(y in 1:31) {an<-list(1:40); for(x in 1:length(levels(valitutKESK[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutKESK[[14+3*y]]==levels(valitutKESK[[14+3*y]])[x]))}; tulosKESK[[y]] <- as.numeric(an)}
# PUOLUE (KD)
tulosKD <- list(1:30)
for(y in 1:31) {an<-list(1:40); for(x in 1:length(levels(valitutKD[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutKD[[14+3*y]]==levels(valitutKD[[14+3*y]])[x]))}; tulosKD[[y]] <- as.numeric(an)}
# PUOLUE (SDP)
tulosSDP <- list(1:30)
for(y in 1:31) {an<-list(1:40); for(x in 1:length(levels(valitutSDP[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutSDP[[14+3*y]]==levels(valitutSDP[[14+3*y]])[x]))}; tulosSDP[[y]] <- as.numeric(an)}
# PUOLUE (VAS)
tulosVAS <- list(1:30)
for(y in 1:31) {an<-list(1:40); for(x in 1:length(levels(valitutVAS[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutVAS[[14+3*y]]==levels(valitutVAS[[14+3*y]])[x]))}; tulosVAS[[y]] <- as.numeric(an)}
# PUOLUE (VIHR)
tulosVIHR <- list(1:30)
for(y in 1:31) {an<-list(1:40); for(x in 1:length(levels(valitutVIHR[[14+3*y]])))
{an[[x]] <- sum(as.numeric(valitutVIHR[[14+3*y]]==levels(valitutVIHR[[14+3*y]])[x]))}; tulosVIHR[[y]] <- as.numeric(an)}
#
#
#
# Yhteenveto tuloksista (KOK)
#
# Maaritellaan lista, jonka alkiot koostuvat maksimipisteet saaneen vaihtoehdon
# paikasta merkittyna nro:lla 1 (vahemman kannatusta saaneet vaihtoehdot
# saavat arvokseen nollan). Kampa poimii muut kysymykset paitsi nrot 21 ja 31 joissa vastaajat
# voivat valita useamman vaihtoehdon:
#
kampa<-c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,22,23,24,25,26,27,28,29,30);
maxKOK <- list(1:30);
for(x in kampa) {maxKOK[[x]] <- as.numeric(tulosKOK[[x]]==max(tulosKOK[[x]]))};
#
# Tutkitaan mihin vastauksista on yksikasitteiset vastaukset summavektorin summaKOK avulla:
# for(x in 1:30) {summaKOK[[x]] <- sum(maxKOK[[x]])}; summaKOK
# tulostaa [1] 1 2 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1
# Poimi vain ne joissa ykkonen:
# as.numeric(summaKOK %in% 1)
# tulostaa [1] 1 0 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1
# Pakataan ylla olevat vahan tiiviimpaan muotoon:
summaKOK <- 1:30;
for(x in 1:30) {summaKOK[[x]] <- sum(maxKOK[[x]])};
apuS <- 1:30; summaKOK2 <- apuS*as.numeric(summaKOK %in% 1);
yksikasitteisetKOK <- summaKOK2[summaKOK2 !=0];
#
# Luupataan joukolle x yksikasitteisissa lapi maxKOK-vektori ja talletetaan
# varastovektoriin kannatKOK ensimmainen 1:sta matchaavan alkion sijanti
# maxKOK[x]-alivektorissa. Lopuksi muutetaan NA-luvut ykkosiksi (vastaavat
# levelia '-'):
kannatKOK <- list(1:30); kannatKOK <- NA;
for(x in yksikasitteisetKOK) {kannatKOK[[x]] <- match(1,maxKOK[[x]])};
indKOK <- which(is.na(kannatKOK)); kannatKOK[indKOK] <- 1; kannatKOK[31] <- 1;
#
# Seuraavaksi tulostetaan sanallisessa muodossa mita kantaa kannatKOK-vektorin
# arvot eri kysymyksille tarkoittavat (tulostus tapahtuu printtaamalla kannatKOK-vektori):
kannatKOK2 <- list(1:31);
for(x in 1:31) {kannatKOK2[x] <- levels(valitutKOK[[14+3*x]])[kannatKOK[x]]};
#
# Yhteenveto tuloksista (PS)
#
maxPS <- list(1:30);
for(x in kampa) {maxPS[[x]] <- as.numeric(tulosPS[[x]]==max(tulosPS[[x]]))};
summaPS <- 1:30;
for(x in 1:30) {summaPS[[x]] <- sum(maxPS[[x]])};
apuS <- 1:30; summaPS2 <- apuS*as.numeric(summaPS %in% 1);
yksikasitteisetPS <- summaPS2[summaPS2 !=0];
kannatPS <- list(1:30); kannatPS <- NA;
for(x in yksikasitteisetPS) {kannatPS[[x]] <- match(1,maxPS[[x]])};
indPS <- which(is.na(kannatPS)); kannatPS[indPS] <- 1; kannatPS[31] <- 1;
kannatPS2 <- list(1:31);
for(x in 1:31) {kannatPS2[x] <- levels(valitutPS[[14+3*x]])[kannatPS[x]]};
#
# Yhteenveto tuloksista (RKP)
#
maxRKP <- list(1:30);
for(x in kampa) {maxRKP[[x]] <- as.numeric(tulosRKP[[x]]==max(tulosRKP[[x]]))};
summaRKP <- 1:30;
for(x in 1:30) {summaRKP[[x]] <- sum(maxRKP[[x]])};
apuS <- 1:30; summaRKP2 <- apuS*as.numeric(summaRKP %in% 1);
yksikasitteisetRKP <- summaRKP2[summaRKP2 !=0];
kannatRKP <- list(1:30); kannatRKP <- NA;
for(x in yksikasitteisetRKP) {kannatRKP[[x]] <- match(1,maxRKP[[x]])};
indRKP <- which(is.na(kannatRKP)); kannatRKP[indRKP] <- 1; kannatRKP[31] <- 1;
kannatRKP2 <- list(1:31);
for(x in 1:31) {kannatRKP2[x] <- levels(valitutRKP[[14+3*x]])[kannatRKP[x]]};
#
# Yhteenveto tuloksista (KESK)
#
maxKESK <- list(1:30);
for(x in kampa) {maxKESK[[x]] <- as.numeric(tulosKESK[[x]]==max(tulosKESK[[x]]))};
summaKESK <- 1:30;
for(x in 1:30) {summaKESK[[x]] <- sum(maxKESK[[x]])};
apuS <- 1:30; summaKESK2 <- apuS*as.numeric(summaKESK %in% 1);
yksikasitteisetKESK <- summaKESK2[summaKESK2 !=0];
kannatKESK <- list(1:30); kannatKESK <- NA;
for(x in yksikasitteisetKESK) {kannatKESK[[x]] <- match(1,maxKESK[[x]])};
indKESK <- which(is.na(kannatKESK)); kannatKESK[indKESK] <- 1; kannatKESK[31] <- 1;
kannatKESK2 <- list(1:31);
for(x in 1:31) {kannatKESK2[x] <- levels(valitutKESK[[14+3*x]])[kannatKESK[x]]};
#
# Yhteenveto tuloksista (KD)
#
maxKD <- list(1:30);
for(x in kampa) {maxKD[[x]] <- as.numeric(tulosKD[[x]]==max(tulosKD[[x]]))};
summaKD <- 1:30;
for(x in 1:30) {summaKD[[x]] <- sum(maxKD[[x]])};
apuS <- 1:30; summaKD2 <- apuS*as.numeric(summaKD %in% 1);
yksikasitteisetKD <- summaKD2[summaKD2 !=0];
kannatKD <- list(1:30); kannatKD <- NA;
for(x in yksikasitteisetKD) {kannatKD[[x]] <- match(1,maxKD[[x]])};
indKD <- which(is.na(kannatKD)); kannatKD[indKD] <- 1; kannatKD[31] <- 1;
kannatKD2 <- list(1:31);
for(x in 1:31) {kannatKD2[x] <- levels(valitutKD[[14+3*x]])[kannatKD[x]]};
#
# Yhteenveto tuloksista (SDP)
#
maxSDP <- list(1:30);
for(x in kampa) {maxSDP[[x]] <- as.numeric(tulosSDP[[x]]==max(tulosSDP[[x]]))};
summaSDP <- 1:30;
for(x in 1:30) {summaSDP[[x]] <- sum(maxSDP[[x]])};
apuS <- 1:30; summaSDP2 <- apuS*as.numeric(summaSDP %in% 1);
yksikasitteisetSDP <- summaSDP2[summaSDP2 !=0];
kannatSDP <- list(1:30); kannatSDP <- NA;
for(x in yksikasitteisetSDP) {kannatSDP[[x]] <- match(1,maxSDP[[x]])};
indSDP <- which(is.na(kannatSDP)); kannatSDP[indSDP] <- 1; kannatSDP[31] <- 1;
kannatSDP2 <- list(1:31);
for(x in 1:31) {kannatSDP2[x] <- levels(valitutSDP[[14+3*x]])[kannatSDP[x]]};
#
# Yhteenveto tuloksista (VAS)
#
maxVAS <- list(1:30);
for(x in kampa) {maxVAS[[x]] <- as.numeric(tulosVAS[[x]]==max(tulosVAS[[x]]))};
summaVAS <- 1:30;
for(x in 1:30) {summaVAS[[x]] <- sum(maxVAS[[x]])};
apuS <- 1:30; summaVAS2 <- apuS*as.numeric(summaVAS %in% 1);
yksikasitteisetVAS <- summaVAS2[summaVAS2 !=0];
kannatVAS <- list(1:30); kannatVAS <- NA;
for(x in yksikasitteisetVAS) {kannatVAS[[x]] <- match(1,maxVAS[[x]])};
indVAS <- which(is.na(kannatVAS)); kannatVAS[indVAS] <- 1; kannatVAS[31] <- 1;
kannatVAS2 <- list(1:31);
for(x in 1:31) {kannatVAS2[x] <- levels(valitutVAS[[14+3*x]])[kannatVAS[x]]};
#
# Yhteenveto tuloksista (VIHR)
#
maxVIHR <- list(1:30);
for(x in kampa) {maxVIHR[[x]] <- as.numeric(tulosVIHR[[x]]==max(tulosVIHR[[x]]))};
summaVIHR <- 1:30;
for(x in 1:30) {summaVIHR[[x]] <- sum(maxVIHR[[x]])};
apuS <- 1:30; summaVIHR2 <- apuS*as.numeric(summaVIHR %in% 1);
yksikasitteisetVIHR <- summaVIHR2[summaVIHR2 !=0];
kannatVIHR <- list(1:30); kannatVIHR <- NA;
for(x in yksikasitteisetVIHR) {kannatVIHR[[x]] <- match(1,maxVIHR[[x]])};
indVIHR <- which(is.na(kannatVIHR)); kannatVIHR[indVIHR] <- 1; kannatVIHR[31] <- 1;
kannatVIHR2 <- list(1:31);
for(x in 1:31) {kannatVIHR2[x] <- levels(valitutVIHR[[14+3*x]])[kannatVIHR[x]]};
#
# Muutetaan nollauksen jalkeen listan vektorialkioiden kannatKOK[[y]]'s komponentti puolueen
# paikkamaaran mukaiseksi.
# Paikkamaarat ovat: KOK(44), PS(39), RKP(10), KESK(35), KD(6), SDP(42), VAS(14), VIHR(10)
#
tulosBKOK <- tulosKOK; tulosBPS <- tulosPS; tulosBRKP <- tulosRKP;
tulosBKESK <- tulosKESK; tulosBKD <- tulosKD; tulosBSDP <- tulosSDP;
tulosBVAS <- tulosVAS; tulosBVIHR <- tulosVIHR;
for(y in 1:31) {for(x in 1:length(levels(valitutKOK[[14+3*y]])))
{tulosBKOK[[y]][x] <- 0}; tulosBKOK[[y]][kannatKOK[[y]]] <- 44};
for(y in 1:31) {for(x in 1:length(levels(valitutPS[[14+3*y]])))
{tulosBPS[[y]][x] <- 0}; tulosBPS[[y]][kannatPS[[y]]] <- 39};
for(y in 1:31) {for(x in 1:length(levels(valitutRKP[[14+3*y]])))
{tulosBRKP[[y]][x] <- 0}; tulosBRKP[[y]][kannatRKP[[y]]] <- 10};
for(y in 1:31) {for(x in 1:length(levels(valitutKESK[[14+3*y]])))
{tulosBKESK[[y]][x] <- 0}; tulosBKESK[[y]][kannatKESK[[y]]] <- 35};
for(y in 1:31) {for(x in 1:length(levels(valitutKD[[14+3*y]])))
{tulosBKD[[y]][x] <- 0}; tulosBKD[[y]][kannatKD[[y]]] <- 6};
for(y in 1:31) {for(x in 1:length(levels(valitutSDP[[14+3*y]])))
{tulosBSDP[[y]][x] <- 0}; tulosBSDP[[y]][kannatSDP[[y]]] <- 42};
for(y in 1:31) {for(x in 1:length(levels(valitutVAS[[14+3*y]])))
{tulosBVAS[[y]][x] <- 0}; tulosBVAS[[y]][kannatVAS[[y]]] <- 14};
for(y in 1:31) {for(x in 1:length(levels(valitutVIHR[[14+3*y]])))
{tulosBVIHR[[y]][x] <- 0}; tulosBVIHR[[y]][kannatVIHR[[y]]] <- 10};
#
# Sitten summataan eri puolueiden tulosvektorit yhteen
hallitusohjelma <- list(1:31);
for(y in 1:31)
{hallitusohjelma[[y]] <- tulosBKOK[[y]]+tulosBPS[[y]]+
tulosBRKP[[y]]+tulosBKESK[[y]]+tulosBKD[[y]]+tulosBSDP[[y]]+
tulosBVAS[[y]]+tulosBVIHR[[y]]};
#
# Lopuksi haetaan maksimit eri komponenteille (yllä muodostettujen summien maksimi = eniten kannatusta saanut vaihtoehto)
#
hallitusohjelmaB <- list(1:31);
for(y in 1:31) {hallitusohjelmaB[[y]] <- as.numeric(hallitusohjelma[[y]]==max(hallitusohjelma[[y]]))};
#
# apuH-muuttuja kertoo kuinka mones level vastaa yllä laskettua summamaksimia. Tätä hyödynnetään sanallisen
# hallitusohjelmaC-listan muodostamisessa.
apuH <- list(1:31);
for(y in 1:31) {apuH[[y]] <- match(1,hallitusohjelmaB[[y]])};
hallitusohjelmaC <- list(1:31);
for(x in 1:31) {hallitusohjelmaC[x] <- levels(valitutKOK[[14+3*x]])[apuH[[x]]]}
| |