version 0.3.0

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: diagonals
 Title: Block Diagonal Extraction or Replacement
-Version: 0.2.0
+Version: 0.3.0
 Authors@R: person("Bastiaan", "Quast", email = "bquast@gmail.com", role = c("aut", "cre"))
 Description: Several tools for handling block-matrix diagonals and similar constructs are implemented. Block-diagonal matrices can be extracted or removed using two small functions implemented here. In addition, non-square matrices are supported. Block diagonal matrices occur when two dimensions of a data set are combined along one edge of a matrix. For example, trade-flow data in the 'decompr' and 'gvc' packages have each country-industry combination occur along both edges of the matrix.
 Depends: R (>= 2.10)
@@ -11,8 +11,8 @@ BugReports: https://github.com/bquast/diagonals/issues
 Suggests: testthat, knitr
 VignetteBuilder: knitr
 NeedsCompilation: no
-Packaged: 2015-05-29 14:39:27 UTC; bquast
+Packaged: 2015-06-15 10:27:50 UTC; bquast
 Author: Bastiaan Quast [aut, cre]
 Maintainer: Bastiaan Quast <bquast@gmail.com>
 Repository: CRAN
-Date/Publication: 2015-05-29 18:22:47
+Date/Publication: 2015-06-15 16:26:14

MD5

@@ -1,27 +1,18 @@
-f223a6df2b193258f76f4262fb0e206b *DESCRIPTION
-37e62a88e55986c673d9a9527933174b *NAMESPACE
-89019cc99fe8a4e12779899993d2aa28 *NEWS
-15ac30f074e5bf865414c836a60de74d *R/block_matrix.R
-b4cf40c8d3c368e352e5ecf10a0fc1f0 *R/diagonals.R
-19d8810c393708880df39a44c1e9c667 *R/minus_block_matrix.R
-baece1619a24a555eba011f19337b308 *R/minus_rectangle_matrix.R
-91b921a198e7d64c62024aa710b8c095 *R/rectangle_matrix.R
-3ace33d405c0d3028f38f0e05820b6fa *README.md
-dcfad8ae7d14329cfd9e5926832516de *build/vignette.rds
+c712d225ecd0632ecdb61d856652e048 *DESCRIPTION
+8978180e2735e69064cef803abafe717 *NAMESPACE
+eb5e3dd144d47e8547b1a2103cb1e8b8 *NEWS
+bc2c446941b5d490cd38d9d0c37d8ce6 *R/diag.R
+02cff18352477edf52936f5595e13a1c *R/diagonals.R
+5af0caad0e4182b4b84fafeeda171316 *R/fatdiag.R
+2691863cc52ccddc31bd1827f4d36316 *R/split_vector.R
+26fe789783dc13f51938b45052cecf69 *README.md
+1dd6f9352cf54f6af30e0843bd7c3b1b *build/vignette.rds
 33f6179f4338f18d0cf1e5835082901e *inst/CITATION
-5e4ffb24be47eec4335ddfcb9e09a04b *inst/doc/diagonals.R
-015bd4bc82069e63d98d49356100f491 *inst/doc/diagonals.Rmd
-4037c269a0b9f0c5404c280d1ebd07c6 *inst/doc/diagonals.html
-2c4461a145dc94b32fd3c7dfb79a9737 *inst/doc/network.R
-ce089bb79194a626a1ea082f05ff8fa7 *inst/doc/network.Rmd
-2169c5e197ae89a60a306978b00f1250 *inst/doc/network.html
-f3be68f69f44c7427b803ca9d7339a94 *man/block_matrix.Rd
+45fdf83e44b249d29b6b7b9692f26615 *inst/doc/fatdiag.R
+e23972aca3ae53b88b14f101b238abf2 *inst/doc/fatdiag.Rmd
+e958b5271fa92f93515aa5550e0a7367 *inst/doc/fatdiag.html
+0af75b2f297a085f04552c174498edfb *man/diag-set.Rd
 63c593eac8c9f0d5894c21fa56350bdf *man/diagonals.Rd
