Project: s41467-024-48324-y | Function: pair.int.phy (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Computes pairwise phylogenetic integration Z-scores between all bone combinations using phylogenetic partial least squares analysis. Implements the core methodology for quantifying evolutionary integration between skeletal modules accounting for phylogenetic relationships, which is central to testing the paper's hypotheses about modular evolution.

**KEY TERMS:** {
  "input": "landmark coordinate arrays for bones",
  "bone_combinations": "pairwise combinations of skeletal elements",
  "z.score": "phylogenetic integration Z-scores",
  "p.val": "significance values for integration tests",
  "output": "matrix of pairwise integration statistics"
}

**CONTEXT CODE:** # The landmark constellations from which these data were extracted 
# are available at: https://doi.org/10.1038/s41586-022-05372-y
# (Navalon et al., 2022)
# Thereafter, the birds' masses will be used to perform
# a phylogenetically-informed Generalised Least Squares regression, 
# and the residuals will be extracted.
# This will remove allometric scaling in centroid size. 
# Residual centroid sizes of skeletal elements across birds are known 
# to exhibit a modular organisation of evolutionary covariances;
# some bones are more likely to evolve in concert than others. 
# This has widespread ramifications for how birds adapt to ecological demands. 
# https://doi.org/10.1038/s41559-021-01509-w
# (Orkney, Bjarnason, et al., 2021)
# This script will explore whether this modular organisation varies within birds, 
# specifically whether body mass variety is associated with different modular
# schemes of evolution. 

# Load required analytical R packages
library( geomorph ) # version 4.0.5
library( ape ) # version 5.0
library( nlme ) # version 3.1-162
library( phytools ) # version 1.5-1
# Done

setwd('C:/Users/Lab/Documents/Navalon_birds/File S1.Bird_landmarks_Navalon_2022/Clean')
# Set work directory appropriately (you will need to adjust this if you
# are replicating the work undertaken here)

# Load centroid sizes for study birds. 
load('Csize.12.4.2023.RData')
# In our study, we defined this object as an array called 'GPA.Csize'

# Load phylogenetic tree of birds
load('tree.12.4.2023.RData')
# Pruned tree produced as described in Navalon et al., 2022
# It is a merger of Prum and Oliveros
# The object is a phylogeny called 'pruned.tree'.

# Load bird masses
load('masses.12.4.2023.RData')
# The object is a named numeric vector called 'masses'.

# Define a sundry function to interract with data objects such as GPA.coords
get.item <- function( X , item ) { X[[ item ]] }
# This is a simple indexing function

# Define a function to compute the residual skeletal element centroid cizes, after the affects of allometry are removed
get.residual.Csize <- function( array, masses, phylogeny, taxa ){
    stop("Function implementation has been masked")
}
pair.int.phy <- function( input, phylogeny, taxa ){
    stop("Function implementation has been masked")
}

# This function uses phylogenetic Generalised Least Squares to compute the allometrically adjusted centroid sizes of skeletal elements.
# The user must provide the array of original bird skeletal element centroid sizes, bodymasses, phylogeny and taxa of interest. 

# Compute residual centroid sizes by applying function:
residual.Csize <- get.residual.Csize( array = GPA.Csize, masses = masses, phylogeny = pruned.tree, taxa=names(masses) )
# Which taxa do we wish to investigate? 
# In this example, we will investigate all birds. 

# This script will produce '.csv' files for 20 different bins of body mass, 
# showing how integration among pairwise combinations of bones changes with mass
# For the studied birds (228 species), these bins will be overlapping, 
# which will generate statistical non-independence between some bins
# This can be regarded as being similar to a rolling-average
# Because the birds are not uniformly distributed in frequency over log10(bodymass), 
# some bins will have wider or narrower ranges of mass represented than others

# Load package 'abind'; the 'array bind' function will be needed;
# If the user has not installed this package run 'install.packages('abind')' and proceed as guided
# no further comments advising package installation will be provided
library(abind) # version 1.4-5
# Package loaded

# Retrieve the names of the skeletal elements to be considered
bones<-names(residual.Csize)
# Names defined

# The following lines specify a function 
# that computes pairwise Z-scores (effect sizes) of integration between 
# different combinations of bones, for a stated group of taxa and a provided phylogeny relating the taxa

pairwise_phylogenetic_integration <- function(bone_list, phylogeny, taxa, nperm = 999, seed = NULL) {
  # Computes pairwise phylogenetic PLS-based integration Z-scores and permutation p-values
  #
  # Arguments:
  #               - a matrix/data.frame with rows = taxa and columns = variables (flattened coords)
  #               - a 3D array where the first dimension is taxa (taxa x landmarks x dims)
  #               Row names (taxa) must be present or dimnames for the taxa dimension.
  #   phylogeny : object of class 'phylo' (ape)
  #   nperm     : number of permutations for null distribution (default 999)
  #
  # Returns:
  #     z.score : symmetric matrix of Z-scores (pairwise bone combinations)
  #     p.val   : symmetric matrix of two-sided permutation p-values
  #
  # Notes:
  #   - Implementation computes phylogenetic independent contrasts (PICs) for every variable
  #
  if (!requireNamespace("ape", quietly = TRUE)) {
    stop("The 'ape' package is required but not installed. Please install it (install.packages('ape')).")
  }
  if (!inherits(phylogeny, "phylo")) stop("'phylogeny' must be an object of class 'phylo'")
  if (!is.list(bone_list) || length(bone_list) < 2) {
    stop("'bone_list' must be a named list with at least two bone elements")
  }
  if (is.null(names(bone_list)) || any(names(bone_list) == "")) {
    stop("'bone_list' must be a named list (names are used in output)")
  }
  flatten_bone <- function(x) {
    if (is.data.frame(x)) x <- as.matrix(x)
    if (is.matrix(x)) {
      if (is.null(rownames(x))) stop("Matrix bone elements must have rownames corresponding to taxa")
      return(as.matrix(x))
    }
    if (is.array(x) && length(dim(x)) == 3) {
      # Prefer when dim1 corresponds to taxa (has dimnames).
      dn <- dimnames(x)
      if (!is.null(dn) && !is.null(dn[[1]])) {
        taxa_names <- dn[[1]]
        # flatten remaining two dims into columns: landmarks * dims
        mat <- matrix(nrow = length(taxa_names), ncol = dim(x)[2] * dim(x)[3])
        colnames(mat) <- paste0(
          rep(if (!is.null(dn[[2]])) dn[[2]] else paste0("L", seq_len(dim(x)[2])),
              each = dim(x)[3]),
          "_",
          rep(if (!is.null(dn[[3]])) dn[[3]] else paste0("D", seq_len(dim(x)[3])),
              times = dim(x)[2])
        )
        rownames(mat) <- taxa_names
        for (i in seq_len(length(taxa_names))) {
          mat[i, ] <- as.vector(x[i, , ])
        }
        return(mat)
      } else {
        if (!is.null(dn) && !is.null(dn[[3]])) {
          taxa_names <- dn[[3]]
          mat <- matrix(nrow = length(taxa_names), ncol = dim(x)[1] * dim(x)[2])
          colnames(mat) <- paste0(
            rep(if (!is.null(dn[[1]])) dn[[1]] else paste0("L", seq_len(dim(x)[1])),
                each = dim(x)[2]),
            "_",
            rep(if (!is.null(dn[[2]])) dn[[2]] else paste0("D", seq_len(dim(x)[2])),
                times = dim(x)[1])
          )
          rownames(mat) <- taxa_names
          for (i in seq_len(length(taxa_names))) {
            mat[i, ] <- as.vector(x[ , , i])


Complete the function implementation replacing "stop("Not implemented")".