Nothing
R/print.psych.R
In psych: Procedures for Psychological, Psychometric, and Personality Research
#reorganized May 25, 2009 to call several print functions (psych.print.x where x = {fa, omega, stats, vss}
#reorganized, January 18, 2009 to make some what clearer
#added the switch capability, August 25, 2011 following suggestions by Joshua Wiley
#changed from print.psych.x to print_psych.x because of change to R development not liking print.x.y format
"print.psych" <-
function(x,digits=2,all=FALSE,cut=NULL,sort=FALSE,short=TRUE,lower=TRUE,signif=NULL,...) {
#probably need to fix this with inherits but trying to avoid doing that now.
if(length(class(x)) > 1) { value <- class(x)[2] } else {
#these next test for non-psych functions that may be printed using print.psych.fa
if((!is.null(x$communality.iterations)) | (!is.null(x$uniquenesses)) | (!is.null(x$rotmat)) | (!is.null(x$Th)) ) {value <- fa }
}
if(all) value <- "all"
if(value == "score.items") value <- "scores"
if(value =="set.cor") value <- "setCor"
switch(value,
## the following functions have their own print function
esem = {print_psych.esem(x,digits=digits,short=short,cut=cut,...)},
extension = { print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
extend = {print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
fa = {print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
fa.ci = { print_psych.fa.ci(x,digits=digits,all=all,... )},
iclust= { print_psych.iclust(x,digits=digits,all=all,cut=cut,sort=sort,...)},
omega = { print_psych.omega(x,digits=digits,all=all,cut=cut,sort=sort,...)},
omegaSem= {print_psych.omegaSem(x,digits=digits,all=all,cut=cut,sort=sort,...)},
principal ={print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
schmid = { print_psych.schmid(x,digits=digits,all=all,cut=cut,sort=sort,...)},
stats = { print_psych.stats(x,digits=digits,all=all,cut=cut,sort=sort,...)},
vss= { print_psych.vss(x,digits=digits,all=all,cut=cut,sort=sort,...)},
cta = {print_psych.cta(x,digits=digits,all=all,...)},
mediate = {print_psych.mediate(x,digits=digits,short=short,...)},
multilevel = {print_psych.multilevel(x,digits=digits,short=short,...)},
testRetest = {print_psych.testRetest(x,digits=digits,short=short,...)},
bestScales = {print_psych.bestScales(x,digits=digits,short=short,...)},
##Now, for the smaller print jobs, just do it here.
all= {class(x) <- "list"
print(x,digits=digits) }, #find out which function created the data and then print accordingly
alpha = {
cat("\nReliability analysis ",x$title," \n")
cat("Call: ")
print(x$call)
cat("\n ")
print(x$total,digits=digits)
cat("\n 95% confidence boundaries \n")
temp.df <- data.frame(lower=x$feldt$lower.ci, alpha= x$feldt$alpha,upper.ci =x$feldt$upper.ci)
colnames(temp.df ) <- c("lower","alpha","upper")
rownames(temp.df) <- "Feldt"
if(!is.null(x$total$ase)){
temp.df[2,] <- c(x$total$raw_alpha - 1.96* x$total$ase, x$total$raw_alpha,x$total$raw_alpha +1.96* x$total$ase)
#cat(round(c(x$total$raw_alpha - 1.96* x$total$ase, x$total$raw_alpha,x$total$raw_alpha +1.96* x$total$ase),digits=digits) ,"\n")}
#if(!is.null(x$feldt)) {cat("\n 95% confidence boundaries (Feldt) \n")
#temp.df <- data.frame(lower=x$feldt$lower.ci, alpha= x$feldt$alpha,upper.ci =x$feldt$upper.ci)
rownames(temp.df)[2]<- "Duhachek"
}
if(!is.null(x$boot.ci)) { #{cat("\n lower median upper bootstrapped confidence intervals\n",round(x$boot.ci,digits=digits))}
temp.df[3,] <- x$boot.ci
rownames(temp.df)[3] <- "bootstrapped"}
print(round(temp.df,digits))
cat("\n Reliability if an item is dropped:\n")
print(x$alpha.drop,digits=digits)
cat("\n Item statistics \n")
print(x$item.stats,digits=digits)
if(!is.null(x$response.freq)) {
cat("\nNon missing response frequency for each item\n")
print(round(x$response.freq,digits=digits))}
},
alpha.ci = { cat("\n 95% confidence boundaries (Feldt)\n")
if(is.na(x$r.bar)) {print("I am sorry, you need to specify the n.var to get confidence interals")} else {
temp.df <- data.frame(lower=x$lower.ci, alpha= x$alpha,upper.ci =x$upper.ci)
colnames(temp.df ) <- c("lower","alpha","upper")
rownames(temp.df)<-""
print(round (temp.df,digits))}
},
autoR = {cat("\nAutocorrelations \n")
if(!is.null(x$Call)) {cat("Call: ")
print(x$Call)}
print(round(x$autoR,digits=digits))
},
bassAck = {
cat("\nCall: ")
print(x$Call)
nf <- length(x$bass.ack)-1
for (f in 1:nf) {
cat("\n",f,
x$sumnames[[f]])}
if(!short) {
for (f in 1:nf) {
cat("\nFactor correlations\n ")
print(round(x$bass.ack[[f]],digits=digits))}
} else {cat("\nUse print with the short = FALSE option to see the correlations, or use the summary command.")}
},
auc = {cat('Decision Theory and Area under the Curve\n')
cat('\nThe original data implied the following 2 x 2 table\n')
print(x$probabilities,digits=digits)
cat('\nConditional probabilities of \n')
print(x$conditional,digits=digits)
cat('\nAccuracy = ',round(x$Accuracy,digits=digits),' Sensitivity = ',round(x$Sensitivity,digits=digits), ' Specificity = ',round(x$Specificity,digits=digits), '\nwith Area Under the Curve = ', round(x$AUC,digits=digits) )
cat('\nd.prime = ',round(x$d.prime,digits=digits), ' Criterion = ',round(x$criterion,digits=digits), ' Beta = ', round(x$beta,digits=digits))
cat('\nObserved Phi correlation = ',round(x$phi,digits=digits), '\nInferred latent (tetrachoric) correlation = ',round(x$tetrachoric,digits=digits))
},
bestScales = {if(!is.null(x$first.result)) {
cat("\nCall = ")
print(x$Call)
# print(x$first.result)
# print(round(x$means,2))
print(x$summary,digits=digits)
# x$replicated.items
items <- x$items
size <- NCOL(items[[1]])
nvar <- length(items)
for(i in 1:nvar) {
if(NCOL(items[[i]]) > 3) {items[[i]] <- items[[i]][,-1]}
# items[[i]][,2:3] <- round(items[[i]][,2:3],digits)
if(length( items[[i]][1]) > 0 ) {
items[[i]][,c("mean.r","sd.r")] <- round(items[[i]][,c("mean.r","sd.r")],digits)
}}
cat("\n Best items on each scale with counts of replications\n")
print(items)} else {
df <- data.frame(correlation=x$r,n.items = x$n.items)
cat("The items most correlated with the criteria yield r's of \n")
print(round(df,digits=digits))
if(length(x$value) > 0) {cat("\nThe best items, their correlations and content are \n")
print(x$value) } else {cat("\nThe best items and their correlations are \n")
for(i in 1:length(x$short.key)) {print(round(x$short.key[[i]],digits=digits))}
}
}
},
bifactor = {
cat("Call: ")
print(x$Call)
cat("Alpha: ",round(x$alpha,digits),"\n")
cat("G.6: ",round(x$G6,digits),"\n")
cat("Omega Hierarchical: " ,round(x$omega_h,digits),"\n")
# cat("Omega H asymptotic: " ,round(x$omega.lim,digits),"\n")
cat("Omega Total " ,round(x$omega.tot,digits),"\n")
print(x$f,digits=digits,sort=sort)
},
circ = {cat("Tests of circumplex structure \n")
cat("Call:")
print(x$Call)
res <- data.frame(x[1:4])
print(res,digits=2)
},
circadian = {if(!is.null(x$Call)) {cat("Call: ")
print(x$Call)}
cat("\nCircadian Statistics :\n")
if(!is.null(x$F)) {
cat("\nCircadian F test comparing groups :\n")
print(round(x$F,digits))
if(short) cat("\n To see the pooled and group statistics, print with the short=FALSE option")
}
if(!is.null(x$pooled) && !short) { cat("\nThe pooled circadian statistics :\n")
print( x$pooled)}
if(!is.null(x$bygroup) && !short) {cat("\nThe circadian statistics by group:\n")
print(x$bygroup)}
#if(!is.null(x$result)) print(round(x$result,digits))
if(!is.null(x$phase.rel)) {
cat("\nSplit half reliabilities are split half correlations adjusted for test length\n")
x.df <- data.frame(phase=x$phase.rel,fits=x$fit.rel)
print(round(x.df,digits)) }
if(is.data.frame(x)) {class(x) <- "data.frame"
print(round(x,digits=digits)) }
},
cluster.cor = {
cat("Call: ")
print(x$Call)
cat("\n(Standardized) Alpha:\n")
print(x$alpha,digits)
cat("\n(Standardized) G6*:\n")
print(x$G6,digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits)
cat("\nNumber of items:\n")
print(x$size)
cat("\nSignal to Noise ratio based upon average r and n \n")
print(x$sn,digits=digits)
# cat("\nScale intercorrelations:\n")
# print(x$cor,digits=digits)
cat("\nScale intercorrelations corrected for attenuation \n raw correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
print(x$corrected,digits)
},
cluster.loadings = {
cat("Call: ")
print(x$Call)
cat("\n(Standardized) Alpha:\n")
print(x$alpha,digits)
cat("\n(Standardized) G6*:\n")
print(x$G6,digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits)
cat("\nNumber of items:\n")
print(x$size)
cat("\nScale intercorrelations corrected for attenuation \n raw correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
print(x$corrected,digits)
cat("\nItem by scale intercorrelations\n corrected for item overlap and scale reliability\n")
print(x$loadings,digits)
#cat("\nItem by scale Pattern matrix\n")
# print(x$pattern,digits)
},
cohen.d = {cat("Call: ")
print(x$Call)
cat("Cohen d statistic of difference between two means\n")
if(NCOL(x$cohen.d) == 3) {print(round(x$cohen.d,digits=digits))} else {print( data.frame(round(x$cohen.d[1:3],digits=digits),x$cohen.d[4:NCOL(x$cohen.d)]))}
cat("\nMultivariate (Mahalanobis) distance between groups\n")
print(x$M.dist,digits=digits)
cat("r equivalent of difference between two means\n")
print(round(x$r,digits=digits))
},
cohen.d.by = {cat("Call: ")
print(x$Call)
ncases <- length(x)
for (i in (1:ncases)) {cat("\n Group levels = ",names(x[i]),"\n")
cat("Cohen d statistic of difference between two means\n")
print(x[[i]]$cohen.d,digits=digits)
cat("\nMultivariate (Mahalanobis) distance between groups\n")
print(x[[i]]$M.dist,digits=digits)
cat("r equivalent of difference between two means\n")
print(x[[i]]$r,digits=digits)
}
cat("\nUse summary for more compact output")
},
cohen.profile = {cat("Cohen Profile coefficients \n")
print(round(unclass(x),digits=digits))},
congruence = {cat("Congruence coefficients \n")
print(round(unclass(x),digits=digits))},
comorbid = {cat("Call: ")
print(x$Call)
cat("Comorbidity table \n")
print(x$twobytwo,digits=digits)
cat("\nimplies phi = ",round(x$phi,digits), " with Yule = ", round(x$Yule,digits), " and tetrachoric correlation of ", round(x$tetra$rho,digits))
cat("\nand normal thresholds of ",round(-x$tetra$tau,digits))
},
corCi = {#cat("Call:")
# print(x$Call)
cat("\n Correlations and normal theory confidence intervals \n")
print(round(x$r.ci,digits=digits))
},
cor.ci = {cat("Call:")
print(x$Call)
cat("\n Coefficients and bootstrapped confidence intervals \n")
lowerMat(x$rho)
phis <- x$rho[lower.tri(x$rho)]
cci <- data.frame(lower.emp =x$ci$low.e, lower.norm=x$ci$lower,estimate =phis ,upper.norm= x$ci$upper, upper.emp=x$ci$up.e,p = x$ci$p)
rownames(cci) <- rownames(x$ci)
cat("\n scale correlations and bootstrapped confidence intervals \n")
print(round(cci,digits=digits))
},
cor.cip = {class(x) <- NULL
cat("\n High and low confidence intervals \n")
print(round(x,digits=digits))
},
corr.test = {cat("Call:")
print(x$Call)
cat("Correlation matrix \n")
print(round(x$r,digits))
cat("Sample Size \n")
print(x$n)
if(x$sym) {cat("Probability values (Entries above the diagonal are adjusted for multiple tests.) \n")} else {
if (x$adjust != "none" ) {cat("These are the unadjusted probability values.\n The probability values adjusted for multiple tests are in the p.adj object. \n")}}
print(round(x$p,digits))
if(short) cat("\n To see confidence intervals of the correlations, print with the short=FALSE option\n")
if(!short) {cat("\n Confidence intervals based upon normal theory. To get bootstrapped values, try cor.ci\n")
if(is.null(x$ci.adj)) { ci.df <- data.frame(raw=x$ci) } else {
ci.df <- data.frame(raw=x$ci,lower.adj = x$ci.adj$lower.adj,upper.adj=x$ci.adj$upper.adj)}
print(round(ci.df,digits)) }
},
corr.p = {cat("Call:")
print(x$Call)
cat("Correlation matrix \n")
print(round(x$r,digits))
cat("Sample Size \n")
print(x$n)
if(x$sym) {cat("Probability values (Entries above the diagonal are adjusted for multiple tests.) \n")} else {
if (x$adjust != "none" ) {cat("These are the unadjusted probability values. \n To see the values adjusted for multiple tests see the p.adj object. \n")}}
print(round(x$p,digits))
if(short) cat("\n To see confidence intervals of the correlations, print with the short=FALSE option\n")
if(!short) {cat("\n Confidence intervals based upon normal theory. To get bootstrapped values, try cor.ci\n")
print(round(x$ci,digits)) }
},
cortest= {cat("Tests of correlation matrices \n")
cat("Call:")
print(x$Call)
cat(" Chi Square value" ,round(x$chi,digits)," with df = ",x$df, " with probability <", signif(x$p,digits),"\n" )
if(!is.null(x$z)) cat("z of differences = ",round(x$z,digits),"\n")
},
cor.wt = {cat("Weighted Correlations \n")
cat("Call:")
print(x$Call)
lowerMat(x$r,digits=digits) },
crossV = {if(is.null(x$mean.fit)) {
cat("Cross Validation\n")
cat("Call:")
print(x$Call)
cat("\nValidities from raw items or from the correlation matrix\n")
cat("Number of unique predictors used = ",x$nvars,"\n")
print(x$crossV,digits=digits)
if(!is.null(x$item.R)) {cat("\nCorrelations based upon item based regressions \n")
lowerMat(x$item.R)}
cat("\nCorrelations based upon correlation matrix based regressions\n")
lowerMat(x$mat.R)
} else {cat("Bootstrapped Cross Validation\n")
cat("Call:")
print(x$Call)
print(round(x$mean.fit,digits=digits))
cat("\n With average coefficents of \n")
print(round(x$mean.coeff,digits=digits))
}
},
describe= {if(!is.null(x$signif)) {
if( missing(signif) ) signif <-x$signif
x$signif <- NULL }
if (length(dim(x))==1) {class(x) <- "list"
attr(x,"call") <- NULL
if(!missing(signif)) x <- signifNum(x,digits=signif)
print(round(x,digits=digits))
} else {class(x) <- "data.frame"
if(!missing(signif)) x <- signifNum(x,digits=signif)
print(round(x,digits=digits)) }
},
describeBy = {cat("\n Descriptive statistics by group \n")
if(!is.null(x$Call)){ cat("Call: " )
print(x$Call) }
class(x) <- "by"
print(x,digits=digits)
},
describeData = {if (length(dim(x))==1) {class(x) <- "list"
attr(x,"call") <- NULL
print(round(x,digits=digits))
} else {
cat('n.obs = ', x$n.obs, "of which ", x$complete.cases," are complete cases. Number of variables = ",x$nvar," of which all are numeric ",x$all.numeric," \n")
print(x$variables) }
},
describeFast = { cat("\n Number of observations = " , x$n.obs, "of which ", x$complete.cases," are complete cases. Number of variables = ",x$nvar," of which ",x$numeric," are numeric and ",x$factors," are factors \n")
if(!short) {print(x$result.df) } else {cat("\n To list the items and their counts, print with short = FALSE") }
},
direct = { cat("Call: ")
print(x$Call)
cat("\nDirect Schmid Leiman = \n")
print(x$direct,cut=cut)
} ,
faBy = { cat("Call: ")
print(x$Call)
cat("\n Factor analysis by Groups\n")
cat("\nAverage standardized loadings (pattern matrix) based upon correlation matrix for all cases as well as each group\n")
cat("\nlow and high ", x$quant,"% quantiles\n")
print(x$faby.sum,digits)
if(!short) {
cat("\n Pooled loadings across groups \n")
print(x$mean.loading,digits=digits)
cat("\n Average factor intercorrelations for all cases and each group\n")
print(x$mean.Phi,digits=2)
cat("\nStandardized loadings (pattern matrix) based upon correlation matrix for all cases as well as each group\n")
print(x$loadings,digits=digits)
cat("\n With factor intercorrelations for all cases and for each group\n")
print(x$Phi,digits=2)
if(!is.null(x$fa)) {
cat("\nFactor analysis results for each group\n")
print(x$fa,digits)
} else {print("For a more informative output, print with short=FALSE")}}
},
faCor = { cat("Call: ")
print(x$Call)
if(!short) { cat("\n Factor Summary for first solution\n")
summary(x$f1)
cat("\n Factor Summary for second solution\n")
summary(x$f2)
}
cat("\n Factor correlations between the two solutions\n")
print(x$r,digits=digits)
cat("\n Factor congruence between the two solutions\n")
print(x$congruence,digits=digits)
},
fa.reg ={cat("Call: ")
print(x$Call)
if(!short) { cat("\n Factor analysis based regression \n")
print (x$regression)} else { cat("\n Factor analysis based regression \n")
summary(x$regression)
cat("\n set short = FALSE to see the detailed statistics \n" )
}
},
guttman = {
cat("Call: ")
print(x$Call)
cat("\nAlternative estimates of reliability\n")
# cat("Beta = ", round(x$beta,digits), " This is an estimate of the worst split half reliability")
cat("\nGuttman bounds \nL1 = ",round(x$lambda.1,digits), "\nL2 = ", round(x$lambda.2,digits), "\nL3 (alpha) = ", round(x$lambda.3,digits),"\nL4 (max) = " ,round(x$lambda.4,digits), "\nL5 = ", round(x$lambda.5,digits), "\nL6 (smc) = " ,round(x$lambda.6,digits), "\n")
cat("TenBerge bounds \nmu0 = ",round(x$tenberge$mu0,digits), "mu1 = ", round(x$tenberge$mu1,digits), "mu2 = " ,round(x$tenberge$mu2,digits), "mu3 = ",round(x$tenberge$mu3,digits) , "\n")
cat("\nalpha of first PC = ",round( x$alpha.pc,digits), "\nestimated greatest lower bound based upon communalities= ", round(x$glb,digits),"\n")
cat("\nbeta found by splitHalf = ", round(x$beta,digits),"\n")
} ,
ICC = {cat("Call: ")
print(x$Call)
cat("\nIntraclass correlation coefficients \n")
print(x$results,digits=digits)
cat("\n Number of subjects =", x$n.obs, " Number of Judges = ",x$n.judge)
cat("\nSee the help file for a discussion of the other 4 McGraw and Wong estimates,")
},
glb = {
cat("Call: ")
print(x$Call)
cat("\nEstimates of the Greatest Lower Bound for reliability, based on factor and cluster models")
cat("\nGLB estimated from factor based communalities = ", round(x$glb.fa$glb,digits) ,"with ",x$nf, " factors.")
cat("\nUse glb.fa to see more details \n")
cat("\n Various estimates based upon splitting the scale into two (see keys for the various splits)")
cat("\nBeta = ", round(x$beta,digits) , "\nBeta fa",round(x$beta.fa,digits), " This is an estimate of the worst split half reliability")
cat("\nKmeans clusters for best split ",round(x$glb.Km,digits=2))
cat("\nCluster based estimates \nglb.IC = ",round(x$glb.IC,digits))
cat("\nglb.max ", round(x$glb.max,digits),"Is the maximum of these estimates")
cat("\n alpha-PC = ", round(x$alpha.pc,digits),"An estimate of alpha based on eignvalues") #\nglb.IC) = " ,round(x$glb.IC,digits)) #"\nL5 = ", round(x$lambda.5,digits), "\nL6 (smc) = " ,round(x$lambda.6,digits), "\n")
cat("\nTenBerge bounds \nmu0 = ",round(x$tenberge$mu0,digits), "mu1 = ", round(x$tenberge$mu1,digits), "mu2 = " ,round(x$tenberge$mu2,digits), "mu3 = ",round(x$tenberge$mu3,digits) , "\n")
cat("\nestimated greatest lower bound based upon splitHalf = ", round(x$glb.Fa,digits),"\n")
if(!short) {cat("\n Various ways of keying the results\n")
x$keys} else {cat("\nUse short = FALSE to see the various ways of splitting the scale")}
},
iclust.sort = {
nvar <- ncol(x$sort)
x$sort[4:nvar] <- round(x$sort[4:nvar],digits)
print(x$sort)
},
irt.fa = {
cat("Item Response Analysis using Factor Analysis \n")
cat("\nCall: ")
print(x$Call)
if (!is.null(x$plot)) print(x$plot)
if(!short) {
nf <- length(x$irt$difficulty)
for(i in 1:nf) {temp <- data.frame(discrimination=x$irt$discrimination[,i],location=x$irt$difficulty[[i]])
cat("\nItem discrimination and location for factor ",colnames(x$irt$discrimination)[i],"\n")
print(round(temp,digits))}
cat("\n These parameters were based on the following factor analysis\n")
print(x$fa)
} else {summary(x$fa)}
},
irt.poly = {
cat("Item Response Analysis using Factor Analysis \n")
cat("\nCall: ")
print(x$Call)
if (!is.null(x$plot)) print(x$plot) #this calls the polyinfo print function below
if(!short) {
nf <- length(x$irt$difficulty)
for(i in 1:nf) {temp <- data.frame(discrimination=x$irt$discrimination[,i],location=x$irt$difficulty[[i]])
cat("\nItem discrimination and location for factor ",colnames(x$irt$discrimination)[i],"\n")
print(round(temp,digits))}
cat("\n These parameters were based on the following factor analysis\n")
print(x$fa)
} else {summary(x$fa) }
},
kappa = {if(is.null(x$cohen.kappa)) {
cat("Call: ")
print(x$Call)
cat("\nCohen Kappa and Weighted Kappa correlation coefficients and confidence boundaries \n")
print(x$confid,digits=digits)
cat("\n Number of subjects =", x$n.obs,"\n")} else {
cat("\nCohen Kappa (below the diagonal) and Weighted Kappa (above the diagonal) \nFor confidence intervals and detail print with all=TRUE\n")
print(x$cohen.kappa,digits=digits)
if(!is.null(x$av.kappa)) cat("\nAverage Cohen kappa for all raters ", round(x$av.kappa,digits=digits))
if(!is.null(x$av.wt)) cat("\nAverage weighted kappa for all raters ",round(x$av.wt,digits=digits))
}
},
mardia = {
cat("Call: ")
print(x$Call)
cat("\nMardia tests of multivariate skew and kurtosis\n")
cat("Use describe(x) the to get univariate tests")
cat("\nn.obs =",x$n.obs," num.vars = ",x$n.var,"\n")
cat("b1p = ",round(x$b1p,digits)," skew = ",round(x$skew,digits ), " with probability <= ", signif(x$p.skew,digits))
cat("\n small sample skew = ",round(x$small.skew,digits ), " with probability <= ", signif(x$p.small,digits))
cat("\nb2p = ", round(x$b2p,digits)," kurtosis = ",round(x$kurtosis,digits)," with probability <= ",signif(x$p.kurt,digits ))
},
mchoice = {
cat("Call: ")
print(x$Call)
cat("\n(Unstandardized) Alpha:\n")
print(x$alpha,digits=digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits=digits)
if(!is.null(x$item.stats)) {
cat("\nitem statistics \n")
print(round(x$item.stats,digits=digits))}
},
mixed= { cat("Call: ")
print(x$Call)
if(is.null(x$rho)) {if(lower) {lowerMat(x,digits=digits)} else {print(x,digits)} } else {
if(lower) {if(length(x$rho)>1) { lowerMat (x$rho,digits=digits)} else {print(x$rho,digits)}}
}},
omegaDirect ={ cat("Call: ")
print(x$Call)
cat("\nOmega from direct Schmid Leiman = ", round(x$omega.g,digits=digits),"\n")
print_psych.fa(x)
eigenvalues <- diag(t(x$loadings) %*% x$loadings)
cat("\nWith eigenvalues of:\n")
print(eigenvalues,digits=2)
cat("The degrees of freedom for the model is",x$orth.f$dof," and the fit was ",round(x$orth.f$objective,digits),"\n")
if(!is.na(x$orth.f$n.obs)) {cat("The number of observations was ",x$orth.f$n.obs, " with Chi Square = ",round(x$orth.f$STATISTIC,digits), " with prob < ", round(x$orth.f$PVAL,digits),"\n")}
if(!is.null(x$orth.f$rms)) {cat("\nThe root mean square of the residuals is ", round(x$orth.f$rms,digits),"\n") }
if(!is.null(x$orth.f$crms)) {cat("The df corrected root mean square of the residuals is ", round(x$orth.f$crms,digits),"\n") }
if(!is.null(x$orth.f$RMSEA)) {cat("\nRMSEA and the ",x$orth.f$RMSEA[4] ,"confidence intervals are ",round(x$orth.f$RMSEA[1:3],digits+1)) }
if(!is.null(x$orth.f$BIC)) {cat("\nBIC = ",round(x$orth.f$BIC,digits))}
cat("\n Total, General and Subset omega for each subset\n")
colnames(x$om.group) <- c("Omega total for total scores and subscales","Omega general for total scores and subscales ", "Omega group for total scores and subscales")
#rownames(x$om.group) <- tn
print(round(t(x$om.group),digits))},
paired.r = {cat("Call: ")
print(x$Call)
print(x$test)
if(is.null(x$z)) {cat("t =",round(x$t,digits))
} else {cat("z =",round(x$z,digits)) }
cat(" With probability = ",round(x$p,digits))
},
pairwise = {cat("Call: ")
print(x$Call)
cat("\nMean correlations within/between scales\n")
lowerMat(x$av.r)
cat("\nPercentage of complete correlations\n")
lowerMat(x$percent)
cat("\nNumber of complete correlations per scale\n")
lowerMat(x$count)
if(!is.null(x$size)) {cat("\nAverage number of pairwise observations per scale\n")
lowerMat(round(x$size))}
cat("\n Imputed correlations (if found) are in the imputed object")
},
pairwiseCounts = {cat("Call: ")
print(x$Call)
cat("\nOverall descriptive statistics\n")
if(!is.null(x$description)) print(x$description)
cat("\nNumber of item pairs <=", x$cut," = ", dim(x$df)[1])
cat("\nItem numbers with pairs <= ",x$cut, " (row wise)", length(x$rows))
cat("\nItem numbers with pairs <= ",x$cut,"(col wise)", length(x$cols))
cat("\nFor names of the offending items, print with short=FALSE")
if(!short) {cat("\n Items names with pairs < ", x$cut," (row wise)\n", names(x$rows))
cat("\n Items names with pairs <=",x$cut," (col wise)\n", names(x$cols))}
cat("\nFor even more details examine the rows, cols and df report" )
},
parallel= {
cat("Call: ")
print(x$Call)
if(!is.null(x$fa.values) & !is.null(x$pc.values) ) {
parallel.df <- data.frame(fa=x$fa.values,fa.sam =x$fa.simr,fa.sim=x$fa.sim,pc= x$pc.values,pc.sam =x$pc.simr,pc.sim=x$pc.sim)
fa.test <- x$nfact
pc.test <- x$ncomp
cat("Parallel analysis suggests that ")
cat("the number of factors = ",fa.test, " and the number of components = ",pc.test,"\n")
cat("\n Eigen Values of \n")
colnames(parallel.df) <- c("Original factors","Resampled data", "Simulated data","Original components", "Resampled components", "Simulated components")
if(any(is.na(x$fa.sim))) parallel.df <- parallel.df[-c(3,6)]
}
if(is.na(fa.test) ) fa.test <- 0
if(is.na(pc.test)) pc.test <- 0
if(!any(is.na(parallel.df))) {print(round(parallel.df[1:max(fa.test,pc.test),],digits))} else {
if(!is.null(x$fa.values)) {cat("\n eigen values of factors\n")
print(round(x$fa.values,digits))}
if(!is.null(x$fa.sim)){cat("\n eigen values of simulated factors\n")
print(round(x$fa.sim,digits))}
if(!is.null(x$pc.values)){cat("\n eigen values of components \n")
print(round(x$pc.values,digits))}
if(!is.null(x$pc.sim)) {cat("\n eigen values of simulated components\n")
print(round(x$pc.sim,digits=digits))}
}
},
partial.r = {cat("partial correlations \n")
print(round(unclass(x),digits))
},
phi.demo = {print(x$tetrachoric)
cat("\nPearson (phi) below the diagonal, phi2tetras above the diagonal\n")
print(round(x$phis,digits))
cat("\nYule correlations")
print(x$Yule)
},
poly= {cat("Call: ")
print(x$Call)
cat("Polychoric correlations \n")
if(!is.null(x$twobytwo)) {
print(x$twobytwo,digits=digits)
cat("\n implies tetrachoric correlation of ",round(-x$rho,digits))} else {
if(!isSymmetric(x$rho)) lower<- FALSE
if(lower) {lowerMat (x$rho,digits) } else {print(x$rho,digits)}
cat("\n with tau of \n")
print(x$tau,digits)
if(!is.null(x$tauy)) print(x$tauy,digits)
}
},
polydi= {cat("Call: ")
print(x$Call)
cat("Correlations of polytomous with dichotomous\n")
print(x$rho,digits)
cat("\n with tau of \n")
print(x$tau,digits)
},
polyinfo = {cat("Item Response Analysis using Factor Analysis \n")
cat("\n Summary information by factor and item")
names(x$sumInfo ) <- paste("Factor",1:length(x$sumInfo))
for (f in 1:length(x$sumInfo)) {
cat("\n Factor = ",f,"\n")
temp <- x$sumInfo[[f]]
temps <- rowSums(temp)
if(sort) {ord <- order(temps,decreasing=TRUE)
temp <- temp[ord,]
temps <- temps[ord]}
temp <- temp[temps > 0,]
summary <- matrix(c(colSums(temp),sqrt(1/colSums(temp)),1-1/colSums(temp)),nrow=3,byrow=TRUE)
rownames(summary) <-c("Test Info","SEM", "Reliability")
temp <- rbind(temp,summary)
if(ncol(temp) == 61) {print(round(temp[,seq(1,61,10)],digits=digits)) } else {print(round(temp,digits=digits))} #this gives us info at each unit
}
if(!short) {
cat("\n Average information (area under the curve) \n")
AUC <-x$AUC
max.info <-x$max.info
if(dim(AUC)[2]==1) {item <- 1:length(AUC) } else {item <- 1:dim(AUC)[1]}
if(sort) {
#first sort them into clusters
#first find the maximum for each row and assign it to that cluster
cluster <- apply(AUC,1,which.max)
ord <- sort(cluster,index.return=TRUE)
AUC <- AUC[ord$ix,,drop=FALSE]
max.info <- max.info[ord$ix,,drop=FALSE]
#now sort column wise
#now sort the AUC that have their highest AUC on each cluster
items <- table(cluster) #how many items are in each cluster?
first <- 1
for (i in 1:length(items)) {# i is the factor number
if(items[i] > 0 ) {
last <- first + items[i]- 1
ord <- sort(abs(AUC[first:last,i]),decreasing=TRUE,index.return=TRUE)
AUC[first:last,] <- AUC[item[ord$ix+first-1],]
max.info[first:last,] <- max.info[item[ord$ix+first-1],]
rownames(AUC)[first:last] <- rownames(max.info)[first:last] <- rownames(AUC)[ord$ix+first-1]
first <- first + items[i] }
}
} #end of sort
print(AUC,digits=digits)
cat("\nMaximum value is at \n")
print(max.info,digits=digits)
}
},
validity = { cat("Call: ")
print(x$Call)
cat("\nPredicted Asymptotic Scale Validity:\n")
print(x$asymptotic,digits)
cat("\n For predicted scale validities, average item validities, or scale reliabilities, print the separate objects")
},
overlap = {
cat("Call: ")
print(x$Call)
cat("\n(Standardized) Alpha:\n")
print(x$alpha,digits)
cat("\n(Standardized) G6*:\n")
print(x$G6,digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits)
cat("\nMedian item correlation:\n")
print(x$med.r,digits)
cat("\nNumber of items:\n")
print(x$size)
cat("\nSignal to Noise ratio based upon average r and n \n")
print(x$sn,digits=digits)
cat("\nScale intercorrelations corrected for item overlap and attenuation \n adjusted for overlap correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
print(x$corrected,digits)
if(!is.null(x$quality) ) {cat("\n Percentage of keyed items with highest absolute correlation with scale (scale quality)\n")
print(x$quality,digits=2) }
if(!is.null(x$MIMS) ) {cat("\n Average adjusted correlations within and between scales (MIMS)\n")
lowerMat(x$MIMS) }
if(!is.null(x$MIMT) ) {cat("\n Average adjusted item x scale correlations within and between scales (MIMT)\n")
lowerMat(x$MIMT) }
if(short) {cat("\n In order to see the item by scale loadings and frequency counts of the data\n print with the short option = FALSE") } else {
if(!is.null(x$item.cor) ) {
cat("\nItem by scale correlations:\n corrected for item overlap and scale reliability\n" )
print(round(x$item.cor,digits=digits)) }
}
},
frequency = { cat("Response frequencies (of non-missing items) \n")
print(unclass(x),digits=digits)
},
r.test = {cat("Correlation tests \n")
cat("Call:")
print(x$Call)
cat( x$Test,"\n")
if(!is.null(x$t)) {cat(" t value" ,round(x$t,digits)," with probability <", signif(x$p,digits) )}
if(!is.null(x$z)) {cat(" z value" ,round(x$z,digits)," with probability ", round(x$p,digits) )}
if(!is.null(x$ci)) {cat("\n and confidence interval ",round(x$ci,digits) ) }
},
reliability ={cat("Measures of reliability \n")
if(is.list(x)) {
print(x$Call)
x <- x$result.df}
print(round(unclass(x),digits))
},
residuals = { if(NCOL(x) == NROW(x)) {
if (lower) {lowerMat (x,digits=digits)}} else {print(round(unclass(x),digits))} #tweaked 1/30/18
},
rmsea ={cat("RMSEA: Root Mean Square Error of Approximation\n")
#"RMSEA=",round(x[[1]],digits=digits), "with lower bound = " ,round(x[[3]],digits=digits), "upper bound = ",round(x[[2]],digits=digits))
if(!is.null(x) ){cat("\nRMSEA and the ",1-x[[4]] ,"confidence intervals are ",round(x[[1]],digits+1),round(x[[2]],digits+1),round(x[[3]],digits+1))
} },
scree = {
cat("Scree of eigen values \nCall: ")
print(x$Call)
if(!is.null(x$fv)) {cat("Eigen values of factors ")
print(round(x$fv,digits))}
if (!is.null(x$pcv)) {cat("Eigen values of Principal Components")
print(round(x$pcv,digits))}
},
scores = {
cat("Call: ")
print(x$Call)
if(x$raw) {
cat("\n(Unstandardized) Alpha:\n") } else {cat("\n(Standardized) Alpha:\n") }
print(x$alpha,digits=digits)
if(!is.null(x$ase)) {cat("\nStandard errors of unstandardized Alpha:\n")
rownames(x$ase) <- "ASE "
print(x$ase,digit=digits) }
if(!is.null(x$alpha.ob)) {cat("\nStandardized Alpha of observed scales:\n")
print(x$alpha.ob,digits=digits)}
cat("\nAverage item correlation:\n")
print(x$av.r,digits=digits)
cat("\nMedian item correlation:\n")
print(x$med.r,digits=digits)
cat("\n Guttman 6* reliability: \n")
print(x$G6,digits=digits)
cat("\nSignal/Noise based upon av.r : \n")
print(x$sn,digits=digits)
#if(iclust) {cat("\nOriginal Beta:\n")
# print(x$beta,digits) }
cat("\nScale intercorrelations corrected for attenuation \n raw correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
if(!is.null(x$alpha.ob)) {cat("\nNote that these are the correlations of the complete scales based on the correlation matrix,\n not the observed scales based on the raw items.\n")}
print(x$corrected,digits)
if(!is.null(x$MIMS) ) {cat("\n Average adjusted correlations within and between scales (MIMS)\n")
lowerMat(x$MIMS) }
if(!is.null(x$MIMT) ) {cat("\n Average adjusted item x scale correlations within and between scales (MIMT)\n")
lowerMat(x$MIMT) }
if(short) {cat("\n In order to see the item by scale loadings and frequency counts of the data\n print with the short option = FALSE") } else {
if(!is.null(x$item.cor) ) {
cat("\nItem by scale correlations:\n corrected for item overlap and scale reliability\n" )
print(round(x$item.corrected,digits=digits)) }
if(!is.null(x$response.freq)) {
cat("\nNon missing response frequency for each item\n")
print(round(x$response.freq,digits=digits))}
}
},
scoreBy = { cat("Call: ")
print(x$Call)
ngroup <- length(x$cor)
for(i in 1:ngroup) {
# cat("\n group = ",names(x$cor[i]),"\n")
if(!is.na(x$cor[[i]])) {
cat("\n Correlations for group",names(x$cor[i]),"\n")
lowerMat(x$cor[[i]]$cor)
cat("\n alpha \n")
print(round(x$alpha[[i]]$alpha,digits))
}}
cat("\n To see the correlations as a matrix, examine the cor.mat object ")
},
setCor= { cat("Call: ")
print(x$Call)
if(x$raw) {cat("\nMultiple Regression from raw data \n")} else {
cat("\nMultiple Regression from matrix input \n")}
if(!is.null(x$z)) cat("The following variables were partialed out:", x$z, "\n and are included in the calculation of df1 and df2\n")
ny <- NCOL(x$coefficients)
for(i in 1:ny) {cat("\n DV = ",colnames(x$coefficients)[i], "\n")
# if(!is.na(x$intercept[i])) {cat(' intercept = ',round(x$intercept[i],digits=digits),"\n")}
if(!is.null(x$se)) {result.df <- data.frame( round(x$coefficients[,i],digits),round(x$se[,i],digits),round(x$t[,i],digits),signif(x$Probability[,i],digits),round(x$ci[,i],digits), round(x$ci[,(i +ny)],digits),round(x$VIF,digits),round(x$Vaxy[,i],digits))
colnames(result.df) <- c("slope","se", "t", "p","lower.ci","upper.ci", "VIF","Vy.x")
print(result.df)
cat("\nResidual Standard Error = ",round(x$SE.resid[i],digits), " with ",x$df[2], " degrees of freedom\n")
result.df <- data.frame(R = round(x$R[i],digits), R2 = round(x$R2[i],digits), Ruw = round(x$ruw[i],digits),R2uw = round( x$ruw[i]^2,digits), round(x$shrunkenR2[i],digits),round(x$seR2[i],digits), round(x$F[i],digits),x$df[1],x$df[2], signif(x$probF[i],digits+1))
colnames(result.df) <- c("R","R2", "Ruw", "R2uw","Shrunken R2", "SE of R2", "overall F","df1","df2","p")
cat("\n Multiple Regression\n")
print(result.df)
} else {
result.df <- data.frame( round(x$coefficients[,i],digits),round(x$VIF,digits),round(x$Vaxy[,i],digits))
colnames(result.df) <- c("slope", "VIF","Vy.x")
print(result.df)
result.df <- data.frame(R = round(x$R[i],digits), R2 = round(x$R2[i],digits), Ruw = round(x$ruw[i],digits),R2uw = round( x$ruw[i]^2,digits))
colnames(result.df) <- c("R","R2", "Ruw", "R2uw")
cat("\n Multiple Regression\n")
print(result.df)
}
}
if(!is.null(x$cancor)) {
cat("\nVarious estimates of between set correlations\n")
cat("Squared Canonical Correlations \n")
print(x$cancor2,digits=digits)
if(!is.null(x$Chisq)) {cat("Chisq of canonical correlations \n")
print(x$Chisq,digits=digits)}
cat("\n Average squared canonical correlation = ",round(x$T,digits=digits))
cat("\n Cohen's Set Correlation R2 = ",round(x$Rset,digits=digits))
#print(x$Rset,digits=digits)
if(!is.null(x$Rset.shrunk)){ cat("\n Shrunken Set Correlation R2 = ",round(x$Rset.shrunk,digits=digits))
cat("\n F and df of Cohen's Set Correlation ",round(c(x$Rset.F,x$Rsetu,x$Rsetv), digits=digits))}
cat("\nUnweighted correlation between the two sets = ",round(x$Ruw,digits))
}
},
sim = { if(is.matrix(x)) {x <-unclass(x)
round(x,digits) } else {
cat("Call: ")
print(x$Call)
cat("\n $model (Population correlation matrix) \n")
print(x$model,digits)
if(!is.null(x$reliability)) { cat("\n$reliability (population reliability) \n")
print(x$reliability,digits) }
if(!is.null(x$N) && !is.null(x$r)) {
cat("\n$r (Sample correlation matrix for sample size = ",x$N,")\n")
print(x$r,digits)}
}
},
smoother = {x <- unclass(x)
print(x)
},
split ={ cat("Split half reliabilities ")
cat("\nCall: ")
print(x$Call)
cat("\nMaximum split half reliability (lambda 4) = ",round(x$maxrb,digits=digits))
cat("\nGuttman lambda 6 = ",round(x$lambda6,digits=digits))
cat("\nAverage split half reliability = ",round(x$meanr,digits=digits))
cat("\nGuttman lambda 3 (alpha) = ",round(x$alpha,digits=digits))
cat("\nGuttman lambda 2 = ", round(x$lambda2,digits=digits))
cat("\nMinimum split half reliability (beta) = ",round(x$minrb,digits=digits))
if(x$covar) { cat("\nAverage interitem covariance = ",round(x$av.r,digits=digits)," with median = ", round(x$med.r,digits=digits))} else { cat("\nAverage interitem r = ",round(x$av.r,digits=digits)," with median = ", round(x$med.r,digits=digits))}
if(!is.na(x$ci[1])) {cat("\n ",names(x$ci))
cat("\n Quantiles of split half reliability = ",round(x$ci,digits=digits))}
},
statsBy ={
cat("Statistics within and between groups ")
cat("\nCall: ")
print(x$Call)
cat("Intraclass Correlation 1 (Percentage of variance due to groups) \n")
print(round(x$ICC1,digits))
cat("Intraclass Correlation 2 (Reliability of group differences) \n")
print(round(x$ICC2,digits))
cat("eta^2 between groups \n")
print(round(x$etabg^2,digits))
if(short) { cat("\nTo see the correlations between and within groups, use the short=FALSE option in your print statement.")}
if(!short) {cat("Correlation between groups \n")
lowerMat(x$rbg)
cat("Correlation within groups \n")
lowerMat(x$rwg)
}
cat("\nMany results are not shown directly. To see specific objects select from the following list:\n",names(x))
},
tau = {cat("Tau values from dichotomous or polytomous data \n")
class(x) <- NULL
print(x,digits)
},
tetra = {cat("Call: ")
print(x$Call)
cat("tetrachoric correlation \n")
if(!is.null(x$twobytwo)) {
print(x$twobytwo,digits=digits)
cat("\n implies tetrachoric correlation of ",round(x$rho,digits))} else {if(length(x$rho)>1) {
if(!isSymmetric(x$rho)) lower <- FALSE} else {lower<- FALSE}
if(is.matrix(x$rho) && lower) {lowerMat (x$rho,digits)} else { print(x$rho,digits)}
cat("\n with tau of \n")
print(x$tau,digits)
if(!is.null(x$tauy)) print(x$tauy,digits)
}
},
thurstone = {
cat("Thurstonian scale (case 5) scale values ")
cat("\nCall: ")
print(x$Call)
print(x$scale)
cat("\n Goodness of fit of model ", round(x$GF,digits))
},
KMO = {cat("Kaiser-Meyer-Olkin factor adequacy")
cat("\nCall: ")
print(x$Call)
cat("Overall MSA = ",round(x$MSA,digits))
cat("\nMSA for each item = \n")
print(round(x$MSAi,digits))
},
unidim= {
cat("\nA measure of unidimensionality \n Call: ")
print(x$Call)
cat("\nUnidimensionality index = \n" )
print(round(x$uni,digits=digits))
cat("\nunidim adjusted index reverses negatively scored items.")
cat("\nalpha "," Based upon reverse scoring some items.")
cat ("\naverage and median correlations are based upon reversed scored items")
},
yule = {cat("Yule and Generalized Yule coefficients")
cat("\nCall: ")
print(x$Call)
cat("\nYule coefficient \n")
print(round(x$rho,digits))
cat("\nUpper and Lower Confidence Intervals = \n")
print(round(x$ci,digits))
},
Yule = {cat("Yule and Generalized Yule coefficients")
cat("\nLower CI Yule coefficient Upper CI \n")
print(round(c(x$lower,x$rho,x$upper),digits))
}
) #end of switch
} #end function
Try the psych package in your browser
Any scripts or data that you put into this service are public.
psych documentation built on Sept. 26, 2023, 1:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#reorganized May 25, 2009 to call several print functions (psych.print.x where x = {fa, omega, stats, vss}
#reorganized, January 18, 2009 to make some what clearer
#added the switch capability, August 25, 2011 following suggestions by Joshua Wiley
#changed from print.psych.x to print_psych.x because of change to R development not liking print.x.y format
"print.psych" <-
function(x,digits=2,all=FALSE,cut=NULL,sort=FALSE,short=TRUE,lower=TRUE,signif=NULL,...) {
#probably need to fix this with inherits but trying to avoid doing that now.
if(length(class(x)) > 1) { value <- class(x)[2] } else {
#these next test for non-psych functions that may be printed using print.psych.fa
if((!is.null(x$communality.iterations)) | (!is.null(x$uniquenesses)) | (!is.null(x$rotmat)) | (!is.null(x$Th)) ) {value <- fa }
}
if(all) value <- "all"
if(value == "score.items") value <- "scores"
if(value =="set.cor") value <- "setCor"
switch(value,
## the following functions have their own print function
esem = {print_psych.esem(x,digits=digits,short=short,cut=cut,...)},
extension = { print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
extend = {print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
fa = {print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
fa.ci = { print_psych.fa.ci(x,digits=digits,all=all,... )},
iclust= { print_psych.iclust(x,digits=digits,all=all,cut=cut,sort=sort,...)},
omega = { print_psych.omega(x,digits=digits,all=all,cut=cut,sort=sort,...)},
omegaSem= {print_psych.omegaSem(x,digits=digits,all=all,cut=cut,sort=sort,...)},
principal ={print_psych.fa(x,digits=digits,all=all,cut=cut,sort=sort,...)},
schmid = { print_psych.schmid(x,digits=digits,all=all,cut=cut,sort=sort,...)},
stats = { print_psych.stats(x,digits=digits,all=all,cut=cut,sort=sort,...)},
vss= { print_psych.vss(x,digits=digits,all=all,cut=cut,sort=sort,...)},
cta = {print_psych.cta(x,digits=digits,all=all,...)},
mediate = {print_psych.mediate(x,digits=digits,short=short,...)},
multilevel = {print_psych.multilevel(x,digits=digits,short=short,...)},
testRetest = {print_psych.testRetest(x,digits=digits,short=short,...)},
bestScales = {print_psych.bestScales(x,digits=digits,short=short,...)},
##Now, for the smaller print jobs, just do it here.
all= {class(x) <- "list"
print(x,digits=digits) }, #find out which function created the data and then print accordingly
alpha = {
cat("\nReliability analysis ",x$title," \n")
cat("Call: ")
print(x$call)
cat("\n ")
print(x$total,digits=digits)
cat("\n 95% confidence boundaries \n")
temp.df <- data.frame(lower=x$feldt$lower.ci, alpha= x$feldt$alpha,upper.ci =x$feldt$upper.ci)
colnames(temp.df ) <- c("lower","alpha","upper")
rownames(temp.df) <- "Feldt"
if(!is.null(x$total$ase)){
temp.df[2,] <- c(x$total$raw_alpha - 1.96* x$total$ase, x$total$raw_alpha,x$total$raw_alpha +1.96* x$total$ase)
#cat(round(c(x$total$raw_alpha - 1.96* x$total$ase, x$total$raw_alpha,x$total$raw_alpha +1.96* x$total$ase),digits=digits) ,"\n")}
#if(!is.null(x$feldt)) {cat("\n 95% confidence boundaries (Feldt) \n")
#temp.df <- data.frame(lower=x$feldt$lower.ci, alpha= x$feldt$alpha,upper.ci =x$feldt$upper.ci)
rownames(temp.df)[2]<- "Duhachek"
}
if(!is.null(x$boot.ci)) { #{cat("\n lower median upper bootstrapped confidence intervals\n",round(x$boot.ci,digits=digits))}
temp.df[3,] <- x$boot.ci
rownames(temp.df)[3] <- "bootstrapped"}
print(round(temp.df,digits))
cat("\n Reliability if an item is dropped:\n")
print(x$alpha.drop,digits=digits)
cat("\n Item statistics \n")
print(x$item.stats,digits=digits)
if(!is.null(x$response.freq)) {
cat("\nNon missing response frequency for each item\n")
print(round(x$response.freq,digits=digits))}
},
alpha.ci = { cat("\n 95% confidence boundaries (Feldt)\n")
if(is.na(x$r.bar)) {print("I am sorry, you need to specify the n.var to get confidence interals")} else {
temp.df <- data.frame(lower=x$lower.ci, alpha= x$alpha,upper.ci =x$upper.ci)
colnames(temp.df ) <- c("lower","alpha","upper")
rownames(temp.df)<-""
print(round (temp.df,digits))}
},
autoR = {cat("\nAutocorrelations \n")
if(!is.null(x$Call)) {cat("Call: ")
print(x$Call)}
print(round(x$autoR,digits=digits))
},
bassAck = {
cat("\nCall: ")
print(x$Call)
nf <- length(x$bass.ack)-1
for (f in 1:nf) {
cat("\n",f,
x$sumnames[[f]])}
if(!short) {
for (f in 1:nf) {
cat("\nFactor correlations\n ")
print(round(x$bass.ack[[f]],digits=digits))}
} else {cat("\nUse print with the short = FALSE option to see the correlations, or use the summary command.")}
},
auc = {cat('Decision Theory and Area under the Curve\n')
cat('\nThe original data implied the following 2 x 2 table\n')
print(x$probabilities,digits=digits)
cat('\nConditional probabilities of \n')
print(x$conditional,digits=digits)
cat('\nAccuracy = ',round(x$Accuracy,digits=digits),' Sensitivity = ',round(x$Sensitivity,digits=digits), ' Specificity = ',round(x$Specificity,digits=digits), '\nwith Area Under the Curve = ', round(x$AUC,digits=digits) )
cat('\nd.prime = ',round(x$d.prime,digits=digits), ' Criterion = ',round(x$criterion,digits=digits), ' Beta = ', round(x$beta,digits=digits))
cat('\nObserved Phi correlation = ',round(x$phi,digits=digits), '\nInferred latent (tetrachoric) correlation = ',round(x$tetrachoric,digits=digits))
},
bestScales = {if(!is.null(x$first.result)) {
cat("\nCall = ")
print(x$Call)
# print(x$first.result)
# print(round(x$means,2))
print(x$summary,digits=digits)
# x$replicated.items
items <- x$items
size <- NCOL(items[[1]])
nvar <- length(items)
for(i in 1:nvar) {
if(NCOL(items[[i]]) > 3) {items[[i]] <- items[[i]][,-1]}
# items[[i]][,2:3] <- round(items[[i]][,2:3],digits)
if(length( items[[i]][1]) > 0 ) {
items[[i]][,c("mean.r","sd.r")] <- round(items[[i]][,c("mean.r","sd.r")],digits)
}}
cat("\n Best items on each scale with counts of replications\n")
print(items)} else {
df <- data.frame(correlation=x$r,n.items = x$n.items)
cat("The items most correlated with the criteria yield r's of \n")
print(round(df,digits=digits))
if(length(x$value) > 0) {cat("\nThe best items, their correlations and content are \n")
print(x$value) } else {cat("\nThe best items and their correlations are \n")
for(i in 1:length(x$short.key)) {print(round(x$short.key[[i]],digits=digits))}
}
}
},
bifactor = {
cat("Call: ")
print(x$Call)
cat("Alpha: ",round(x$alpha,digits),"\n")
cat("G.6: ",round(x$G6,digits),"\n")
cat("Omega Hierarchical: " ,round(x$omega_h,digits),"\n")
# cat("Omega H asymptotic: " ,round(x$omega.lim,digits),"\n")
cat("Omega Total " ,round(x$omega.tot,digits),"\n")
print(x$f,digits=digits,sort=sort)
},
circ = {cat("Tests of circumplex structure \n")
cat("Call:")
print(x$Call)
res <- data.frame(x[1:4])
print(res,digits=2)
},
circadian = {if(!is.null(x$Call)) {cat("Call: ")
print(x$Call)}
cat("\nCircadian Statistics :\n")
if(!is.null(x$F)) {
cat("\nCircadian F test comparing groups :\n")
print(round(x$F,digits))
if(short) cat("\n To see the pooled and group statistics, print with the short=FALSE option")
}
if(!is.null(x$pooled) && !short) { cat("\nThe pooled circadian statistics :\n")
print( x$pooled)}
if(!is.null(x$bygroup) && !short) {cat("\nThe circadian statistics by group:\n")
print(x$bygroup)}
#if(!is.null(x$result)) print(round(x$result,digits))
if(!is.null(x$phase.rel)) {
cat("\nSplit half reliabilities are split half correlations adjusted for test length\n")
x.df <- data.frame(phase=x$phase.rel,fits=x$fit.rel)
print(round(x.df,digits)) }
if(is.data.frame(x)) {class(x) <- "data.frame"
print(round(x,digits=digits)) }
},
cluster.cor = {
cat("Call: ")
print(x$Call)
cat("\n(Standardized) Alpha:\n")
print(x$alpha,digits)
cat("\n(Standardized) G6*:\n")
print(x$G6,digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits)
cat("\nNumber of items:\n")
print(x$size)
cat("\nSignal to Noise ratio based upon average r and n \n")
print(x$sn,digits=digits)
# cat("\nScale intercorrelations:\n")
# print(x$cor,digits=digits)
cat("\nScale intercorrelations corrected for attenuation \n raw correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
print(x$corrected,digits)
},
cluster.loadings = {
cat("Call: ")
print(x$Call)
cat("\n(Standardized) Alpha:\n")
print(x$alpha,digits)
cat("\n(Standardized) G6*:\n")
print(x$G6,digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits)
cat("\nNumber of items:\n")
print(x$size)
cat("\nScale intercorrelations corrected for attenuation \n raw correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
print(x$corrected,digits)
cat("\nItem by scale intercorrelations\n corrected for item overlap and scale reliability\n")
print(x$loadings,digits)
#cat("\nItem by scale Pattern matrix\n")
# print(x$pattern,digits)
},
cohen.d = {cat("Call: ")
print(x$Call)
cat("Cohen d statistic of difference between two means\n")
if(NCOL(x$cohen.d) == 3) {print(round(x$cohen.d,digits=digits))} else {print( data.frame(round(x$cohen.d[1:3],digits=digits),x$cohen.d[4:NCOL(x$cohen.d)]))}
cat("\nMultivariate (Mahalanobis) distance between groups\n")
print(x$M.dist,digits=digits)
cat("r equivalent of difference between two means\n")
print(round(x$r,digits=digits))
},
cohen.d.by = {cat("Call: ")
print(x$Call)
ncases <- length(x)
for (i in (1:ncases)) {cat("\n Group levels = ",names(x[i]),"\n")
cat("Cohen d statistic of difference between two means\n")
print(x[[i]]$cohen.d,digits=digits)
cat("\nMultivariate (Mahalanobis) distance between groups\n")
print(x[[i]]$M.dist,digits=digits)
cat("r equivalent of difference between two means\n")
print(x[[i]]$r,digits=digits)
}
cat("\nUse summary for more compact output")
},
cohen.profile = {cat("Cohen Profile coefficients \n")
print(round(unclass(x),digits=digits))},
congruence = {cat("Congruence coefficients \n")
print(round(unclass(x),digits=digits))},
comorbid = {cat("Call: ")
print(x$Call)
cat("Comorbidity table \n")
print(x$twobytwo,digits=digits)
cat("\nimplies phi = ",round(x$phi,digits), " with Yule = ", round(x$Yule,digits), " and tetrachoric correlation of ", round(x$tetra$rho,digits))
cat("\nand normal thresholds of ",round(-x$tetra$tau,digits))
},
corCi = {#cat("Call:")
# print(x$Call)
cat("\n Correlations and normal theory confidence intervals \n")
print(round(x$r.ci,digits=digits))
},
cor.ci = {cat("Call:")
print(x$Call)
cat("\n Coefficients and bootstrapped confidence intervals \n")
lowerMat(x$rho)
phis <- x$rho[lower.tri(x$rho)]
cci <- data.frame(lower.emp =x$ci$low.e, lower.norm=x$ci$lower,estimate =phis ,upper.norm= x$ci$upper, upper.emp=x$ci$up.e,p = x$ci$p)
rownames(cci) <- rownames(x$ci)
cat("\n scale correlations and bootstrapped confidence intervals \n")
print(round(cci,digits=digits))
},
cor.cip = {class(x) <- NULL
cat("\n High and low confidence intervals \n")
print(round(x,digits=digits))
},
corr.test = {cat("Call:")
print(x$Call)
cat("Correlation matrix \n")
print(round(x$r,digits))
cat("Sample Size \n")
print(x$n)
if(x$sym) {cat("Probability values (Entries above the diagonal are adjusted for multiple tests.) \n")} else {
if (x$adjust != "none" ) {cat("These are the unadjusted probability values.\n The probability values adjusted for multiple tests are in the p.adj object. \n")}}
print(round(x$p,digits))
if(short) cat("\n To see confidence intervals of the correlations, print with the short=FALSE option\n")
if(!short) {cat("\n Confidence intervals based upon normal theory. To get bootstrapped values, try cor.ci\n")
if(is.null(x$ci.adj)) { ci.df <- data.frame(raw=x$ci) } else {
ci.df <- data.frame(raw=x$ci,lower.adj = x$ci.adj$lower.adj,upper.adj=x$ci.adj$upper.adj)}
print(round(ci.df,digits)) }
},
corr.p = {cat("Call:")
print(x$Call)
cat("Correlation matrix \n")
print(round(x$r,digits))
cat("Sample Size \n")
print(x$n)
if(x$sym) {cat("Probability values (Entries above the diagonal are adjusted for multiple tests.) \n")} else {
if (x$adjust != "none" ) {cat("These are the unadjusted probability values. \n To see the values adjusted for multiple tests see the p.adj object. \n")}}
print(round(x$p,digits))
if(short) cat("\n To see confidence intervals of the correlations, print with the short=FALSE option\n")
if(!short) {cat("\n Confidence intervals based upon normal theory. To get bootstrapped values, try cor.ci\n")
print(round(x$ci,digits)) }
},
cortest= {cat("Tests of correlation matrices \n")
cat("Call:")
print(x$Call)
cat(" Chi Square value" ,round(x$chi,digits)," with df = ",x$df, " with probability <", signif(x$p,digits),"\n" )
if(!is.null(x$z)) cat("z of differences = ",round(x$z,digits),"\n")
},
cor.wt = {cat("Weighted Correlations \n")
cat("Call:")
print(x$Call)
lowerMat(x$r,digits=digits) },
crossV = {if(is.null(x$mean.fit)) {
cat("Cross Validation\n")
cat("Call:")
print(x$Call)
cat("\nValidities from raw items or from the correlation matrix\n")
cat("Number of unique predictors used = ",x$nvars,"\n")
print(x$crossV,digits=digits)
if(!is.null(x$item.R)) {cat("\nCorrelations based upon item based regressions \n")
lowerMat(x$item.R)}
cat("\nCorrelations based upon correlation matrix based regressions\n")
lowerMat(x$mat.R)
} else {cat("Bootstrapped Cross Validation\n")
cat("Call:")
print(x$Call)
print(round(x$mean.fit,digits=digits))
cat("\n With average coefficents of \n")
print(round(x$mean.coeff,digits=digits))
}
},
describe= {if(!is.null(x$signif)) {
if( missing(signif) ) signif <-x$signif
x$signif <- NULL }
if (length(dim(x))==1) {class(x) <- "list"
attr(x,"call") <- NULL
if(!missing(signif)) x <- signifNum(x,digits=signif)
print(round(x,digits=digits))
} else {class(x) <- "data.frame"
if(!missing(signif)) x <- signifNum(x,digits=signif)
print(round(x,digits=digits)) }
},
describeBy = {cat("\n Descriptive statistics by group \n")
if(!is.null(x$Call)){ cat("Call: " )
print(x$Call) }
class(x) <- "by"
print(x,digits=digits)
},
describeData = {if (length(dim(x))==1) {class(x) <- "list"
attr(x,"call") <- NULL
print(round(x,digits=digits))
} else {
cat('n.obs = ', x$n.obs, "of which ", x$complete.cases," are complete cases. Number of variables = ",x$nvar," of which all are numeric ",x$all.numeric," \n")
print(x$variables) }
},
describeFast = { cat("\n Number of observations = " , x$n.obs, "of which ", x$complete.cases," are complete cases. Number of variables = ",x$nvar," of which ",x$numeric," are numeric and ",x$factors," are factors \n")
if(!short) {print(x$result.df) } else {cat("\n To list the items and their counts, print with short = FALSE") }
},
direct = { cat("Call: ")
print(x$Call)
cat("\nDirect Schmid Leiman = \n")
print(x$direct,cut=cut)
} ,
faBy = { cat("Call: ")
print(x$Call)
cat("\n Factor analysis by Groups\n")
cat("\nAverage standardized loadings (pattern matrix) based upon correlation matrix for all cases as well as each group\n")
cat("\nlow and high ", x$quant,"% quantiles\n")
print(x$faby.sum,digits)
if(!short) {
cat("\n Pooled loadings across groups \n")
print(x$mean.loading,digits=digits)
cat("\n Average factor intercorrelations for all cases and each group\n")
print(x$mean.Phi,digits=2)
cat("\nStandardized loadings (pattern matrix) based upon correlation matrix for all cases as well as each group\n")
print(x$loadings,digits=digits)
cat("\n With factor intercorrelations for all cases and for each group\n")
print(x$Phi,digits=2)
if(!is.null(x$fa)) {
cat("\nFactor analysis results for each group\n")
print(x$fa,digits)
} else {print("For a more informative output, print with short=FALSE")}}
},
faCor = { cat("Call: ")
print(x$Call)
if(!short) { cat("\n Factor Summary for first solution\n")
summary(x$f1)
cat("\n Factor Summary for second solution\n")
summary(x$f2)
}
cat("\n Factor correlations between the two solutions\n")
print(x$r,digits=digits)
cat("\n Factor congruence between the two solutions\n")
print(x$congruence,digits=digits)
},
fa.reg ={cat("Call: ")
print(x$Call)
if(!short) { cat("\n Factor analysis based regression \n")
print (x$regression)} else { cat("\n Factor analysis based regression \n")
summary(x$regression)
cat("\n set short = FALSE to see the detailed statistics \n" )
}
},
guttman = {
cat("Call: ")
print(x$Call)
cat("\nAlternative estimates of reliability\n")
# cat("Beta = ", round(x$beta,digits), " This is an estimate of the worst split half reliability")
cat("\nGuttman bounds \nL1 = ",round(x$lambda.1,digits), "\nL2 = ", round(x$lambda.2,digits), "\nL3 (alpha) = ", round(x$lambda.3,digits),"\nL4 (max) = " ,round(x$lambda.4,digits), "\nL5 = ", round(x$lambda.5,digits), "\nL6 (smc) = " ,round(x$lambda.6,digits), "\n")
cat("TenBerge bounds \nmu0 = ",round(x$tenberge$mu0,digits), "mu1 = ", round(x$tenberge$mu1,digits), "mu2 = " ,round(x$tenberge$mu2,digits), "mu3 = ",round(x$tenberge$mu3,digits) , "\n")
cat("\nalpha of first PC = ",round( x$alpha.pc,digits), "\nestimated greatest lower bound based upon communalities= ", round(x$glb,digits),"\n")
cat("\nbeta found by splitHalf = ", round(x$beta,digits),"\n")
} ,
ICC = {cat("Call: ")
print(x$Call)
cat("\nIntraclass correlation coefficients \n")
print(x$results,digits=digits)
cat("\n Number of subjects =", x$n.obs, " Number of Judges = ",x$n.judge)
cat("\nSee the help file for a discussion of the other 4 McGraw and Wong estimates,")
},
glb = {
cat("Call: ")
print(x$Call)
cat("\nEstimates of the Greatest Lower Bound for reliability, based on factor and cluster models")
cat("\nGLB estimated from factor based communalities = ", round(x$glb.fa$glb,digits) ,"with ",x$nf, " factors.")
cat("\nUse glb.fa to see more details \n")
cat("\n Various estimates based upon splitting the scale into two (see keys for the various splits)")
cat("\nBeta = ", round(x$beta,digits) , "\nBeta fa",round(x$beta.fa,digits), " This is an estimate of the worst split half reliability")
cat("\nKmeans clusters for best split ",round(x$glb.Km,digits=2))
cat("\nCluster based estimates \nglb.IC = ",round(x$glb.IC,digits))
cat("\nglb.max ", round(x$glb.max,digits),"Is the maximum of these estimates")
cat("\n alpha-PC = ", round(x$alpha.pc,digits),"An estimate of alpha based on eignvalues") #\nglb.IC) = " ,round(x$glb.IC,digits)) #"\nL5 = ", round(x$lambda.5,digits), "\nL6 (smc) = " ,round(x$lambda.6,digits), "\n")
cat("\nTenBerge bounds \nmu0 = ",round(x$tenberge$mu0,digits), "mu1 = ", round(x$tenberge$mu1,digits), "mu2 = " ,round(x$tenberge$mu2,digits), "mu3 = ",round(x$tenberge$mu3,digits) , "\n")
cat("\nestimated greatest lower bound based upon splitHalf = ", round(x$glb.Fa,digits),"\n")
if(!short) {cat("\n Various ways of keying the results\n")
x$keys} else {cat("\nUse short = FALSE to see the various ways of splitting the scale")}
},
iclust.sort = {
nvar <- ncol(x$sort)
x$sort[4:nvar] <- round(x$sort[4:nvar],digits)
print(x$sort)
},
irt.fa = {
cat("Item Response Analysis using Factor Analysis \n")
cat("\nCall: ")
print(x$Call)
if (!is.null(x$plot)) print(x$plot)
if(!short) {
nf <- length(x$irt$difficulty)
for(i in 1:nf) {temp <- data.frame(discrimination=x$irt$discrimination[,i],location=x$irt$difficulty[[i]])
cat("\nItem discrimination and location for factor ",colnames(x$irt$discrimination)[i],"\n")
print(round(temp,digits))}
cat("\n These parameters were based on the following factor analysis\n")
print(x$fa)
} else {summary(x$fa)}
},
irt.poly = {
cat("Item Response Analysis using Factor Analysis \n")
cat("\nCall: ")
print(x$Call)
if (!is.null(x$plot)) print(x$plot) #this calls the polyinfo print function below
if(!short) {
nf <- length(x$irt$difficulty)
for(i in 1:nf) {temp <- data.frame(discrimination=x$irt$discrimination[,i],location=x$irt$difficulty[[i]])
cat("\nItem discrimination and location for factor ",colnames(x$irt$discrimination)[i],"\n")
print(round(temp,digits))}
cat("\n These parameters were based on the following factor analysis\n")
print(x$fa)
} else {summary(x$fa) }
},
kappa = {if(is.null(x$cohen.kappa)) {
cat("Call: ")
print(x$Call)
cat("\nCohen Kappa and Weighted Kappa correlation coefficients and confidence boundaries \n")
print(x$confid,digits=digits)
cat("\n Number of subjects =", x$n.obs,"\n")} else {
cat("\nCohen Kappa (below the diagonal) and Weighted Kappa (above the diagonal) \nFor confidence intervals and detail print with all=TRUE\n")
print(x$cohen.kappa,digits=digits)
if(!is.null(x$av.kappa)) cat("\nAverage Cohen kappa for all raters ", round(x$av.kappa,digits=digits))
if(!is.null(x$av.wt)) cat("\nAverage weighted kappa for all raters ",round(x$av.wt,digits=digits))
}
},
mardia = {
cat("Call: ")
print(x$Call)
cat("\nMardia tests of multivariate skew and kurtosis\n")
cat("Use describe(x) the to get univariate tests")
cat("\nn.obs =",x$n.obs," num.vars = ",x$n.var,"\n")
cat("b1p = ",round(x$b1p,digits)," skew = ",round(x$skew,digits ), " with probability <= ", signif(x$p.skew,digits))
cat("\n small sample skew = ",round(x$small.skew,digits ), " with probability <= ", signif(x$p.small,digits))
cat("\nb2p = ", round(x$b2p,digits)," kurtosis = ",round(x$kurtosis,digits)," with probability <= ",signif(x$p.kurt,digits ))
},
mchoice = {
cat("Call: ")
print(x$Call)
cat("\n(Unstandardized) Alpha:\n")
print(x$alpha,digits=digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits=digits)
if(!is.null(x$item.stats)) {
cat("\nitem statistics \n")
print(round(x$item.stats,digits=digits))}
},
mixed= { cat("Call: ")
print(x$Call)
if(is.null(x$rho)) {if(lower) {lowerMat(x,digits=digits)} else {print(x,digits)} } else {
if(lower) {if(length(x$rho)>1) { lowerMat (x$rho,digits=digits)} else {print(x$rho,digits)}}
}},
omegaDirect ={ cat("Call: ")
print(x$Call)
cat("\nOmega from direct Schmid Leiman = ", round(x$omega.g,digits=digits),"\n")
print_psych.fa(x)
eigenvalues <- diag(t(x$loadings) %*% x$loadings)
cat("\nWith eigenvalues of:\n")
print(eigenvalues,digits=2)
cat("The degrees of freedom for the model is",x$orth.f$dof," and the fit was ",round(x$orth.f$objective,digits),"\n")
if(!is.na(x$orth.f$n.obs)) {cat("The number of observations was ",x$orth.f$n.obs, " with Chi Square = ",round(x$orth.f$STATISTIC,digits), " with prob < ", round(x$orth.f$PVAL,digits),"\n")}
if(!is.null(x$orth.f$rms)) {cat("\nThe root mean square of the residuals is ", round(x$orth.f$rms,digits),"\n") }
if(!is.null(x$orth.f$crms)) {cat("The df corrected root mean square of the residuals is ", round(x$orth.f$crms,digits),"\n") }
if(!is.null(x$orth.f$RMSEA)) {cat("\nRMSEA and the ",x$orth.f$RMSEA[4] ,"confidence intervals are ",round(x$orth.f$RMSEA[1:3],digits+1)) }
if(!is.null(x$orth.f$BIC)) {cat("\nBIC = ",round(x$orth.f$BIC,digits))}
cat("\n Total, General and Subset omega for each subset\n")
colnames(x$om.group) <- c("Omega total for total scores and subscales","Omega general for total scores and subscales ", "Omega group for total scores and subscales")
#rownames(x$om.group) <- tn
print(round(t(x$om.group),digits))},
paired.r = {cat("Call: ")
print(x$Call)
print(x$test)
if(is.null(x$z)) {cat("t =",round(x$t,digits))
} else {cat("z =",round(x$z,digits)) }
cat(" With probability = ",round(x$p,digits))
},
pairwise = {cat("Call: ")
print(x$Call)
cat("\nMean correlations within/between scales\n")
lowerMat(x$av.r)
cat("\nPercentage of complete correlations\n")
lowerMat(x$percent)
cat("\nNumber of complete correlations per scale\n")
lowerMat(x$count)
if(!is.null(x$size)) {cat("\nAverage number of pairwise observations per scale\n")
lowerMat(round(x$size))}
cat("\n Imputed correlations (if found) are in the imputed object")
},
pairwiseCounts = {cat("Call: ")
print(x$Call)
cat("\nOverall descriptive statistics\n")
if(!is.null(x$description)) print(x$description)
cat("\nNumber of item pairs <=", x$cut," = ", dim(x$df)[1])
cat("\nItem numbers with pairs <= ",x$cut, " (row wise)", length(x$rows))
cat("\nItem numbers with pairs <= ",x$cut,"(col wise)", length(x$cols))
cat("\nFor names of the offending items, print with short=FALSE")
if(!short) {cat("\n Items names with pairs < ", x$cut," (row wise)\n", names(x$rows))
cat("\n Items names with pairs <=",x$cut," (col wise)\n", names(x$cols))}
cat("\nFor even more details examine the rows, cols and df report" )
},
parallel= {
cat("Call: ")
print(x$Call)
if(!is.null(x$fa.values) & !is.null(x$pc.values) ) {
parallel.df <- data.frame(fa=x$fa.values,fa.sam =x$fa.simr,fa.sim=x$fa.sim,pc= x$pc.values,pc.sam =x$pc.simr,pc.sim=x$pc.sim)
fa.test <- x$nfact
pc.test <- x$ncomp
cat("Parallel analysis suggests that ")
cat("the number of factors = ",fa.test, " and the number of components = ",pc.test,"\n")
cat("\n Eigen Values of \n")
colnames(parallel.df) <- c("Original factors","Resampled data", "Simulated data","Original components", "Resampled components", "Simulated components")
if(any(is.na(x$fa.sim))) parallel.df <- parallel.df[-c(3,6)]
}
if(is.na(fa.test) ) fa.test <- 0
if(is.na(pc.test)) pc.test <- 0
if(!any(is.na(parallel.df))) {print(round(parallel.df[1:max(fa.test,pc.test),],digits))} else {
if(!is.null(x$fa.values)) {cat("\n eigen values of factors\n")
print(round(x$fa.values,digits))}
if(!is.null(x$fa.sim)){cat("\n eigen values of simulated factors\n")
print(round(x$fa.sim,digits))}
if(!is.null(x$pc.values)){cat("\n eigen values of components \n")
print(round(x$pc.values,digits))}
if(!is.null(x$pc.sim)) {cat("\n eigen values of simulated components\n")
print(round(x$pc.sim,digits=digits))}
}
},
partial.r = {cat("partial correlations \n")
print(round(unclass(x),digits))
},
phi.demo = {print(x$tetrachoric)
cat("\nPearson (phi) below the diagonal, phi2tetras above the diagonal\n")
print(round(x$phis,digits))
cat("\nYule correlations")
print(x$Yule)
},
poly= {cat("Call: ")
print(x$Call)
cat("Polychoric correlations \n")
if(!is.null(x$twobytwo)) {
print(x$twobytwo,digits=digits)
cat("\n implies tetrachoric correlation of ",round(-x$rho,digits))} else {
if(!isSymmetric(x$rho)) lower<- FALSE
if(lower) {lowerMat (x$rho,digits) } else {print(x$rho,digits)}
cat("\n with tau of \n")
print(x$tau,digits)
if(!is.null(x$tauy)) print(x$tauy,digits)
}
},
polydi= {cat("Call: ")
print(x$Call)
cat("Correlations of polytomous with dichotomous\n")
print(x$rho,digits)
cat("\n with tau of \n")
print(x$tau,digits)
},
polyinfo = {cat("Item Response Analysis using Factor Analysis \n")
cat("\n Summary information by factor and item")
names(x$sumInfo ) <- paste("Factor",1:length(x$sumInfo))
for (f in 1:length(x$sumInfo)) {
cat("\n Factor = ",f,"\n")
temp <- x$sumInfo[[f]]
temps <- rowSums(temp)
if(sort) {ord <- order(temps,decreasing=TRUE)
temp <- temp[ord,]
temps <- temps[ord]}
temp <- temp[temps > 0,]
summary <- matrix(c(colSums(temp),sqrt(1/colSums(temp)),1-1/colSums(temp)),nrow=3,byrow=TRUE)
rownames(summary) <-c("Test Info","SEM", "Reliability")
temp <- rbind(temp,summary)
if(ncol(temp) == 61) {print(round(temp[,seq(1,61,10)],digits=digits)) } else {print(round(temp,digits=digits))} #this gives us info at each unit
}
if(!short) {
cat("\n Average information (area under the curve) \n")
AUC <-x$AUC
max.info <-x$max.info
if(dim(AUC)[2]==1) {item <- 1:length(AUC) } else {item <- 1:dim(AUC)[1]}
if(sort) {
#first sort them into clusters
#first find the maximum for each row and assign it to that cluster
cluster <- apply(AUC,1,which.max)
ord <- sort(cluster,index.return=TRUE)
AUC <- AUC[ord$ix,,drop=FALSE]
max.info <- max.info[ord$ix,,drop=FALSE]
#now sort column wise
#now sort the AUC that have their highest AUC on each cluster
items <- table(cluster) #how many items are in each cluster?
first <- 1
for (i in 1:length(items)) {# i is the factor number
if(items[i] > 0 ) {
last <- first + items[i]- 1
ord <- sort(abs(AUC[first:last,i]),decreasing=TRUE,index.return=TRUE)
AUC[first:last,] <- AUC[item[ord$ix+first-1],]
max.info[first:last,] <- max.info[item[ord$ix+first-1],]
rownames(AUC)[first:last] <- rownames(max.info)[first:last] <- rownames(AUC)[ord$ix+first-1]
first <- first + items[i] }
}
} #end of sort
print(AUC,digits=digits)
cat("\nMaximum value is at \n")
print(max.info,digits=digits)
}
},
validity = { cat("Call: ")
print(x$Call)
cat("\nPredicted Asymptotic Scale Validity:\n")
print(x$asymptotic,digits)
cat("\n For predicted scale validities, average item validities, or scale reliabilities, print the separate objects")
},
overlap = {
cat("Call: ")
print(x$Call)
cat("\n(Standardized) Alpha:\n")
print(x$alpha,digits)
cat("\n(Standardized) G6*:\n")
print(x$G6,digits)
cat("\nAverage item correlation:\n")
print(x$av.r,digits)
cat("\nMedian item correlation:\n")
print(x$med.r,digits)
cat("\nNumber of items:\n")
print(x$size)
cat("\nSignal to Noise ratio based upon average r and n \n")
print(x$sn,digits=digits)
cat("\nScale intercorrelations corrected for item overlap and attenuation \n adjusted for overlap correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
print(x$corrected,digits)
if(!is.null(x$quality) ) {cat("\n Percentage of keyed items with highest absolute correlation with scale (scale quality)\n")
print(x$quality,digits=2) }
if(!is.null(x$MIMS) ) {cat("\n Average adjusted correlations within and between scales (MIMS)\n")
lowerMat(x$MIMS) }
if(!is.null(x$MIMT) ) {cat("\n Average adjusted item x scale correlations within and between scales (MIMT)\n")
lowerMat(x$MIMT) }
if(short) {cat("\n In order to see the item by scale loadings and frequency counts of the data\n print with the short option = FALSE") } else {
if(!is.null(x$item.cor) ) {
cat("\nItem by scale correlations:\n corrected for item overlap and scale reliability\n" )
print(round(x$item.cor,digits=digits)) }
}
},
frequency = { cat("Response frequencies (of non-missing items) \n")
print(unclass(x),digits=digits)
},
r.test = {cat("Correlation tests \n")
cat("Call:")
print(x$Call)
cat( x$Test,"\n")
if(!is.null(x$t)) {cat(" t value" ,round(x$t,digits)," with probability <", signif(x$p,digits) )}
if(!is.null(x$z)) {cat(" z value" ,round(x$z,digits)," with probability ", round(x$p,digits) )}
if(!is.null(x$ci)) {cat("\n and confidence interval ",round(x$ci,digits) ) }
},
reliability ={cat("Measures of reliability \n")
if(is.list(x)) {
print(x$Call)
x <- x$result.df}
print(round(unclass(x),digits))
},
residuals = { if(NCOL(x) == NROW(x)) {
if (lower) {lowerMat (x,digits=digits)}} else {print(round(unclass(x),digits))} #tweaked 1/30/18
},
rmsea ={cat("RMSEA: Root Mean Square Error of Approximation\n")
#"RMSEA=",round(x[[1]],digits=digits), "with lower bound = " ,round(x[[3]],digits=digits), "upper bound = ",round(x[[2]],digits=digits))
if(!is.null(x) ){cat("\nRMSEA and the ",1-x[[4]] ,"confidence intervals are ",round(x[[1]],digits+1),round(x[[2]],digits+1),round(x[[3]],digits+1))
} },
scree = {
cat("Scree of eigen values \nCall: ")
print(x$Call)
if(!is.null(x$fv)) {cat("Eigen values of factors ")
print(round(x$fv,digits))}
if (!is.null(x$pcv)) {cat("Eigen values of Principal Components")
print(round(x$pcv,digits))}
},
scores = {
cat("Call: ")
print(x$Call)
if(x$raw) {
cat("\n(Unstandardized) Alpha:\n") } else {cat("\n(Standardized) Alpha:\n") }
print(x$alpha,digits=digits)
if(!is.null(x$ase)) {cat("\nStandard errors of unstandardized Alpha:\n")
rownames(x$ase) <- "ASE "
print(x$ase,digit=digits) }
if(!is.null(x$alpha.ob)) {cat("\nStandardized Alpha of observed scales:\n")
print(x$alpha.ob,digits=digits)}
cat("\nAverage item correlation:\n")
print(x$av.r,digits=digits)
cat("\nMedian item correlation:\n")
print(x$med.r,digits=digits)
cat("\n Guttman 6* reliability: \n")
print(x$G6,digits=digits)
cat("\nSignal/Noise based upon av.r : \n")
print(x$sn,digits=digits)
#if(iclust) {cat("\nOriginal Beta:\n")
# print(x$beta,digits) }
cat("\nScale intercorrelations corrected for attenuation \n raw correlations below the diagonal, alpha on the diagonal \n corrected correlations above the diagonal:\n")
if(!is.null(x$alpha.ob)) {cat("\nNote that these are the correlations of the complete scales based on the correlation matrix,\n not the observed scales based on the raw items.\n")}
print(x$corrected,digits)
if(!is.null(x$MIMS) ) {cat("\n Average adjusted correlations within and between scales (MIMS)\n")
lowerMat(x$MIMS) }
if(!is.null(x$MIMT) ) {cat("\n Average adjusted item x scale correlations within and between scales (MIMT)\n")
lowerMat(x$MIMT) }
if(short) {cat("\n In order to see the item by scale loadings and frequency counts of the data\n print with the short option = FALSE") } else {
if(!is.null(x$item.cor) ) {
cat("\nItem by scale correlations:\n corrected for item overlap and scale reliability\n" )
print(round(x$item.corrected,digits=digits)) }
if(!is.null(x$response.freq)) {
cat("\nNon missing response frequency for each item\n")
print(round(x$response.freq,digits=digits))}
}
},
scoreBy = { cat("Call: ")
print(x$Call)
ngroup <- length(x$cor)
for(i in 1:ngroup) {
# cat("\n group = ",names(x$cor[i]),"\n")
if(!is.na(x$cor[[i]])) {
cat("\n Correlations for group",names(x$cor[i]),"\n")
lowerMat(x$cor[[i]]$cor)
cat("\n alpha \n")
print(round(x$alpha[[i]]$alpha,digits))
}}
cat("\n To see the correlations as a matrix, examine the cor.mat object ")
},
setCor= { cat("Call: ")
print(x$Call)
if(x$raw) {cat("\nMultiple Regression from raw data \n")} else {
cat("\nMultiple Regression from matrix input \n")}
if(!is.null(x$z)) cat("The following variables were partialed out:", x$z, "\n and are included in the calculation of df1 and df2\n")
ny <- NCOL(x$coefficients)
for(i in 1:ny) {cat("\n DV = ",colnames(x$coefficients)[i], "\n")
# if(!is.na(x$intercept[i])) {cat(' intercept = ',round(x$intercept[i],digits=digits),"\n")}
if(!is.null(x$se)) {result.df <- data.frame( round(x$coefficients[,i],digits),round(x$se[,i],digits),round(x$t[,i],digits),signif(x$Probability[,i],digits),round(x$ci[,i],digits), round(x$ci[,(i +ny)],digits),round(x$VIF,digits),round(x$Vaxy[,i],digits))
colnames(result.df) <- c("slope","se", "t", "p","lower.ci","upper.ci", "VIF","Vy.x")
print(result.df)
cat("\nResidual Standard Error = ",round(x$SE.resid[i],digits), " with ",x$df[2], " degrees of freedom\n")
result.df <- data.frame(R = round(x$R[i],digits), R2 = round(x$R2[i],digits), Ruw = round(x$ruw[i],digits),R2uw = round( x$ruw[i]^2,digits), round(x$shrunkenR2[i],digits),round(x$seR2[i],digits), round(x$F[i],digits),x$df[1],x$df[2], signif(x$probF[i],digits+1))
colnames(result.df) <- c("R","R2", "Ruw", "R2uw","Shrunken R2", "SE of R2", "overall F","df1","df2","p")
cat("\n Multiple Regression\n")
print(result.df)
} else {
result.df <- data.frame( round(x$coefficients[,i],digits),round(x$VIF,digits),round(x$Vaxy[,i],digits))
colnames(result.df) <- c("slope", "VIF","Vy.x")
print(result.df)
result.df <- data.frame(R = round(x$R[i],digits), R2 = round(x$R2[i],digits), Ruw = round(x$ruw[i],digits),R2uw = round( x$ruw[i]^2,digits))
colnames(result.df) <- c("R","R2", "Ruw", "R2uw")
cat("\n Multiple Regression\n")
print(result.df)
}
}
if(!is.null(x$cancor)) {
cat("\nVarious estimates of between set correlations\n")
cat("Squared Canonical Correlations \n")
print(x$cancor2,digits=digits)
if(!is.null(x$Chisq)) {cat("Chisq of canonical correlations \n")
print(x$Chisq,digits=digits)}
cat("\n Average squared canonical correlation = ",round(x$T,digits=digits))
cat("\n Cohen's Set Correlation R2 = ",round(x$Rset,digits=digits))
#print(x$Rset,digits=digits)
if(!is.null(x$Rset.shrunk)){ cat("\n Shrunken Set Correlation R2 = ",round(x$Rset.shrunk,digits=digits))
cat("\n F and df of Cohen's Set Correlation ",round(c(x$Rset.F,x$Rsetu,x$Rsetv), digits=digits))}
cat("\nUnweighted correlation between the two sets = ",round(x$Ruw,digits))
}
},
sim = { if(is.matrix(x)) {x <-unclass(x)
round(x,digits) } else {
cat("Call: ")
print(x$Call)
cat("\n $model (Population correlation matrix) \n")
print(x$model,digits)
if(!is.null(x$reliability)) { cat("\n$reliability (population reliability) \n")
print(x$reliability,digits) }
if(!is.null(x$N) && !is.null(x$r)) {
cat("\n$r (Sample correlation matrix for sample size = ",x$N,")\n")
print(x$r,digits)}
}
},
smoother = {x <- unclass(x)
print(x)
},
split ={ cat("Split half reliabilities ")
cat("\nCall: ")
print(x$Call)
cat("\nMaximum split half reliability (lambda 4) = ",round(x$maxrb,digits=digits))
cat("\nGuttman lambda 6 = ",round(x$lambda6,digits=digits))
cat("\nAverage split half reliability = ",round(x$meanr,digits=digits))
cat("\nGuttman lambda 3 (alpha) = ",round(x$alpha,digits=digits))
cat("\nGuttman lambda 2 = ", round(x$lambda2,digits=digits))
cat("\nMinimum split half reliability (beta) = ",round(x$minrb,digits=digits))
if(x$covar) { cat("\nAverage interitem covariance = ",round(x$av.r,digits=digits)," with median = ", round(x$med.r,digits=digits))} else { cat("\nAverage interitem r = ",round(x$av.r,digits=digits)," with median = ", round(x$med.r,digits=digits))}
if(!is.na(x$ci[1])) {cat("\n ",names(x$ci))
cat("\n Quantiles of split half reliability = ",round(x$ci,digits=digits))}
},
statsBy ={
cat("Statistics within and between groups ")
cat("\nCall: ")
print(x$Call)
cat("Intraclass Correlation 1 (Percentage of variance due to groups) \n")
print(round(x$ICC1,digits))
cat("Intraclass Correlation 2 (Reliability of group differences) \n")
print(round(x$ICC2,digits))
cat("eta^2 between groups \n")
print(round(x$etabg^2,digits))
if(short) { cat("\nTo see the correlations between and within groups, use the short=FALSE option in your print statement.")}
if(!short) {cat("Correlation between groups \n")
lowerMat(x$rbg)
cat("Correlation within groups \n")
lowerMat(x$rwg)
}
cat("\nMany results are not shown directly. To see specific objects select from the following list:\n",names(x))
},
tau = {cat("Tau values from dichotomous or polytomous data \n")
class(x) <- NULL
print(x,digits)
},
tetra = {cat("Call: ")
print(x$Call)
cat("tetrachoric correlation \n")
if(!is.null(x$twobytwo)) {
print(x$twobytwo,digits=digits)
cat("\n implies tetrachoric correlation of ",round(x$rho,digits))} else {if(length(x$rho)>1) {
if(!isSymmetric(x$rho)) lower <- FALSE} else {lower<- FALSE}
if(is.matrix(x$rho) && lower) {lowerMat (x$rho,digits)} else { print(x$rho,digits)}
cat("\n with tau of \n")
print(x$tau,digits)
if(!is.null(x$tauy)) print(x$tauy,digits)
}
},
thurstone = {
cat("Thurstonian scale (case 5) scale values ")
cat("\nCall: ")
print(x$Call)
print(x$scale)
cat("\n Goodness of fit of model ", round(x$GF,digits))
},
KMO = {cat("Kaiser-Meyer-Olkin factor adequacy")
cat("\nCall: ")
print(x$Call)
cat("Overall MSA = ",round(x$MSA,digits))
cat("\nMSA for each item = \n")
print(round(x$MSAi,digits))
},
unidim= {
cat("\nA measure of unidimensionality \n Call: ")
print(x$Call)
cat("\nUnidimensionality index = \n" )
print(round(x$uni,digits=digits))
cat("\nunidim adjusted index reverses negatively scored items.")
cat("\nalpha "," Based upon reverse scoring some items.")
cat ("\naverage and median correlations are based upon reversed scored items")
},
yule = {cat("Yule and Generalized Yule coefficients")
cat("\nCall: ")
print(x$Call)
cat("\nYule coefficient \n")
print(round(x$rho,digits))
cat("\nUpper and Lower Confidence Intervals = \n")
print(round(x$ci,digits))
},
Yule = {cat("Yule and Generalized Yule coefficients")
cat("\nLower CI Yule coefficient Upper CI \n")
print(round(c(x$lower,x$rho,x$upper),digits))
}
) #end of switch
} #end function
Try the psych package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.