Skip to content

Instantly share code, notes, and snippets.

@tukachev
Last active August 29, 2015 13:56
Show Gist options
  • Save tukachev/8846459 to your computer and use it in GitHub Desktop.
Save tukachev/8846459 to your computer and use it in GitHub Desktop.
# 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