version 0.4.0

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: diagonals
 Title: Block Diagonal Extraction or Replacement
-Version: 0.3.0
+Version: 0.4.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-06-15 10:27:50 UTC; bquast
+Packaged: 2015-10-05 09:48:02 UTC; quast
 Author: Bastiaan Quast [aut, cre]
 Maintainer: Bastiaan Quast <bquast@gmail.com>
 Repository: CRAN
-Date/Publication: 2015-06-15 16:26:14
+Date/Publication: 2015-10-05 12:58:14

MD5

@@ -1,18 +1,20 @@
-c712d225ecd0632ecdb61d856652e048 *DESCRIPTION
+4f2e1bb438b4a47b611cba8b8c7fa6e2 *DESCRIPTION
 8978180e2735e69064cef803abafe717 *NAMESPACE
-eb5e3dd144d47e8547b1a2103cb1e8b8 *NEWS
-bc2c446941b5d490cd38d9d0c37d8ce6 *R/diag.R
+2ed492dd4faec5c6788023dbb74a99fa *NEWS
 02cff18352477edf52936f5595e13a1c *R/diagonals.R
-5af0caad0e4182b4b84fafeeda171316 *R/fatdiag.R
+4377a30de60cad31bfb694ae662cec8f *R/fatdiag.R
+298c36468bfb2d9975a29144beef49a2 *R/matricise.R
 2691863cc52ccddc31bd1827f4d36316 *R/split_vector.R
-26fe789783dc13f51938b45052cecf69 *README.md
-1dd6f9352cf54f6af30e0843bd7c3b1b *build/vignette.rds
+2e893a67e041f980be9686901d7705c2 *README.md
+de11144bf9e5ebbd75ece150afed8766 *build/vignette.rds
 33f6179f4338f18d0cf1e5835082901e *inst/CITATION
 45fdf83e44b249d29b6b7b9692f26615 *inst/doc/fatdiag.R
 e23972aca3ae53b88b14f101b238abf2 *inst/doc/fatdiag.Rmd
-e958b5271fa92f93515aa5550e0a7367 *inst/doc/fatdiag.html
-0af75b2f297a085f04552c174498edfb *man/diag-set.Rd
+8953ecbcc4cd5fb807db69b3b90aef0c *inst/doc/fatdiag.html
 63c593eac8c9f0d5894c21fa56350bdf *man/diagonals.Rd
-540357d29ae3e0d39187c4c67f1d3025 *man/fatdiag.Rd
+bd788ef8fb02ae4f78922fd926962b16 *man/fatdiag.Rd
+1d283b65348018be7e9a126d40783b95 *man/matricise.Rd
 eb40293ad564fe7a042c28c1f5b6a1f2 *man/split_vector.Rd
+93a1e65fece34405d313bc933811acfa *tests/testthat.R
+9232d7b7bb1ed4bdf0cd3afc6e6d24d0 *tests/testthat/test_fatdiag.R
 e23972aca3ae53b88b14f101b238abf2 *vignettes/fatdiag.Rmd

NEWS

@@ -1,3 +1,9 @@
+diagonals 0.4.0
+===================
+
+* various small fixes
+
+
 diagonals 0.3.0
 ===================
 

R/fatdiag.R

@@ -8,57 +8,100 @@
 #' @param ncol the number of columns
 #' @details Either steps or size is expected to be provided.
 #' @export
+#' @examples
+#' fatdiag(12, steps=3)
+#'
+#' ( m <- matrix(111, nrow=6, ncol=9) )
+#' fatdiag(m, steps=3) <- 5
+#'
+#' fatdiag(m, steps=3)
+#'
+#' fatdiag(12, size=4)
+#'
+#' fatdiag(12, size=c(3,4) )
 
 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 (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 have a 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)] )
+    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 ( is.null( dim(x) ) && 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 <- length(x) %/% ( max(size) * min(size) )
+      dx    <- size * steps
+    } else {
+      size <- c( sqrt(length(x)/steps), sqrt(length(x)/steps) )
+      dx   <- c( (length(x) / size),  (length(x) / size)  )
     }
