Merge pull request #33 from anespinosa/develop

Add permutation matrix

NAMESPACE

@@ -38,6 +38,8 @@ export(mixed_census)
 export(multilevel_degree)
 export(multiplex_census)
 export(percolation_clique)
+export(perm_label)
+export(perm_matrix)
 export(posneg_index)
 export(power_function)
 export(q_analysis)

R/path_distances.R

@@ -1,13 +1,13 @@
 #' Relational Composition
 #'
-#' This function return the relational composition of the given matrices. The compound relations define the paths along with social processes flows of the given matrices (Pattison, 1993). However, those whom they link may or may not be aware of them. The compound relations allows to identify "the possibly very long and devious chains of effects propagating withing concrete social systems through links of various kinds" (Lorrain & White, 1971: 50).
+#' This function returns the relational composition of the given matrices. The compound relations define the paths and the social process flows of the given matrices (Pattison, 1993). However, those whom they link may or may not be aware of them. The compound relations allow us to identify "the possibly very long and devious chains of effects propagating withing concrete social systems through links of various kinds" (Lorrain & White, 1971: 50).
 #'
 #' @param l   A list of matrices.
 #' @param comp  A number with the length of paths to form the compound relation.
 #' @param matrices   Whether to return the resulting matrices of the compound relations.
 #' @param equate   Whether to return the semigroup equations.
 #'
-#' @return This function provide the composition, or concatenation of compound relations and the primitives of the matrices.
+#' @return This function provides the composition or concatenation of compound relations and the primitives of the matrices.
 #'
 #' @references
 #'

R/utilities.R