-dd77bda8ff23bd4c9c1b2b25633d5dbf *man/minus_block_matrix.Rd
-a2e55320a5c7c7e55a3611d0359d2411 *man/minus_rectangle_matrix.Rd
-b25cb16405e006257be72d5559ef6b06 *man/rectangle_matrix.Rd
-93a1e65fece34405d313bc933811acfa *tests/testthat.R
-f29803d466c01d3220d07486bb3f529f *tests/testthat/test_block_matrix.R
-e089aa8758bc303b81527dcd057b9eea *tests/testthat/test_minus_block_matrix.R
-015bd4bc82069e63d98d49356100f491 *vignettes/diagonals.Rmd
-ce089bb79194a626a1ea082f05ff8fa7 *vignettes/network.Rmd
+540357d29ae3e0d39187c4c67f1d3025 *man/fatdiag.Rd
+eb40293ad564fe7a042c28c1f5b6a1f2 *man/split_vector.Rd
+e23972aca3ae53b88b14f101b238abf2 *vignettes/fatdiag.Rmd

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2 (4.1.1): do not edit by hand
 
-export(block_matrix)
-export(minus_block_matrix)
-export(minus_rectangle_matrix)
-export(rectangle_matrix)
+export("fatdiag<-")
+export(fatdiag)
+export(split_vector)

NEWS

@@ -1,3 +1,11 @@
+diagonals 0.3.0
+===================
+
+* replace all previous functions with fatdiag
+
+* add fatdig <- function
+
+
 diagonals 0.2.0
 ===================
 

R/diag.R

@@ -0,0 +1,23 @@
+#' Matrix Diagonals
+#'
+#' @description A small extension of the `diag<-` function from the base package, allowing for replacement vectors smaller than the diagonal.
+#' @param x a matrix, vector or 1D array, or missing.
+#' @param value either a single value or a vector of length equal to that of the current diagonal. Should be of a mode which can be coerced to that of x.
+#' @details The `diag<-` function in the base package allows for two type of value, either of length 1, or of length equal to the length of the diagonal
+#' This function extends that by allowing
+
+
+`diag<-` <- function (x, value) {
+  dx <- dim(x)
+  if (length(dx) != 2L)
+    stop("only matrix diagonals can be replaced")
+  len.i <- min(dx)
+  len.v <- length(value)
+  if (len.v != 1L && len.i %% len.v != 0)
+    stop("replacement diagonal has wrong length")
+  if (len.i) {
+    i <- seq_len(len.i)
+    x[cbind(i, i)] <- value
+  }
+  x
+}

R/diagonals.R

@@ -4,3 +4,10 @@
 #' @author Bastiaan Quast \email{bquast@@gmail.com}
 #' @seealso http://qua.st/diagonals
 NULL