+
+    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) <- x
+    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)] )
+  } else {
+    stop("x is not a valid vector or matrix")
+  }
+
 }
 
 #' @describeIn fatdiag the set version of fatdiag
@@ -69,6 +112,10 @@ fatdiag <- function( x = 1, steps=NULL, size=NULL, nrow=NULL, ncol=NULL) {
 #' @export
 `fatdiag<-` <- function( x, steps = NULL, size = NULL, on_diagonal=TRUE, value ) {
 
+
+  if (length(size) == 1)
+    size <- c(size, size)
+
   # save dimensions
   dx <- dim(x)
   # save value length
@@ -82,7 +129,7 @@ fatdiag <- function( x = 1, steps=NULL, size=NULL, nrow=NULL, ncol=NULL) {
   if ( is.null(steps) && !is.null(size) ) {
 
     # coerce to integer
-    size <- floor(size)
+    # size <- floor(size)
 
     # create steps
     steps <- max(dx) %/% max(size)
@@ -110,12 +157,12 @@ fatdiag <- function( x = 1, steps=NULL, size=NULL, nrow=NULL, ncol=NULL) {
 
   }
 
-  # check that dimensions of this square matrix are a multiple of size
+  # check that dimensions of this 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")
+    stop("value fat diagonal has wrong length")
 
 
   # split dimension according to steps

R/matricise.R

@@ -0,0 +1,63 @@
+#' Matricise
+#'
+#' @name matricise
+#' @param x a higher-order array (length(dim(x)) >= 3)
+#' @param row_dim the input array dimension which should be added to the row dimension of the output matrix, the value has to be 3 or 4.
+#' @param col_dim the input array dimension which should be added to the column dimension of the output matrix, the value has to be 3 or 4.
+#' @return a matrix (length(dim(x)) == 2 )
+
+matricise <- function(x, row_dim = c(NULL,3,4), col_dim = c(NULL,3,4) ) {
+
+  # save dimensions
+  dx <- dim(x)
+
+  # create row and col dims
+  if (!is.null(row_dim)) {
+    dr <- dx[row_dim]
+  } else {
+    dr <- 1L
+  }
+  if (!is.null(col_dim)) {
+    dc <- dx[col_dim]
+  } else {
+    dc <- 1L
+  }
+
+  # create intermediate array
+  a <- array( dim=c(nrow=(dx[1]*dr), ncol=dx[2], dc ) )
+
+  # sort in lists
+  s1 <- split_vector( 1:(dx[1]*dr), steps=dx[dr] )
+
+  if (row_dim == 3) {
+    # fill output matrix
+    for (i in 1:length(s1) ) {
+      a[s1[[i]], ,] <- x[,,i,]
+    }
+  } else if (row_dim == 4) {
+    # fill output matrix
+    for (i in 1:length(s1) ) {
+      a[s1[[i]], ,] <- x[,,,i]
+    }
+  } else {
+    stop("row_dim is not a valid array dimension")
+  }
+
+  # use new dimensions
+  dx <- dim(a)
+
+  # create output matrix
+  m <- matrix(nrow=dx[1],ncol=(dx[2]*dc) )
+
+  # sort in lists
+  s2 <- split_vector( 1:(dx[2]*dc), steps=dc )
+
+  # fill output matrix
+  for (i in 1:length(s2) ) {
+    m[, s2[[i]] ] <- a[,,i]
+  }
+
+  # return output matrix
+  return(m)
+
+}

README.md

@@ -1,6 +1,7 @@
 diagonals
 -------------
 [![CRAN Version](http://www.r-pkg.org/badges/version/diagonals)](http://cran.r-project.org/package=diagonals)
+[![RStudio Cloud Downloads](http://cranlogs.r-pkg.org/badges/diagonals?color=brightgreen)](http://cran.rstudio.com/package=diagonals)
 [![Travis-CI Build Status](https://travis-ci.org/bquast/diagonals.svg?branch=master)](https://travis-ci.org/bquast/diagonals) 
 [![Coverage Status](https://img.shields.io/coveralls/bquast/diagonals.svg)](https://coveralls.io/r/bquast/diagonals?branch=master)