@@ -1239,7 +1239,7 @@ extract_component <- function(A, maximum = TRUE, position = NULL) {
 
 #' Power matrix
 #'
-#' Power of a matrix computed by succesive matrix multiplication.
+#' Power of a matrix computed by successive matrix multiplication.
 #'
 #' @param A   A matrix
 #' @param n   Positive integer
@@ -1253,20 +1253,120 @@ extract_component <- function(A, maximum = TRUE, position = NULL) {
 #' @author Alejandro Espinosa-Rada
 #'
 #' @examples
-#' A <- matrix(c(1,0,0,0,
-#'               1,1,0,0,
-#'               1,0,1,0,
-#'               0,1,1,1), byrow = TRUE, ncol = 4, nrow = 4)
+#' A <- matrix(c(
+#'   1, 0, 0, 0,
+#'   1, 1, 0, 0,
+#'   1, 0, 1, 0,
+#'   0, 1, 1, 1
+#' ), byrow = TRUE, ncol = 4, nrow = 4)
 #' power_function(A, 1000)
-#' 
+#'
 #' @export
 
-power_function<- function(A, n){
+power_function <- function(A, n) {
   return(powA(n))
 }
 
-powA <- function(n){
-  if (n == 1) return(A)
-  if (n == 2) return(A %*% A)
-  if (n > 2) return(A %*% powA(n-1))
+powA <- function(n) {
+  if (n == 1) {
+    return(A)
+  }
+  if (n == 2) {
+    return(A %*% A)
+  }
+  if (n > 2) {
+    return(A %*% powA(n - 1))
+  }
+}
+
+#' Permutation matrix
+#'
+#' This function create permutation matrices.
+#'
+#' @param n   The size of the square matri
+#' @param m   Number of permutations
+#' @param unique   Whether to return unique cases
+#'
+#' @return This function returns a list of permutation matrices
+#'
+#' @author Alejandro Espinosa-Rada
+#'
+#' @examples
+#'
+#' W <- matrix(c(
+#'   0, 1, 0, 0, 0,
+#'   0, 0, 1, 0, 0,
+#'   1, 0, 0, 0, 0,
+#'   0, 0, 0, 0, 1,
+#'   0, 0, 0, 1, 0
+#' ), byrow = TRUE, ncol = 5)
+#' rownames(W) <- c("P", "Q", "R", "S", "T")
+#' colnames(W) <- rownames(W)
+#' perm_matrix(5, m = 1000, unique = TRUE)
+#'
+#' @export
+
+perm_matrix <- function(n, m = 1, unique = FALSE) {
+  matrices <- list()
+  for (m in seq_len(m)) {
+    A <- matrix(0, ncol = n, nrow = n, byrow = TRUE)
+    vector <- sample(NROW(A), NROW(A))
+    for (i in seq_len(length(vector))) {
+      A[vector[i], i] <- 1
+    }
+    matrices[[m]] <- A
+  }
+
+  if (unique) {
+    matrices <- unique(matrices)
+    # factorial(n) == length(matrices) # should reach this limit!
+  }
+
+  return(matrices)
+}
+
+#' Permute labels of a matrix
+#'
+#' This function permutes the labels of a matrix.
+#'
+#' @param A   A matrix
+#' @param m   Number of permutations
+#' @param unique   Whether to return unique cases
+#'
+#' @return This function returns the permutation of labels.
+#'
+#' @author Alejandro Espinosa-Rada
+#'
+#' @examples
+#'
+#' W <- matrix(c(
+#'   0, 1, 0, 0, 0,
+#'   0, 0, 1, 0, 0,
+#'   1, 0, 0, 0, 0,
+#'   0, 0, 0, 0, 1,
+#'   0, 0, 0, 1, 0
+#' ), byrow = TRUE, ncol = 5)
+#' rownames(W) <- c("P", "Q", "R", "S", "T")
+#' colnames(W) <- rownames(W)
+#' perm_label(W, m = 1000, unique = TRUE)
+#'
+#' @export
+
+perm_label <- function(A, m = 1, unique = FALSE) {
+  if (is.null(rownames(A))) {
+    rownames(A) <- 1:NROW(A)
+    colnames(A) <- rownames(A)
+  }
+  label <- rownames(A)
+
+  perm <- list()
+  for (i in seq_len(m)) {
+    perm[[i]] <- label[seq_len(NROW(A)) %*% perm_matrix(NCOL(A))[[1]]]
+  }
+
+  if (unique) {
+    perm <- unique(perm)
+  }
+
+  return(do.call(rbind, perm))
 }

README.Rmd

@@ -73,21 +73,25 @@ Utilities:
 
 9. `hypergraph()`: Hypergraphs
 
-10. `power_function()`: Power of a matrix
+10. `perm_matrix()`: Permutation matrix
 
-11. `meta_matrix()`: Meta matrix for multilevel networks
+11. `perm_label()`: Permute labels of a matrix
 
-12. `minmax_overlap()`: Minimum/maximum overlap
+12. `power_function()`: Power of a matrix
 
-13. `mix_matrix()`: Mixing matrix
+13. `meta_matrix()`: Meta matrix for multilevel networks
 
-14. `simplicial_complexes()`: Simplicial Complexes
+14. `minmax_overlap()`: Minimum/maximum overlap
 
-15. `structural_na()`: Structural missing data
+15. `mix_matrix()`: Mixing matrix
 
-16. `ego_net()`: Ego network
+16. `simplicial_complexes()`: Simplicial Complexes
 
-17. `zone_sample()`: Zone-2 sampling from second-mode
+17. `structural_na()`: Structural missing data
+
+18. `ego_net()`: Ego network
+
+19. `zone_sample()`: Zone-2 sampling from second-mode
 
 Ego and personal networks:
 
@@ -424,6 +428,8 @@ participating in this project you agree to abide by its terms.
 
 - [`{multinet}`](https://CRAN.R-project.org/package=multinet)
 
+- [`{muxViz}`](https://github.com/manlius/muxViz)
+
 - [`{tnet}`](https://toreopsahl.com/tnet/)
 
 - [`{xUCINET}`](https://www.analyzingsocialnetworksusingr.com/xucinet)

README.md

@@ -72,21 +72,25 @@ Utilities:
 
 9.  `hypergraph()`: Hypergraphs
 
-10. `power_function()`: Power of a matrix
+10. `perm_matrix()`: Permutation matrix
 
-11. `meta_matrix()`: Meta matrix for multilevel networks
+11. `perm_label()`: Permute labels of a matrix
 
-12. `minmax_overlap()`: Minimum/maximum overlap
+12. `power_function()`: Power of a matrix
 
-13. `mix_matrix()`: Mixing matrix
+13. `meta_matrix()`: Meta matrix for multilevel networks
 
-14. `simplicial_complexes()`: Simplicial Complexes
+14. `minmax_overlap()`: Minimum/maximum overlap
 
-15. `structural_na()`: Structural missing data
+15. `mix_matrix()`: Mixing matrix
 
-16. `ego_net()`: Ego network
+16. `simplicial_complexes()`: Simplicial Complexes
 
-17. `zone_sample()`: Zone-2 sampling from second-mode
+17. `structural_na()`: Structural missing data
+
+18. `ego_net()`: Ego network
+
+19. `zone_sample()`: Zone-2 sampling from second-mode
 
 Ego and personal networks:
 
@@ -560,6 +564,8 @@ participating in this project you agree to abide by its terms.
 
 - [`{multinet}`](https://CRAN.R-project.org/package=multinet)
 
+- [`{muxViz}`](https://github.com/manlius/muxViz)
+
 - [`{tnet}`](https://toreopsahl.com/tnet/)
 
 - [`{xUCINET}`](https://www.analyzingsocialnetworksusingr.com/xucinet)

docs/pkgdown.yml

@@ -3,5 +3,5 @@ pkgdown: 2.0.7
 pkgdown_sha: ~
 articles:
   multilayer: multilayer.html
-last_built: 2023-06-02T22:04Z
+last_built: 2023-06-04T16:18Z