# # # # basicspace_blackbox.r -- Does BASIC SPACE SCALING ON 1980 ISSUE SCALES # # # &&&&&&&&& STIMULI -- 14 ISSUE SCALES FROM 1980 NES &&&&&&&& # # 'LIBERAL/CONSERVATIVE ' VAR0267 # 'DEFENSE ' VAR0281 # 'GOVT SERVICES ' VAR0291 # 'INFLATION ' VAR0301 # 'ABORTION ' VAR0311 # 'TAX CUTS ' VAR0323 # 'LIBERAL/CONSERVATIVE ' VAR1037 # 'GOVT HELP MINORITIES ' VAR1062 # 'RUSSIA ' VAR1078 # 'WOMENS EQUAL ROLE ' VAR1094 # 'GOVT JOBS ' VAR1110 # 'EQUAL RIGHTS AMEND ' VAR1127 # 'BUSING ' VAR1133 # 'ABORTION ' VAR1136 # # # rm(list=ls(all=TRUE)) # library(MASS) library(foreign) library(basicspace) setwd("C:/basicspace_examples") data <- read.dta("nes1980_first_11.dta") # attach(data,warn.conflicts = FALSE) # T <- cbind(VAR0267,VAR0281,VAR0291,VAR0301,VAR0311,VAR0323,VAR1037,VAR1062,VAR1078, VAR1094,VAR1110,VAR1127,VAR1133,VAR1136) # # RECODE TWO ABORTION QUESTIONS THAT ARE 4-POINT SCALES T[T[,5]==7,5] <- 8 T[T[,14]==7,14] <- 8 TT <- T mode(TT) <- "double" colnames(TT) <- c("lib-consv1","def-spend","govt-serv","inflation", "abortion1","tax-cuts","lib-consv2","govt-help-min","russia", "womens-eq-role","govt-jobs","ERA","busing","abortion2") # #> dim(TT) #[1] 1614 14 # table(TT[,5]) # # 1 2 3 4 8 9 # 178 506 294 569 57 10 # # table(TT[,13]) # # 0 1 2 3 4 5 6 7 8 9 # 81 49 37 39 80 73 230 795 19 211 # Ntrials <- 101 result <- vector("list", Ntrials) # resultx <- blackbox(TT,missing=c(0,8,9),dims=3,minscale=8,verbose=F) # for(i in 1:Ntrials) result[[i]] <- blackbox(data=TT[sample(1:nrow(TT),nrow(TT),replace=TRUE),], missing=c(0,8,9),dims=3,minscale=8,verbose=TRUE) # for(jjj in 1:3){ # # LOOP OVER OVER W MATRIX COEFFICIENTS AND R-SQUARE # kloop <- jjj+3 for(j in 2:kloop){ # final <- matrix(NA,nrow=length(result[[1]]$stimuli[[jjj]][[j]]),ncol=Ntrials) # # Correct For Sign Flips TT0 <- resultx$stimuli[[jjj]][[j]] for(i in 1:Ntrials){ TX0 <- result[[i]]$stimuli[[jjj]][[j]] kcor <- cor(TT0,TX0) # if(kcor < 0)result[[i]]$stimuli[[jjj]][[j]]=(-1.0)*(result[[i]]$stimuli[[jjj]][[j]]) } # for(i in 1:Ntrials) final[,i] <- result[[i]]$stimuli[[jjj]][[j]] std.error <- apply(final,1,sd) # kk <- length(result[[1]]$stimuli[[jjj]][[j]]) TOUT <- rep(0,2*kk) dim(TOUT) <- c(2,kk) TOUT[1,] <- formatC(resultx$stimuli[[jjj]][[j]],digits=5,width=10,format="f") TOUT[2,] <- formatC(std.error,digits=5,width=10,format="f") # rownames(TOUT) <- c("Coordinate","StdErr") # finalz <- rbind(names(resultx$stimuli),TOUT) # write.fwf(x=format(as.data.frame(finalz),digits=5,width=10,scientific=FALSE),append=TRUE,quote=FALSE,rownames=TRUE,colnames=FALSE,"1980_Stimuli.txt") # } # END OF LOOP OVER W MATRIX jjj # } # END OF LOOP OVER ALL W MATRICES # ---- Useful Commands To See What is in an Object # # > length(result) # [1] 9 # > class(result) # [1] "blackbox" # > names(result) # [1] "stimuli" "individuals" "fits" "Nrow" "Ncol" # [6] "Ndata" "Nmiss" "SS_mean" "dims" # > summary(result) -- shows everything # # SSE SSE.explained percent SE singular # Dimension 1 25703.68 27001.45 51.231166 1.356291 111.56085 # Dimension 2 20521.54 32183.59 9.832316 1.271719 78.52109 # Dimension 3 16899.33 35805.80 6.872598 1.217271 70.67879 # #