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(x=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.05'] < 0) && (res$boot$path[myind,'perc.95'] > 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.05'] < 0) && (res$boot$total.efs[myind,'perc.95'] > 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()
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$xxx$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,r$xxx$scaled)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Weighting Scheme',header=TRUE)
a<-table.element(a,r$xx$scheme)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Bootstrapping?',header=TRUE)
a<-table.element(a,r$xx$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$xx$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$input$Type[i])
a<-table.element(a,r$unidim$MVs[i])
a<-table.element(a,r$unidim$Type.measure[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$unidim$Type.measure[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',5,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
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:n) {
a<-table.row.start(a)
a<-table.element(a,latnames[i],5,header=TRUE)
a<-table.row.end(a)
for (j in 1:length(r$outer.mod[[i]][,1])) {
a<-table.row.start(a)
a<-table.element(a,rownames(r$outer.mod[[i]])[j],header=T)
a<-table.element(a,r$outer.mod[[i]][j,1])
a<-table.element(a,r$outer.mod[[i]][j,2])
a<-table.element(a,r$outer.mod[[i]][j,3])
a<-table.element(a,r$outer.mod[[i]][j,4])
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:n) {
a<-table.row.start(a)
a<-table.element(a,latnames[i],n+1,header=TRUE)
a<-table.row.end(a)
for (j in 1:length(r$outer.cor[[i]][,1])) {
a<-table.row.start(a)
a<-table.element(a,rownames(r$outer.cor[[i]])[j],header=T)
for (iii in 1:n) {
a<-table.element(a,r$outer.cor[[i]][j,iii])
}
a<-table.row.end(a)
}
}
a<-table.end(a)
table.save(a,file='mytable5.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'INNER MODEL',3,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Block',header=TRUE)
a<-table.element(a,'Concept',header=TRUE)
a<-table.element(a,'Value',header=TRUE)
a<-table.row.end(a)
for (i in 1:(length(labels(r$inner.mod)))) {
a<-table.row.start(a)
print (paste('i=',i,sep=''))
a<-table.element(a,labels(r$inner.mod)[i],3,header=TRUE)
a<-table.row.end(a)
for (j in 1:length(r$inner.mod[[i]][,1])) {
print (paste('j=',j,sep=''))
a<-table.row.start(a)
a<-table.element(a,rownames(r$inner.mod[[i]])[j],header=T)
a<-table.element(a,r$inner.mod[[i]][j,1],header=T)
a<-table.element(a,r$inner.mod[[i]][j,2])
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$latent.cor[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',8,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,'Measure',header=TRUE)
a<-table.element(a,'MVs',header=TRUE)
a<-table.element(a,'R.square',header=TRUE)
a<-table.element(a,'Av.Commu',header=TRUE)
a<-table.element(a,'Av.Redun',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.sum[i,1])
a<-table.element(a,r$inner.sum[i,2])
a<-table.element(a,r$inner.sum[i,3])
a<-table.element(a,r$inner.sum[i,4])
a<-table.element(a,r$inner.sum[i,5])
a<-table.element(a,r$inner.sum[i,6])
a<-table.element(a,r$inner.sum[i,7])
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,'GOODNESS-OF-FIT',2,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'GoF',header=TRUE)
a<-table.element(a,'Value',header=TRUE)
a<-table.row.end(a)
for (i in 1:4) {
a<-table.row.start(a)
a<-table.element(a,r$gof[i,1],header=T)
a<-table.element(a,r$gof[i,2])
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable9.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')
-SERVER-vre.aston.ac.uk
|
