version 0.2.3

DESCRIPTION

@@ -1,8 +1,11 @@
 Package: IsingSampler
 Type: Package
 Title: Sampling Methods and Distribution Functions for the Ising Model
-Version: 0.2.1
-Author: Sacha Epskamp
+Version: 0.2.3
+Authors@R: c(
+  person("Sacha", "Epskamp", email = "mail@sachaepskamp.com",role = c("aut", "cre")),
+  person("Jesse", "Boot", role = c("ctb"))
+  )
 Maintainer: Sacha Epskamp <mail@sachaepskamp.com>
 Description: Sample states from the Ising model and compute the probability of states. Sampling can be done for any number of nodes, but due to the intractibility of the Ising model the distribution can only be computed up to ~10 nodes.
 License: GPL-2
@@ -11,6 +14,8 @@ Depends: Rcpp (>= 0.10.4), R (>= 3.0.0)
 LinkingTo: Rcpp
 URL: github.com/SachaEpskamp/IsingSampler
 NeedsCompilation: yes
-Packaged: 2020-01-25 12:55:50 UTC; ubuntu
+Packaged: 2023-08-21 08:55:07 UTC; sachaepskamp
+Author: Sacha Epskamp [aut, cre],
+  Jesse Boot [ctb]
 Repository: CRAN
-Date/Publication: 2020-01-25 13:20:02 UTC
+Date/Publication: 2023-08-21 09:42:33 UTC

MD5

@@ -1,22 +1,22 @@
-07a209f1cdf92a1e149d31ca9701b2e2 *DESCRIPTION
+e9b1ab6d7a83445824174fff09c8a257 *DESCRIPTION
 6d860fd6c8876d801fab6beb8734968c *NAMESPACE
-b46f5456524ceaf329139f76d6a91ebe *NEWS
+b1cec3d8aba6ee5e848908d24280324c *NEWS
 bed2bfc1096592cd22bbefac05c67dbc *R/Distribution.R
 95ce57e7269be4078ec7eb6ce3e613de *R/Entrophy.R
-b64aae533938dffc9c8edc0628c50338 *R/EstimateIsing.R
+02ee85aab57b87737e62a3f685f1f3ad *R/EstimateIsing.R
 d7703488891d599df35f7ca09078e017 *R/IsingSampler.R
 135a1c7333c258e6da982a501564c10a *R/LinTransform.R
 b972bac52ff7e633b41994914085c85c *R/PseudoLikelihood.R
 cc69c000898d5befade43a2285dec893 *R/RcppExports.R
-596f65ddef1c0c39d544e89caeadeef2 *R/logisticRegressionEstimation.R
+138e912f706f996febd06ae9036ae034 *R/logisticRegressionEstimation.R
 d41d8cd98f00b204e9800998ecf8427e *R/positiveGraph.R
 ff547ababc85108875b8e8f94239d4dd *inst/COPYING
 bb280cb0bbd7ffc5f80b6cb7732c6787 *inst/COPYRIGHTS
-6eb0c9ce7ff38f5b026d88408bb06fa0 *man/EstimateIsing.Rd
+96471bbacf3da64d458d2dbbfab9b66e *man/EstimateIsing.Rd
 cbb3d12148df1da856c606386ea6ebb8 *man/IsingEntrophy.Rd
 2bfaa60d2951ba41ae7d0cd34e539317 *man/IsingLikelihood.Rd
 8747e4758e744717dc404a67814088da *man/IsingPL.Rd
-bbdf0f5ab867bc738ee19f5aa80de865 *man/IsingSampler-package.Rd
+7252df50eecc5e525c3ab782aa3dd043 *man/IsingSampler-package.Rd
 2e4ccc4c2c151f7be07e6cb6757bd0e2 *man/IsingSampler.Rd
 e9d55cdbd7d8faf6cc5262a63198b7ba *man/IsingStateProb.Rd
 d82f8f2d44aa9009eb9b889353826fed *man/IsingSumLikelihood.Rd
