Last active
August 29, 2015 13:56
-
-
Save tukachev/8846459 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# McCrae's rpa (r profile agreement) | |
rpa <- function(p1,p2){ | |
if (length(p1) != length(p2)) | |
stop("'p1' and 'p2' must have the same length") | |
k <- length(p1) | |
sumM.sq <- sum(((p1 + p2)/2)^2) | |
sumd.sq <- sum((p1 - p2)^2) | |
ipa <- (k + 2*sumM.sq - sumd.sq) / sqrt(10*k) | |
rpa <- ipa / sqrt(k - 2 + ipa^2) | |
return(rpa) | |
} | |
#Example 1 | |
#Result graph https://dl.dropboxusercontent.com/u/33111025/pic/rpa.png | |
b5plus <- c("Экстраверсия", "Согласие","Самоконтроль", "Стабильность", "Новаторство") | |
p1 <- c(9.3, 2.1, 4.8, 8.5, 7.2) | |
p2 <- c(6.5, 1, 4.8, 3.1, 1.8) | |
id <- c(7.1, 3.5, 6.0, 7.7, 6.8) | |
profile1 <- c(1.90, -1.70, -0.35, 1.50, 0.85) | |
profile2 <- c(0.50, -2.25, -0.35, -1.20, -1.85) | |
ideal <- c(0.80, -1.00, 0.25, 1.10, 0.65) | |
#rpa | |
r <- rpa(profile1,ideal) | |
r2 <- rpa(profile2,ideal) | |
r3 <- rpa(profile1,profile1) | |
#r | |
cor(p1, id) | |
cor(p2, id) | |
cor(p1, p2) | |
plot(id, type="o", col="blue", lty=1, lwd=2, axes=FALSE, ann=FALSE, ylim=c(1,10)) | |
axis(1, at=1:5, lab=b5plus) | |
axis(2, at=1:10) | |
lines(p1, type="o", col="green", lty=1, lwd=2, axes=FALSE, ann=FALSE) | |
lines(p2, type="o", col="red", lty=1, lwd=2, axes=FALSE, ann=FALSE) | |
title(xlab="Шкалы большой пятерки (методика b5plus)", col.lab=rgb(0,0.5,0)) | |
title(ylab="Стены", col.lab=rgb(0,0.5,0)) | |
title(main="Сходство \"реального\" и \"идеального\" профиля руководителя", col.main="black", font.main=1) | |
legend(1.5, 10, c("Идеальный","Реальный (успешный)", "Реальный (неуспешный)"), cex=0.8, | |
col=c("blue","green", "red"), lty=c(1,1,1), lwd=c(2,2,2)) | |
text(4, 9, col="green", paste("rpa (успеш) = ",round(r, 2)), cex=0.8) | |
text(4, 2, col="red", paste("rpa (неуспеш) = ",round(r2, 2)), cex=0.8) | |
#Example 2 Two personality profiles agreement | |
neo <- c("N", "E","O", "A", "C") | |
p1 <- c(7.5, 3.5, 4.5, 6.5, 3.5) # Sten Scores | |
p2 <- c(3.5, 7.5, 5.5, 5.5, 7.5) | |
p3 <- c(6.5, 4.5, 5.5, 5.5, 4.5) | |
profile1 <- c(1.0, -1.0, -0.5, 0.5, -1.0) # Scores are standardized (i.e., z-scores, µ = 0 σ = 1) | |
profile2 <- c(-1, 1, 0, 0, 1) | |
profile3 <- c(0.5, -0.5, 0.0, 0.0, -0.5) | |
r <- rpa(profile1,profile2) | |
plot(p1, type="o", col="blue", axes=FALSE, ann=FALSE) | |
axis(1, at=1:5, lab=neo) | |
axis(2, las=1, at=1:10) | |
lines(p2, type="o", col="red", axes=FALSE, ann=FALSE) | |
title(xlab="NEO-PI R", col.lab=rgb(0,0.5,0)) | |
title(ylab="Sten scores", col.lab=rgb(0,0.5,0)) | |
title(main="Two personality profiles agreement", col.main="red", font.main=4) | |
legend(3, 7.5, c("profile1","profile2"), cex=0.8, | |
col=c("blue","red"), pch=21:22, lty=1:2) | |
text(4, 4, paste("rpa = ",round(r, 3))) | |
r <- rpa(profile1,profile3) | |
plot(p1, type="o", col="blue", axes=FALSE, ann=FALSE) | |
axis(1, at=1:5, lab=neo) | |
axis(2, las=1, at=1:10) | |
lines(p3, type="o", col="red", axes=FALSE, ann=FALSE) | |
title(xlab="NEO-PI R", col.lab=rgb(0,0.5,0)) | |
title(ylab="Sten scores", col.lab=rgb(0,0.5,0)) | |
title(main="Two personality profiles agreement", col.main="red", font.main=4) | |
legend(3, 7.5, c("profile1","profile2"), cex=0.8, | |
col=c("blue","red"), pch=21:22, lty=1:2) | |
text(4, 4, paste("rpa = ",round(r, 3))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment