Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 169 lines (137 sloc) 7.892 kb
50a4efb9 »
2012-01-29 Turning tabular into an S3 method for cast_df
1 # adding an an S3 method to tabular ...
2 tabular <- function(...) UseMethod("tabular")
3 tabular.default <- tables::tabular
4
5 # This was tested on "tables" Version: 0.5
6
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
7 tabular.cast_df <- function(xx,...)
8 {
9 # a bunch of assumptions that must be met for this function to work:
10 if(!require(reshape)) stop("The {reshape} package must be installed for this function to work")
6cd612f4 »
2012-01-29 More failsafe and made sure the example wouldn't run when the file is…
11 if(!require(tables)) stop("The {tables} package must be installed for this function to work")
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
12 if(! any(class(xx) == "cast_df")) stop("This function only works for cast_df objects")
13 # xx is a casted object
14
15 m_xx <- melt(xx)
16 rdimnames_xx <- attr(xx, "rdimnames")
17 if(length(rdimnames_xx)>2) stop("This function only works for 2D tables")
18
19 ROWS <- colnames(rdimnames_xx[[1]])
20 COLUMNS <- colnames(rdimnames_xx[[2]])
21 colnames_m_xx <- colnames(m_xx)
22
23 # This is for cases when one of the equations has "(all)" in them due to something like cast(DATA, x ~.)
24 if(all(ROWS == "value")) ROWS <- 1
25 if(all(COLUMNS == "value")) COLUMNS <- 1
26
27 if(any(colnames_m_xx == "value.1")) { # then we are supposed to have a "(all)" case (e.g: cast(DATA, .~x) )
28 # m_xx <- m_xx[, -c(which(colnames_m_xx == "value")[-1])] # then remove the column with no value but "(all)" # This would only work for cast(DATA, x~.) and not for cast(DATA, .~x)
29 m_xx[,"value"] <- m_xx[,"value.1"]
30 column_where_all_is <- which(colnames_m_xx == "value.1")
31 m_xx <- m_xx[, -column_where_all_is] # then remove the column with no value but "(all)"
32 colnames_m_xx <- colnames(m_xx)
33 }
34 if(sum(colnames_m_xx == "value") > 1 ) { # then we are supposed to have a "(all)" case (e.g: cast(DATA, x~.) )
35 # m_xx <- m_xx[, -c(which(colnames_m_xx == "value")[-1])] # then remove the column with no value but "(all)" # This would only work for cast(DATA, x~.) and not for cast(DATA, .~x)
36 column_where_all_is <- which(m_xx[1,] == "(all)")
37 m_xx <- m_xx[, -column_where_all_is] # then remove the column with no value but "(all)"
38 colnames_m_xx <- colnames(m_xx)
39 }
40
41 LEFT <- paste(ROWS , collapse="*")
42 RIGHT <- paste(COLUMNS , collapse="*")
43
44 # turn all ROWS/COLUMNS variables into factors - so to make sure that the tabular will work on them as we expect
45 column_to_turn_into_factor <- intersect(c(ROWS, COLUMNS), colnames_m_xx) # this removes the "1"s in case of cast(DATA, x~.)
46 for(i in column_to_turn_into_factor) m_xx[,i] <- factor(m_xx[,i])
47
210167b5 »
2011-12-11 Removed the bug report text
48 # Further motivation for the above two lines have been given by Duncan (on 11.12.11):
49 # The problem here is that tabular() needs to figure out what you want to do with each variable. value and month are both numeric, so it can't tell which one you want as an analysis variable. temp2 is a character variable; those are also treated as possible analysis variables, but perhaps they should be treated like factors instead. (But then there would need to be syntax to say "don't treat this character as a factor".)
50 # So another way to get what you want would be to change the table spec to
51 # tabular(value*v*factor(month)*factor(temp2) ~ variable2*result_variable, data = m_xx)
52 # but this changes the headings too; so maybe I should have a function Factor that does what factor() does without changing the heading. Here's a quick definition:
53 # Factor <- function( x ) substitute(Heading(xname)*x, list(xname = as.name(substitute(x)), x = factor(x)))
54 # tabular(value*v*Factor(month)*Factor(temp2)~variable2*result_variable, data = melt(xx), suppress=2)
55
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
56 v <- function(x) x[1L]
57 txt <- paste("tabular(value*v*", LEFT , "~" ,RIGHT ,", data = m_xx, suppressLabels = 2,...)", sep = "")
58 # suppressLabels is in order to remove the value and the v labels (which are added so to make sure the information inside the table is presented)
59 eval(parse(text = txt ))
60 }
61
62
32369c1c »
2011-12-11 Examples - Adding the output as comments
63
6cd612f4 »
2012-01-29 More failsafe and made sure the example wouldn't run when the file is…
64 if(F) {
32369c1c »
2011-12-11 Examples - Adding the output as comments
65
66 ###########################################
67 ###### Examples
68 ###########################################
69
70 ###### loading libraries and data
71 ###########################################
72
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
73 library(tables)
74 library(reshape)
75
76 # getting our data ready
77 names(airquality) <- tolower(names(airquality))
78 airquality2 <- airquality
79 airquality2$temp2 <- ifelse(airquality2$temp > median(airquality2$temp), "hot", "cold")
80 aqm <- melt(airquality2, id=c("month", "day","temp2"), na.rm=TRUE)
81 colnames(aqm)[4] <- "variable2" # because otherwise the function is having problem when relying on the melt function of the cast object
82 head(aqm,4)
83 # month day temp2 variable2 value
84 # 1 5 1 cold ozone 41
85 # 2 5 2 cold ozone 36
86 # 3 5 3 cold ozone 12
87
32369c1c »
2011-12-11 Examples - Adding the output as comments
88
89 ###### Running examples:
90 ###########################################
91
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
92 # Examples that work:
32369c1c »
2011-12-11 Examples - Adding the output as comments
93
94 # Trivial, but works:
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
95 tabular.cast_df(cast(aqm, month ~ ., mean))
32369c1c »
2011-12-11 Examples - Adding the output as comments
96 # month All
97 # 5 68.71
98 # 6 87.38
99 # 7 93.50
100 # 8 79.71
101 # 9 71.83
102
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
103 tabular.cast_df(cast(aqm, . ~ temp2, mean))
32369c1c »
2011-12-11 Examples - Adding the output as comments
104 # cold hot
105 # All 69.88 91.06
106
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
107 tabular.cast_df(cast(aqm, . ~ ., mean))
32369c1c »
2011-12-11 Examples - Adding the output as comments
108 # All
109 # All 80.06
110
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
111 tabular.cast_df(cast(aqm, month ~ temp2, mean))
32369c1c »
2011-12-11 Examples - Adding the output as comments
112 # month cold hot
113 # 5 67.64 98.22
114 # 6 79.63 98.83
115 # 7 58.15 96.05
116 # 8 69.21 84.83
117 # 9 67.25 80.86
118
119 # Here starts the cool examples:
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
120 tabular.cast_df(cast(aqm, month ~ temp2, c(mean,sd)))
32369c1c »
2011-12-11 Examples - Adding the output as comments
121 # cold hot
122 # month mean sd mean sd
123 # 5 67.64 86.21 98.22 106.02
124 # 6 79.63 84.49 98.83 95.99
125 # 7 58.15 87.92 96.05 89.44
126 # 8 69.21 71.18 84.83 73.06
127 # 9 67.25 75.87 80.86 68.43
128
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
129 tabular.cast_df(cast(aqm, month ~ variable2, c(mean,sd)))
32369c1c »
2011-12-11 Examples - Adding the output as comments
130 # ozone solar.r wind temp
131 # month mean sd mean sd mean sd mean sd
132 # 5 23.62 22.22 181.3 115.08 11.623 3.531 65.55 6.855
133 # 6 29.44 18.21 190.2 92.88 10.267 3.769 79.10 6.599
134 # 7 59.12 31.64 216.5 80.57 8.942 3.036 83.90 4.316
135 # 8 59.96 39.68 171.9 76.83 8.794 3.226 83.97 6.585
136 # 9 31.45 24.14 167.4 79.12 10.180 3.461 76.90 8.356
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
137
32369c1c »
2011-12-11 Examples - Adding the output as comments
138 tabular.cast_df(cast(aqm, month ~ variable2*temp2, c(mean,sd)))
139 # ozone solar.r wind temp
140 # cold hot cold hot cold hot cold hot
141 # month mean sd mean sd mean sd mean sd mean sd mean sd mean sd mean sd
142 # 5 22.76 22.242 45.00 NaN 178.6 116.47 252.0 NA 11.51 3.538 14.900 NaN 65.03 6.3326 81.00 NA
143 # 6 20.60 10.015 40.50 21.38 170.0 97.58 220.4 79.78 10.38 4.578 10.092 2.237 74.89 3.8177 85.42 4.441
144 # 7 13.00 4.243 62.96 29.78 135.5 181.73 222.1 72.63 10.60 5.233 8.828 2.948 73.50 0.7071 84.62 3.416
145 # 8 31.75 16.360 72.50 40.80 149.7 91.19 184.2 67.26 10.88 2.819 7.800 2.970 77.00 2.2111 87.29 5.198
146 # 9 19.95 8.847 53.30 29.10 163.6 90.30 175.1 53.46 10.95 2.808 8.640 4.243 72.15 4.6257 86.40 5.420
147
148
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
149 # This one doesn't work - nor should it work:
150 tabular.cast_df(cast(aqm, month ~ variable|temp2, fun.aggregate = mean)) # stops the function, since it doesn't work for 3D objects...
151
32369c1c »
2011-12-11 Examples - Adding the output as comments
152 ####################
153 # Bug that was fixed in tables version 0.5.20:
154 # "BUG" this one gets the "temp2" header in all of the first 2 columns
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
155 tabular.cast_df(cast(aqm, month*temp2 ~ variable2, c(mean,sd))) # same problem (but this is a problem with tables not in reshape)
156 tabular.cast_df(cast(aqm, month*temp2*variable2 ~ ., c(mean,sd))) # same issue
32369c1c »
2011-12-11 Examples - Adding the output as comments
157 # variable2 variable2 variable2 mean sd
158 # 5 cold ozone 22.760 22.2416
159 # solar.r 178.577 116.4664
160 # wind 11.513 3.5381
161 # temp 65.033 6.3326
162 # hot ozone 45.000 NaN
163 # solar.r 252.000 NA
164 # wind 14.900 NaN
165 # temp 81.000 NA
166 # ......
118fd910 »
2011-12-10 Added the tabular.cast_df.r function
167
6cd612f4 »
2012-01-29 More failsafe and made sure the example wouldn't run when the file is…
168
169 } # end of if(F)
Something went wrong with that request. Please try again.