1 2# This library is free software; you can redistribute it and/or 3# modify it under the terms of the GNU Library General Public 4# License as published by the Free Software Foundation; either 5# version 2 of the License, or (at your option) any later version. 6# 7# This library is distributed in the hope that it will be useful, 8# but WITHOUT ANY WARRANTY; without even the implied warranty of 9# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 10# GNU Library General Public License for more details. 11# 12# You should have received a copy of the GNU Library General 13# Public License along with this library; if not, write to the 14# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, 15# MA 02111-1307 USA 16 17 18################################################################################ 19# FUNCTION: COLUMN STATISTICS: 20# colStats Computes sample statistics by column 21# colSums Computes sums of all values in each column 22# colMeans Computes means of all values in each column 23# colSds Computes standardard deviation of each column 24# colVars Computes sample variance by column 25# colSkewness Computes sample skewness by column 26# colKurtosis Computes sample kurtosis by column 27# colMaxs Computes maximum values in each colum 28# colMins Computes minimum values in each colum 29# colProds Computes product of all values in each colum 30# colQuantiles Computes quantiles of all values in each colum 31# DEPRECATED: NO LONGER USED: 32# colAvgs Computes sample mean by column 33# colStdevs Computes sample standard deviation by column 34# mean.timeSeries Computes sample means by column 35# var.timeSeries Computes sample variance by column 36################################################################################ 37 38 39colStats <- 40 function(x, FUN, ...) 41{ 42 # A function implemented by Diethelm Wuertz 43 44 # Description: 45 # Computes sample statistics by column 46 47 # FUNCTION: 48 49 # Statistics: 50 if (inherits(x, "timeSeries")) 51 apply(na.omit(getDataPart(x), ...), 2, FUN, ...) #<< YC : as.matrix is slow ! 52 else 53 apply(na.omit(as.matrix(x), ...), 2, FUN, ...) 54} 55 56 57# ------------------------------------------------------------------------------ 58 59 60# YC important because default colSums is unefficient since it retrieves 61# full dimnames, i.e. rownames which is very time consuming 62 63 64if (getRversion() < "2.9.0") { 65 setMethod("colSums", "timeSeries", 66 function(x, na.rm = FALSE, dims = 1L) 67 { 68 x <- getDataPart(x) 69 callGeneric() 70 }) 71} else { 72 setMethod("colSums", "timeSeries", 73 function(x, na.rm = FALSE, dims = 1L, ...) 74 { 75 x <- getDataPart(x) 76 callGeneric() 77 }) 78} 79 80 81# ------------------------------------------------------------------------------ 82 83 84# YC important because default colSums is unefficient since it retrieves 85# full dimnames, i.e. rownames which is very time consuming 86 87 88if (getRversion() < "2.9.0") { 89 setMethod("colMeans", "timeSeries", 90 function(x, na.rm = FALSE, dims = 1L) 91 { 92 x <- getDataPart(x) 93 callGeneric() 94 }) 95} else { 96 setMethod("colMeans", "timeSeries", 97 function(x, na.rm = FALSE, dims = 1L, ...) 98 { 99 x <- getDataPart(x) 100 callGeneric() 101 }) 102} 103 104# ------------------------------------------------------------------------------ 105 106 107colSds <- function(x, ...) { colStats(x, "sd", ...) } 108 109 110colVars <- function(x, ...) { colStats(x, "var", ...) } 111 112 113colSkewness <- function(x, ...) { colStats(x, "skewness", ...) } 114 115 116colKurtosis <- function(x, ...) { colStats(x, "kurtosis", ...) } 117 118 119colMaxs <- function(x, ...) { colStats(x, "max", ...) } 120 121 122colMins <- function(x, ...) { colStats(x, "min", ...) } 123 124 125colProds <- function(x, ...) { colStats(x, "prod", ...) } 126 127 128# ------------------------------------------------------------------------------ 129 130 131colQuantiles <- 132 function(x, prob = 0.05, ...) 133{ 134 # FUNCTION: 135 136 stopifnot(length(prob) == 1) 137 colStats(x, "quantile", probs = prob, ...) 138} 139 140 141################################################################################ 142# DEPRECATED: 143 144 145colAvgs <- 146 function(x, ...) 147{ 148 # FUNCTION: 149 150 colMeans(x, ...) 151} 152 153 154# ------------------------------------------------------------------------------ 155 156 157colStdevs <- 158 function(x, ...) 159{ 160 # FUNCTION: 161 162 colStats(x, "sd", ...) 163} 164 165 166# ------------------------------------------------------------------------------ 167 168 169# mean.timeSeries <- colMeans 170# var.timeSeries <- colVars 171 172 173################################################################################ 174 175