Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add probabilistic model to shuffled_linklist #8

Open
shainova opened this issue Mar 27, 2020 · 0 comments
Open

Add probabilistic model to shuffled_linklist #8

shainova opened this issue Mar 27, 2020 · 0 comments
Labels
stats Z-scores, number of modules, and other indices for structure
Milestone

Comments

@shainova
Copy link
Member

prob_model_large_matrix <- function(M, max_attempts=100, verbose=F){
  num_col <- ncol(M)
  num_row <- nrow(M)
  prob_row <- rowSums(M)/num_col # calculate intrarow probabilities 
  prob_column <- colSums(M)/num_row # calculate intracolumn probabilities 
  P <- matrix(0,num_row,num_col) # matrix of probabilities of interactions
  for (i in 1:num_row){
    for(j in 1:num_col){
      # Possible to select one of two null probabilities:
      P[i,j] <- (prob_row[i]+prob_column[j])/2 # Bascompte et al 2003 (commonly used)
      # P[i,j] <- prob_row[i]*prob_column[j] # Configuration model
    }
  }
  
  # Create an empty matrix to fill
  S <- matrix(0,num_row,num_col)
  # Go row by row to ensure each row has at least one value
  for (ridx in 1:num_row){
    col <- sample(1:num_col, 1, prob=prob_column) # Select a column
    S[ridx, col] <- 1
  }
  if(!all(rowSums(S)==1)){print('Something is wrong. All rows should have one edge at this stage.');return(NULL)}
  # Loop through all the columns that have 0 interactions to ensure each column has at least one interaction
  if (any(colSums(S)==0)){
    empty_cols <- which(colSums(S)==0)
    for (cidx in empty_cols){
      row <- sample(1:num_row, 1, prob=prob_row) # Select a row
      S[row, cidx] <- 1
    }
  }
  if(!all(colSums(S)>=0)){print('Something is wrong. All cols should have one or more edge at this stage.');return(NULL)}
  # Now fill in the rest of the interactions by select the rest of the cells at random according to cell probabilities
  cells_to_fill <- sample(which(S==0), size = sum(M)-sum(S), prob = P[which(S==0)], replace = F) # Select a cell to fill by the probability
  S[cells_to_fill] <- 1
  
  if(sum(S)!=sum(M)){print('Something is wrong. Shuffled matrix fill should be the same as the original at this stage.');return(NULL)}
  
  if (verbose){
    print(paste('Created a shuffled matrix with dimensions: ',nrow(S),'x',ncol(S),' and fill of ',sum(S),sep=''))
  }
  return(S)
}
@shainova shainova added the enhancement New feature or request label Mar 27, 2020
@shainova shainova added structures Data structures and object classes and removed enhancement New feature or request labels Mar 27, 2020
@shainova shainova added this to the Planned milestone Mar 27, 2020
@shainova shainova added stats Z-scores, number of modules, and other indices for structure and removed structures Data structures and object classes labels Mar 27, 2020
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
stats Z-scores, number of modules, and other indices for structure
Projects
None yet
Development

No branches or pull requests

1 participant