Диссертация (1138200), страница 26

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 26)

Вы абсолютно уверены, что все денежные выплаты должны быть официально оформлены,подкреплены соответствующими документами, чеками и т.п.?"# "13. Если представится возможность, Вы заплатите сотруднику ГИБДД для ухода от болеесерьезной (по сравнению с размером взятки) административной ответственности?"# "14.

Если представится возможность, Вы заплатите сотруднику ГИБДД для ухода от уголовнойответственности?"# Оценка респондентом уровня коррумпированности общества:# "12. Вы слышали, что кто-то из окружающих Вас людей, с которым Вы лично знакомы, давалвзятки?"# "1. Скажите, пожалуйста, приходится ли людям сейчас давать взятки чиновникам?"# "2. Скажите, пожалуйста, приходится ли людям сейчас давать взятки работникамправоохранительных органов?"# Уровень поиска респондентом оправдания для коррупционных действий:# "16. Можно ли организовать и поддерживать собственных бизнес абсолютно законно, неиспользуя теневых выплат, не давать взятки и т.п.?"# Доверие:# "7.

Вы полностью доверяете своим друзьям?"# "8. Вы полностью доверяете студентам своей учебной группы?"# "9. Вы полностью доверяете средствам массовой информации (радио, телевидение, газеты,журналы)?# "10. Вы полностью доверяете информации, полученной из сети Интернет?"# Личная лояльность к коррупции:keeps<- c("q11", "q13", "q14")Z<- nodes[keeps]162z <- rowSums(is.na(Z))nodes$corloyal <- rowSums(cbind(abs(nodes$q11-1), nodes$q13, nodes$q14), na.rm=T)/(3-z)mean(nodes$corloyal, na.rm=T )sum(is.na(nodes$corloyal))# Оценка респондентом уровня коррумпированности общества:keeps <- c("q1", "q2", "q12")Z <- nodes[keeps]z <- rowSums(is.na(Z))nodes$corrupt <- rowSums(cbind(nodes$q1, nodes$q2, nodes$q12), na.rm=T)/(3-z)mean(nodes$corrupt, na.rm=T )sum(is.na(nodes$corrupt))# Уровень поиска респондентом оправдания для коррупционных действий:nodes$just <- nodes$q16mean(nodes$just, na.rm=T )sum(is.na(nodes$just))# Горизонтальное доверие:mean(nodes$q7, na.rm=T )mean(nodes$q8, na.rm=T )keeps <- c("q7", "q8")Z <- nodes[keeps]z <- rowSums(is.na(Z))nodes$trust1 <- rowSums(cbind(nodes$q7, nodes$q8), na.rm=T)/(2-z)mean(nodes$trust1, na.rm=T )sum(is.na(nodes$trust1))# Вертикальное доверие:mean(nodes$q9, na.rm=T )mean(nodes$q10, na.rm=T )keeps <- c("q9", "q10")Z <- nodes[keeps]z <- rowSums(is.na(Z))nodes$trust2 <- rowSums(cbind(nodes$q9, nodes$q10), na.rm=T)/(2-z)mean(nodes$trust2, na.rm=T )sum(is.na(nodes$trust2))rm(keeps, z, Z)# составляется датафрейм ребер# отбор переменных для суммированияno<- data_nn[(grep("n", names(data_nn)))]drops <- c("id_in", "n0")no <- no [, !(names(no) %in% drops)]colnames <- names(no)data_nn$sum <- rowSums(data_nn[, colnames], na.rm = TRUE) # сумма указаний ребраwrite.table(data_nn, file = "data_nn_sum.csv", sep = ";", col.names = T, qmethod = "double",row.names=FALSE)links <- subset(data_nn, data_nn$id_in %in% unique(nodes$id))# остаются только те узлы, которыеидут к участвовавшим в анкетированииlinks<- subset(links, links$id_out %in% unique(nodes$id)) # остаются только те узлы, которые идутот участвовавших в анкетированииlinks<- subset(links, links$sum != 0) # остаются только ненулевыеkeeps <- c("id_out", "id_in", "sum")links<- links[, keeps] # удаление лишних переменных# переименование переменныхnames(links)[names(links)=="id_out"] <- "from"names(links)[names(links)=="id_in"] <- "to"names(links)[names(links)=="sum"] <- "type"163rm(keeps, drops, no, colnames)# оптимальный граф:# циклом подбирается такой порог, чтобы итоговый граф оказался из одной компонентыfor(k in 12:1){lcut <- subset(links, links$type > k)nn <-graph_from_data_frame(lcut, directed = T, vertices=nodes)clu <- components(nn, mode = "weak")compnum <- clu$noprint (paste0("iteration = ", 12-k))print(paste0("number of components = ", compnum))if (compnum == 1) { break }}rm(compnum, clu)v <- gorder(nn)e<- gsize(nn)# остаются только узлы, которые имеют исходящие связиnodescut <- nodesc0 <- unique(links$from)c1 <- unique(lcut$from)while (length(c0)>length(c1)){lcut <- subset(lcut, lcut$to %in% c1)c0 <- c1c1 <- unique(lcut$from)nodescut <- subset(nodescut, nodescut$id %in% c1)}rm(c0, c1)nn <-graph_from_data_frame(lcut, directed = T, vertices=nodescut)v <- gorder(nn)e <- gsize(nn)# визуализация графаV(nn)$frame.color<- "white"V(nn)$color <- "lightgrey"V(nn)$color[nodes$corloyal > .5]<- "lightcoral"V(nn)$color[nodes$corloyal <= .5] <- "lightblue3"E(nn)$color <- "grey"V(nn)$shape <- "circle"# V(nn)$label <- V(nn)$namedeg <- degree(nn, mode="all")V(nn)$size <- deg/1.5plot(nn, edge.arrow.size=.1,vertex.label=NA)# укладка графаlkk <- layout.kamada.kawai(nn)plot(nn, edge.arrow.size=.1, vertex.label=V(nn)$id,rescale=F, layout=lkk*.2)plot(nn, edge.arrow.size=.1, vertex.label=NA,rescale=F, layout=lkk*.2,main ="Нижний Новгород",sub = paste0("Порог = ", k,", число вершин = ", v,", число ребер = ", e,".Красный = высокая лояльность к коррупции, синий - низкая лояльность к коррупции"))# без подписей:plot(nn, edge.arrow.size=.1, vertex.label=NA,164rescale=F, layout=lkk*.2)nodescut$degree <- deg# АНАЛИЗ ЛОЯЛЬНОСТИ К КОРРУПЦИИcorloyal<- nodescut# keeps <- c("id", "corloyal", "female")# corloyal <- corloyal [, (names(corloyal) %in% keeps)]corloyal <- subset(corloyal, is.na(corloyal) == F)# rm(keeps)# средняя лояльность к коррупции по окружениюcorloyal$corloyalfr <- 0len <- length(corloyal$id)a<- rle(sort(lcut$from)) # частота from в lcut, т.е.

