Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 169 lines (137 sloc) 7.892 kB
50a4efb @talgalili Turning tabular into an S3 method for cast_df
authored
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
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
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
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
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
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
63
6cd612f @talgalili More failsafe and made sure the example wouldn't run when the file is…
authored
64 if(F) {
32369c1 @talgalili Examples - Adding the output as comments
authored
65
66 ###########################################
67 ###### Examples
68 ###########################################
69
70 ###### loading libraries and data
71 ###########################################
72
118fd91 @talgalili Added the tabular.cast_df.r function
authored
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
88
89 ###### Running examples:
90 ###########################################
91
118fd91 @talgalili Added the tabular.cast_df.r function
authored
92 # Examples that work:
32369c1 @talgalili Examples - Adding the output as comments
authored
93
94 # Trivial, but works:
118fd91 @talgalili Added the tabular.cast_df.r function
authored
95 tabular.cast_df(cast(aqm, month ~ ., mean))
32369c1 @talgalili Examples - Adding the output as comments
authored
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
103 tabular.cast_df(cast(aqm, . ~ temp2, mean))
32369c1 @talgalili Examples - Adding the output as comments
authored
104 # cold hot
105 # All 69.88 91.06
106
118fd91 @talgalili Added the tabular.cast_df.r function
authored
107 tabular.cast_df(cast(aqm, . ~ ., mean))
32369c1 @talgalili Examples - Adding the output as comments
authored
108 # All
109 # All 80.06
110
118fd91 @talgalili Added the tabular.cast_df.r function
authored
111 tabular.cast_df(cast(aqm, month ~ temp2, mean))
32369c1 @talgalili Examples - Adding the output as comments
authored
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
120 tabular.cast_df(cast(aqm, month ~ temp2, c(mean,sd)))
32369c1 @talgalili Examples - Adding the output as comments
authored
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
129 tabular.cast_df(cast(aqm, month ~ variable2, c(mean,sd)))
32369c1 @talgalili Examples - Adding the output as comments
authored
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
137
32369c1 @talgalili Examples - Adding the output as comments
authored
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
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
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
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
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
167
6cd612f @talgalili More failsafe and made sure the example wouldn't run when the file is…
authored
168
169 } # end of if(F)
Something went wrong with that request. Please try again.