Add additiveDEA to CRANhaven, because archived on 2025-01-26 10:02:00…

… +0000

additiveDEA/DESCRIPTION

@@ -0,0 +1,36 @@
+Package: additiveDEA
+Type: Package
+Title: Additive Data Envelopment Analysis Models
+Version: 1.1
+Date: 2017-10-02
+Author: Andreas Diomedes Soteriades
+Maintainer: Andreas Diomedes Soteriades <[email protected]>
+Description: Provides functions for calculating efficiency with two
+        types of additive Data Envelopment Analysis models: (i)
+        Generalized Efficiency Measures: unweighted additive model
+        (Cooper et al., 2007 <doi:10.1007/978-0-387-45283-8>), Range
+        Adjusted Measure (Cooper et al., 1999,
+        <doi:10.1023/A:1007701304281>), Bounded Adjusted Measure
+        (Cooper et al., 2011 <doi:10.1007/s11123-010-0190-2>), Measure
+        of Inefficiency Proportions (Cooper et al., 1999
+        <doi:10.1023/A:1007701304281>), and the Lovell-Pastor Measure
+        (Lovell and Pastor, 1995 <doi:10.1016/0167-6377(95)00044-5>);
+        and (ii) the Slacks-Based Measure (Tone, 2001
+        <doi:10.1016/S0377-2217(99)00407-5>). The functions provide
+        several options: (i) constant and variable returns to scale;
+        (ii) fixed (non-controllable) inputs and/or outputs; (iii)
+        bounding the slacks so that unrealistically large slack values
+        are avoided; and (iv) calculating the efficiency of specific
+        Decision-Making Units (DMUs), rather than of the whole sample.
+        Package additiveDEA also provides a function for reducing
+        computation time when datasets are large.
+License: GPL-2
+Depends: R (>= 3.1.0), lpSolveAPI
+Imports: Benchmarking
+URL: https://www.r-project.org
+RoxygenNote: 6.0.1
+NeedsCompilation: no
+Packaged: 2017-10-02 11:05:32 UTC; mac
+Repository: CRAN
+Date/Publication: 2017-10-02 11:14:36 UTC
+Additional_repositories: https://cranhaven.r-universe.dev

additiveDEA/MD5

@@ -0,0 +1,8 @@
+452a1b6638c5789963e7ec640fa9c47a *DESCRIPTION
+193b09b1d2bd7b137bb04c1353861911 *NAMESPACE
+8fd3aa024b34b11c8b4ac1023475e9e3 *R/dea.fast.R
+0fcbae6e1e441eee8ec56b6ed660b021 *R/dea.gem.R
+301b0c6d5491043e5c9cd070ff9afccd *R/dea.sbm.R
+6ee4628d2509784074170d5ada6b8c04 *man/dea.fast.Rd
+48b3a110210314074ea82071d60ee80b *man/dea.gem.Rd
+4aa2229f1d1a83bec88b07367591748e *man/dea.sbm.Rd

additiveDEA/NAMESPACE

@@ -0,0 +1,4 @@
+exportPattern("^[[:alpha:]]+")
+import(lpSolveAPI)
+importFrom("stats", "sd")
+importFrom("utils", "tail")

additiveDEA/R/dea.fast.R

