SSAS (Sexual Segregation and Aggregation Statistic) in R - calling C

问题

I am running the following code, found in this appendix of a paper https://wiley.figshare.com/articles/Supplement_1_R_code_used_to_format_the_data_and_compute_the_SSAS_/3528698/1 to calculate the Sexual Segregation and Aggregation Statistic in R - but keep getting the following error - presumably there is an issue with calling a function from C, but I cannot resolve it.

# Main function, computes both the SSAS (Sexual Segregation and
# Aggregation Statistic) and the 95% limits of SSAS
# under the assumption of random association of both sexes

SSAS <- function(x, conf.int = 0.95, B = 10000)
{
 x <- as.matrix(x)
 nr <- nrow(x)
 nc <- ncol(x)
 sr <- rowSums(x)
 sc <- colSums(x)
 n <- sum(x)
 E <- outer(sr, sc, "*")/n
 dimnames(E) <- dimnames(x)
 tmp <- .C("chisqsim", as.integer(nr), as.integer(nc),as.integer(sr),
 as.integer(sc), as.integer(n), as.integer(B), as.double(E), integer(nr * nc),
 double(n + 1), integer(nc), results = double(B), PACKAGE = "stats")
 obs <- sum(sort((x - E)^2/E, decreasing = TRUE))/n
 sim <- tmp$results/n
 p0 <- (1 - conf.int)/2
 return(c(obs, quantile(sim, p0), quantile(sim, 1 -p0)))
}

# This function formats data to be run with the SSAS function

splitmfd <- function(mfd) {
 loca1 <- function(x) {
  x <- t(x[, 1:2])
  dimnames(x) <- list(c("mal", "fem"), as.character(1:ncol(x)))
  x
 }
 l0 <- split(mfd, mfd$mon)
 lapply(l0, loca1)
}

# Example 1: Isard

rup <- read.table("http://pbil.univ-lyon1.fr/R/donnees/mfdrupicapra.txt",
h = T)
  # Load data from the web

plot1 <- function(w, titre = "") {
 plot(1:12, w[, 1], ylim = range(w), ax = F, pch = 19,
 type = "n", ylab = "IK", xlab = "")
 title(main = titre)
 box()
 axis(1, 1:12, c("Jan", "Feb", "Mar", "Apr", "May",
 "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"))
 axis(2, pretty(range(w)), tck = 1)
 polyx <- c(1:12, 12:1)
 polyy <- c(w[, 3], rev(w[, 2]))
 polygon(polyx, polyy, col = grey(0.9))
 points(w[, 1], pch = 19, type = "b")
}
  # Function to plot data and 95\ levels of significance

l1 <- splitmfd(rup)
  # Format data to be used with SSAS function
w <- matrix(unlist(lapply(l1, SSAS)), ncol = 3, byrow = T)
  # "w" is a matrix having 3 columns and 12 rows. In the first columns are
  # the SSAS estimates for each month, and the lower and upper limits in columns 2
  # and 3 respectively.

plot1(w, "Isard")
  # Plot figure 3a

# Example 2: Red deer

cer <- read.table("http://pbil.univ-lyon1.fr/R/donnees/mfdcervus.txt",
h = T)
l1 <- splitmfd(cer)
w <- matrix(unlist(lapply(l1, SSAS)), ncol = 3, byrow = T)
plot1(w, "Red deer")
  # Plot figure 3c

# Example 3: Roe deer

cap <- read.table("http://pbil.univ-lyon1.fr/R/donnees/mfdcapreolus.txt",
h = T)
l1 <- splitmfd(cap)
w <- matrix(unlist(lapply(l1, SSAS)), ncol = 3, byrow = T)
plot1(w, "Roe deer")
# Plot figure 3e

Here is my error:

w <- matrix(unlist(lapply(l1, SSAS)), ncol = 3, byrow = T) Error in .C("chisqsim", as.integer(nr), as.integer(nc), as.integer(sr), : "chisqsim" not available for .C() for package "stats"

回答1:

This is a prime-example why you should not call internal C functions in R user code. R internals can (and do) change. Here, these changes are relevant: "more use of .Call" by Prof. Ripley.

Thus, you can change the function to this:

SSAS <- function(x, conf.int = 0.95, B = 10000)
{
  x <- as.matrix(x)
  nr <- nrow(x)
  nc <- ncol(x)
  sr <- rowSums(x)
  sc <- colSums(x)
  n <- sum(x)
  E <- outer(sr, sc, "*")/n
  dimnames(E) <- dimnames(x)
  tmp <- .Call(stats:::C_chisq_sim, sr, sc, B, E)
  obs <- sum(sort((x - E)^2/E, decreasing = TRUE))/n
  sim <- tmp/n
  p0 <- (1 - conf.int)/2
  return(c(obs, quantile(sim, p0), quantile(sim, 1 -p0)))
}

Then, the code runs, but I have not checked for correctness. So, no warranties (as usual on Stack Overflow).

来源：https://stackoverflow.com/questions/54431096/ssas-sexual-segregation-and-aggregation-statistic-in-r-calling-c

标签

chi-squared