Skip to content
Newer
Older
100644 169 lines (137 sloc) 7.71 KB
50a4efb @talgalili Turning tabular into an S3 method for cast_df
authored Jan 29, 2012
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
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
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")
6cd612f @talgalili More failsafe and made sure the example wouldn't run when the file is…
authored Jan 29, 2012
11 if(!require(tables)) stop("The {tables} package must be installed for this function to work")
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
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
210167b @talgalili Removed the bug report text
authored Dec 11, 2011
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
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
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
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 11, 2011
63
6cd612f @talgalili More failsafe and made sure the example wouldn't run when the file is…
authored Jan 29, 2012
64 if(F) {
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
65
66 ###########################################
67 ###### Examples
68 ###########################################
69
70 ###### loading libraries and data
71 ###########################################
72
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
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
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
88
89 ###### Running examples:
90 ###########################################
91
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
92 # Examples that work:
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
93
94 # Trivial, but works:
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
95 tabular.cast_df(cast(aqm, month ~ ., mean))
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
96 # month All
97 # 5 68.71
98 # 6 87.38
99 # 7 93.50
100 # 8 79.71
101 # 9 71.83
102
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
103 tabular.cast_df(cast(aqm, . ~ temp2, mean))
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
104 # cold hot
105 # All 69.88 91.06
106
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
107 tabular.cast_df(cast(aqm, . ~ ., mean))
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
108 # All
109 # All 80.06
110
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
111 tabular.cast_df(cast(aqm, month ~ temp2, mean))
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
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:
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
120 tabular.cast_df(cast(aqm, month ~ temp2, c(mean,sd)))
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
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
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
129 tabular.cast_df(cast(aqm, month ~ variable2, c(mean,sd)))
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
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
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
137
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
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
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
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
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
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
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
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
32369c1 @talgalili Examples - Adding the output as comments
authored Dec 10, 2011
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 # ......
118fd91 @talgalili Added the tabular.cast_df.r function
authored Dec 10, 2011
167
6cd612f @talgalili More failsafe and made sure the example wouldn't run when the file is…
authored Jan 29, 2012
168
169 } # end of if(F)
Something went wrong with that request. Please try again.