R/getStp.R

Defines functions getStp

Documented in getStp

# Function to obtain the steepness measure based on dyadic dominance indices or on proportions of wins#

getStp <- function(X,method=c("Dij","Pij")){
  if (nrow(X) != ncol(X)) 
    return("Error: Sociomatrix must be square");
  if ( sum(is.na(X))>0 || !is.numeric(X))
    return("Error: Sociomatrix must be numeric");
  method <- match.arg(method)
  dyadc <- X + t(X);
  if (method == "Dij"){
    Dij <- X/dyadc-(((X/dyadc)-0.5)/(dyadc+1))
    Dij[is.nan(Dij)] <- 0.
    w1 <- rowSums(Dij);
    w2 <- Dij%*%w1;
    l1 <-colSums(Dij);
    l2 <- t(l1)%*%Dij;
  }
  if (method == "Pij"){
    Pij <- array(dim=c(nrow(X),ncol(X)),0.);
    Pij <- X/dyadc;
    Pij[is.nan(Pij)] <- 0.
    w1 <- rowSums(Pij);
    w2 <- Pij%*%w1;
    l1 <-colSums(Pij);
    l2 <- t(l1)%*%Pij;
  }
DS <- w1 + w2 - l1 - t(l2);
maxDS <- nrow(X)*(nrow(X)-1)/2;
NormDS <- (DS + maxDS)/nrow(X);
SortNormDS <- sort(NormDS,decreasing=TRUE,index.return=TRUE)
NormDS <- array(SortNormDS$x,dim=nrow(X))
rnk <- 1:nrow(X)
Stp <- abs(lm(NormDS ~ rnk)$coefficients[2])
names(Stp)<-NULL
return(Stp)
}

Try the steepness package in your browser

Any scripts or data that you put into this service are public.

steepness documentation built on May 6, 2022, 9:07 a.m.