Next: About this document ...
Up: nesR
Previous: Data program example:
*** RESULTS YOUR PROGRAM PRODUCED ***
R : Copyright 2001, The R Development Core Team
Version 1.3.1 (2001-08-31)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type `license()' or `licence()' for distribution details.
R is a collaborative project with many contributors.
Type `contributors()' for more information.
Type `demo()' for some demos, `help()' for on-line help, or
`help.start()' for a HTML browser interface to help.
Type `q()' to quit R.
> invisible(options(echo = TRUE))
> # R
> XallmissXXX <- function(x) {
+ if (x) {
+ print("A variable is completely missing.")
+ print("Skipping table.")
+ }
+ invisible(x);
+ }
> XruntabXXX <- function(f, nvars, freqs) {
+ XtableXXX <- xtabs(f , drop.unused.levels = T);
+ if (freqs=="Y") {
+ print("weighted frequencies ");
+ print(XtableXXX);
+ }
+ if (nvars==1) {
+ print("weighted proportions ");
+ print(round(XtableXXX / sum(XtableXXX), digits=3));
+ }
+ if (nvars==2) {
+ print("independence test ");
+ print(summary(XtableXXX));
+ print("weighted column proportions ");
+ print(round(t(t(XtableXXX) / apply(XtableXXX,2,sum)), digits=3));
+ }
+ if (nvars==3) {
+ print("weighted column proportions ");
+ XnXXX <- length(dim(XtableXXX));
+ XtsumXXX <- apply(XtableXXX,2:XnXXX,sum);
+ XaXXX <- array(XtsumXXX,dim=dim(XtableXXX)[c(2:XnXXX,1)]);
+ print(round(XtableXXX/aperm(XaXXX,c(XnXXX,1:(XnXXX-1))), digits=3));
+ }
+ invisible(XtableXXX);
+ }
> # using data from year 2000
>
> # CF0301 is 7-PT SCALE PARTY IDENTIFICATION
> # CF0704 is PARTY OF PRES VOTE- ALL MAJOR CANDIDATES
> # CF0704A is PARTY OF PRES VOTE- 2 MAJOR PARTIES
> # CF0724 is DID R WATCH TV PROGRAMS ABOUT CAMPAIGN
> # VCF0803 is LIBERAL-CONSERVATIVE 7PT SCALE
> # CF9088 is DEM PRES CAND- 7PT LIBERAL/CONSERV SCALE
> # CF9096 is REP PRES CAND- 7PT LIBERAL/CONSERV SCALE
> DF <- read.table(file="tmp.sas2awk.dat",header=T);
> attach(DF);
> # preserve raw variables
> oCF0301 <- CF0301;
> oCF0704 <- CF0704;
> oCF0704A <- CF0704A;
> oCF0724 <- CF0724;
> oVCF0803 <- VCF0803;
> oCF9088 <- CF9088;
> oCF9096 <- CF9096;
> # set NES-defined missing values to R's NA code
>
> CF0301 <- ifelse ( CF0301 == 0 , NA , CF0301 );
> CF0704 <- ifelse ( CF0704 == 0 , NA , CF0704 );
> CF0704A <- ifelse ( CF0704A == 0 , NA , CF0704A );
> CF0724 <- ifelse ( CF0724 == 0 , NA , CF0724 );
> VCF0803 <- ifelse ( VCF0803 == 0 , NA , VCF0803 );
> CF9088 <- ifelse ( CF9088 == 0 , NA , CF9088 );
> CF9088 <- ifelse ( CF9088 >= 8 , NA , CF9088 );
> CF9096 <- ifelse ( CF9096 == 0 , NA , CF9096 );
> CF9096 <- ifelse ( CF9096 >= 8 , NA , CF9096 );
>
> # get rid of unwanted value in party ID
> pid <- CF0301;
> pid <- ifelse(pid == 9, NA, pid);
>
> # get rid of unwanted value in libcon self-placement
> libcon <- VCF0803;
> libcon <- ifelse(libcon == 9, NA, libcon);
>
> # presvote3 is three major party candidates only
> presvote3 <- CF0704;
>
> # presvote is Dem and Rep candidates only
> presvote <- CF0704A - 1;
>
> # watchtv is how much watched campaign on TV
> watchtv <- CF0724;
>
> # compute spatial model measure of difference between Dem and Rep candidates
> demlibcon <- CF9088;
> replibcon <- CF9096;
> demdist <- abs(libcon-demlibcon);
> repdist <- abs(libcon-replibcon);
> distdiff <- demdist-repdist;
>
> # crosstab of libcon given pid
> # xtable libcon pid
> if (!XallmissXXX(all(is.na(libcon)) | all(is.na(pid)) )) {
+ XtableXXX <- XruntabXXX(as.formula("wgtXXX ~ libcon + pid"), 2, "Y");
+ }
[1] "weighted frequencies "
pid
libcon 1 2 3 4 5 6 7
1 7 2 6 0 0 1 0
2 35 13 16 4 4 2 1
3 24 17 21 8 7 6 2
4 32 38 46 30 32 24 12
5 10 11 7 9 30 29 17
6 15 8 11 10 15 24 57
7 1 0 0 3 6 6 10
[1] "independence test "
Call: xtabs(formula = f, drop.unused.levels = T)
Number of cases in table: 669
Number of factors: 2
Test for independence of all factors:
Chisq = 268.99, df = 36, p-value = 1.93e-37
Chi-squared approximation may be incorrect
[1] "weighted column proportions "
pid
libcon 1 2 3 4 5 6 7
1 0.056 0.022 0.056 0.000 0.000 0.011 0.000
2 0.282 0.146 0.150 0.062 0.043 0.022 0.010
3 0.194 0.191 0.196 0.125 0.074 0.065 0.020
4 0.258 0.427 0.430 0.469 0.340 0.261 0.121
5 0.081 0.124 0.065 0.141 0.319 0.315 0.172
6 0.121 0.090 0.103 0.156 0.160 0.261 0.576
7 0.008 0.000 0.000 0.047 0.064 0.065 0.101
>
> # crosstab of libcon given pid and watchtv
> # xtable libcon pid watchtv
> if (!XallmissXXX(all(is.na(libcon)) | all(is.na(pid)) | all(is.na(watchtv)) )) {
+ XtableXXX <- XruntabXXX(as.formula("wgtXXX ~ libcon + pid + watchtv"), 3, "Y");
+ }
[1] "weighted frequencies "
, , watchtv = 1
pid
libcon 1 2 3 4 5 6 7
1 0 1 1 0 0 1 0
2 2 0 5 1 1 0 0
3 0 4 4 1 3 2 0
4 3 6 6 5 6 4 1
5 0 1 1 4 2 7 2
6 2 0 1 2 1 3 3
7 0 0 0 0 1 2 1
, , watchtv = 2
pid
libcon 1 2 3 4 5 6 7
1 6 0 4 0 0 0 0
2 24 9 10 1 3 2 1
3 22 13 15 7 4 4 2
4 24 24 34 21 23 13 9
5 8 10 6 4 24 19 12
6 11 6 6 6 13 19 45
7 1 0 0 2 5 4 9
[1] "weighted column proportions "
, , watchtv = 1
pid
libcon 1 2 3 4 5 6 7
1 0.000 0.083 0.056 0.000 0.000 0.053 0.000
2 0.286 0.000 0.278 0.077 0.071 0.000 0.000
3 0.000 0.333 0.222 0.077 0.214 0.105 0.000
4 0.429 0.500 0.333 0.385 0.429 0.211 0.143
5 0.000 0.083 0.056 0.308 0.143 0.368 0.286
6 0.286 0.000 0.056 0.154 0.071 0.158 0.429
7 0.000 0.000 0.000 0.000 0.071 0.105 0.143
, , watchtv = 2
pid
libcon 1 2 3 4 5 6 7
1 0.062 0.000 0.053 0.000 0.000 0.000 0.000
2 0.250 0.145 0.133 0.024 0.042 0.033 0.013
3 0.229 0.210 0.200 0.171 0.056 0.066 0.026
4 0.250 0.387 0.453 0.512 0.319 0.213 0.115
5 0.083 0.161 0.080 0.098 0.333 0.311 0.154
6 0.115 0.097 0.080 0.146 0.181 0.311 0.577
7 0.010 0.000 0.000 0.049 0.069 0.066 0.115
>
> # crosstab of three-party vote given pid and watchtv
> # xtable presvote3 pid
> if (!XallmissXXX(all(is.na(presvote3)) | all(is.na(pid)) )) {
+ XtableXXX <- XruntabXXX(as.formula("wgtXXX ~ presvote3 + pid"), 2, "Y");
+ }
[1] "weighted frequencies "
pid
presvote3 1 2 3 4 5 6 7
1 239 153 113 37 21 20 4
2 6 18 31 37 124 122 189
[1] "independence test "
Call: xtabs(formula = f, drop.unused.levels = T)
Number of cases in table: 1114
Number of factors: 2
Test for independence of all factors:
Chisq = 697.4, df = 6, p-value = 2.209e-147
[1] "weighted column proportions "
pid
presvote3 1 2 3 4 5 6 7
1 0.976 0.895 0.785 0.5 0.145 0.141 0.021
2 0.024 0.105 0.215 0.5 0.855 0.859 0.979
>
> # crosstab of two-party vote given pid and watchtv
> # xtable presvote pid
> if (!XallmissXXX(all(is.na(presvote)) | all(is.na(pid)) )) {
+ XtableXXX <- XruntabXXX(as.formula("wgtXXX ~ presvote + pid"), 2, "Y");
+ }
[1] "weighted frequencies "
pid
presvote 1 2 3 4 5 6 7
0 239 153 113 37 21 20 4
1 6 18 31 37 124 122 189
[1] "independence test "
Call: xtabs(formula = f, drop.unused.levels = T)
Number of cases in table: 1114
Number of factors: 2
Test for independence of all factors:
Chisq = 697.4, df = 6, p-value = 2.209e-147
[1] "weighted column proportions "
pid
presvote 1 2 3 4 5 6 7
0 0.976 0.895 0.785 0.5 0.145 0.141 0.021
1 0.024 0.105 0.215 0.5 0.855 0.859 0.979
>
> # one-way frequency table of libcon placements
> # xtable libcon
> if (!XallmissXXX(all(is.na(libcon)) )) {
+ XtableXXX <- XruntabXXX(as.formula("wgtXXX ~ libcon"), 1, "Y");
+ }
[1] "weighted frequencies "
libcon
1 2 3 4 5 6 7
17 77 85 215 113 140 26
[1] "weighted proportions "
libcon
1 2 3 4 5 6 7
0.025 0.114 0.126 0.319 0.168 0.208 0.039
> # xtable demlibcon
> if (!XallmissXXX(all(is.na(demlibcon)) )) {
+ XtableXXX <- XruntabXXX(as.formula("wgtXXX ~ demlibcon"), 1, "Y");
+ }
[1] "weighted frequencies "
demlibcon
1 2 3 4 5 6 7
75 229 166 180 59 57 13
[1] "weighted proportions "
demlibcon
1 2 3 4 5 6 7
0.096 0.294 0.213 0.231 0.076 0.073 0.017
> # xtable replibcon
> if (!XallmissXXX(all(is.na(replibcon)) )) {
+ XtableXXX <- XruntabXXX(as.formula("wgtXXX ~ replibcon"), 1, "Y");
+ }
[1] "weighted frequencies "
replibcon
1 2 3 4 5 6 7
14 55 55 107 166 310 71
[1] "weighted proportions "
replibcon
1 2 3 4 5 6 7
0.018 0.071 0.071 0.138 0.213 0.398 0.091
>
> # simple ordinary least squares regression model of two-party vote
> # explanatory variables are PID dummy variables and spatial model difference
> summary(lm(presvote ~ factor(pid) + distdiff, weights=wgtXXX));
Call:
lm(formula = presvote ~ factor(pid) + distdiff, weights = wgtXXX)
Residuals:
Min 1Q Median 3Q Max
-0.87512 -0.14025 -0.01548 0.12488 0.86611
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.142374 0.037939 3.753 0.000200 ***
factor(pid)2 0.050728 0.055555 0.913 0.361710
factor(pid)3 0.157684 0.052541 3.001 0.002851 **
factor(pid)4 0.197297 0.071936 2.743 0.006356 **
factor(pid)5 0.598660 0.057706 10.374 < 2e-16 ***
factor(pid)6 0.614330 0.061321 10.018 < 2e-16 ***
factor(pid)7 0.658245 0.061613 10.684 < 2e-16 ***
distdiff 0.059207 0.007822 7.569 2.42e-13 ***
---
Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1
Residual standard error: 0.3115 on 418 degrees of freedom
Multiple R-Squared: 0.6193, Adjusted R-squared: 0.6129
F-statistic: 97.12 on 7 and 418 DF, p-value: 0
>
> # simple probit regression model of two-party vote
> # explanatory variables are PID dummy variables and spatial model difference
> summary(glm(presvote ~ factor(pid) + distdiff,
+ family=binomial(link="probit"), weights=wgtXXX));
Call:
glm(formula = presvote ~ factor(pid) + distdiff, family = binomial(link = "probit"),
weights = wgtXXX)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.29088 -0.43120 -0.02143 0.30605 2.20075
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.74971 0.35730 -4.897 9.73e-07 ***
factor(pid)2 0.75213 0.42669 1.763 0.07795 .
factor(pid)3 1.27405 0.40371 3.156 0.00160 **
factor(pid)4 1.26644 0.44424 2.851 0.00436 **
factor(pid)5 2.45253 0.41060 5.973 2.33e-09 ***
factor(pid)6 2.50555 0.42860 5.846 5.04e-09 ***
factor(pid)7 3.08645 0.48306 6.389 1.67e-10 ***
distdiff 0.35076 0.05172 6.783 1.18e-11 ***
---
Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 590.55 on 425 degrees of freedom
Residual deviance: 246.41 on 418 degrees of freedom
AIC: 262.41
Number of Fisher Scoring iterations: 5
>
> proc.time()
[1] 5.49 0.70 6.11 0.00 0.00
>
Walter Mebane
2002-10-26