Create graph

N1 = 5;
N2 = 5;

p = 1;
q = 0.2;

creategraph[N1_,N2_,p_,q_] :=
Module[{links,i,j,Asparse},
links = {};
Do[
Do[
If[RandomReal[]≤p,
AppendTo[links,{i,j}->1];
AppendTo[links,{j,i}->1]
],
{j,i+1,N1}
],
{i,1,N1-1}
];
Do[
Do[
If[RandomReal[]≤p,
AppendTo[links,{i,j}->1];
AppendTo[links,{j,i}->1]
],
{j,i+1,N1+N2}
],
{i,N1+1,N1+N2-1}
];
Do[
Do[
If[RandomReal[]≤q,
AppendTo[links,{i,j}->1];
AppendTo[links,{j,i}->1]
],
{j,N1+1,N1+N2}
],
{i,1,N1}
];
Asparse =
SparseArray[links,{N1+N2,N1+N2}];
Normal[Asparse]
];

Amat = creategraph[N1,N2,p,q];
MatrixForm[Amat]

Assign features

d = 2;

assignfeatures[N1_,N2_,d_] :=
Module[{i,flist},
flist = {};
Do[
sex = Which[RandomReal[]<1/2,0,True,1];
x = RandomReal[1,d];
AppendTo[flist,{sex,x}],
{i,1,N1+N2}
];
flist
];

flist = assignfeatures[N1,N2,d]

Draw graph

plot1points =
Table[
Which[
flist[[i,1]] == 0,{Red,Text[Style["♂",Large],flist[[i,2]]]},
True,{Red,Text[Style["♀",Large],flist[[i,2]]]}
],
{i,1,N1}
];
plot2points =
Table[
Which[
flist[[i,1]] == 0,{Blue,Text[Style["♂",Large],flist[[i,2]]]},
True,{Blue,Text[Style["♀",Large],flist[[i,2]]]}
],
{i,N1+1,N1+N2}
];
plotgraph ={LightGray};
Do[
Do[
If[Amat[[i,j]] == 1,
AppendTo[plotgraph,Line[{flist[[i,2]],flist[[j,2]]}]]
],
{j,i+1,N1+N2}
],
{i,1,N1+N2-1}
];

Graphics[
{{White,Rectangle[{0,0},{1,1}]},
plotgraph,
plot1points,
plot2points
},
AspectRatio->Automatic
]

Match

match[Amat_,flist_] :=
Module[{matching,pairs,si,sj,xi,xj,i,j,dist,p,newpairs,pair},
pairs = {};
Do[
Do[
If[Amat[[i,j]] == 1,
{si,xi} = flist[[i]];
{sj,xj} = flist[[j]];
If[si≠sj,
dist = Norm[xi-xj];
AppendTo[pairs,{dist,i,j}]
]
],
{j,i+1,N1+N2}
],
{i,1,N1+N2-1}
];
pairs= Sort[pairs];
matching = {};
While[pairs≠{},
{dist,i,j} = First[pairs];
AppendTo[matching,{dist,i,j}];
newpairs = {};
Do[
pair = pairs[[p]];
If[!MemberQ[pair,i] && ! MemberQ[pair,j],
AppendTo[newpairs,pair]
],
{p,1,Length[pairs]}
];
pairs = newpairs
];
matching
];

matching = match[Amat,flist]

Draw matching

plotmatching = 
Table[
{Purple,Thick,
Line[
{flist[[matching[[i,2]],2]],
flist[[matching[[i,3]],2]]
}
]
},
{i,1,Length[matching]}
];

Graphics[
{{White,Rectangle[{0,0},{1,1}]},
plotgraph,
plotmatching,
plot1points,
plot2points
},
AspectRatio->Automatic
]

Compute statistics

r  =2;
N1 = 50;
N2 = 50;

Nruns = 100;

p = 1;
d = 2;

plotsize = {};
plotdiversity = {};
plotstrength = {};
Do[
q = i/10;
sizes = {};
diversities = {};
strengths = {};
Do[
Amat = creategraph[N1,N2,p,q];
flist = assignfeatures[N1,N2,d];
matching = match[Amat,flist];
size = Length[matching];
AppendTo[sizes,size];
interpairs = 
Select[matching,(#[[2]]≤N1 && #[[3]]> N1) &];
diversity = (Length[interpairs]/size)*(r/(r-1));
AppendTo[diversities,diversity];
strength = 
(Sqrt[2]-Mean[First[Transpose[matching]]])/Sqrt[2];
AppendTo[strengths,strength],
{run,1,Nruns}
];
AppendTo[plotsize,{q,Mean[sizes],StandardDeviation[sizes]}];
AppendTo[plotdiversity,{q,Mean[diversities],StandardDeviation[diversities]}];
AppendTo[plotstrength,{q,Mean[strengths],StandardDeviation[strengths]}],
{i,0,10}
];

Plot statistics

sizegraphics = 
Graphics[
{Blue,
Table[
Line[
{{plotsize[[i,1]],plotsize[[i,2]]-plotsize[[i,3]]},
{plotsize[[i,1]],plotsize[[i,2]]+plotsize[[i,3]]}
}
],
{i,1,Length[plotsize]}
]
}
];
sizeplot =
ListLinePlot[
Table[{plotsize[[i,1]],plotsize[[i,2]]},{i,1,Length[plotsize]}],
PlotStyle->Red
];
Show[
sizeplot,sizegraphics,
AxesOrigin->{0,0},
AxesStyle->Directive[Thick],
AxesLabel->{"q","no. pairs"},
LabelStyle->Directive[Large],
PlotRange->All,
ImageSize->720
]

diversitygraphics = 
Graphics[
{Blue,
Table[
Line[
{{plotdiversity[[i,1]],plotdiversity[[i,2]]-plotdiversity[[i,3]]},
{plotdiversity[[i,1]],plotdiversity[[i,2]]+plotdiversity[[i,3]]}
}
],
{i,1,Length[plotdiversity]}
]
}
];
diversityplot =
ListLinePlot[
Table[{plotdiversity[[i,1]],plotdiversity[[i,2]]},{i,1,Length[plotdiversity]}],
PlotStyle->Red
];
Clear[q];
oneline = Plot[1,{q,0,1},PlotStyle->Black];
Show[
diversityplot,diversitygraphics,oneline,
AxesOrigin->{0,0},
AxesStyle->Directive[Thick],
AxesLabel->{"q","diversity"},
LabelStyle->Directive[Large],
PlotRange->All,
ImageSize->720
]

strengthgraphics = 
Graphics[
{Blue,
Table[
Line[
{{plotstrength[[i,1]],plotstrength[[i,2]]-plotstrength[[i,3]]},
{plotstrength[[i,1]],plotstrength[[i,2]]+plotstrength[[i,3]]}
}
],
{i,1,Length[plotstrength]}
]
}
];
strengthplot =
ListLinePlot[
Table[{plotstrength[[i,1]],plotstrength[[i,2]]},{i,1,Length[plotstrength]}],
PlotStyle->Red
];
Show[
strengthplot,strengthgraphics,oneline,
AxesOrigin->{0,0},
AxesStyle->Directive[Thick],
AxesLabel->{"q","strength"},
LabelStyle->Directive[Large],
PlotRange->All,
ImageSize->720
]