R version 2.13.0 (2011-04-13)
Copyright (C) 2011 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: i486-pc-linux-gnu (32-bit)
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 and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> x <- array(list(41
+ ,14
+ ,39
+ ,18
+ ,30
+ ,11
+ ,31
+ ,12
+ ,34
+ ,16
+ ,35
+ ,18
+ ,39
+ ,14
+ ,34
+ ,14
+ ,36
+ ,15
+ ,37
+ ,15
+ ,38
+ ,17
+ ,36
+ ,19
+ ,38
+ ,10
+ ,39
+ ,16
+ ,33
+ ,18
+ ,32
+ ,14
+ ,36
+ ,14
+ ,38
+ ,17
+ ,39
+ ,14
+ ,32
+ ,16
+ ,32
+ ,18
+ ,31
+ ,11
+ ,39
+ ,14
+ ,37
+ ,12
+ ,39
+ ,17
+ ,41
+ ,9
+ ,36
+ ,16
+ ,33
+ ,14
+ ,33
+ ,15
+ ,34
+ ,11
+ ,31
+ ,16
+ ,27
+ ,13
+ ,37
+ ,17
+ ,34
+ ,15
+ ,34
+ ,14
+ ,32
+ ,16
+ ,29
+ ,9
+ ,36
+ ,15
+ ,29
+ ,17
+ ,35
+ ,13
+ ,37
+ ,15
+ ,34
+ ,16
+ ,38
+ ,16
+ ,35
+ ,12
+ ,38
+ ,12
+ ,37
+ ,11
+ ,38
+ ,15
+ ,33
+ ,15
+ ,36
+ ,17
+ ,38
+ ,13
+ ,32
+ ,16
+ ,32
+ ,14
+ ,32
+ ,11
+ ,34
+ ,12
+ ,32
+ ,12
+ ,37
+ ,15
+ ,39
+ ,16
+ ,29
+ ,15
+ ,37
+ ,12
+ ,35
+ ,12
+ ,30
+ ,8
+ ,38
+ ,13
+ ,34
+ ,11
+ ,31
+ ,14
+ ,34
+ ,15
+ ,35
+ ,10
+ ,36
+ ,11
+ ,30
+ ,12
+ ,39
+ ,15
+ ,35
+ ,15
+ ,38
+ ,14
+ ,31
+ ,16
+ ,34
+ ,15
+ ,38
+ ,15
+ ,34
+ ,13
+ ,39
+ ,12
+ ,37
+ ,17
+ ,34
+ ,13
+ ,28
+ ,15
+ ,37
+ ,13
+ ,33
+ ,15
+ ,37
+ ,16
+ ,35
+ ,15
+ ,37
+ ,16
+ ,32
+ ,15
+ ,33
+ ,14
+ ,38
+ ,15
+ ,33
+ ,14
+ ,29
+ ,13
+ ,33
+ ,7
+ ,31
+ ,17
+ ,36
+ ,13
+ ,35
+ ,15
+ ,32
+ ,14
+ ,29
+ ,13
+ ,39
+ ,16
+ ,37
+ ,12
+ ,35
+ ,14
+ ,37
+ ,17
+ ,32
+ ,15
+ ,38
+ ,17
+ ,37
+ ,12
+ ,36
+ ,16
+ ,32
+ ,11
+ ,33
+ ,15
+ ,40
+ ,9
+ ,38
+ ,16
+ ,41
+ ,15
+ ,36
+ ,10
+ ,43
+ ,10
+ ,30
+ ,15
+ ,31
+ ,11
+ ,32
+ ,13
+ ,32
+ ,14
+ ,37
+ ,18
+ ,37
+ ,16
+ ,33
+ ,14
+ ,34
+ ,14
+ ,33
+ ,14
+ ,38
+ ,14
+ ,33
+ ,12
+ ,31
+ ,14
+ ,38
+ ,15
+ ,37
+ ,15
+ ,33
+ ,15
+ ,31
+ ,13
+ ,39
+ ,17
+ ,44
+ ,17
+ ,33
+ ,19
+ ,35
+ ,15
+ ,32
+ ,13
+ ,28
+ ,9
+ ,40
+ ,15
+ ,27
+ ,15
+ ,37
+ ,15
+ ,32
+ ,16
+ ,28
+ ,11
+ ,34
+ ,14
+ ,30
+ ,11
+ ,35
+ ,15
+ ,31
+ ,13
+ ,32
+ ,15
+ ,30
+ ,16
+ ,30
+ ,14
+ ,31
+ ,15
+ ,40
+ ,16
+ ,32
+ ,16
+ ,36
+ ,11
+ ,32
+ ,12
+ ,35
+ ,9
+ ,38
+ ,16
+ ,42
+ ,13
+ ,34
+ ,16
+ ,35
+ ,12
+ ,35
+ ,9
+ ,33
+ ,13
+ ,36
+ ,13
+ ,32
+ ,14
+ ,33
+ ,19
+ ,34
+ ,13
+ ,32
+ ,12
+ ,34
+ ,13)
+ ,dim=c(2
+ ,162)
+ ,dimnames=list(c('Connected'
+ ,'Happiness')
+ ,1:162))
> y <- array(NA,dim=c(2,162),dimnames=list(c('Connected','Happiness'),1:162))
> for (i in 1:dim(x)[1])
+ {
+ for (j in 1:dim(x)[2])
+ {
+ y[i,j] <- as.numeric(x[i,j])
+ }
+ }
> par3 = 'Pearson Chi-Squared'
> par2 = '2'
> par1 = '1'
> main = 'Association Plot'
> library(vcd)
Loading required package: MASS
Loading required package: grid
Loading required package: colorspace
> cat1 <- as.numeric(par1) #
> cat2<- as.numeric(par2) #
> simulate.p.value=FALSE
> if (par3 == 'Exact Pearson Chi-Squared by Simulation') simulate.p.value=TRUE
> x <- t(x)
> (z <- array(unlist(x),dim=c(length(x[,1]),length(x[1,]))))
[,1] [,2]
[1,] 41 14
[2,] 39 18
[3,] 30 11
[4,] 31 12
[5,] 34 16
[6,] 35 18
[7,] 39 14
[8,] 34 14
[9,] 36 15
[10,] 37 15
[11,] 38 17
[12,] 36 19
[13,] 38 10
[14,] 39 16
[15,] 33 18
[16,] 32 14
[17,] 36 14
[18,] 38 17
[19,] 39 14
[20,] 32 16
[21,] 32 18
[22,] 31 11
[23,] 39 14
[24,] 37 12
[25,] 39 17
[26,] 41 9
[27,] 36 16
[28,] 33 14
[29,] 33 15
[30,] 34 11
[31,] 31 16
[32,] 27 13
[33,] 37 17
[34,] 34 15
[35,] 34 14
[36,] 32 16
[37,] 29 9
[38,] 36 15
[39,] 29 17
[40,] 35 13
[41,] 37 15
[42,] 34 16
[43,] 38 16
[44,] 35 12
[45,] 38 12
[46,] 37 11
[47,] 38 15
[48,] 33 15
[49,] 36 17
[50,] 38 13
[51,] 32 16
[52,] 32 14
[53,] 32 11
[54,] 34 12
[55,] 32 12
[56,] 37 15
[57,] 39 16
[58,] 29 15
[59,] 37 12
[60,] 35 12
[61,] 30 8
[62,] 38 13
[63,] 34 11
[64,] 31 14
[65,] 34 15
[66,] 35 10
[67,] 36 11
[68,] 30 12
[69,] 39 15
[70,] 35 15
[71,] 38 14
[72,] 31 16
[73,] 34 15
[74,] 38 15
[75,] 34 13
[76,] 39 12
[77,] 37 17
[78,] 34 13
[79,] 28 15
[80,] 37 13
[81,] 33 15
[82,] 37 16
[83,] 35 15
[84,] 37 16
[85,] 32 15
[86,] 33 14
[87,] 38 15
[88,] 33 14
[89,] 29 13
[90,] 33 7
[91,] 31 17
[92,] 36 13
[93,] 35 15
[94,] 32 14
[95,] 29 13
[96,] 39 16
[97,] 37 12
[98,] 35 14
[99,] 37 17
[100,] 32 15
[101,] 38 17
[102,] 37 12
[103,] 36 16
[104,] 32 11
[105,] 33 15
[106,] 40 9
[107,] 38 16
[108,] 41 15
[109,] 36 10
[110,] 43 10
[111,] 30 15
[112,] 31 11
[113,] 32 13
[114,] 32 14
[115,] 37 18
[116,] 37 16
[117,] 33 14
[118,] 34 14
[119,] 33 14
[120,] 38 14
[121,] 33 12
[122,] 31 14
[123,] 38 15
[124,] 37 15
[125,] 33 15
[126,] 31 13
[127,] 39 17
[128,] 44 17
[129,] 33 19
[130,] 35 15
[131,] 32 13
[132,] 28 9
[133,] 40 15
[134,] 27 15
[135,] 37 15
[136,] 32 16
[137,] 28 11
[138,] 34 14
[139,] 30 11
[140,] 35 15
[141,] 31 13
[142,] 32 15
[143,] 30 16
[144,] 30 14
[145,] 31 15
[146,] 40 16
[147,] 32 16
[148,] 36 11
[149,] 32 12
[150,] 35 9
[151,] 38 16
[152,] 42 13
[153,] 34 16
[154,] 35 12
[155,] 35 9
[156,] 33 13
[157,] 36 13
[158,] 32 14
[159,] 33 19
[160,] 34 13
[161,] 32 12
[162,] 34 13
> (table1 <- table(z[,cat1],z[,cat2]))
7 8 9 10 11 12 13 14 15 16 17 18 19
27 0 0 0 0 0 0 1 0 1 0 0 0 0
28 0 0 1 0 1 0 0 0 1 0 0 0 0
29 0 0 1 0 0 0 2 0 1 0 1 0 0
30 0 1 0 0 2 1 0 1 1 1 0 0 0
31 0 0 0 0 2 1 2 2 1 2 1 0 0
32 0 0 0 0 2 3 2 5 3 5 0 1 0
33 1 0 0 0 0 1 1 5 5 0 0 1 2
34 0 0 0 0 2 1 4 4 3 3 0 0 0
35 0 0 2 1 0 3 1 1 5 0 0 1 0
36 0 0 0 1 2 0 2 1 2 2 1 0 1
37 0 0 0 0 1 4 1 0 5 3 3 1 0
38 0 0 0 1 0 1 2 2 4 3 3 0 0
39 0 0 0 0 0 1 0 3 1 3 2 1 0
40 0 0 1 0 0 0 0 0 1 1 0 0 0
41 0 0 1 0 0 0 0 1 1 0 0 0 0
42 0 0 0 0 0 0 1 0 0 0 0 0 0
43 0 0 0 1 0 0 0 0 0 0 0 0 0
44 0 0 0 0 0 0 0 0 0 0 1 0 0
> (V1<-dimnames(y)[[1]][cat1])
[1] "Connected"
> (V2<-dimnames(y)[[1]][cat2])
[1] "Happiness"
> postscript(file="/var/wessaorg/rcomp/tmp/17lnw1321101715.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556)
> assoc(ftable(z[,cat1],z[,cat2],row.vars=1,dnn=c(V1,V2)),shade=T)
> dev.off()
null device
1
>
> #Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/wessaorg/rcomp/createtable")
>
> a<-table.start()
> a<-table.row.start(a)
> a<-table.element(a,'Tabulation of Results',ncol(table1)+1,TRUE)
> a<-table.row.end(a)
> a<-table.row.start(a)
> a<-table.element(a,paste(V1,' x ', V2),ncol(table1)+1,TRUE)
> a<-table.row.end(a)
> a<-table.row.start(a)
> a<-table.element(a, ' ', 1,TRUE)
> for(nc in 1:ncol(table1)){
+ a<-table.element(a, colnames(table1)[nc], 1, TRUE)
+ }
> a<-table.row.end(a)
> for(nr in 1:nrow(table1) ){
+ a<-table.element(a, rownames(table1)[nr], 1, TRUE)
+ for(nc in 1:ncol(table1) ){
+ a<-table.element(a, table1[nr, nc], 1, FALSE)
+ }
+ a<-table.row.end(a)
+ }
> a<-table.end(a)
> table.save(a,file="/var/wessaorg/rcomp/tmp/24c2h1321101715.tab")
> (cst<-chisq.test(table1, simulate.p.value=simulate.p.value) )
Pearson's Chi-squared test
data: table1
X-squared = 232.0125, df = 204, p-value = 0.08681
Warning message:
In chisq.test(table1, simulate.p.value = simulate.p.value) :
Chi-squared approximation may be incorrect
> if (par3 == 'McNemar Chi-Squared') {
+ (cst <- mcnemar.test(table1))
+ }
> if (par3=='Fisher Exact Test') {
+ (cst <- fisher.test(table1))
+ }
> if ((par3 != 'McNemar Chi-Squared') & (par3 != 'Fisher Exact Test')) {
+ a<-table.start()
+ a<-table.row.start(a)
+ a<-table.element(a,'Tabulation of Expected Results',ncol(table1)+1,TRUE)
+ a<-table.row.end(a)
+ a<-table.row.start(a)
+ a<-table.element(a,paste(V1,' x ', V2),ncol(table1)+1,TRUE)
+ a<-table.row.end(a)
+ a<-table.row.start(a)
+ a<-table.element(a, ' ', 1,TRUE)
+ for(nc in 1:ncol(table1)){
+ a<-table.element(a, colnames(table1)[nc], 1, TRUE)
+ }
+ a<-table.row.end(a)
+ for(nr in 1:nrow(table1) ){
+ a<-table.element(a, rownames(table1)[nr], 1, TRUE)
+ for(nc in 1:ncol(table1) ){
+ a<-table.element(a, round(cst$expected[nr, nc], digits=2), 1, FALSE)
+ }
+ a<-table.row.end(a)
+ }
+ a<-table.end(a)
+ table.save(a,file="/var/wessaorg/rcomp/tmp/3iqzw1321101715.tab")
+ }
> a<-table.start()
> a<-table.row.start(a)
> a<-table.element(a,'Statistical Results',2,TRUE)
> a<-table.row.end(a)
> a<-table.row.start(a)
> a<-table.element(a, cst$method, 2,TRUE)
> a<-table.row.end(a)
> a<-table.row.start(a)
> if (par3=='Pearson Chi-Squared') a<-table.element(a, 'Pearson Chi Square Statistic', 1, TRUE)
> if (par3=='Exact Pearson Chi-Squared by Simulation') a<-table.element(a, 'Exact Pearson Chi Square Statistic', 1, TRUE)
> if (par3=='McNemar Chi-Squared') a<-table.element(a, 'McNemar Chi Square Statistic', 1, TRUE)
> if (par3=='Fisher Exact Test') a<-table.element(a, 'Odds Ratio', 1, TRUE)
> if (par3=='Fisher Exact Test') {
+ if ((ncol(table1) == 2) & (nrow(table1) == 2)) {
+ a<-table.element(a, round(cst$estimate, digits=2), 1,FALSE)
+ } else {
+ a<-table.element(a, '--', 1,FALSE)
+ }
+ } else {
+ a<-table.element(a, round(cst$statistic, digits=2), 1,FALSE)
+ }
> a<-table.row.end(a)
> if(!simulate.p.value){
+ if(par3!='Fisher Exact Test') {
+ a<-table.row.start(a)
+ a<-table.element(a, 'Degrees of Freedom', 1, TRUE)
+ a<-table.element(a, cst$parameter, 1,FALSE)
+ a<-table.row.end(a)
+ }
+ }
> a<-table.row.start(a)
> a<-table.element(a, 'P value', 1, TRUE)
> a<-table.element(a, round(cst$p.value, digits=2), 1,FALSE)
> a<-table.row.end(a)
> a<-table.end(a)
> table.save(a,file="/var/wessaorg/rcomp/tmp/47xqg1321101715.tab")
>
> try(system("convert tmp/17lnw1321101715.ps tmp/17lnw1321101715.png",intern=TRUE))
character(0)
>
>
> proc.time()
user system elapsed
2.543 0.100 2.635