Project: s41467-025-59974-x | Function: mat.link.input.bipartite (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:** Generate input matrix for bipartite network linkage analysis. Creates adjacency matrix structure for ecological network analysis.

**KEY TERMS:** {
  "mat.link": "linkage matrix",
  "bipartite": "two-mode network",
  "input": "network input data"
}

**CONTEXT CODE:** library(ggalluvial)

library(ggpubr)
library(AICcmodavg)
library(segmented)
library(bipartite)
library(gdata)
library(funModeling)
library(betapart)
library(doSNOW)
library(scales)
library(picante)
library(plotly)
library(binovisualfields)
library(googlesheets4)
library(googledrive)
library(tidyverse)
library(ggplot2)
library(ggdendro)
library(openxlsx)
library(nlme)
library(paleoTS)
library(cluster)
library(plotrix)
library(wesanderson)
library(munsell)
library(RColorBrewer)
library(stringr)
library(dplyr)
library(tidyr)
library(vegan)
library(ape)
library(geiger)
library(phytools)
library(ade4)
library(doParallel)
library(picante)
library(fastmatch)
library(foreach)
library(factoextra)
library(countrycode)
library(HDInterval)
library(devtools)


###### Functions Input Network Analysis #########


#### Functions to create the Infomap input for the network analysis

mat.link.input.bipartite <- function(...) { stop("Function implementation has been masked") }
write.input.info.bipartite<-function(mat,path,file){
  link.node<-mat.link.input.bipartite(mat)
  vert<-cbind(c(1:(ncol(mat)+nrow(mat))),c(colnames(mat),rownames(mat))) 
  input<-list(cbind("*Vertices",nrow(vert)),vert,cbind("*Edges",nrow(link.node)),link.node)####old input
  #input<-list(cbind("*Vertices",nrow(vert)),vert,cbind("*Bipartite",ncol(occ_analysis_functional_types)+1),link.node)###bipartite
  write.table(input[[1]], paste(path,file,sep=""),row.names=FALSE,col.names=FALSE,quote=FALSE)
  write.table(input[[2]], paste(path,file,sep=""), append= TRUE,row.names=FALSE,col.names=FALSE,quote=c(2))
  write.table(input[[3]], paste(path,file,sep=""), append= TRUE,row.names=FALSE,col.names=FALSE,quote=FALSE )
  write.table(input[[4]], paste(path,file,sep=""), append= TRUE,row.names=FALSE,col.names=FALSE,quote=FALSE)
  return(input)
}


run.infomap <- function(path.info, path.in, name, extension, path.out, parameters){
  system(paste("bash -c", shQuote(paste("cd ", path.info ," && ./Infomap ", path.in, name , extension  ," ", path.out, " ", parameters, sep=""),type="sh")),wait=T)
  out.win<-gsub("/mnt/c","C:",path.out)
  par<-read.table(paste(out.win,name,".tree",sep="")) 
  scan_csv <- scan(paste(out.win,name,".tree",sep=""), what="character", sep=NULL)
  ####Activate to have one output for every possible combination of relaxation and percolation value
  #par<-read.table(paste(out.win,name,"_","states",".tree",sep="")) 
  #scan_csv <- scan(paste(out.win,name,"_","states",".tree",sep=""), what="character", sep=NULL)
  mod_value <- scan_csv[grep("savings",scan_csv)+1]
  quality <- as.numeric(gsub("%","",mod_value))
  list(par,quality)
}



sam.val.fun <- function(x,path.unix,grep,treshold,Ntrain,Ntest,Nsam){
  path.win<-gsub("/mnt/c","C:",path.unix)
  setwd(path.win)
  write.table(x,"input_partitions.txt",sep=" ",row.names=F,col.names=F,quote=F)
  k<- paste(Ntrain,Ntest,Nsam,sep=" ")
  system(paste("bash -c", shQuote(paste("cd ",path.unix," && ./partition-validation -s ", runif(1,0,1000)," -t ", treshold, " --validation-sampling ", k, " input_partitions.txt ", grep, sep=""),type="sh")),wait=T)
  read.table(paste(grep,"_validation",sep=""))
}

jac.fun<-function(x,y){sum(x%in%y)/length(unique(c(x,y)))}


##### Load data  ####
#Load raw data
large_herb_matrix<- read.xlsx()
#Load fdata
no_na_fdata_art <- read.xlsx()
#Load the occ species
occ_analysis_fdata <- read.xlsx()
#Load ftypes
functional_types <- read.xlsx()
#Load occ ftypes
occ_analysis_functional_types<- read.xlsx()

###########  Functional distances ###### 

###Calculate the distance matrix

####Order the traits we can

hyp_ordered <- c("bra","mes","hyp")
no_na_fdata_art$hypsodonty <- ordered(no_na_fdata_art$hypsodonty, levels=hyp_ordered)
buccal_ordered <- c("2","3","M")
no_na_fdata_art$buccal_cusp <- ordered(no_na_fdata_art$buccal_cusp, levels=buccal_ordered)
lingual_ordered <- c("1","2","3","M")
no_na_fdata_art$lingual_cusp <- ordered(no_na_fdata_art$lingual_cusp, levels=lingual_ordered)
longitudinal_ordered <- c("0","1","2")
no_na_fdata_art$longitudinal_lophs <- ordered(no_na_fdata_art$longitudinal_lophs, levels=longitudinal_ordered)
transverse_ordered <- c("0","1","2","3","M")
no_na_fdata_art$transverse_lophs <- ordered(no_na_fdata_art$transverse_lophs, levels=transverse_ordered)
horizodonty_ordered <- c("0","1","2","3")
no_na_fdata_art$horizodonty <- ordered(no_na_fdata_art$horizodonty, levels=horizodonty_ordered)
bs_ordered <- c("B","C","D","E","F","G","H","I","J")
no_na_fdata_art$body_size_categories <- ordered(no_na_fdata_art$body_size_categories, levels= bs_ordered)

# dental traits
weights <- rep(1/6, ncol(no_na_fdata_art))

# Body size
weights[colnames(no_na_fdata_art) %in% c("body_size_categories")] <- bs_weight <- 1

# tooth shape
weights[colnames(no_na_fdata_art) %in% c("tooth_shape_multicusp")] <- 1


#### Calculate the dissimilarity matrix
distances <- NULL
#which variables are ordered
ordratio <- c(2,4,5,6,7,8,14)
distances <- daisy(no_na_fdata_art, metric="gower", type = list(ordratio = ordratio),weights = weights)

distance_matrix <- as.matrix(distances)

pcoa_sp_distances <- NULL
pcoa_sp_distances <- pcoa(distance_matrix, correction="none")
pcoa_vectors <-as.data.frame (pcoa_sp_distances$vectors) 
pcoa_disim_analy <- pcoa_vectors[,1:3]


#########################Betapart to calculate the functional distances between sites



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