How to calculate border length between adjacent Voronoi regions?

Question

I have a set of Voronoi cells that I partition into some defined regions. I would like to then calculate the length of the "borders" between these adjacent regions, using the edges of the underlying Voronoi cells that constitute each region.

Suppose I have points Ps:

Ps = {{-0.025, -0.34},
{0.29, -0.11}, {0.31, 0.83}, {-0.76, 0.76}, {0.73, 0.13}, {-0.36, 0.13}, {-0.47, 0.84}, {-0.73, 0.10}, {-0.91, -0.65}, {0.73, -0.27}, {0.98, 0.71}, {-0.37, 0.25}, {-0.53, -0.08}, {-0.49, 0.06}, {-0.52, 0.34}};

Then I group them into 4 regions:

R1 = {2, 13, 6, 9};
R2 = {10, 4, 11, 5, 3};
R3 = {14, 12, 15};
R4 = {1, 7, 8};

We visualize the Voronoi Mesh Vm with these 4 regions:

Vm = VoronoiMesh[Ps, {-1, 1}, MeshCellLabel -> {2 -> "Index"},
  MeshCellStyle -> {{2, R1} -> LightOrange, {2, R2} -> 
     LightBlue, {2, R3} -> LightYellow, {2, R4} -> LightPink}]

How could I compute the perimeter length of each "border"?

For instance, what's the perimeter length of the Organge-Yellow border? (and so on, for all region borders).

I know we can compute individual Mesh-cell perimeters (e.g. this question), but how could we compute "border" perimeters between two arbitrary regions of the mesh?

Ideally, I'd like to be able to compute pairwise "border lengths", for instance:

BorderLength[R1,R2] = some perimeter length

Thanks!

Answer 1

Update:

Construct a MeshRegion for each collection of faces R1 thru R4:

pieces = MeshRegion[MeshCoordinates[Vm], MeshCells[Vm, {2, #}]] & /@ {R1, R2, R3, R4};

Find the RegionIntersection for each pair of regions in pieces and collect the pairs with non-empty intersection in an Association using "Ri-Rj" as the key for the pair {Ri, Rj}:

borderAssoc = Association[DeleteCases[(StringRiffle["R" <> ToString@# & /@ #, "-"] -> 
        RegionIntersection @@ (pieces[[#]] & /@ #)) & /@ 
     Subsets[Range@Length@pieces, {2}], Rule[_, _EmptyRegion]]];

Line primitives for each border:

MeshPrimitives[#, 1] & /@ borderAssoc // Short[#, 3] &

<|R1 - R2 -> {Line[{{-0.874688, -0.261875}, {-0.91, -0.2534}}], Line[{{-0.619773, 0.0213636}, {-0.874688, -<< 9 >>}}], Line[<< 1 >>], Line[{{-0.501794, 0.200344}, {-0.591545, 0.190727}}]}, << 4 >>|>

Border lengths can be obtained mapping RegionMeasure on borderAssoc:

 RegionMeasure /@ borderAssoc

<|R1 - R2 -> 0.679339, R1 - R3 -> 0.868023, R2 - R3 -> 1.48467, R2 - R4 -> 0.0918997, R3 - R4 -> 1.65446|>

Construct a legend combining region colors in Vm with colors of your choice for border lines:

colors = ColorData[97] /@ Range[Length@Keys[borderAssoc]];

legend = Column[{SwatchLegend[{LightOrange, LightBlue, LightYellow,  LightPink}, 
     Row /@ Thread[ {"R" <> ToString@# <> " = " & /@ Range[4], {R1, R2, R3, R4}}], 
     LegendMarkerSize -> {20, 20}, LegendLabel -> "regions"], 
    LineLegend[colors, Row[#, " : "] & /@ 
      List @@@ Normal[RegionMeasure /@ borderAssoc], 
     LegendLabel -> "border lengths"]}];

Show Vm with the border lines and the legend:

Legended[Show[Vm, 
  Graphics@ {AbsoluteThickness[3], 
    Thread[{colors, Values[MeshPrimitives[#, 1] & /@ borderAssoc]}]}],
  Placed[legend, Right]]

Original answer:

pieces = MeshRegion[MeshCoordinates[Vm], MeshCells[Vm, {2, #}]] & /@ {R1, R2, R3, R4};

borders = DeleteCases[RegionIntersection @@@ Subsets[pieces, {2}], _EmptyRegion];

Show[Vm, Graphics @ {AbsoluteThickness[3], RandomColor[], #} & /@ 
   (MeshPrimitives[#, 1] & /@  borders)]

lengths = RegionMeasure[RegionUnion @@ #] & /@ borders

{0.679339, 0.868023, 1.48467, 0.0918997, 1.65446}