@@ -0,0 +1,144 @@
+dea.fast <-
+function(base, noutput, fixed = NULL, rts = 2, bound = NULL, 
+                     add.model = c('additive', 'RAM', 'BAM', 'MIP', 
+                     'LovPast', 'SBM'), blockSize = 200) {
+
+  baseEfficient <- list()
+  n <- nrow(base)
+  mod <- (n - (n %% blockSize)) / blockSize
+  blocks <- c(1, 1:mod * blockSize + 1)
+  for (i in 1:mod) {
+    aux <- blocks[i]:(blocks[i + 1] - 1)
+    base1 <- base[aux, ]
+    bound1 <- bound[aux, ]
+    if (add.model != 'SBM') {
+      eff <- round(dea.gem(base = base1, noutput, fixed, rts, 
+        bound = bound1, add.model)$eff, 7)
+      index <- which(is.na(eff))
+      if (length(index) > 0) {
+        eff[index] <- round(dea.gem(base = base1, noutput, fixed, rts, 
+          bound = bound1, add.model, whichDMUs = index)$eff, 7)
+      }
+      baseEfficient[[i]] <- base1[which(eff == 0), ]
+    } else {
+      eff <- round(dea.sbm(base = base1, noutput, fixed, rts, 
+        bound = bound1)$eff, 7)
+      index <- which(is.na(eff))
+      if (length(index) > 0) {
+        eff[index] <- round(dea.sbm(base = base1, noutput, fixed, rts, 
+          bound = bound1, whichDMUs = index)$eff, 7)
+      }
+      baseEfficient[[i]] <- base1[which(eff == 1), ]
+    }
+  }
+  if (n %% blockSize != 0) {
+    aux <- (n - (n %% blockSize) + 1):n
+    base1 <- base[aux, ]
+    bound1 <- bound[aux, ]
+    if (add.model != 'SBM') {
+      eff <- round(dea.gem(base = base1, noutput, fixed, rts, 
+        bound = bound1, add.model)$eff, 7)
+      index <- which(is.na(eff))
+      if (length(index) > 0) {
+        eff[index] <- round(dea.gem(base = base1, noutput, fixed, rts, 
+          bound = bound1, add.model, whichDMUs = index)$eff, 7)
+      }
+      baseEfficient[[i + 1]] <- base1[which(eff == 0), ]
+    } else {
+      eff <- round(dea.sbm(base = base1, noutput, fixed, rts, 
+        bound = bound1)$eff, 7)
+      index <- which(is.na(eff))
+      if (length(index) > 0) {
+        eff[index] <- round(dea.sbm(base = base1, noutput, fixed, rts, 
+          bound = bound1, whichDMUs = index)$eff, 7)
+      }
+      baseEfficient[[i + 1]] <- base1[which(eff == 1), ]
+    }
+  }
+
+  baseEfficient <- do.call("rbind", baseEfficient)
+  if (add.model != 'SBM') {
+    eff <- round(dea.gem(base = base1, noutput, fixed, rts, 
+      bound = bound1, add.model)$eff, 7)
+    index <- which(is.na(eff))
+    if (length(index) > 0) {
+      eff[index] <- round(dea.gem(base = base1, noutput, fixed, rts, 
+        bound = bound1, add.model, whichDMUs = index)$eff, 7)
+    }
+    baseEfficient <- base1[which(eff == 0), ]
+  } else {
+    eff <- round(dea.sbm(base = base1, noutput, fixed, rts, 
+      bound = bound1)$eff, 7)
+    index <- which(is.na(eff))
+    if (length(index) > 0) {
+      eff[index] <- round(dea.sbm(base = base1, noutput, fixed, rts, 
+        bound = bound1, whichDMUs = index)$eff, 7)
+    }
+    baseEfficient <- base1[which(eff == 1), ]
+  }
+
+  eff <- list()
+  for (i in 1:mod) {
+    aux <- blocks[i]:(blocks[i + 1] - 1)
+    base1 <- base[aux, ]
+    base1 <- rbind(base1, baseEfficient)
+    bound1 <- bound[aux, ]
+    if (!is.null(bound)) {
+      df <- data.frame(matrix(0, 
+        nrow = nrow(base1[1:(nrow(base1) - blockSize), ]), 
+        ncol = ncol(base1)))
+      names(df) <- names(bound1)
+      bound1 <- rbind(bound1, df)
+    }
+    if (add.model != 'SBM') {
+      eff[[i]] <- dea.gem(base = base1, noutput, fixed, rts, 
+        bound = bound1, add.model, whichDMUs = 1:blockSize)$eff
+      index <- which(is.na(eff[[i]]))
+      if (length(index) > 0) {
+        eff[[i]][index] <- dea.gem(base = base1, noutput, fixed, rts, 
+          bound = bound1, add.model, whichDMUs = index)$eff
+      }
+    } else {
+      eff[[i]] <- dea.sbm(base = base1, noutput, fixed, rts, 
+        bound = bound1, whichDMUs = 1:blockSize)$eff
+      index <- which(is.na(eff[[i]]))
+      if (length(index) > 0) {
+        eff[[i]][index] <- dea.sbm(base = base1, noutput, fixed, rts, 
+          bound = bound1, whichDMUs = index)$eff
+      }
+    }
+  }
+  if (n %% blockSize != 0) {
+    aux <- (n - (n %% blockSize) + 1):n
+    base1 <- base[aux, ]
+    base1 <- rbind(base1, baseEfficient)
+    bound1 <- bound[aux, ]
+    newBlockSize <- nrow(base) - mod * blockSize
+    if (!is.null(bound)) {
+      df <- data.frame(matrix(0, 
+        nrow = nrow(base1[1:(nrow(base1) - newBlockSize), ]), 
+        ncol = ncol(base1)))
+     names(df) <- names(bound1)
+     bound1 <- rbind(bound1, df)
+    }
+    if (add.model != 'SBM') {
+      eff[[i + 1]] <- dea.gem(base = base1, noutput, fixed, rts, 
+        bound = bound1, add.model, whichDMUs = 1:newBlockSize)$eff
+      index <- which(is.na(eff[[i + 1]]))
+      if (length(index) > 0) {
+        eff[[i + 1]][index] <- dea.gem(base = base1, noutput, fixed, rts, 
+          bound = bound1, add.model, whichDMUs = index)$eff
+      }
+    } else {
+      eff[[i + 1]] <- dea.sbm(base = base1, noutput, fixed, rts, 
+        bound = bound1, whichDMUs = 1:newBlockSize)$eff
+      index <- which(is.na(eff[[i + 1]]))
+      if (length(index) > 0) {
+        eff[[i + 1]][index] <- dea.sbm(base = base1, noutput, fixed, rts, 
+          bound = bound1, whichDMUs = index)$eff
+      }
+    }
+  }
+  eff <- unlist(eff)
+  return(eff)
+}