[Desire-commits] r26 - in packages/desire: R man

[noreply at r-forge.r-project.org]

Author: olafm
Date: 2008-05-31 00:21:57 +0200 (Sat, 31 May 2008)
New Revision: 26

Added:
   packages/desire/R/mean_di.R
   packages/desire/man/meanDI.Rd
Log:
* Add weighted mean desirability index


Added: packages/desire/R/mean_di.R
===================================================================
--- packages/desire/R/mean_di.R	                        (rev 0)
+++ packages/desire/R/mean_di.R	2008-05-30 22:21:57 UTC (rev 26)
@@ -0,0 +1,56 @@
+##
+## mean_di.R - weighted mean desirability index
+##
+## Authors:
+##  Heike Trautmann  <trautmann at statistik.uni-dortmund.de>
+##  Detlef Steuer    <detlef.steuer at hsu-hamburg.de>
+##  Olaf Mersmann    <olafm at statistik.uni-dortmund.de>
+##
+
+meanDI <- function(f, ..., weights=1) 
+  UseMethod("meanDI", f)
+
+## Vector input
+meanDI.numeric <- function(f, ..., weights) {
+  weights <- weights/sum(weights)
+  mean(f*weights)
+}
+  
+## Matrix input
+meanDI.matrix <- function(f, margin=1, ..., weights=1) {
+  weights <- weights/sum(weights)
+  apply(f, margin, function(x) mean(x*weights))
+}
+
+## Array input
+meanDI.array <- function(f, margin=1, ..., weights=1)  {
+  weights <- weights/sum(weights)
+  apply(f, margin, function(x) mean(x * weights))
+}
+
+meanDI.desire.function <- function(f, ..., weights=1) {
+  weights <- weights/sum(weights)
+  ev <- function(x)
+    mean(sapply(i, function(k) dfs[[k]](x[k])) * weights)
+  
+  dfs <- list(f, ...)
+  if (!all(sapply(dfs, is.desirability)))
+    stop("Not all supplied arguments are desirability functions.")
+  
+  i <- 1:length(dfs)
+  class(ev) <- "desire.index"
+  return(ev)
+}
+
+meanDI.composite.desire.function <- function(f, ..., weights=1) {
+  weights <- weights/sum(weights)
+  ev <- function(x)
+    mean(sapply(dfs, function(f) f(x)) * weights)
+  
+  dfs <- list(f, ...)
+  if (!all(sapply(dfs, is.composite.desirability)))
+    stop("Not all supplied arguments are composite desirability functions.")
+  
+  class(ev) <- "desire.index"
+  return(ev)
+}

Added: packages/desire/man/meanDI.Rd
===================================================================
--- packages/desire/man/meanDI.Rd	                        (rev 0)
+++ packages/desire/man/meanDI.Rd	2008-05-30 22:21:57 UTC (rev 26)
@@ -0,0 +1,24 @@
+\name{meanDI}
+\alias{meanDI}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{Weighted mean desirability index}
+\description{
+  TBD
+}
+\usage{
+meanDI(f, ..., weights = 1)
+}
+\arguments{
+  \item{f,\dots}{\dots}
+  \item{weights}{vector of weights. Need not sum to one.}
+}
+\details{
+}
+\author{
+  Heike Trautmann \email{trautmann at statistik.uni-dortmund.de},
+  Detlef Steuer \email{steuer at hsu-hamburg.de} and
+  Olaf Mersmann \email{olafm at statistik.uni-dortmund.de}
+}
+\seealso{\code{\link{geometricDI}} and \code{\link{minimumDI}}}
+\keyword{optimization}
+\keyword{multivariate}