Merge pull request #301 from stocnet/develop

v1.4.5

.github/workflows/pushrelease.yml

@@ -85,24 +85,16 @@ jobs:
           DEFAULT_BUMP: patch
           RELEASE_BRANCHES: main
       - name: Checkout two
-        uses: actions/checkout@v2
-      - name: Create Release
-        id: create_release
-        uses: actions/create-release@v1
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-        with:
-          tag_name: ${{ steps.newtag.outputs.tag }}
-          release_name: Release ${{ steps.newtag.outputs.tag }}
-          draft: false
-          prerelease: false
+        uses: actions/checkout@v4
+
+      - name: Extract version
+        run: |
+          echo "PACKAGE_VERSION=$(grep '^Version' DESCRIPTION | sed 's/.*: *//')" >> $GITHUB_ENV
+          echo "PACKAGE_NAME=$(grep '^Package' DESCRIPTION | sed 's/.*: *//')" >> $GITHUB_ENV
 
       - name: Download binaries
         uses: actions/download-artifact@v4
 
-      - name: Display structure of downloaded files
-        run: ls -R
-
       - name: Rename binaries release
         shell: bash
         run: |
@@ -112,7 +104,7 @@ jobs:
           cp ./winOS/${{ env.PACKAGE_NAME }}_${{ env.PACKAGE_VERSION }}*.zip .
           echo "Renamed files"
           ls migraph_*
-
+       
       - name: Create Release and Upload Assets
         id: create_release
         uses: softprops/action-gh-release@v2
@@ -128,7 +120,7 @@ jobs:
             migraph_*.tar.gz
             migraph_*.zip
         env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 
 
   pkgdown:
     name: Build and deploy website

DESCRIPTION

@@ -1,16 +1,16 @@
 Package: migraph
 Title: Univariate and Multivariate Tests for Multimodal and Other Networks 
-Version: 1.4.3
-Date: 2024-11-06
+Version: 1.4.5
+Date: 2024-11-30
 Description: A set of tools for testing networks.
    It includes functions for univariate and multivariate 
    conditional uniform graph and quadratic assignment procedure testing,
    and network regression.
    The package is a complement to 
    'Multimodal Political Networks' (2021, ISBN:9781108985000),
    and includes various datasets used in the book.
-   Built on the 'manynet' package, all functions operate with matrices, edge lists, 
-   and 'igraph', 'network', and 'tidygraph' objects,
+   Built on the 'manynet' package, all functions operate with matrices, 
+   edge lists, and 'igraph', 'network', and 'tidygraph' objects,
    and on one-mode and two-mode (bipartite) networks.
 URL: https://stocnet.github.io/migraph/
 BugReports: https://github.com/stocnet/migraph/issues
@@ -32,7 +32,7 @@ Imports:
 Suggests: 
     covr,
     roxygen2,
-    testthat
+    testthat (>= 3.0.0)
 Authors@R: 
     c(person(given = "James",
              family = "Hollway",

NAMESPACE

@@ -5,6 +5,8 @@ S3method(glance,netlogit)
 S3method(plot,netlm)
 S3method(plot,netlogit)
 S3method(plot,network_test)
+S3method(print,netlm)
+S3method(print,netlogit)
 S3method(print,network_test)
 S3method(tidy,netlm)
 S3method(tidy,netlogit)

NEWS.md

@@ -1,3 +1,28 @@
+# migraph 1.4.4
+
+2024-11-30
+
+## Package
+
+- Fixed dependency issue
+
+# migraph 1.4.4
+
+2024-11-29
+
+## Package
+
+- Updated github actions
+
+## Models
+
+- Updated `net_regression()`
+  - It now works (better) with unweighted networks
+  - Added print methods that combine `tidy()` and `glance()`
+  - Fixed effect naming error
+  - Updated `same()` to work for two-mode networks
+  - Updated specification advice for testing for homophily in two-mode networks
+
 # migraph 1.4.3
 
 2024-11-06

R/class_models.R

@@ -132,6 +132,22 @@ glance.netlogit <- function(x, ...) {
   )
 }
 
+#' @export
+print.netlm <- function(x, ...){
+  cat("# Fitted model results\n")
+  print(tidy(x))
+  cat("\n# Model summary statistics\n")
+  print(glance(x))
+}
+
+#' @export
+print.netlogit <- function(x, ...){
+  cat("# Fitted model results\n")
+  print(tidy(x))
+  cat("\n# Model summary statistics\n")
+  print(glance(x))
+}
+
 #' @export
 plot.netlm <- function(x, ...){
   distrib <- x$dist

R/data_mpn.R

@@ -79,7 +79,7 @@
 #' @references
 #' Domhoff, G William. 2016. \href{https://whorulesamerica.ucsc.edu/power_elite/}{“Who Rules America? Power Elite Database.”}
 #' 
-#' The Center for Responsive Politics. 2019. \href{https://www.opensecrets.org}{“OpenSecrets.”}
+#' The Center for Responsive Politics. 2019. “OpenSecrets.” https://www.opensecrets.org.
 #' 
 #' Knoke, David, Mario Diani, James Hollway, and Dimitris C Christopoulos. 2021.
 #' \href{https://www.cambridge.org/core/books/multimodal-political-networks/43EE8C192A1B0DCD65B4D9B9A7842128}{\emph{Multimodal Political Networks}}.

R/model_regression.R

@@ -287,8 +287,8 @@ vectorise_list <- function(glist, simplex, directed){
                                                        function(x) c(x)))))
 }
 
