From d2d7094d7adf32bf6f4c809b047992f38c3a05d3 Mon Sep 17 00:00:00 2001 From: Michael Levy Date: Fri, 8 Jul 2016 13:52:08 -0700 Subject: [PATCH] sna and magrittr namespace bug fix + update description fields --- DESCRIPTION | 5 +++-- NAMESPACE | 4 ++-- R/functions.R | 35 +++++++++++++++++++++-------------- inst/app.R | 21 +++++---------------- tests/testthat/test_degCent.R | 15 +++++++++++++++ 5 files changed, 46 insertions(+), 34 deletions(-) create mode 100644 tests/testthat/test_degCent.R diff --git a/DESCRIPTION b/DESCRIPTION index 2465420..1178fa3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,21 +1,22 @@ Package: gwdegree Title: A Shiny App to Aid Interpretation of Geometrically-Weighted Degree Estimates in Exponential Random Graph Models -Version: 0.1.0.9000 +Version: 0.1.1 Authors@R: person("Michael", "Levy", email = "malevy@ucdavis.edu", role = c("aut", "cre")) License: MIT + file LICENSE Description: This is a Shiny application intended to provide better understanding of how geometrically-weighted degree terms function in exponential random graph models of networks. It contains just one user function, gwdegree(), which launches the Shiny application. URL: https://github.com/michaellevy/gwdegree, https://michaellevy.shinyapps.io/gwdegree/ +BugReports: https://github.com/michaellevy/gwdegree/issues Depends: R (>= 3.2.3), ergm, ggplot2, + magrittr, shiny, shinydashboard Imports: dplyr, gtools, - magrittr, network, scales, sna, diff --git a/NAMESPACE b/NAMESPACE index fdd40b7..b340584 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,14 +5,14 @@ import(dplyr) import(ergm) import(ggplot2) import(gtools) +import(magrittr) import(scales) import(shiny) import(shinydashboard) import(sna) -import(tidyr) importFrom(grDevices,topo.colors) importFrom(graphics,plot) -importFrom(magrittr,"%>%") importFrom(network,network) importFrom(network,network.size) importFrom(stats,rbinom) +importFrom(tidyr,gather) diff --git a/R/functions.R b/R/functions.R index 3ca46d5..5957ac8 100644 --- a/R/functions.R +++ b/R/functions.R @@ -5,13 +5,13 @@ utils::globalVariables(".") # For the magrittr pipe to circumvent cran-check no #' @return NULL Called for side-effect of launching shiny application #' @export #' -#' @import ergm sna ggplot2 scales dplyr tidyr gtools shiny shinydashboard +#' @import ergm sna ggplot2 magrittr scales dplyr gtools shiny shinydashboard #' @importFrom grDevices topo.colors #' @importFrom graphics plot #' @importFrom network network.size #' @importFrom network network -#' @importFrom magrittr "%>%" #' @importFrom stats rbinom +#' @importFrom tidyr gather #' #' @examples #' \dontrun{ @@ -66,18 +66,25 @@ simCCCent = function(gwdRange = c(-2, 2), gwespRange = c(-.5, .5), N = makeNetwork(netSize, density) - lapply(1:nrow(dfForSim), function(i) { - n = simulate.formula(N ~ gwdegree(theta_s, TRUE) + gwesp(theta_t, TRUE), - coef = unlist(dfForSim[i, ]), - constraints = ~ edges, - nsim = nsim) - data.frame( - Centralization = mean(sna::centralization(n, 'degree', mode = 'graph')), - ClusteringCoef = mean(clusteringCoef(n)) - ) - }) %>% - do.call(rbind, .) %>% - cbind(dfForSim, .) + cbind(dfForSim, + do.call(rbind, + lapply(1:nrow(dfForSim), function(i) { + n = simulate.formula(N ~ gwdegree(theta_s, TRUE) + gwesp(theta_t, TRUE), + coef = unlist(dfForSim[i, ]), + constraints = ~ edges, + nsim = nsim) + data.frame( + Centralization = mean(degCent(n)), + ClusteringCoef = mean(clusteringCoef(n)) + ) + }) + ) + ) +} + +degCent = function(n) { + degs = sna::degree(n) + sum(abs(max(degs) - degs)) / sna::degree(n, tmaxdev = TRUE) } clusteringCoef = function(net) diff --git a/inst/app.R b/inst/app.R index 3512e91..c0a7a5d 100644 --- a/inst/app.R +++ b/inst/app.R @@ -222,12 +222,8 @@ ui = dashboardPage(header, sidebar, body) server = shinyServer(function(input, output, session) { - # lapply(c('ergm', 'network', 'sna', 'ggplot2', 'dplyr', 'scales', 'magrittr'), - # require, char = TRUE) - # source("../R/functions.R") theme_set(theme_bw(base_size = 20)) - ### Change-statistic plot #### deltaGWDdf = reactive({ gwdegree:::makeDeltaGWDdF(kmin = input$degreeRange[1], @@ -262,7 +258,7 @@ server = isolate({ networks = vector('list', 2L) networks[[1]] = replicate(input$reps, - gwdegree:::makeNetwork(input$netSize, density = input$density), + gwdegree:::makeNetwork(input$netSize, input$density), simplify = FALSE) networks[[2]] = lapply(networks[[1]], function(basis) { # To keep number edges same across types @@ -279,7 +275,7 @@ server = # type is stack of simulated graphs of a particular type # Split into each simulation, tabulate degrees, and use `smartbind` to match on names (ie, degree) deg = - degree(networks[[type]], g = 1:length(networks[[type]]), gmode = 'graph') %>% + sna::degree(networks[[type]], g = 1:length(networks[[type]]), gmode = 'graph') %>% split(., 1:ncol(.)) %>% lapply(table) %>% do.call(gtools::smartbind, .) %>% @@ -294,15 +290,10 @@ server = deg[is.na(deg)] = 0 deg$type = names(networks[type]) - list(deg = deg, - var = data.frame( - type = names(networks)[type], - var = mean(sapply(networks[[type]], function(n) var(degree(n, gmode = 'graph')))) - )) + deg }) - vari = do.call(rbind, lapply(dd, "[[", "var")) - deg = do.call(rbind, lapply(dd, "[[", "deg")) + deg = do.call(rbind, dd) # Fill in the degrees-never-found to keep box-widths constant filled = expand.grid( @@ -316,15 +307,13 @@ server = filled$type = factor(filled$type, levels = sort(unique(filled$type), decreasing = TRUE)) }) - list(dd = filled, variance = vari, random = networks[[1]][[1]], gwd = networks[[2]][[1]]) + list(dd = filled, random = networks[[1]][[1]], gwd = networks[[2]][[1]]) }) #### Plot degree distributions #### - # Pretty the x-axis labels and get outlier points colored - # And add average variance output$degDistPlot = renderPlot({ ggplot(degDists()[["dd"]], aes(x = factor(degree), y = count, fill = type)) + diff --git a/tests/testthat/test_degCent.R b/tests/testthat/test_degCent.R new file mode 100644 index 0000000..58514ba --- /dev/null +++ b/tests/testthat/test_degCent.R @@ -0,0 +1,15 @@ +library(sna) +context("clustering coefficient function") + +networks = list( + nEmpty = gwdegree:::makeNetwork(100, 0), + nFull = gwdegree:::makeNetwork(100, 1), + nOther = gwdegree:::makeNetwork(100, .2) +) + +test_that("Degree centralization is the same for my function as package:sna", + expect_equal( + sapply(networks, gwdegree:::degCent), + sapply(networks, sna::centralization, sna::degree, "graph") + )) +