+.onAttach <- function(...) {
+  packageStartupMessage('
+D I
+A G
+    O N
+    A L
+        S')}

R/fatdiag.R

@@ -0,0 +1,148 @@
+#' Fat Matrix Diagonals
+#'
+#' @aliases fatdiag<-
+#' @param x a matrix where the dimensions are integer multiples of size or integer dividors of steps
+#' @param steps the required number of steps (block matrices) across the diagonal
+#' @param size the width or height of the matrix being dropped over the diagonal of matrix x
+#' @param nrow the number of rows
+#' @param ncol the number of columns
+#' @details Either steps or size is expected to be provided.
+#' @export
+
+fatdiag <- function( x = 1, steps=NULL, size=NULL, nrow=NULL, ncol=NULL) {
+
+  if (length(size) == 1)
+    size <- c(size, size)
+
+    if (length(x) == 1) {
+
+      if ( !is.null(nrow) && !is.null(ncol) ) {
+        dx <- as.vector( c(nrow,ncol) )
+      } else if ( !is.null(nrow) && is.null(ncol)) {
+        if ("common denominator x and nrow")
+          stop("nrow and x do not havea common denominator")
+        dx <- as.vector(c(nrow, x))
+      } else if ( is.null(nrow) && !is.null(ncol)) {
+        if ("common denominator x and ncol")
+          stop("ncol and x do not have a common denominator")
+        dx <- c(x, ncol)
+      } else if ( is.null(nrow) && is.null(ncol) && is.null(steps) ) {
+        steps <- x %/% max(size)
+        dx    <- size * steps
+      } else {
+        dx <- c(x, x)
+      }
+
+      if ( !all(dx %% steps == 0) )
+        stop("steps is not an integer divisor of x on all dimensions")
+
+      # create a fat diagonal matrix
+      m <- matrix(0, nrow=dx[1], ncol = dx[2])
+      fatdiag(m, steps = steps, size = size) <- 1
+      return(m)
+
+    } else if ( length(dim(x)) == 2) {
+
+        # extract the fat diagonal
+
+        dx <- dim(x)
+        size <- dx %/% steps
+        # split dimension according to steps
+        spl1 <- split_vector(1:dx[1], steps = steps)
+        spl2 <- split_vector(1:dx[2], steps = steps)
+        # create vectors
+        a <- vector()
+        b <- vector()
+        for (i in 1:steps) {
+          a <- c(a, rep(spl1[[i]], times = size[2]) )
+          b <- c(b, rep(spl2[[i]], each  = size[1]) )
+        }
+        return( x[cbind(a,b)] )
+    }
+}
+
+#' @describeIn fatdiag the set version of fatdiag
+#' @title fatdiag set
+#' @aliases fatdiag
+#' @param on_diagonal should the operation be apply to the elements on the fat diagonal.
+#' @param value replacement value
+#' @export
+`fatdiag<-` <- function( x, steps = NULL, size = NULL, on_diagonal=TRUE, value ) {
+
+  # save dimensions
+  dx <- dim(x)
+  # save value length
+  lv <- length(value)
+
+  # square if dimensions are right
+  if (length(dx) != 2L)
+    stop("not a matrix")
+
+  # determine the size of the step
+  if ( is.null(steps) && !is.null(size) ) {
+
+    # coerce to integer
+    size <- floor(size)
+
+    # create steps
+    steps <- max(dx) %/% max(size)
+
+  } else if ( !is.null(steps) & is.null(size) ) {
+
+    # calculate size
+    size <- dx %/% steps
+
+  } else if (is.null(steps) & is.null(size) ) {
+
+    # issue warning
+    warning("Both steps and size parameters are NULL, trying to guess size")
+
+    if ( all(sqrt(dx) %% 1 == 0) ) {
+      size  <- sqrt(dx)
+      steps <- sqrt(dx[1])
+      warning("using the square root as steps and size")
+    } else {
+      # set to unit
+      size <- 1L
+      # create steps
+      steps <- dx[1] %/% size
+    }
+
+  }
+
+  # check that dimensions of this square matrix are a multiple of size
+  if( !all(dx %% size == 0) )
+    stop("Matrix dimensions are not a multiple of size")
+
+  if (as.integer(size[1]*size[2]*steps) %% lv != 0 && lv != 1L)
+    stop("value fat diagonals has wrong length")
+
+
+  # split dimension according to steps
+  spl1 <- split_vector(1:dx[1], steps = steps)
+  spl2 <- split_vector(1:dx[2], steps = steps)
+
+  # create vectors
+  a <- vector()
+  b <- vector()
+
+  if (!on_diagonal) {
+    for (i in 1:steps) {
+      a <- c(a, rep(spl1[[i]], times=dx[1]-size) )
+      b <- c(b, rep(setdiff(1:dx[1], spl2[[i]]), each=size) )
+      }
+    } else {
+    # insert combinations
+    for (i in 1:steps) {
+      a <- c(a, rep(spl1[[i]], times = size[2]) )
+      b <- c(b, rep(spl2[[i]], each  = size[1]) )
+      }
+    }
+
+  # replace
+  x[cbind(a,b)] <- value
+
+  # return output
+  return(x)
+
+}