-convertToMatrixList <- function(formula, data){
-  data <- manynet::as_tidygraph(data)
+convertToMatrixList <- function(formula, .data){
+  data <- manynet::as_tidygraph(.data)
   if(manynet::is_weighted(data) & getDependentName(formula)=="weight"){
     DV <- manynet::as_matrix(data) 
   } else DV <- manynet::as_matrix(data)
@@ -350,11 +350,31 @@ convertToMatrixList <- function(formula, data){
           }
           # same ####
       } else if (IV[[elem]][1] == "same"){
-        rows <- matrix(manynet::node_attribute(data, IV[[elem]][2]),
-                       nrow(DV), ncol(DV))
-        cols <- matrix(manynet::node_attribute(data, IV[[elem]][2]),
-                       nrow(DV), ncol(DV), byrow = TRUE)
-        out <- (rows==cols)*1
+        attrib <- manynet::node_attribute(data, IV[[elem]][2])
+        if(manynet::is_twomode(.data)){
+          if(all(is.na(attrib[!manynet::node_is_mode(.data)]))){ # if 2nd mode
+            attrib <- attrib[manynet::node_is_mode(.data)]
+            out <- vapply(1:length(attrib), function(x){
+              net <- manynet::as_matrix(manynet::delete_nodes(.data, 
+                                                              manynet::net_dims(.data)[1]+x))
+              rowSums(net * matrix((attrib[-x]==attrib[x])*1, 
+                                   nrow(DV), ncol(DV)-1, byrow = TRUE))/
+                rowSums(net)
+            }, FUN.VALUE = numeric(nrow(DV)))
+          } else { # or then attrib must be on first mode
+            attrib <- attrib[!manynet::node_is_mode(.data)]
+            out <- t(vapply(1:length(attrib), function(x){
+              net <- manynet::as_matrix(manynet::delete_nodes(.data, x))
+              colSums(net * matrix((attrib[-x]==attrib[x])*1, 
+                                   nrow(DV)-1, ncol(DV)))/
+                colSums(net)
+            }, FUN.VALUE = numeric(ncol(DV))))
+          }
+        } else {
+          rows <- matrix(attrib, nrow(DV), ncol(DV))
+          cols <- matrix(attrib, nrow(DV), ncol(DV), byrow = TRUE)
+          out <- (rows==cols)*1  
+        }
         out <- list(out)
         names(out) <- paste(IV[[elem]], collapse = " ")
         out <- out
@@ -417,13 +437,19 @@ convertToMatrixList <- function(formula, data){
       out
     } else {
       if(is.list(out[[1]]))
-        out[[1]] else{
-          list(out[[1]])
+        out[[1]] else {
+          out <- list(out[[1]])
+          names(out) <- attr(out[[1]], "names")[1]
+          attr(out[[1]], "names") <- NULL
+          out
         } 
     }})
   IVs <- purrr::flatten(IVs)
   out <- c(list(DV), list(matrix(1, dim(DV)[1], dim(DV)[2])), IVs)
-  names(out)[1:2] <- c(formula[[2]], "(intercept)")
+  # Getting the names right
+  DVname <- formula[[2]]
+  if(DVname == ".") DVname <- "ties"
+  names(out)[1:2] <- c(DVname, "(intercept)")
   out
 }
 
@@ -451,7 +477,9 @@ specificationAdvice <- function(formula, data){
     vars <- formdf[formdf[,1] %in% c("sim","same"), 2]
     suggests <- vapply(vars, function(x){
       incl <- unname(formdf[formdf[,2]==x, 1])
-      excl <- setdiff(c("ego","alter"), incl)
+      if(manynet::is_twomode(data)){
+        excl <- setdiff(c("ego","tertius"), incl)
+      } else excl <- setdiff(c("ego","alter"), incl)
       if(length(excl)>0) paste0(excl, "(", x, ")", collapse = ", ") else NA_character_
       # incl
     }, FUN.VALUE = character(1))
@@ -460,9 +488,9 @@ specificationAdvice <- function(formula, data){
     if(length(suggests)>0){
       if(length(suggests) > 1)
         suggests <- paste0(suggests, collapse = ", ")
-      warning(paste("When testing for homophily,",
-                    "it is recommended to include also more fundamental effects such as `ego()` and `alter()`.",
-                    "Try adding", suggests, "to the model specification."))
+      cat(paste("When testing for homophily,",
+                    "it is recommended to include all more fundamental effects.\n",
+                    "Try adding", suggests, "to the model specification.\n\n"))
       }
   }
 }