@@ -25,4 +25,4 @@ a65816cf9b559f1261228648256d0b14 *man/LinTransform.Rd
 b3f86c20b81b51f5162874977d38784d *src/Makevars
 73505498722ad4b07b0ddb3067e92523 *src/Makevars.win
 8fd74081fe8ecc6a5dd24ad79fe3c2a8 *src/PseudoLikelihood.cpp
-8d10ac235b96291838a2dfbc5ad5ad05 *src/RcppExports.cpp
+7860da7c350f7f464889702233a88d31 *src/RcppExports.cpp

NEWS

@@ -1,3 +1,10 @@
+Changes in version 0.2.2
+  o Small change to help file
+
+Changes in version 0.2.2
+  o Added thresholding and minimum sum score correction to EstimateIsing Uni method
+  o 'uni' is now the default for EstimateIsing
+
 Changes in version 0.2.1
   o Added an option to IsingLikelihood to return the potential of each state
 

R/EstimateIsing.R

@@ -4,7 +4,7 @@
 # - bi: bivariate logistic regressions
 # - ll: Loglinear model
 
-EstimateIsing <- function(data, responses, beta = 1, method = c('pl', 'uni', 'bi', 'll'),adj = matrix(1, ncol(data), ncol(data)), ...){
+EstimateIsing <- function(data, responses, beta = 1, method = c('uni','pl' , 'bi', 'll'),adj = matrix(1, ncol(data), ncol(data)), ...){
 
   method <- match.arg(method)
 

R/logisticRegressionEstimation.R

@@ -1,13 +1,22 @@
 # Univariate:
-EstimateIsingUni <- function(data, responses, beta = 1, adj = matrix(1, ncol(data), ncol(data)), ...){
+EstimateIsingUni <- function(data, responses, beta = 1, adj = matrix(1, ncol(data), ncol(data)), min_sum = -Inf, thresholding = FALSE, alpha = 0.01, AND = TRUE, ...){
+  data <- as.matrix(data)
+
+  # Check data:
+  if (min_sum > -Inf){
+    if (min(rowSums(data)) < min_sum){
+      stop("One or more sumscores in the data are lower than the threshold set using the 'min_sum' argument.")
+    }
+  }
+
   if (missing(responses)){
     responses <- sort(unique(c(data)))
   }
 
   if (length(responses) != 2){
     stop("Binary data required")
   }
-
+  
   if (!is.logical(adj)){
     adj <- adj != 0
   }
@@ -24,24 +33,48 @@ EstimateIsingUni <- function(data, responses, beta = 1, adj = matrix(1, ncol(dat
 
   # Number of variables:
   n <- ncol(data)
-
+  
   # GLM for every node:
   Res <- lapply(seq_len(n), function(i){
+    data <- data[rowSums(data[,-i]) != min_sum-1,]
     glm(data[,i] ~ data[,adj[i,]], family = binomial, ...)
-    })
+  })
 
   # Coefficients:
   Coefs <- lapply(Res, coef)
 
   # Thresholds:
   Thresholds <- sapply(Coefs, '[[', 1)
-  # Network:
-  Net <- matrix(0, n, n)
+
+  # P-values:
+  p_values <- lapply(Res, function(model) {
+    coef_summary <- summary(model)$coefficients
+    return(coef_summary[, "Pr(>|z|)"])
+  })
+  # Raw network:
+  Raw_Net <- matrix(0, n, n)
   for (i in seq_len(n)){
-    Net[i,adj[i,]] <- Coefs[[i]][-1]
+    Raw_Net[i,adj[i,]] <- Coefs[[i]][-1]
+  }
+  if(thresholding == TRUE) {  
+
+    # Test for significance
+    Sig <- matrix(0, n, n)
+    for (i in seq_len(n)){
+      Sig[i,adj[i,]] <- p_values[[i]][-1]
+    }
+    Net <- ifelse(Sig < alpha, Raw_Net, 0 ) 
+
+    #And or OR rule:
+    if (AND == TRUE) {
+      Net <- ifelse(Net != 0 & t(Net != 0), Net, 0)
+      Net <- (Net+t(Net))/2 }
+    else {
+      Net <- (Net+t(Net))/2  
+    } }
+  else {
+    Net <- (Raw_Net + t(Raw_Net)) / 2
   }
-  # Average:
-  Net <- (Net + t(Net)) / 2
 
   # Rescale:
   Trans <- LinTransform(Net, Thresholds, c(0,1), responses)
@@ -51,9 +84,7 @@ EstimateIsingUni <- function(data, responses, beta = 1, adj = matrix(1, ncol(dat
     thresholds = Trans$thresholds,
     results = Res))
 }
-
-
-
+
 
 # Bivariate DOESNT WORK WHEN 11 COUNT IS LOW!:
 EstimateIsingBi <- function(data, responses, beta = 1, ...){

man/EstimateIsing.Rd

@@ -13,11 +13,12 @@ non-regularized estimation methods for the Ising Model
 This function can be used for several non-regularized estimation methods of the Ising Model. See details.
 }
 \usage{
-EstimateIsing(data, responses, beta = 1, method = c("pl", "uni",
+EstimateIsing(data, responses, beta = 1, method = c("uni", "pl",
                  "bi", "ll"), adj = matrix(1, ncol(data), ncol(data)),
                  ...)
 EstimateIsingUni(data, responses, beta = 1, adj = matrix(1, ncol(data),
-                 ncol(data)), ...)
+                 ncol(data)), min_sum = -Inf, thresholding = FALSE, alpha = 0.01, 
+                 AND = TRUE, ...)
 EstimateIsingBi(data, responses, beta = 1, ...)
 EstimateIsingPL(data, responses, beta = 1, ...)
 EstimateIsingLL(data, responses, beta = 1, adj = matrix(1, ncol(data),
@@ -40,7 +41,11 @@ EstimateIsingLL(data, responses, beta = 1, adj = matrix(1, ncol(data),
 \item{adj}{
 Adjacency matrix of the Ising model.
 }
-  \item{\dots}{
+  \item{min_sum}{ The minimum sum score that is artifically possible in the dataset. Defaults to -Inf. Set this only if you know a lower sum score is not possible in the data, for example due to selection bias.}
+    \item{thresholding}{Logical, should the model be thresholded for significance?}
+    \item{alpha}{Alpha level used in thresholding}
+    \item{AND}{Logical, should an AND-rule (both regressions need to be significant) or OR-rule (one of the regressions needs to be significant) be used?}
+    \item{\dots}{
  Arguments sent to estimator functions
 }
 }

man/IsingSampler-package.Rd

@@ -6,16 +6,6 @@ Sampling methods and distribution functions for the Ising model
 }
 \description{
 This package can be used to sample states from the Ising model and compute the probability of states. Sampling can be done for any number of nodes, but due to the intractibility of the Ising model the distribution can only be computed up to ~10 nodes.
-}
-\details{
-\tabular{ll}{
-Package: \tab IsingSampler\cr
-Type: \tab Package\cr
-Version: \tab 1.0\cr
-Date: \tab 2013-08-02\cr
-License: \tab What license is it under?\cr
-}
-
 }
 \author{
 Sacha Epskamp

src/RcppExports.cpp

@@ -5,6 +5,11 @@
 
 using namespace Rcpp;
 
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
 // IsingProcess
 IntegerMatrix IsingProcess(int nSample, NumericMatrix graph, NumericVector thresholds, double beta, IntegerVector responses);
 RcppExport SEXP _IsingSampler_IsingProcess(SEXP nSampleSEXP, SEXP graphSEXP, SEXP thresholdsSEXP, SEXP betaSEXP, SEXP responsesSEXP) {