#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 ") }, lmCor= { 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