|
|
| 第7行： |
第7行： |
| | ==论文R代码== | | ==论文R代码== |
| | <pre> | | <pre> |
| − | #加载安装包
| |
| − | library(psychmeta)
| |
| − | library(tidyr)
| |
| − | library(magrittr)
| |
| − | library(dplyr)
| |
| − | library(tidyverse)
| |
| − | library(rio)
| |
| − | library(metaSEM)
| |
| − | library(semPlot)
| |
| − | library(plyr)
| |
| − | library(meta)
| |
| − |
| |
| − | setwd("D:\\")
| |
| − | #请将data20201209.xlsx放在D盘根目录下。
| |
| − | #如果放在其他目录下，请在此做相应调整。
| |
| − | ################## 全部数据准备 ######################
| |
| − | data <- import("data20201209.xlsx")
| |
| − | attach(data)
| |
| − | correct_main <- correct_r(correction = c("meas", "uvdrr_x", "uvdrr_y", "uvirr_x",
| |
| − | "uvirr_y", "bvdrr", "bvirr"),
| |
| − | rxyi = rxy, ux = 1, uy = 1,
| |
| − | rxx = rxx,
| |
| − | ryy = ryy, ux_observed = TRUE, uy_observed = TRUE,
| |
| − | rxx_restricted = TRUE, rxx_type = "alpha", k_items_x = NA,
| |
| − | ryy_restricted = TRUE, ryy_type = "alpha", k_items_y = NA,
| |
| − | sign_rxz = 1, sign_ryz = 1, n = NULL, conf_level = 0.95,
| |
| − | correct_bias = FALSE)
| |
| − | data$rtp = correct_main[["correlations"]][["rtp"]]
| |
| − | write.csv(data, "data.csv")
| |
| − | data <- import("data.csv")
| |
| − | orig.data <- subset(data.frame(data, correct_main$correlations), rtp <1)
| |
| − |
| |
| − | k.article <- length(unique(paste(orig.data$author, orig.data$title)))
| |
| − | k.inde.sample <- length(unique(orig.data$id))
| |
| − | k.eff.size <- nrow(unique(data.frame(orig.data$title, orig.data$rxy, orig.data$x, orig.data$y)))
| |
| − | sample.size <- unique(data.frame(orig.data$title, orig.data$n))
| |
| − | n.sample.size <- as.vector(sample.size$orig.data.n)%>%sum
| |
| − |
| |
| − | descr <- data.frame(c("文献", "独立样本", "效应值", "样本规模"),
| |
| − | c(k.article, k.inde.sample, k.eff.size, n.sample.size))%>%
| |
| − | set_colnames(c("类型", "数量"))
| |
| − | #### 1………………直接效应分析………………####
| |
| − | #### 失安全系数计算 ####
| |
| − | d <- subset(orig.data, orig.data$x.frame.all == "资质过剩感")
| |
| − | attach(d)
| |
| − | d$zr <- 0.5*log((1+rxy)/(1-rxy))
| |
| − | zr <- split(d$zr, d$y.coding.t)
| |
| − | n <- split(d$n, d$y.coding.t)
| |
| − | t <- list()
| |
| − | for (i in 1:length(n)){
| |
| − | t[[i]] <- zr[[i]]*sqrt(n[[i]]-3)
| |
| − | i = i + 1}
| |
| − | nfs <- vector()
| |
| − | for (i in 1:length(zr)){
| |
| − | nfs[[i]] <- abs(round(sum(t[[i]])^2/2.706 - length(zr[[i]])))
| |
| − | i = i + 1}
| |
| − | final.nfs = data.frame(names(zr),nfs) %>% set_colnames(c("name", "nfs"))
| |
| − |
| |
| − | zr.t <- split(d$zr, d$y.frame.all)
| |
| − | n.t <- split(d$n, d$y.frame.all)
| |
| − | for (i in 1:length(n.t)){
| |
| − | t[[i]] <- zr.t[[i]]*sqrt(n.t[[i]]-3)
| |
| − | i = i + 1}
| |
| − | nfs <- vector()
| |
| − | for (i in 1:length(zr.t)){
| |
| − | nfs[[i]] <- abs(round(sum(t[[i]])^2/2.706 - length(zr.t[[i]])))
| |
| − | i = i + 1}
| |
| − | final.nfs.t = data.frame(names(zr.t),nfs)%>% set_colnames(c("name", "nfs"))
| |
| − | nfs = rbind(final.nfs, final.nfs.t)
| |
| − |
| |
| − | order <- data.frame(c("消极情绪", "愤怒", "无聊",
| |
| − | "积极自我概念", "一般效能感", "其他效能感", "一般自尊", "基于组织的自尊",
| |
| − | "消极行为", "反生产行为", "离职意愿",
| |
| − | "积极行为", "创新", "工作重塑", "建言", "前瞻行为",
| |
| − | "知识共享", "组织公民行为", "任务绩效")) %>% set_colnames("order")
| |
| − |
| |
| − | t.nfs = left_join(order, nfs, by=c("order"="name"))
| |
| − | write.csv(t.nfs, "nfs.csv")
| |
| − |
| |
| − | attach(orig.data)
| |
| − | #### 主要变量直接效应 ####
| |
| − | main_r <- ma_r(rxyi = rxy, n = n,
| |
| − | sample_id = id, citekey = id,
| |
| − | construct_x = orig.data$x.frame.all,
| |
| − | construct_y = orig.data$y.frame.all,
| |
| − | moderators = orig.data$y.coding.t,
| |
| − | data = orig.data)
| |
| − | main_rho <- ma_r(rxyi = rtp, n = n,
| |
| − | sample_id = id, citekey = id,
| |
| − | construct_x = orig.data$x.frame.all,
| |
| − | construct_y = orig.data$y.frame.all,
| |
| − | moderators = orig.data$y.coding.t,
| |
| − | data = orig.data)
| |
| − |
| |
| − | #### 异质性检验 ####
| |
| − | hetero <- heterogeneity(main_rho)%>%get_heterogeneity
| |
| − | data.hetero = data.frame(matrix(NA, nrow = length(hetero), ncol=2))
| |
| − | names(data.hetero) = c("id","var")
| |
| − | data.hetero$id = colnames(sapply(hetero, function(x) x[[1]]))
| |
| − | data.hetero$var = sapply(hetero, function(x) x[[1]]$percent_var_accounted[[1]])
| |
| − |
| |
| − | #### 主效应分析表制作 ####
| |
| − | main_r <- main_r %>% summary %>% get_metatab
| |
| − | main_rho <- main_rho %>% summary %>% get_metatab
| |
| − | maineffects <- data.frame(main_r$analysis_id,
| |
| − | main_r$construct_x,
| |
| − | main_r$construct_y,
| |
| − | main_r$`orig.data$y.coding.t`,
| |
| − | main_r$k, main_r$N,
| |
| − | round(cbind(main_r$mean_r, main_r$sd_r,
| |
| − | main_rho$mean_r,main_rho$sd_r),2),
| |
| − | paste("[", round(main_rho$CI_LL_95, 2), ", ",
| |
| − | round(main_rho$CI_UL_95, 2), "]"),
| |
| − | paste("[", round(main_rho$CR_LL_80, 2), ", ",
| |
| − | round(main_rho$CR_UL_80, 2),"]"),
| |
| − | data.hetero) %>%
| |
| − | set_colnames(c("id", "x", "y", "dim", "k", "n",
| |
| − | "r", "SD_r","rho", "SD_rho",
| |
| − | "95% CI", "80% CV",
| |
| − | "var%"))
| |
| − | main.poq <- subset(maineffects, maineffects$x == "资质过剩感" &
| |
| − | maineffects$y != "个人工作匹配"&
| |
| − | maineffects$y != "个人组织匹配"&
| |
| − | maineffects$y != "健康"&
| |
| − | maineffects$y != "对工作的态度"&
| |
| − | maineffects$y != "对组织的态度")
| |
| − | main.poq$`5k+10` = main.poq$k * 5 + 10
| |
| − |
| |
| − | maineffects.poq = left_join(main.poq, t.nfs, by=c("dim"="order")) %>%
| |
| − | left_join(t.nfs, by=c("y"="order")) %>% unique
| |
| − |
| |
| − | mainpoq <- data.frame(maineffects.poq[, 3:12],
| |
| − | round(unlist(maineffects.poq$`var%`),2),
| |
| − | maineffects.poq[, 14:16])%>%set_colnames(
| |
| − | c("y", "dim", "k", "n", "r",
| |
| − | "SD_r", "rho", "SD_rho", "95%CI", "80%CV",
| |
| − | "var", "5k+10", "nfs.dim", "nfs.all"))
| |
| − | write.csv(mainpoq, file = "poq直接效应.csv")
| |
| − |
| |
| − |
| |
| − | attach(maineffects)
| |
| − | maineffects$word <- paste("(", r,", ", rho, ")","\n",
| |
| − | "(", k,", ", maineffects$n, ")","\n",
| |
| − | `95% CI`,"\n",
| |
| − | `80% CV`)
| |
| − |
| |
| − |
| |
| − | #### 2………………中介效应检验………………####
| |
| − | #### 数据准备：全模型数据 ####
| |
| − | varnames <- c("POQ","NE", "PS", "NB", "PB", "JP")
| |
| − | attach(maineffects)
| |
| − | poq.ne <- subset(maineffects, x == "资质过剩感" &
| |
| − | y == "消极情绪" &
| |
| − | dim == "All Levels")
| |
| − | poq.ps <- subset(maineffects, x == "资质过剩感" &
| |
| − | y == "积极自我概念" &
| |
| − | dim == "All Levels")
| |
| − | poq.nb <- subset(maineffects, x == "资质过剩感" &
| |
| − | y == "消极行为" &
| |
| − | dim == "All Levels")
| |
| − | poq.pb <- subset(maineffects, x == "资质过剩感" &
| |
| − | y == "积极行为" &
| |
| − | dim == "All Levels")
| |
| − | poq.jp <- subset(maineffects, x == "资质过剩感" &
| |
| − | y == "任务绩效" &
| |
| − | dim == "All Levels")
| |
| − |
| |
| − | ne.ps <- subset(maineffects, (x == "消极情绪" &
| |
| − | y == "积极自我概念" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "积极自我概念" &
| |
| − | dim == "All Levels"))
| |
| − | ne.nb <- subset(maineffects, (x == "消极情绪" &
| |
| − | y == "消极行为" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "消极行为" &
| |
| − | dim == "All Levels"))
| |
| − | ne.pb <- subset(maineffects, (x == "消极情绪" &
| |
| − | y == "积极行为" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "积极行为" &
| |
| − | dim == "All Levels"))
| |
| − | ne.jp <- subset(maineffects, (x == "消极情绪" &
| |
| − | y == "任务绩效" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "任务绩效" &
| |
| − | dim == "All Levels"))
| |
| − |
| |
| − | ps.nb <- subset(maineffects, (x == "积极自我概念" &
| |
| − | y == "消极行为" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "消极行为" &
| |
| − | dim == "All Levels"))
| |
| − | ps.pb <- subset(maineffects, (x == "积极自我概念" &
| |
| − | y == "积极行为" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "积极行为" &
| |
| − | dim == "All Levels"))
| |
| − | ps.jp <- subset(maineffects, (x == "积极自我概念" &
| |
| − | y == "任务绩效" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "任务绩效" &
| |
| − | dim == "All Levels"))
| |
| − |
| |
| − | nb.pb <- subset(maineffects, (x == "消极行为" &
| |
| − | y == "积极行为" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "消极行为" &
| |
| − | x == "积极行为" &
| |
| − | dim == "All Levels"))
| |
| − | nb.jp <- subset(maineffects, (x == "消极行为" &
| |
| − | y == "任务绩效" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "消极行为" &
| |
| − | x == "任务绩效" &
| |
| − | dim == "All Levels"))
| |
| − |
| |
| − | pb.jp <- subset(maineffects, (x == "积极行为" &
| |
| − | y == "任务绩效" &
| |
| − | dim == "All Levels")|
| |
| − | (y == "积极行为" &
| |
| − | x == "任务绩效" &
| |
| − | dim == "All Levels"))
| |
| − | all.matrix <- vec2symMat(c(poq.ne$rho, poq.ps$rho, poq.nb$rho, poq.pb$rho, poq.jp$rho,
| |
| − | ne.ps$rho, ne.nb$rho, ne.pb$rho, ne.jp$rho,
| |
| − | ps.nb$rho, ps.pb$rho, ps.jp$rho,
| |
| − | nb.pb$rho, nb.jp$rho,
| |
| − | pb.jp$rho),
| |
| − | diag = FALSE, byrow = FALSE) %>%
| |
| − | set_colnames(varnames) %>%
| |
| − | set_rownames(varnames)
| |
| − |
| |
| − | all_dat <- list(all.matrix)
| |
| − | is.pd(all_dat)
| |
| − |
| |
| − |
| |
| − | attach(orig.data)
| |
| − | main_in_r <- ma_r(rxyi = rxy, n = n,
| |
| − | sample_id = id, citekey = id,
| |
| − | construct_x = orig.data$x.frame.all,
| |
| − | construct_y = orig.data$y.frame.all,
| |
| − | moderators = orig.data$indi,
| |
| − | data = orig.data)
| |
| − | main_in_rho <- ma_r(rxyi = rtp, n = n,
| |
| − | sample_id = id, citekey = id,
| |
| − | construct_x = orig.data$x.frame.all,
| |
| − | construct_y = orig.data$y.frame.all,
| |
| − | moderators = orig.data$indi,
| |
| − | data = orig.data)
| |
| − | hetero_in <- heterogeneity(main_in_rho)%>%get_heterogeneity
| |
| − | data.hetero_in = data.frame(matrix(NA, nrow = length(hetero_in), ncol=2))
| |
| − | names(data.hetero_in) = c("id","var")
| |
| − | data.hetero_in$id = colnames(sapply(hetero_in, function(x) x[[1]]))
| |
| − | data.hetero_in$var = sapply(hetero_in, function(x) x[[1]]$percent_var_accounted[[1]])
| |
| − |
| |
| − |
| |
| − | main_in_r <- main_in_r %>% summary %>% get_metatab %>% na.omit
| |
| − | main_in_rho <- main_in_rho %>% summary %>% get_metatab %>% na.omit
| |
| − |
| |
| − | main_indi <- data.frame(main_in_r$analysis_id,
| |
| − | main_in_r$construct_x,
| |
| − | main_in_r$construct_y,
| |
| − | main_in_r$`orig.data$indi`,
| |
| − | main_in_r$k, main_in_r$N,
| |
| − | round(cbind(main_in_r$mean_r, main_in_r$sd_r,
| |
| − | main_in_rho$mean_r,main_in_rho$sd_r),2),
| |
| − | paste("[", round(main_in_rho$CI_LL_95, 2), ", ",
| |
| − | round(main_in_rho$CI_UL_95, 2), "]"),
| |
| − | paste("[", round(main_in_rho$CR_LL_80, 2), ", ",
| |
| − | round(main_in_rho$CR_UL_80, 2),"]")
| |
| − | ) %>%
| |
| − | set_colnames(c("id", "x", "y", "indi", "k", "n",
| |
| − | "r", "SD_r","rho", "SD_rho",
| |
| − | "95% CI", "80% CV"))
| |
| − |
| |
| − | #### 数据准备：低个人主义（高集体主义）数据 ####
| |
| − | attach(main_indi)
| |
| − | poq.ne.l <- subset(main_indi, x == "资质过剩感" & y == "消极情绪" & indi == "L")
| |
| − |
| |
| − | poq.ps.l <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "积极自我概念" &
| |
| − | indi == "L")
| |
| − | poq.nb.l <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "消极行为" &
| |
| − | indi == "L")
| |
| − | poq.pb.l <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "积极行为" &
| |
| − | indi == "L")
| |
| − | poq.jp.l <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "L")
| |
| − |
| |
| − | ne.ps.l <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "积极自我概念" &
| |
| − | indi == "L")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "积极自我概念" &
| |
| − | indi == "L"))
| |
| − | ne.nb.l <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "消极行为" &
| |
| − | indi == "L")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "消极行为" &
| |
| − | indi == "L"))
| |
| − | ne.pb.l <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "积极行为" &
| |
| − | indi == "L")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "积极行为" &
| |
| − | indi == "L"))
| |
| − | ne.jp.l <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "L")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "L"))
| |
| − |
| |
| − | ps.nb.l <- subset(main_indi, (x == "积极自我概念" &
| |
| − | y == "消极行为" &
| |
| − | indi == "L")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "消极行为" &
| |
| − | indi == "L"))
| |
| − | ps.pb.l <- subset(main_indi, (x == "积极自我概念" &
| |
| − | y == "积极行为" &
| |
| − | indi == "L")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "积极行为" &
| |
| − | indi == "L"))
| |
| − | ps.jp.l <- subset(main_indi, (x == "积极自我概念" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "L")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "L"))
| |
| − |
| |
| − | nb.pb.l <- subset(main_indi, (x == "消极行为" &
| |
| − | y == "积极行为" &
| |
| − | indi == "L")|
| |
| − | (y == "消极行为" &
| |
| − | x == "积极行为" &
| |
| − | indi == "L"))
| |
| − | nb.jp.l <- subset(main_indi, (x == "消极行为" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "L")|
| |
| − | (y == "消极行为" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "L"))
| |
| − |
| |
| − | pb.jp.l <- subset(main_indi, (x == "积极行为" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "L")|
| |
| − | (y == "积极行为" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "L"))
| |
| − | all.matrix.l <- vec2symMat(c(poq.ne.l$rho, poq.ps.l$rho, poq.nb.l$rho, poq.pb.l$rho, poq.jp.l$rho,
| |
| − | ne.ps.l$rho, ne.nb.l$rho, ne.pb.l$rho, ne.jp.l$rho,
| |
| − | ps.nb.l$rho, ps.pb.l$rho, ps.jp.l$rho,
| |
| − | nb.pb.l$rho, nb.jp.l$rho,
| |
| − | pb.jp.l$rho),
| |
| − | diag = FALSE, byrow = FALSE) %>%
| |
| − | set_colnames(varnames) %>%
| |
| − | set_rownames(varnames)
| |
| − |
| |
| − | all_dat.l <- list(all.matrix.l)
| |
| − | is.pd(all_dat.l)
| |
| − | #### 数据准备：高个人主义（低集体主义）数据 ####
| |
| − | attach(main_indi)
| |
| − | poq.ne.h <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "消极情绪" &
| |
| − | indi == "H")
| |
| − | poq.ps.h <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "积极自我概念" &
| |
| − | indi == "H")
| |
| − | poq.nb.h <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "消极行为" &
| |
| − | indi == "H")
| |
| − | poq.pb.h <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "积极行为" &
| |
| − | indi == "H")
| |
| − | poq.jp.h <- subset(main_indi, x == "资质过剩感" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "H")
| |
| − |
| |
| − | ne.ps.h <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "积极自我概念" &
| |
| − | indi == "H")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "积极自我概念" &
| |
| − | indi == "H"))
| |
| − | ne.nb.h <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "消极行为" &
| |
| − | indi == "H")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "消极行为" &
| |
| − | indi == "H"))
| |
| − | ne.pb.h <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "积极行为" &
| |
| − | indi == "H")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "积极行为" &
| |
| − | indi == "H"))
| |
| − | ne.jp.h <- subset(main_indi, (x == "消极情绪" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "H")|
| |
| − | (y == "消极情绪" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "H"))
| |
| − |
| |
| − | ps.nb.h <- subset(main_indi, (x == "积极自我概念" &
| |
| − | y == "消极行为" &
| |
| − | indi == "H")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "消极行为" &
| |
| − | indi == "H"))
| |
| − | ps.pb.h <- subset(main_indi, (x == "积极自我概念" &
| |
| − | y == "积极行为" &
| |
| − | indi == "H")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "积极行为" &
| |
| − | indi == "H"))
| |
| − | ps.jp.h <- subset(main_indi, (x == "积极自我概念" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "H")|
| |
| − | (y == "积极自我概念" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "H"))
| |
| − |
| |
| − | nb.pb.h <- subset(main_indi, (x == "消极行为" &
| |
| − | y == "积极行为" &
| |
| − | indi == "H")|
| |
| − | (y == "消极行为" &
| |
| − | x == "积极行为" &
| |
| − | indi == "H"))
| |
| − | nb.jp.h <- subset(main_indi, (x == "消极行为" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "H")|
| |
| − | (y == "消极行为" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "H"))
| |
| − |
| |
| − | pb.jp.h <- subset(main_indi, (x == "积极行为" &
| |
| − | y == "任务绩效" &
| |
| − | indi == "H")|
| |
| − | (y == "积极行为" &
| |
| − | x == "任务绩效" &
| |
| − | indi == "H"))
| |
| − | all.matrix.h <- vec2symMat(c(poq.ne.h$rho, poq.ps.h$rho, poq.nb.h$rho, poq.pb.h$rho, poq.jp.h$rho,
| |
| − | ne.ps.h$rho, ne.nb.h$rho, ne.pb.h$rho, ne.jp.h$rho,
| |
| − | ps.nb.h$rho, ps.pb.h$rho, ps.jp.h$rho,
| |
| − | nb.pb.h$rho, nb.jp.h$rho,
| |
| − | pb.jp.h$rho),
| |
| − | diag = FALSE, byrow = FALSE) %>%
| |
| − | set_colnames(varnames) %>%
| |
| − | set_rownames(varnames)
| |
| − |
| |
| − | all_dat.h <- list(all.matrix.h)
| |
| − | is.pd(all_dat.h)
| |
| − | #### 调和平均数 ####
| |
| − | library(psych)
| |
| − | all_n <- c(poq.ne$n, poq.ps$n, poq.nb$n, poq.pb$n, poq.jp$n,
| |
| − | ne.ps$n, ne.nb$n, ne.pb$n, ne.jp$n,
| |
| − | ps.nb$n, ps.pb$n, ps.jp$n,
| |
| − | nb.pb$n, nb.jp$n,
| |
| − | pb.jp$n) %>% harmonic.mean %>% round
| |
| − | n_l <- c(poq.ne.l$n, poq.ps.l$n, poq.nb.l$n, poq.pb.l$n, poq.jp.l$n,
| |
| − | ne.ps.l$n, ne.nb.l$n, ne.pb.l$n, ne.jp.l$n,
| |
| − | ps.nb.l$n, ps.pb.l$n, ps.jp.l$n,
| |
| − | nb.pb.l$n, nb.jp.l$n,
| |
| − | pb.jp.l$n) %>% harmonic.mean %>% round
| |
| − | n_h <- c(poq.ne.h$n, poq.ps.h$n, poq.nb.h$n, poq.pb.h$n, poq.jp.h$n,
| |
| − | ne.ps.h$n, ne.nb.h$n, ne.pb.h$n, ne.jp.h$n,
| |
| − | ps.nb.h$n, ps.pb.h$n, ps.jp.h$n,
| |
| − | nb.pb.h$n, nb.jp.h$n,
| |
| − | pb.jp.h$n) %>% harmonic.mean %>% round
| |
| − |
| |
| − | ####模型设置 ####
| |
| − |
| |
| − | model_all <- 'NB ~ POQ + PS + NE
| |
| − | PB ~ POQ + PS + NE
| |
| − | JP ~ POQ + PS + NE
| |
| − |
| |
| − | NE ~ POQ
| |
| − | PS ~ POQ
| |
| − |
| |
| − | NE ~~ 1*NE
| |
| − | PS ~~ 1*PS
| |
| − | POQ ~~ 1*POQ
| |
| − |
| |
| − | NE ~~ 0.1*PS
| |
| − |
| |
| − | NB ~~ 0.1*NB
| |
| − | PB ~~ 0.1*PB
| |
| − | JP ~~ 0.1*JP
| |
| − |
| |
| − | NB ~~ 0.1*PB
| |
| − | NB ~~ 0.1*JP
| |
| − | JP ~~ 0.1*PB'
| |
| − |
| |
| − | plot(model_all, col="yellow")
| |
| − |
| |
| − | RAM_all <- lavaan2RAM(model_all, obs.variables = varnames)
| |
| − | RAM_all
| |
| − |
| |
| − |
| |
| − | #### SEM全部数据及调和平均数 ####
| |
| − | fin_dat <- list(all_dat, all_dat.l, all_dat.h)
| |
| − | fin_n <- c(all_n, n_l, n_h)
| |
| − |
| |
| − |
| |
| − | stage1 <- list()
| |
| − | stage2 <- list()
| |
| − | stage2_LB <- list()
| |
| − | stage2_Z <- list()
| |
| − | ind_LB <- list()
| |
| − | ind_Z <- list()
| |
| − | fitness <- list()
| |
| − | path <- list()
| |
| − | ind <- list()
| |
| − | sem <- list()
| |
| − | name <- c("all", "low individualism", "high individualism")
| |
| − | for (i in 1:length(fin_dat)){
| |
| − | #### stage1 ####
| |
| − | stage1[[i]] <- tssem1(Cov = fin_dat[[i]], n = fin_n[i], method = "FEM",
| |
| − | RE.type = "Diag", RE.startvalues=0.1,
| |
| − | acov = "weighted")
| |
| − |
| |
| − | summary(stage1[[i]])
| |
| − | #### stage2 ####
| |
| − | stage2[[i]] <- tssem2(stage1[[i]], Amatrix = RAM_all$A, Smatrix = RAM_all$S)
| |
| − | summary(stage2[[i]])
| |
| − |
| |
| − | stage2_LB[[i]] <- tssem2(stage1[[i]], Amatrix = RAM_all$A, Smatrix = RAM_all$S,
| |
| − | diag.constraints = TRUE, intervals.type = "LB",
| |
| − | mx.algebras = list(
| |
| − | #POQ-NE-Y
| |
| − | IndNE_NB = mxAlgebra(NEONPOQ*NBONNE, name = "IndNE_NB"),
| |
| − | IndNE_PB = mxAlgebra(NEONPOQ*PBONNE, name = "IndNE_PB"),
| |
| − | IndNE_JP = mxAlgebra(NEONPOQ*JPONNE, name = "IndNE_JP"),
| |
| − | #POQ-PS-Y
| |
| − | IndPS_NB = mxAlgebra(PSONPOQ*NBONPS, name = "IndPS_NB"),
| |
| − | IndPS_PB = mxAlgebra(PSONPOQ*PBONPS, name = "IndPS_PB"),
| |
| − | IndPS_JP = mxAlgebra(PSONPOQ*JPONPS, name = "IndPS_JP"),
| |
| − | #POQ-NE+PS-Y
| |
| − | Indall_NB = mxAlgebra(NEONPOQ*NBONNE + PSONPOQ*NBONPS, name = "Indall_NB"),
| |
| − | Indall_PB = mxAlgebra(NEONPOQ*PBONNE + PSONPOQ*PBONPS, name = "Indall_PB"),
| |
| − | Indall_JP = mxAlgebra(NEONPOQ*JPONNE + PSONPOQ*JPONPS, name = "Indall_JP"),
| |
| − | #POQ-NE+PS-Y PLUS POQ-Y
| |
| − | Total_NB = mxAlgebra(NEONPOQ*NBONNE + PSONPOQ*NBONPS + NBONPOQ, name = "Total_NB"),
| |
| − | Total_PB = mxAlgebra(NEONPOQ*PBONNE + PSONPOQ*PBONPS + PBONPOQ, name = "Total_PB"),
| |
| − | Total_JP = mxAlgebra(NEONPOQ*JPONNE + PSONPOQ*JPONPS + JPONPOQ, name = "Total_JP"),
| |
| − | #Diff POQ-(NE-PS)-Y
| |
| − | DIF_NEminusPS_NB= mxAlgebra(NEONPOQ*NBONNE - PSONPOQ*NBONPS, name = "DIF_NEminusPS_NB"),
| |
| − | DIF_NEminusPS_PB= mxAlgebra(NEONPOQ*PBONNE - PSONPOQ*PBONPS, name = "DIF_NEminusPS_PB"),
| |
| − | DIF_NEminusPS_JP= mxAlgebra(NEONPOQ*JPONNE - PSONPOQ*JPONPS, name = "DIF_NEminusPS_JP")))
| |
| − | stage2_LB[[i]] <- rerun(stage2_LB[[i]])
| |
| − | ind_LB[[i]] <- summary(stage2_LB[[i]])
| |
| − |
| |
| − | stage2_Z[[i]] <- tssem2(stage1[[i]], Amatrix = RAM_all$A, Smatrix = RAM_all$S,
| |
| − | diag.constraints = FALSE, intervals.type = "z",
| |
| − | mx.algebras = list(
| |
| − | IndNE_NB = mxAlgebra(NEONPOQ*NBONNE, name = "IndNE_NB"),
| |
| − | IndNE_PB = mxAlgebra(NEONPOQ*PBONNE, name = "IndNE_PB"),
| |
| − | IndNE_JP = mxAlgebra(NEONPOQ*JPONNE, name = "IndNE_JP"),
| |
| − |
| |
| − | IndPS_NB = mxAlgebra(PSONPOQ*NBONPS, name = "IndPS_NB"),
| |
| − | IndPS_PB = mxAlgebra(PSONPOQ*PBONPS, name = "IndPS_PB"),
| |
| − | IndPS_JP = mxAlgebra(PSONPOQ*JPONPS, name = "IndPS_JP"),
| |
| − |
| |
| − | Indall_NB = mxAlgebra(NEONPOQ*NBONNE + PSONPOQ*NBONPS, name = "Indall_NB"),
| |
| − | Indall_PB = mxAlgebra(NEONPOQ*PBONNE + PSONPOQ*PBONPS, name = "Indall_PB"),
| |
| − | Indall_JP = mxAlgebra(NEONPOQ*JPONNE + PSONPOQ*JPONPS, name = "Indall_JP"),
| |
| − |
| |
| − | Total_NB = mxAlgebra(NEONPOQ*NBONNE + PSONPOQ*NBONPS + NBONPOQ, name = "Total_NB"),
| |
| − | Total_PB = mxAlgebra(NEONPOQ*PBONNE + PSONPOQ*PBONPS + PBONPOQ, name = "Total_PB"),
| |
| − | Total_JP = mxAlgebra(NEONPOQ*JPONNE + PSONPOQ*JPONPS + JPONPOQ, name = "Total_JP"),
| |
| − |
| |
| − | DIF_NEminusPS_NB= mxAlgebra(NEONPOQ*NBONNE - PSONPOQ*NBONPS, name = "DIF_NEminusPS_NB"),
| |
| − | DIF_NEminusPS_PB= mxAlgebra(NEONPOQ*PBONNE - PSONPOQ*PBONPS, name = "DIF_NEminusPS_PB"),
| |
| − | DIF_NEminusPS_JP= mxAlgebra(NEONPOQ*JPONNE - PSONPOQ*JPONPS, name = "DIF_NEminusPS_JP")))
| |
| − | stage2_Z[[i]] <- rerun(stage2_Z[[i]])
| |
| − | ind_Z[[i]] <- summary(stage2_Z[[i]])
| |
| − | #### 拟合系数 ####
| |
| − | fitness[[i]] <- ind_LB[[i]][["stat"]]%>%as.data.frame%>%round(2)%>%
| |
| − | set_colnames("Goodness-of-fit indices")
| |
| − | #### 路径系数 ####
| |
| − | path[[i]] <- data.frame(round(ind_Z[[i]][["coefficients"]][,1], 2),
| |
| − | paste("[", round(ind_Z[[i]][["coefficients"]][,3], 2),",",
| |
| − | round(ind_Z[[i]][["coefficients"]][,4], 2), "]"),
| |
| − | round(ind_Z[[i]][["coefficients"]][,2], 2),
| |
| − | round(ind_Z[[i]][["coefficients"]][,5], 2),
| |
| − | round(ind_Z[[i]][["coefficients"]][,6], 2)) %>%
| |
| − | set_colnames(c("β", "95% CI", "SE", "z", "p")) %>%
| |
| − | set_rownames(c("JPONNE", "JPONPOQ", "JPONPS",
| |
| − | "NBONNE", "NBONPOQ", "NBONPS",
| |
| − | "NEONPOQ", "PBONNE", "PBONPOQ",
| |
| − | "PBONPS", "PSONPOQ"))
| |
| − | #### 中介效应 ####
| |
| − | ind[[i]] <- data.frame(round(ind_LB[[i]][["mx.algebras"]][,2],2),
| |
| − | paste("[", round(ind_LB[[i]][["mx.algebras"]][,1],2), ",",
| |
| − | round(ind_LB[[i]][["mx.algebras"]][,3],2), "]")) %>%
| |
| − | set_colnames(c("β", "95%CI"))%>%
| |
| − | set_rownames(c("IndNE_NB", "IndNE_PB", "IndNE_JP",
| |
| − | "IndPS_NB", "IndPS_PB", "IndPS_JP",
| |
| − | "Indall_NB", "Indall_PB", "Indall_JP",
| |
| − | "Total_NB", "Total_PB", "Total_JP",
| |
| − | "DIF_NEminusPS_NB", "DIF_NEminusPS_PB", "DIF_NEminusPS_JP"))
| |
| − | sem[[i]] <- list(name = name[i],
| |
| − | fit=fitness[[i]], path = path[[i]], ind = ind[[i]])
| |
| − | sem[[i]]
| |
| − |
| |
| − | i = i + 1}
| |
| − | sem
| |
| − | #### 结构方程分析结果表格 ####
| |
| − | final_fit <- cbind(sem[[1]][["fit"]][c(1,7,4),],
| |
| − | sem[[2]][["fit"]][c(1,7,4),],
| |
| − | sem[[3]][["fit"]][c(1,7,4),])%>%
| |
| − | set_rownames(c("n", "Chi", "p"))%>%
| |
| − | set_colnames(c("全样本", "高集体主义", "低集体主义"))
| |
| − | final_path <- rbind(c("全样本", " "," ", " ", " ",
| |
| − | "高集体主义", " "," ", " ", " ",
| |
| − | "低集体主义", " "," ", " ", " "),
| |
| − | rep(c("β", "95%CI", "SE", "z", "p"), 3),
| |
| − | cbind(rbind(sem[[1]][["path"]]),
| |
| − | rbind(sem[[2]][["path"]]),
| |
| − | rbind(sem[[3]][["path"]])))%>%
| |
| − | set_colnames(c(1:15))
| |
| − | final_ind <- rbind(rep(c("β", "95%CI"),3),
| |
| − | cbind(sem[[1]][["ind"]],
| |
| − | sem[[2]][["ind"]],
| |
| − | sem[[3]][["ind"]]))%>%
| |
| − | set_colnames(c(1:6))
| |
| − | write.csv(final_ind, "ind.csv")
| |
| − | #### 相关系数文本 ####
| |
| − | sem.matrix <- cbind(c(poq.ne$word, poq.ps$word, poq.nb$word, poq.pb$word, poq.jp$word),
| |
| − | c(" ", ne.ps$word, ne.nb$word, ne.pb$word, ne.jp$word),
| |
| − | c(" ", " ", ps.nb$word, ps.pb$word,ps.jp$word),
| |
| − | c(" ", " ", " ", nb.pb$word, nb.jp$word),
| |
| − | c(" ", " "," ", " ", pb.jp$word))%>%
| |
| − | set_colnames(c("资质过剩感", "消极情绪", "积极自我概念", "消极角色外行为", "积极角色外行为"))%>%
| |
| − | set_rownames(c("消极情绪", "积极自我概念", "消极角色外行为", "积极角色外行为", "任务绩效"))
| |
| − | sem.matrix
| |
| − |
| |
| − | #### 3………………概念冗余度检验………………####
| |
| − | #### 相关矩阵构建 ####
| |
| − | attach(maineffects)
| |
| − | matrix <- data.frame(x, y, dim,
| |
| − | paste( "(", k, ",", maineffects$n, ")" ) ,
| |
| − | paste( "(", r, ",", rho, ")" ) ,
| |
| − | `95% CI`, `80% CV`, rho)%>%
| |
| − | set_colnames(c("x", "dim", "y", "(k, n)", "(r, ρ)", "95% CI", "80% CV", "rho"))
| |
| − |
| |
| − | matrix$all = paste(matrix$`(k, n)`, "\n", matrix$`(r, ρ)`, "\n",
| |
| − | matrix$`95% CI`, "\n", matrix$`80% CV`)
| |
| − |
| |
| − |
| |
| − | attach(matrix)
| |
| − | poq_pj <- subset(matrix, x == "资质过剩感" & y == "个人工作匹配")
| |
| − | poq_po <- subset(matrix, x == "资质过剩感" & y == "个人组织匹配")
| |
| − | poq_y <- subset(matrix, (y == "压力（反向）"|
| |
| − | y == "组织承诺"|
| |
| − | y == "工作满意度"|
| |
| − | y == "创新"|
| |
| − | y == "组织公民行为"|
| |
| − | y == "反生产行为"|
| |
| − | y == "离职意愿"|
| |
| − | y == "任务绩效")&
| |
| − | x == "资质过剩感")
| |
| − | pj_po <- subset(matrix, x == "个人工作匹配" &
| |
| − | dim == "个人组织匹配")
| |
| − | pj_y<- subset(matrix, (x == "个人工作匹配"&
| |
| − | (y == "压力（反向）"|
| |
| − | y == "组织承诺"|
| |
| − | y == "工作满意度"))|
| |
| − | (dim == "个人工作匹配"&
| |
| − | (y == "创新"|
| |
| − | y == "组织公民行为"|
| |
| − | y == "反生产行为"|
| |
| − | y == "离职意愿"|
| |
| − | y == "任务绩效")))
| |
| − | po_y <- subset(matrix, (x == "个人组织匹配"&
| |
| − | (y == "压力（反向）"|
| |
| − | y == "组织承诺"|
| |
| − | y == "工作满意度"))|
| |
| − | (dim == "个人组织匹配"&
| |
| − | (y == "创新"|
| |
| − | y == "组织公民行为"|
| |
| − | y == "反生产行为"|
| |
| − | y == "离职意愿"|
| |
| − | y == "任务绩效")))
| |
| − |
| |
| − | #### 相关矩阵表格 ####
| |
| − | ynames <- c("创新", "组织公民行为", "反生产行为", "离职意愿",
| |
| − | "任务绩效", "压力（反向）", "工作满意度", "组织承诺")
| |
| − | rwa.text <- data.frame(ynames, poq_y= poq_y$all, pj_y = pj_y$all, po_y = po_y$all,
| |
| − | poq_pj = poq_pj$all, poq_po = poq_po$all,
| |
| − | pj_po = pj_po$all)
| |
| − |
| |
| − | varnames <- list()
| |
| − | lables <- list()
| |
| − | text.mx <- list()
| |
| − | for (i in 1:nrow(rwa.text)){
| |
| − | varnames[[i]] <- c(ynames[[i]], "资质过剩感", "个人工作匹配", "个人组织匹配")
| |
| − | lables[[i]] <- list (varnames[[i]], varnames[[i]])
| |
| − | text.mx[[i]] <- vec2symMat(as.matrix(rwa.text[i,2:ncol(rwa.text)]),
| |
| − | diag = FALSE, byrow = FALSE)
| |
| − | dimnames(text.mx[[i]]) <- lables[[i]]
| |
| − | i = i+1}
| |
| − | as.vector(poq_y$y)
| |
| − | poqfit.text.all <- t(data.frame(text.mx[[1]][2:4,2:4], text.mx[[1]][2:4,1],
| |
| − | text.mx[[2]][2:4,1], text.mx[[3]][2:4,1],
| |
| − | text.mx[[4]][2:4,1], text.mx[[5]][2:4,1],
| |
| − | text.mx[[6]][2:4,1], text.mx[[7]][2:4,1],
| |
| − | text.mx[[8]][2:4,1])) %>%
| |
| − | set_rownames(c("资质过剩感", "个人工作匹配", "个人组织匹配",
| |
| − | "创新", "组织公民行为", "反生产行为", "离职意愿",
| |
| − | "任务绩效", "压力（反向）", "工作满意度", "组织承诺"))
| |
| − | write.csv(poqfit.text.all, file = "poq_fit相对矩阵文本.csv")
| |
| − |
| |
| − |
| |
| − | #### 数据准备：相对权重分析 ####
| |
| − | data.rwa <- data.frame(ynames, poq_y= poq_y$rho, pj_y = pj_y$rho, po_y = po_y$rho,
| |
| − | poq_pj = poq_pj$rho, poq_po = poq_po$rho,
| |
| − | pj_po = pj_po$rho)
| |
| − |
| |
| − | varnames <- c("y", "poq", "pj", "po")
| |
| − | lables <- list(varnames, varnames)
| |
| − | cordat <- list()
| |
| − | for (i in 1:nrow(data.rwa)){
| |
| − | cordat[[i]] <- vec2symMat(as.matrix(data.rwa[i,2:ncol(data.rwa)]),
| |
| − | diag = FALSE, byrow = FALSE)
| |
| − | dimnames(cordat[[i]]) <- lables}
| |
| − |
| |
| − | #### 相对权重分析函数 ####
| |
| − | #注：函数来源参考https://relativeimportance.davidson.edu/
| |
| − | #根据本研究做相应调整
| |
| − | multRegress<-function(mydata){
| |
| − | numVar<<-NCOL(mydata)
| |
| − | Variables<<- names(mydata)[2:numVar]
| |
| − | RXX<-mydata[2:numVar,2:numVar]
| |
| − | RXY<-mydata[2:numVar,1]
| |
| − | RXX.eigen<-eigen(RXX)
| |
| − | D<-diag(RXX.eigen$val)
| |
| − | delta<-sqrt(D)
| |
| − | lambda<-RXX.eigen$vec%*%delta%*%t(RXX.eigen$vec)
| |
| − | lambdasq<-lambda^2
| |
| − | beta<-solve(lambda)%*%RXY
| |
| − | rsquare<<-sum(beta^2)
| |
| − | RawWgt<-lambdasq%*%beta^2
| |
| − | import<-(RawWgt/rsquare)*100
| |
| − | result<-data.frame(Variables, Raw.W=round(RawWgt,2),
| |
| − | R.perc=round(import,2),
| |
| − | R2 = round(rsquare,2))
| |
| − | }
| |
| − |
| |
| − | #### POQ fit 相对权重计算 ####
| |
| − | rawdata <- list()
| |
| − | thedata <- list()
| |
| − | Labels <- list()
| |
| − | a <- list()
| |
| − | title <- list()
| |
| − | R_square <- list()
| |
| − | rwa.results <- list()
| |
| − |
| |
| − | for (i in 1:length(cordat))
| |
| − | {
| |
| − | rawdata[[i]]<- data.frame(cordat[[i]])
| |
| − | attach(rawdata[[i]])
| |
| − | thedata[[i]] <- data.frame(y, poq, pj, po)
| |
| − | Labels[[i]] <- names(thedata[[i]])[2:length(thedata[[i]])]
| |
| − | a[[i]] <- multRegress(thedata[[i]]) %>% set_colnames(c("变量", "W", "%R", "R2"))
| |
| − | title[[i]] <- data.frame("", ynames[[i]], "", "") %>% set_colnames(c("变量", "W", "%R", "R2"))
| |
| − | R_square[[i]] <- data.frame("R2", unique(a[[i]][,4]), "", "") %>% set_colnames(c("变量", "W", "%R", "R2"))
| |
| − | rwa.results[[i]] <- rbind(a[[i]], R_square[[i]], title[[i]],
| |
| − | data.frame("变量", "W", "%R", "R2") %>%
| |
| − | set_colnames(c("变量", "W", "%R", "R2")))[, 1:3]
| |
| − | rwa.results[[i]] <- data.frame(id = c(1:nrow(rwa.results[[i]])), rwa.results[[i]])
| |
| − | i = i + 1
| |
| − | }
| |
| − |
| |
| − | rwa.results
| |
| − |
| |
| − | total<-merge(rwa.results[[1]],
| |
| − | rwa.results[2:length(rwa.results)], by="id")%>%t%>%unique%>%t
| |
| − |
| |
| − | total.rwa <- rbind(total[5:6,], total[1:4,])
| |
| − | write.csv(total.rwa, file = "poq_fit相对权重分析结果.csv")
| |
| | </pre> | | </pre> |
| | | | |
| | ==纳入元分析文献== | | ==纳入元分析文献== |
杨伟文 李超平. 资质过剩感对个体绩效的作用效果及机制：基于情绪-认知加工系统与文化情境的元分析研究. 心理学报, 53(4)，100-120