число исходящих реберfor (i in 1:len){corloyal$fr[i] <- a$lengths[which(a$values == corloyal$id[i])]# вершины, к которым идут ребра из вершиныcorloyal$id[i]temp <- lcut[lcut$from == corloyal$id[i], "to"]if(length(temp) == 0) { corloyal$corloyalfr[i] <- NA} # если нет исходящих реберcorloyal$corloyalfr[i] <- corloyal$corloyalfr[i] + sum(corloyal[corloyal$id %in% temp, "corloyal"])rm(temp)}rm(i,len)corloyal$corloyalfr_a <- (corloyal$corloyalfr / corloyal$fr) # средняя лояльность окружения ккоррупции# write.table(corloyal, file = "corloyal_nn.csv", sep = ";", col.names = T, qmethod = "double",row.names=FALSE)library(xlsx)write.xlsx(corloyal, file = "corloyal_nn.xlsx", row.names=FALSE)# корреляцииrequire(Hmisc)# лояльности к коррупции и лояльности к коррупции по окружениюrcorr(corloyal$corloyal, corloyal$corloyalfr_a, type="spearman")# cor.test(corloyal$corloyal, corloyal$corloyalfr_a, method = "spearman")# лояльности к корруцпии и числа мощности узлаrcorr(corloyal$corloyal, corloyal$degree, type="spearman")# отклонение от среднего по соседям:corloyal$dev <- corloyal$corloyal-corloyal$corloyalfr_arequire(Publish)ci.mean(corloyal$dev, na.rm=T, normal=FALSE)ci.mean(corloyal[corloyal$corloyal > .5, "dev"], na.rm=T, normal=FALSE) #для лояльных к коррупцииci.mean(corloyal[corloyal$corloyal <= .5, "dev"], na.rm=T, normal=FALSE) #для нелояльных ккоррупции# матрица переходовmat <- matrix(as_adjacency_matrix(nn), nrow = v, ncol = v)colnames(mat) <- c(nodescut$id)rownames(mat) <- c(nodescut$id)# для corloyalnotna <- c(corloyal$id)theta <- corloyal$corloyal165A <- subset(mat, colnames(mat) %in% notna, rownames(mat) %in% notna)Aout <- A %*% thetaAin <- t(A) %*% theta# минимизация нормы эпсилон:norm_eps <- function(alpha) sqrt(sum((theta-alpha*Aout-(1-alpha)*Ain)^2))# t <- nlm(norm_eps, c(0:1))solution <- optimize(norm_eps, lower = 0, upper = 1, maximum = FALSE)alpha <- solution$minimumeps <- theta-alpha*Aout-(1-alpha)*Ain# fit <- lm(corloyal ~ corloyalfr_a + female + q3 + q4 + q15 +q25, data = corloyal)# summary(fit)# АНАЛИЗ ОЦЕНКИ УРОВНЯ КОРРУМПИРОВАННОСТИ ОБЩЕСТВАcorrupt <- nodescut# keeps <- c("id", "corrupt", "female")# corrupt <- corrupt [, (names(corrupt) %in% keeps)]corrupt <- subset(corrupt, is.na(corrupt) == F)# rm(keeps)# средняя лояльность к коррупции по окружениюcorrupt$corruptfr <- 0len <- length(corrupt$id)a<- rle(sort(lcut$from)) # частота from в lcut, т.е.

число исходящих реберfor (i in 1:len){corrupt$fr[i] <- a$lengths[which(a$values == corrupt$id[i])]# вершины, к которым идут ребра из вершиныcorrupt$id[i]temp <- lcut[lcut$from == corrupt$id[i], "to"]if(length(temp) == 0) { corrupt$corruptfr[i] <- NA} # если нет исходящих реберcorrupt$corruptfr[i] <- corrupt$corruptfr[i] + sum(corrupt[corrupt$id %in% temp, "corrupt"])rm(temp)}rm(i,len)corrupt$corruptfr_a <- (corrupt$corruptfr / corrupt$fr) # средняя лояльность окружения ккоррупции# write.table(corrupt, file = "corrupt_nn.csv", sep = ";", col.names = T, qmethod = "double",row.names=FALSE)library(xlsx)write.xlsx(corrupt, file = "corrupt_nn.xlsx", row.names=FALSE)# корреляцииrequire(Hmisc)# лояльности к коррупции и лояльности к коррупции по окружениюrcorr(corrupt$corrupt, corrupt$corruptfr_a, type="spearman")# cor.test(corrupt$corrupt, corrupt$corruptfr_a, method = "spearman")# лояльности к корруцпии и числа мощности узлаrcorr(corrupt$corrupt, corrupt$degree, type="spearman")# отклонение от среднего по соседям:corrupt$dev <- corrupt$corrupt-corrupt$corruptfr_arequire(Publish)ci.mean(corrupt$dev, na.rm=T, normal=FALSE)ci.mean(corrupt[corrupt$corrupt > .5, "dev"], na.rm=T, normal=FALSE) #для лояльных к коррупции166ci.mean(corrupt[corrupt$corrupt <= .5, "dev"], na.rm=T, normal=FALSE) #для нелояльных ккоррупции# матрица переходовmat <- matrix(as_adjacency_matrix(nn), nrow = v, ncol = v)colnames(mat) <- c(nodescut$id)rownames(mat) <- c(nodescut$id)# для corruptnotna <- c(corrupt$id)theta <- corrupt$corruptA <- subset(mat, colnames(mat) %in% notna, rownames(mat) %in% notna)Aout <- A %*% thetaAin <- t(A) %*% theta# минимизация нормы эпсилон:norm_eps <- function(alpha) sqrt(sum((theta-alpha*Aout-(1-alpha)*Ain)^2))# t <- nlm(norm_eps, c(0:1))solution <- optimize(norm_eps, lower = 0, upper = 1, maximum = FALSE)alpha <- solution$minimumeps <- theta-alpha*Aout-(1-alpha)*Ain# АНАЛИЗ ПОИСКА РЕСПОНДЕНТОМ ОПРАВДАНИЯ ДЛЯ КОРРУПЦИОННЫХ ДЕЙСТВИЙjust <- nodescut# keeps <- c("id", "just", "female")# just <- just [, (names(just) %in% keeps)]just <- subset(just, is.na(just) == F)# rm(keeps)# средняя лояльность к коррупции по окружениюjust$justfr <- 0len <- length(just$id)a<- rle(sort(lcut$from)) # частота from в lcut, т.е.

Характеристики

Список файлов диссертации