library(plspm) library(diagram) y <- as.data.frame(t(y)) is.data.frame(y) head(y) trim <- function(char) { return(sub('s+$', '', sub('^s+', '', char))) } (latnames <- strsplit(par1,' ')[[1]]) (n <- length(latnames)) (L1 <- as.numeric(strsplit(par3,' ')[[1]])) (L2 <- as.numeric(strsplit(par4,' ')[[1]])) (L3 <- as.numeric(strsplit(par5,' ')[[1]])) (L4 <- as.numeric(strsplit(par6,' ')[[1]])) (L5 <- as.numeric(strsplit(par7,' ')[[1]])) (L6 <- as.numeric(strsplit(par8,' ')[[1]])) (L7 <- as.numeric(strsplit(par9,' ')[[1]])) (L8 <- as.numeric(strsplit(par10,' ')[[1]])) (S1 <- as.numeric(strsplit(par11,' ')[[1]])) (S2 <- as.numeric(strsplit(par12,' ')[[1]])) (S3 <- as.numeric(strsplit(par13,' ')[[1]])) (S4 <- as.numeric(strsplit(par14,' ')[[1]])) (S5 <- as.numeric(strsplit(par15,' ')[[1]])) (S6 <- as.numeric(strsplit(par16,' ')[[1]])) (S7 <- as.numeric(strsplit(par17,' ')[[1]])) (S8 <- as.numeric(strsplit(par18,' ')[[1]])) if (n==1) sat.mat <- rbind(S1) if (n==2) sat.mat <- rbind(S1,S2) if (n==3) sat.mat <- rbind(S1,S2,S3) if (n==4) sat.mat <- rbind(S1,S2,S3,S4) if (n==5) sat.mat <- rbind(S1,S2,S3,S4,S5) if (n==6) sat.mat <- rbind(S1,S2,S3,S4,S5,S6) if (n==7) sat.mat <- rbind(S1,S2,S3,S4,S5,S6,S7) if (n==8) sat.mat <- rbind(S1,S2,S3,S4,S5,S6,S7,S8) sat.mat if (n==1) sat.sets <- list(L1) if (n==2) sat.sets <- list(L1,L2) if (n==3) sat.sets <- list(L1,L2,L3) if (n==4) sat.sets <- list(L1,L2,L3,L4) if (n==5) sat.sets <- list(L1,L2,L3,L4,L5) if (n==6) sat.sets <- list(L1,L2,L3,L4,L5,L6) if (n==7) sat.sets <- list(L1,L2,L3,L4,L5,L6,L7) if (n==8) sat.sets <- list(L1,L2,L3,L4,L5,L6,L7,L8) sat.sets (sat.mod <- strsplit(par2,' ')[[1]]) res <- plspm(y, sat.mat, sat.sets, sat.mod, scheme='centroid', scaled=TRUE, boot.val=TRUE) (r <- summary(res)) (myr <- res$path_coefs) myind <- 1 for (j in 1:(length(sat.mat[1,])-1)) { for (i in 1:length(sat.mat[,1])) { if (sat.mat[i,j] == 1) { if ((res$boot$path[myind,'perc.025'] < 0) && (res$boot$path[myind,'perc.975'] > 0)) { myr[i,j] = 0 } myind = myind + 1 } } } bitmap(file='test1.png') plotmat(round(myr,4), pos = NULL, curve = 0, name = latnames, lwd = 1, box.lwd = 1, cex.txt = 1, box.type = 'circle', box.prop = 0.5, box.cex = 1, arr.type = 'triangle', arr.pos = 0.5, shadow.size = 0.01, prefix = '', arr.lcol = 'blue', arr.col = 'blue', arr.width = 0.2, main = c('Inner Model', 'Path Coefficients')) dev.off() (myr <- res$path_coefs) myind <- 1 myi <- 1 for (j in 1:(length(sat.mat[1,])-1)) { for (i in 1:length(sat.mat[,1])) { if (i > j) { myr[i,j] = res$boot$total.efs[myi,'Original'] myi = myi + 1 if ((res$boot$total.efs[myind,'perc.025'] < 0) && (res$boot$total.efs[myind,'perc.975'] > 0)) { myr[i,j] = 0 } myind = myind + 1 } } } bitmap(file='test2.png') plotmat(round(myr,4), pos = NULL, curve = 0, name = latnames, lwd = 1, box.lwd = 1, cex.txt = 1, box.type = 'circle', box.prop = 0.5, box.cex = 1, arr.type = 'triangle', arr.pos = 0.5, shadow.size = 0.01, prefix = '', arr.lcol = 'blue', arr.col = 'blue', arr.width = 0.2, main = c('Inner Model', 'Total Effects')) dev.off() labels(r) labels(r$model) labels(r$gof) labels(r$inputs) print(r$model) print(r$gof) print(r$inputs) load(file='createtable') a<-table.start() a<-table.row.start(a) a<-table.element(a,'PARTIAL LEAST SQUARES PATH MODELING (PLS-PM)',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'MODEL SPECIFICATION',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Number of Cases',header=TRUE) a<-table.element(a,r$model$gens$obs) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Latent Variables',header=TRUE) a<-table.element(a,n) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Manifest Variables',header=TRUE) a<-table.element(a,length(y[1,])) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Scaled?',header=TRUE) a<-table.element(a,as.character(r$model$specs$scaled)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Weighting Scheme',header=TRUE) a<-table.element(a,r$model$specs$scheme) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Bootstrapping?',header=TRUE) a<-table.element(a,as.character(r$model$specs$boot.val)) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Bootstrap samples',header=TRUE) a<-table.element(a,r$model$specs$br) a<-table.row.end(a) a<-table.end(a) table.save(a,file='mytable1.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'BLOCKS DEFINITION',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Block',header=TRUE) a<-table.element(a,'Type',header=TRUE) a<-table.element(a,'NMVs',header=TRUE) a<-table.element(a,'Mode',header=TRUE) a<-table.row.end(a) for (i in 1:n) { a<-table.row.start(a) a<-table.element(a,latnames[i],header=TRUE) a<-table.element(a,r$inputs$Type[i]) a<-table.element(a,r$inputs$Size[i]) a<-table.element(a,r$inputs$Mode[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable2.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'BLOCKS UNIDIMENSIONALITY',7,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Block',header=TRUE) a<-table.element(a,'Type.measure',header=TRUE) a<-table.element(a,'MVs',header=TRUE) a<-table.element(a,'eig.1st',header=TRUE) a<-table.element(a,'eig.2nd',header=TRUE) a<-table.element(a,'C.alpha',header=TRUE) a<-table.element(a,'DG.rho',header=TRUE) a<-table.row.end(a) for (i in 1:n) { a<-table.row.start(a) a<-table.element(a,latnames[i],header=TRUE) a<-table.element(a,r$inputs$Type[i]) a<-table.element(a,r$unidim$MVs[i]) a<-table.element(a,r$unidim$eig.1st[i]) a<-table.element(a,r$unidim$eig.2nd[i]) a<-table.element(a,r$unidim$C.alpha[i]) a<-table.element(a,r$unidim$DG.rho[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable3.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'OUTER MODEL',6,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'MV Number',header=TRUE) a<-table.element(a,'Block',header=TRUE) a<-table.element(a,'weights',header=TRUE) a<-table.element(a,'std.loads',header=TRUE) a<-table.element(a,'communal',header=TRUE) a<-table.element(a,'redundan',header=TRUE) a<-table.row.end(a) for (i in 1:length(r$outer_model[,1])) { a<-table.row.start(a) a<-table.element(a,i,header=T) a<-table.element(a,r$outer_model[i,1]) a<-table.element(a,r$outer_model[i,3]) a<-table.element(a,r$outer_model[i,4]) a<-table.element(a,r$outer_model[i,5]) a<-table.element(a,r$outer_model[i,6]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable4.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'CORRELATIONS BETWEEN MVs AND LVs',n+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Block',header=TRUE) for (iii in 1:n) { a<-table.element(a,latnames[iii],header=TRUE) } a<-table.row.end(a) for (i in 1:length(r$crossloadings[,1])) { a<-table.row.start(a) a<-table.element(a,r$crossloadings[i,1],header=TRUE) for(j in 1:n) { a<-table.element(a,r$crossloadings[i,2+j]) } } a<-table.end(a) table.save(a,file='mytable5.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'INNER MODEL',5,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Block',header=TRUE) a<-table.element(a,'Estimate',header=TRUE) a<-table.element(a,'S.E.',header=TRUE) a<-table.element(a,'t value',header=TRUE) a<-table.element(a,'Pr(>|t|)',header=TRUE) a<-table.row.end(a) for (i in 1:(length(labels(r$inner_model)))) { a<-table.row.start(a) print (paste('i=',i,sep='')) a<-table.element(a,labels(r$inner_model)[i],3,header=TRUE) a<-table.row.end(a) for (j in 1:length(r$inner_model[[i]][,1])) { print (paste('j=',j,sep='')) a<-table.row.start(a) a<-table.element(a,rownames(r$inner_model[[i]])[j],header=T) a<-table.element(a,r$inner_model[[i]][j,1]) a<-table.element(a,r$inner_model[[i]][j,2]) a<-table.element(a,r$inner_model[[i]][j,3]) a<-table.element(a,r$inner_model[[i]][j,4]) a<-table.row.end(a) } } a<-table.end(a) table.save(a,file='mytable6.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'CORRELATIONS BETWEEN LVs',n+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',header=TRUE) for (iii in 1:n) { a<-table.element(a,latnames[iii],header=TRUE) } a<-table.row.end(a) for (i in 1:n) { a<-table.row.start(a) a<-table.element(a,latnames[i],header=T) for (j in 1:n) { a<-table.element(a,r$correlations[i,j]) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable7.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'SUMMARY INNER MODEL',6,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',header=TRUE) a<-table.element(a,'LV.Type',header=TRUE) a<-table.element(a,'R-squared',header=TRUE) a<-table.element(a,'Block Communality',header=TRUE) a<-table.element(a,'Mean Redundancy',header=TRUE) a<-table.element(a,'AVE',header=TRUE) a<-table.row.end(a) for (i in 1:n) { a<-table.row.start(a) a<-table.element(a,latnames[i],header=T) a<-table.element(a,r$inner_summary[i,1]) a<-table.element(a,r$inner_summary[i,2]) a<-table.element(a,r$inner_summary[i,3]) a<-table.element(a,r$inner_summary[i,4]) a<-table.element(a,r$inner_summary[i,5]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable8.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'TOTAL EFFECTS',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'relationships',header=TRUE) a<-table.element(a,'dir.effect',header=TRUE) a<-table.element(a,'ind.effect',header=TRUE) a<-table.element(a,'tot.effect',header=TRUE) a<-table.row.end(a) for (i in 1:length(r$effects[,1])) { a<-table.row.start(a) a<-table.element(a,r$effects[i,1],header=T) a<-table.element(a,r$effects[i,2]) a<-table.element(a,r$effects[i,3]) a<-table.element(a,r$effects[i,4]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable10.tab') dum <- r$boot$weights a<-table.start() a<-table.row.start(a) a<-table.element(a,'BOOTSTRAP VALIDATION - WEIGHTS',length(colnames(dum))+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',header=TRUE) for (i in 1:length(colnames(dum))) { a<-table.element(a,colnames(dum)[i],header=TRUE) } a<-table.row.end(a) for (i in 1:length(rownames(dum))) { a<-table.row.start(a) a<-table.element(a,rownames(dum)[i],header=T) for (j in 1:length(colnames(dum))) { a<-table.element(a,dum[i,j]) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable11.tab') dum <- r$boot$loadings a<-table.start() a<-table.row.start(a) a<-table.element(a,'BOOTSTRAP VALIDATION - LOADINGS',length(colnames(dum))+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',header=TRUE) for (i in 1:length(colnames(dum))) { a<-table.element(a,colnames(dum)[i],header=TRUE) } a<-table.row.end(a) for (i in 1:length(rownames(dum))) { a<-table.row.start(a) a<-table.element(a,rownames(dum)[i],header=T) for (j in 1:length(colnames(dum))) { a<-table.element(a,dum[i,j]) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable12.tab') dum <- r$boot$paths a<-table.start() a<-table.row.start(a) a<-table.element(a,'BOOTSTRAP VALIDATION - PATHS',length(colnames(dum))+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',header=TRUE) for (i in 1:length(colnames(dum))) { a<-table.element(a,colnames(dum)[i],header=TRUE) } a<-table.row.end(a) for (i in 1:length(rownames(dum))) { a<-table.row.start(a) a<-table.element(a,rownames(dum)[i],header=T) for (j in 1:length(colnames(dum))) { a<-table.element(a,dum[i,j]) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable13.tab') dum <- r$boot$rsq a<-table.start() a<-table.row.start(a) a<-table.element(a,'BOOTSTRAP VALIDATION - RSQ',length(colnames(dum))+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',header=TRUE) for (i in 1:length(colnames(dum))) { a<-table.element(a,colnames(dum)[i],header=TRUE) } a<-table.row.end(a) for (i in 1:length(rownames(dum))) { a<-table.row.start(a) a<-table.element(a,rownames(dum)[i],header=T) for (j in 1:length(colnames(dum))) { a<-table.element(a,dum[i,j]) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable14.tab') dum <- r$boot$total.efs a<-table.start() a<-table.row.start(a) a<-table.element(a,'BOOTSTRAP VALIDATION - TOTAL EFFECTS',length(colnames(dum))+1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'',header=TRUE) for (i in 1:length(colnames(dum))) { a<-table.element(a,colnames(dum)[i],header=TRUE) } a<-table.row.end(a) for (i in 1:length(rownames(dum))) { a<-table.row.start(a) a<-table.element(a,rownames(dum)[i],header=T) for (j in 1:length(colnames(dum))) { a<-table.element(a,dum[i,j]) } a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable15.tab')
|