Graph-Matching

 view release on metacpan or  search on metacpan

lib/Graph/Matching.pm  view on Meta::CPAN

sub max_weight_matching($;$) {
    my ($graph, $maxcardinality) = @_;

    $maxcardinality = defined($maxcardinality) && $maxcardinality;

    #
    # Vertices are numbered 0 .. ($nvertex-1).
    # Non-trivial blossoms are numbered nvertex .. (2*$nvertex-1)
    #
    # Edges are numbered 0 .. ($nedge-1).
    # Edge endpoints are numbered 0 .. (2*$nedge-1), such that endpoints
    # (2*k) and (2*k+1) both belong to the edge with index k.
    #
    # Many terms used in the comments come from the paper by Galil.
    # You will probably need the paper to make sense of this code.
    #

    # Don't bother with empty graphs.
    my $nedge = scalar(@{$graph});
    return ( ) if (!$nedge);

lib/Graph/Matching.pm  view on Meta::CPAN

            if (!defined($nodemap{$_})) {
                push @nodelist, $_;
                $nodemap{$_} = $#nodelist;
            }
        }
        $maxweight = $wt if ($wt > $maxweight);
        $all_integer_weights = $all_integer_weights && ($wt == int($wt));
    }
    my $nvertex = $#nodelist + 1;

    # If $p is an endpoint index,
    # $endpoint[$p] is the vertex index to which endpoint $p is attached.
    my @endpoint;
    $#endpoint = 2*$nedge-1;
    for (my $k = $nedge - 1; $k >= 0; $k--) {
        $endpoint[2*$k]   = $nodemap{$graph->[$k]->[0]};
        $endpoint[2*$k+1] = $nodemap{$graph->[$k]->[1]};
    }

    # If $v is a vertex index,
    # $neighbend[$v] refers to an array of remote endpoints attached to $v.
    my @neighbend;
    $#neighbend = $nvertex-1;
    for (my $k = $nedge - 1; $k >= 0; $k--) {
        my $v = $endpoint[2*$k];
        my $w = $endpoint[2*$k+1];
        assert($v != $w);
        push @{$neighbend[$v]}, 2*$k + 1;
        push @{$neighbend[$w]}, 2*$k;
    }

    # If $v is a vertex index,
    # $mate[$v] is the remote endpoint of its matched edge, or -1 if $v
    # is single. (i.e. $endpoint[$mate[$v]] is $v's partner vertex)
    # Initially all vertices are single.
    my @mate = ( -1 ) x $nvertex;

    # If $b is a top-level blossom,
    # $label[$b] is 0 if $b is unlabeled (free);
    #               1 if $b is an S-vertex/blossom;
    #               2 if $b is a T-vertex/blossom.
    # The label of a vertex is found by looking at the label of its top-level
    # containing blossom.
    # If $v is a vertex inside a T-blossom,
    # $label[$v] is 2 iff $v is reachable from an S-vertex outside the blossom.
    # Labels are assigned during a stage and reset after each augmentation.
    my @label = ( 0 ) x (2*$nvertex);

    # If $b is a labeled top-level blossom,
    # $labelend[$b] is the remote endpoint of the edge through which b obtained
    # its label, or -1 if $b's base vertex is single.
    # If $v is a vertex inside a T-blossom and $label[$v] == 2,
    # $labelend[$v] is the remote endpoint of the edge through which $v is
    # reachable from outside the blossom.
    my @labelend = ( undef ) x (2*$nvertex);

    # If $v is a vertex,
    # $inblossom[$v] is the top-level blossom to which $v belongs.
    # If $v is a top-level vertex, $v is itself a blossom (a trivial blossom)
    # and $inblossom[$v] == $v.
    # Initially all vertices are top-level trivial blossoms.
    my @inblossom = (0 .. ($nvertex-1));

lib/Graph/Matching.pm  view on Meta::CPAN

    # If $b is a non-trivial (sub-)blossom,
    # $blossomchilds[$b] refers to an ordered array of its sub-blossoms,
    # starting with the base and going round the blossom.
    my @blossomchilds = ( undef ) x (2*$nvertex);

    # If $b is a (sub-)blossom,
    # $blossombase[$b] is its base VERTEX (i.e. recursive sub-blossom).\
    my @blossombase = ( 0 .. ($nvertex-1), ( undef ) x $nvertex );

    # If $b is a non-trivial (sub-)blossom,
    # $blossomendps[$b] refers to an array of endpoints on its connecting
    # edges, such that $blossomendps[$b]->[$i] is the local endpoint of
    # $blossomchilds[$b]->[$i] on the edge that connects it to
    # $blossomchilds[$b]->[wrap($i+1)].
    my @blossomendps = ( undef ) x (2*$nvertex);

    # If $v is a free vertex (or an unreached vertex inside a T-blossom),
    # $bestedge[$v] is the remote endpoint on a least-slack edge to an S-vertex
    # or -1 if there is no such edge.
    # If $b is a (possibly trivial) top-level S-blossom,
    # $bestedge[$b] is the remote endpoint on a least-slack edge to a
    # different S-blossom, or -1 if there is no such edge.
    # This is used for efficient computation of delta2 and delta3.
    my @bestedge = ( -1 ) x (2*$nvertex);

    # If $b is a non-trivial top-level S-blossom,
    # $blossombestedges[$b] refers to an array of remote endpoints on
    # least-slack edges to neighbouring S-blossoms, or is undef() if no
    # such list has been computed yet.
    # This is used for efficient computation of delta3.
    my @blossombestedges = ( undef ) x (2*$nvertex);

    # List of currently unused blossom numbers.
    my @unusedblossoms = ( $nvertex .. (2*$nvertex-1) );

    # If $v is a vertex,
    # $dualvar[$v] = 2 * u($v) where u($v) is $v's variable in the dual

lib/Graph/Matching.pm  view on Meta::CPAN

    # be zero.
    my @allowedge = ( 0 ) x $nedge;

    # Queue of newly discovered S-vertices.
    my @queue;

    # slack($k)
    # returns 2 * slack of edge $k (does not work inside blossoms).
    local *slack = sub {
        my ($k) = @_;
        my $v = $endpoint[2*$k];
        my $w = $endpoint[2*$k+1];
        my $weight = $graph->[$k]->[2];
        return $dualvar[$v] + $dualvar[$w] - 2 * $weight;
    };

    # blossomleaves($b)
    # returns a list of leaf vertices of (sub-)blossom $b.
    local *blossomleaves = sub {
        my ($b) = @_;
        if ($b < $nvertex) {
            return @_;

lib/Graph/Matching.pm  view on Meta::CPAN

                    unshift @leaves, @{$blossomchilds[$b]};
                }
            }
            return @leaves;
        }
    };

    # assignlabel($w, $t, $p)
    # assigns label $t to the top-level blossom containing vertex $w
    # and record the fact that $w was reached through the edge with
    # remote endpoint $p.
    local *assignlabel = sub {
        my ($w, $t, $p) = @_;
        DBG("assignlabel($w,$t,$p)") if ($DBG);
        my $b = $inblossom[$w];
        assert($label[$w] == 0 && $label[$b] == 0);
        $label[$w] = $t;
        $label[$b] = $t;
        $labelend[$w] = $p;
        $labelend[$b] = $p;
        $bestedge[$w] = -1;

lib/Graph/Matching.pm  view on Meta::CPAN

        if ($t == 1) {
            # $b became an S-blossom; add it(s vertices) to the queue
            push @queue, blossomleaves($b);
            DBG('PUSH ', join(',', blossomleaves($b))) if ($DBG);
        } else {
            # $b became a T-blossom; assign label S to its mate.
            # (If b is a non-trivial blossom, its base is the only vertex
            # with an external mate.)
            my $base = $blossombase[$b];
            assert($mate[$base] >= 0);
            assignlabel($endpoint[$mate[$base]], 1, $mate[$base] ^ 1);
        }
    };

    # scanblossom($v, $w)
    # traces back from vertices $v and $w to discover either a new blossom
    # or an augmenting path; returns the base vertex of the new blossom or -1.
    local *scanblossom = sub {
        my ($v, $w) = @_;
        DBG("scanblossom($v,$w)") if ($DBG);
        # Trace back from $v and $w, placing breadcrumbs as we go.

lib/Graph/Matching.pm  view on Meta::CPAN

            }
            assert($label[$b] == 1);
            push @path, $b;
            $label[$b] = 5;
            # Trace one step back.
            assert($labelend[$b] == $mate[$blossombase[$b]]);
            if ($labelend[$b] == -1) {
                # The base of blossom $b is single; stop tracing this path.
                $v = -1;
            } else {
                $v = $endpoint[$labelend[$b]];
                $b = $inblossom[$v];
                # $b is a T-blossom; trace one more step back.
                assert($label[$b] == 2);
                assert($labelend[$b] >= 0);
                $v = $endpoint[$labelend[$b]];
            }
            # Swap v and w so that we alternate between both paths.
            if ($w != -1) {
                my $t = $v;
                $v = $w;
                $w = $t;
            }
        }
        # Remove breadcrumbs.
        foreach (@path) {

lib/Graph/Matching.pm  view on Meta::CPAN

        # Return base vertex, if we found one.
        return $base;
    };

    # addblossom($base, $k)
    # constructs a new blossom with given base, containing edge $k which
    # connects a pair of S vertices; labels the new blossom as S; sets its dual
    # variable to zero; relabels its T-vertices to S and adds them to the queue.
    local *addblossom = sub {
        my ($base, $k) = @_;
        my $v = $endpoint[2*$k];
        my $w = $endpoint[2*$k+1];
        my $bb = $inblossom[$base];
        my $bv = $inblossom[$v];
        my $bw = $inblossom[$w];
        # Create blossom.
        my $b = pop(@unusedblossoms);
        DBG("addblossom($base,$k) v=$v w=$w -> b=$b") if ($DBG);
        $blossombase[$b] = $base;
        $blossomparent[$b] = -1;
        $blossomparent[$bb] = $b;
        # Build lists of sub-blossoms and their interconnecting edge endpoints.
        my @path;
        my @endps;
        # Trace back from $v to $base.
        while ($bv != $bb) {
            # Add $bv to the new blossom.
            $blossomparent[$bv] = $b;
            unshift @path, $bv;
            unshift @endps, $labelend[$bv];
            # Trace one step back.
            assert($label[$bv] == 2 || ($label[$bv] == 1 && $labelend[$bv] == $mate[$blossombase[$bv]]));
            assert($labelend[$bv] >= 0);
            $v = $endpoint[$labelend[$bv]];
            $bv = $inblossom[$v];
        }
        # Add the base sub-blossom;
        # add the edge that connects the pair of S vertices.
        unshift @path, $bb;
        push @endps, (2*$k);
        # Trace back from $w to $base.
        while ($bw != $bb) {
            # Add $bw to the new blossom.
            $blossomparent[$bw] = $b;
            push @path, $bw;
            push @endps, ($labelend[$bw] ^ 1);
            # Trace one step back.
            assert($label[$bw] == 2 || ($label[$bw] == 1 && $labelend[$bw] == $mate[$blossombase[$bw]]));
            assert($labelend[$bw] >= 0);
            $w = $endpoint[$labelend[$bw]];
            $bw = $inblossom[$w];
        }
        $blossomchilds[$b] = \@path;
        $blossomendps[$b] = \@endps;
        # Set new blossom's label to S.
        assert($label[$bb] == 1);
        $label[$b] = 1;
        $labelend[$b] = $labelend[$bb];
        # Set dual variable to zero.
        $dualvar[$b] = 0;

lib/Graph/Matching.pm  view on Meta::CPAN

            $inblossom[$v] = $b;
        }
        # Compute $blossombestedges[$b].
        my @bestedgeto = ( -1 ) x (2*$nvertex);
        foreach $bv (@path) {
            if (!defined($blossombestedges[$bv])) {
                # This subblossom does not have a list of least-slack edges;
                # get the information from the vertices.
                foreach (blossomleaves($bv)) {
                    foreach my $p (@{$neighbend[$_]}) {
                        my $j = $endpoint[$p];
                        my $bj = $inblossom[$j];
                        if ($bj != $b && $label[$bj] == 1 &&
                            ($bestedgeto[$bj] == -1 ||
                             slack($p>>1) < slack($bestedgeto[$bj]>>1))) {
                            $bestedgeto[$bj] = $p;
                        }
                    }
                }
            } else {
                # Walk this subblossom's least-slack edges.
                foreach my $p (@{$blossombestedges[$bv]}) {
                    my $j = $endpoint[$p];
                    my $bj = $inblossom[$j];
                    if ($bj != $b && $label[$bj] == 1 &&
                        ($bestedgeto[$bj] == -1 ||
                         slack($p>>1) < slack($bestedgeto[$bj]>>1))) {
                        $bestedgeto[$bj] = $p;
                    }
                }
            }
            # Forget about least-slack edges of the subblossom.
            $blossombestedges[$bv] = undef;

lib/Graph/Matching.pm  view on Meta::CPAN

        $blossombestedges[$b] = \@bestedgeto;
        # Select bestedge[b].
        $bestedge[$b] = -1;
        foreach my $p (@bestedgeto) {
            if ($bestedge[$b] == -1 ||
                slack($p>>1) < slack($bestedge[$b]>>1)) {
                $bestedge[$b] = $p;
            }
        }
        DBG("blossomchilds[$b] = ", join(',', @path)) if ($DBG);
        DBG("blossomendps[$b]  = ", join('; ', map { $endpoint[$_] . "," . $endpoint[$_^1] } @{$blossomendps[$b]})) if ($DBG);
    };

    # expandblossom($b, $endstage)
    # expands the given top-level blossom.
    local *expandblossom = sub {
        my ($b, $endstage) = @_;
        DBG("expandblossom($b,$endstage) ", join(',', @{$blossomchilds[$b]})) if ($DBG);
        # Convert sub-blossoms into top-level blossoms.
        foreach my $s (@{$blossomchilds[$b]}) {
            $blossomparent[$s] = -1;

lib/Graph/Matching.pm  view on Meta::CPAN

        }
        # If we expand a T-blossom during a stage, its sub-blossoms must be
        # relabeled.
        if (!$endstage && $label[$b] == 2) {
            # Start at the sub-blossom through which the expanding
            # blossom obtained its label, and relabel sub-blossoms until
            # we reach the base.
            # Figure out through which sub-blossom the expanding blossom
            # obtained its label initially.
            assert($labelend[$b] >= 0);
            my $entrychild = $inblossom[$endpoint[$labelend[$b] ^ 1]];
            # Decide in which direction we will go round the blossom.
            my $j = 0;
            my $jstep;
            $j++ until ($blossomchilds[$b]->[$j] == $entrychild);
            if ($j & 1) {
                # Start index is odd; go forward and wrap.
                $j -= scalar(@{$blossomchilds[$b]});
                $jstep = 1;
            } else {
                # Start index is even; go backward.
                $jstep = -1;
            }
            # Move along the blossom until we get to the base.
            my $p = $labelend[$b];
            while ($j != 0) {
                # Relabel the T-sub-blossom.
                my $q = ($jstep == 1) ? ($blossomendps[$b]->[$j]) :
                                        ($blossomendps[$b]->[$j-1]^1);
                $label[$endpoint[$p^1]] = 0;
                $label[$endpoint[$q^1]] = 0;
                assignlabel($endpoint[$p^1], 2, $p);
                # Step to the next S-sub-blossom and note its forward endpoint.
                $allowedge[$q>>1] = 1;
                $j += $jstep;
                $p = ($jstep == 1) ? ($blossomendps[$b]->[$j]) :
                                     ($blossomendps[$b]->[$j-1]^1);
                # Step to the next T-sub-blossom.
                $allowedge[$p>>1] = 1;
                $j += $jstep;
            }
            # Relabel the base T-sub-blossom WITHOUT stepping through to
            # its mate (so don't call assignlabel).
            my $bv = $blossomchilds[$b]->[$j];
            $label[$endpoint[$p^1]] = 2;
            $label[$bv] = 2;
            $labelend[$endpoint[$p^1]] = $p;
            $labelend[$bv] = $p;
            $bestedge[$bv] = -1;
            # Continue along the blossom until we get back to entrychild.
            $j += $jstep;
            while ($blossomchilds[$b]->[$j] != $entrychild) {
                # Examine the vertices of the sub-blossom to see whether
                # it is reachable from a neighbouring S-vertex outside the
                # expanding blossom.
                $bv = $blossomchilds[$b]->[$j];
                if ($label[$bv] == 1) {

lib/Graph/Matching.pm  view on Meta::CPAN

                        $v = $_;
                        last;
                    }
                }
                # If the sub-blossom contains a reachable vertex, assign
                # label T to the sub-blossom.
                if (defined($v)) {
                    assert($label[$v] == 2);
                    assert($inblossom[$v] == $bv);
                    $label[$v] = 0;
                    $label[$endpoint[$mate[$blossombase[$bv]]]] = 0;
                    assignlabel($v, 2, $labelend[$v]);
                }
                $j += $jstep;
            }
        }
        # Recycle the blossom number.
        $label[$b] = undef;
        $labelend[$b] = undef;
        $blossomparent[$b] = undef;
        $blossomchilds[$b] = undef;

lib/Graph/Matching.pm  view on Meta::CPAN

            # Start index is even; go backward.
            $jstep = -1;
        }  
        # Move along the blossom until we get to the base.
        while ($j != 0) {
            # Step to the next sub-blossom and augment it recursively.
            $j += $jstep;
            $t = $blossomchilds[$b]->[$j];
            my $p = ($jstep == 1) ? ($blossomendps[$b]->[$j]) :
                                    ($blossomendps[$b]->[$j-1]^1);
            augmentblossom($t, $endpoint[$p]) if ($t >= $nvertex);
            # Step to the next sub-blossom and augment it recursively.
            $j += $jstep;
            $t = $blossomchilds[$b]->[$j];
            augmentblossom($t, $endpoint[$p^1]) if ($t >= $nvertex);
            # Match the edge connecting those sub-blossoms.
            $mate[$endpoint[$p]] = $p ^ 1;
            $mate[$endpoint[$p^1]] = $p;
            DBG("PAIR ", $endpoint[$p], " ", $endpoint[$p^1], " k=", $p>>1) if ($DBG);
        }
        # Rotate the list of sub-blossoms to put the new base at the front.
        my $n = scalar(@{$blossomchilds[$b]});
        $blossomchilds[$b] = [ @{$blossomchilds[$b]}[$i .. ($n-1)],
                               @{$blossomchilds[$b]}[0 .. ($i-1)] ];
        $blossomendps[$b]  = [ @{$blossomendps[$b]}[$i .. ($n-1)],
                               @{$blossomendps[$b]}[0 .. ($i-1)] ];
        $blossombase[$b] = $blossombase[$blossomchilds[$b]->[0]];
        assert($blossombase[$b] == $v);
    };

    # augmentmatching($k)
    # swaps matched/unmatched edges over an alternating path between two
    # single vertices; the augmenting path runs through edge $k, which
    # connects a pair of S vertices.
    local *augmentmatching = sub {
        my ($k) = @_;
        my $v = $endpoint[2*$k];
        my $w = $endpoint[2*$k+1];
        DBG("augmentmatching($k) v=$v w=$w") if ($DBG);
        DBG("PAIR $v $w k=$k") if ($DBG);
        foreach my $p (2*$k+1, 2*$k) {
            my $s = $endpoint[$p^1];
            # Match vertex s to remote endpoint p. Then trace back from s
            # until we find a single vertex, swapping matched and unmatched
            # edges as we go.
            while (1) {
                my $bs = $inblossom[$s];
                assert($label[$bs] == 1 &&
                       $labelend[$bs] == $mate[$blossombase[$bs]]);
                # Augment through the S-blossom from s to base.
                augmentblossom($bs, $s) if ($bs >= $nvertex);
                # Update $mate[$s]
                $mate[$s] = $p;
                # Trace one step back.
                last if ($labelend[$bs] == -1); # stop at single vertex
                my $t = $endpoint[$labelend[$bs]];
                my $bt = $inblossom[$t];
                assert($label[$bt] == 2);
                # Trace one step back.
                assert($labelend[$bt] >= 0);
                $s = $endpoint[$labelend[$bt]];
                my $j = $endpoint[$labelend[$bt] ^ 1];
                # Augment through the T-blossom from j to base.
                assert($blossombase[$bt] == $t);
                augmentblossom($bt, $j) if ($bt >= $nvertex);
                # Update $mate[$j]
                $mate[$j] = $labelend[$bt];
                # Keep the opposite endpoint;
                # it will be assigned to $mate[$s] in the next step.
                $p = $labelend[$bt] ^ 1;
                DBG("PAIR $s $t k=", $p>>1) if ($DBG);
            }
        }
    };

    # Verify that the optimum solution has been reached.
    local *verifyoptimum = sub {
        my $vdualoffset = 0;

lib/Graph/Matching.pm  view on Meta::CPAN

        # 0. all dual variables are non-negative
        foreach (@dualvar[0 .. ($nvertex-1)]) {
            assert($_ + $vdualoffset >= 0);
        }
        foreach (@dualvar[$nvertex .. (2*$nvertex-1)]) {
            assert(!defined($_) || $_ >= 0);
        }
        # 0. all edges have non-negative slack and
        # 1. all matched edges have zero slack;
        foreach my $k (0 .. ($nedge-1)) {
            my $v = $endpoint[2*$k];
            my $w = $endpoint[2*$k+1];
            my $weight = $graph->[$k]->[2];
            my $s = $dualvar[$v] + $dualvar[$w] - 2 * $weight;
            my @vblossoms = ( $v );
            my @wblossoms = ( $w );
            push @vblossoms, $blossomparent[$vblossoms[-1]]
                until ($blossomparent[$vblossoms[-1]] == -1);
            push @wblossoms, $blossomparent[$wblossoms[-1]]
                until ($blossomparent[$wblossoms[-1]] == -1);
            while ($#vblossoms >= 0 && $#wblossoms >= 0) {
                my $bv = pop(@vblossoms);

lib/Graph/Matching.pm  view on Meta::CPAN

        # 2. all single vertices have zero dual value;
        foreach my $v (0 .. ($nvertex-1)) {
            assert($mate[$v] >= 0 || $dualvar[$v] + $vdualoffset == 0);
        }
        # 3. all blossoms with positive dual value are full.
        foreach my $b ($nvertex .. (2*$nvertex-1)) {
            if (defined($blossombase[$b]) && $dualvar[$b] > 0) {
                assert((scalar(@{$blossomendps[$b]}) & 1) == 1);
                for (my $j = 1; $j <= $#{$blossomendps[$b]}; $j += 2) {
                    my $p = $blossomendps[$b]->[$j];
                    assert($mate[$endpoint[$p]] == ($p^1));
                    assert($mate[$endpoint[$p^1]] == $p);
                }
            }
        }
        # Ok.
    };

    # Check optimized delta2 against a trivial computation.
    local *checkdelta2 = sub {
        foreach my $v (0 .. ($nvertex-1)) {
            if ($label[$inblossom[$v]] == 0) {
                my $bd;
                foreach my $p (@{$neighbend[$v]}) {
                    my $w = $endpoint[$p];
                    if ($label[$inblossom[$w]] == 1) {
                        my $d = slack($p >> 1);
                        $bd = $d if (!defined($bd) || $d < $bd);
                    }
                }
                assert((!defined($bd) && $bestedge[$v] == -1) || ($bestedge[$v] != -1 && $bd == slack($bestedge[$v]>>1)));
            }
        }
    };

    # Check optimized delta3 against a trivial computation.
    local *checkdelta3 = sub {
        my ($bd, $tbd);
        foreach my $b (0 .. (2*$nvertex-1)) {
            if (defined($blossomparent[$b]) && $blossomparent[$b] == -1 &&
                $label[$b] == 1) {
                foreach my $v (blossomleaves($b)) {
                    foreach my $p (@{$neighbend[$v]}) {
                        my $w = $endpoint[$p];
                        if ($inblossom[$w] != $b && $label[$inblossom[$w]] == 1) {
                            my $d = slack($p>>1);
                            $bd = $d if (!defined($bd) || $d < $bd);
                        }
                    }
                }
                if ($bestedge[$b] != -1) {
                    my $w = $endpoint[$bestedge[$b]];
                    my $v = $endpoint[$bestedge[$b]^1];
                    assert($inblossom[$v] == $b);
                    assert($inblossom[$w] != $b);
                    assert($label[$inblossom[$w]] == 1 && $label[$inblossom[$v]] == 1);
                    my $d = slack($bestedge[$b]>>1);
                    $tbd = $d if (!defined($tbd) || $d < $tbd);
                }
            }
        }
        assert((!defined($bd) && !defined($tbd)) || ($bd == $tbd));
    };

lib/Graph/Matching.pm  view on Meta::CPAN

            while (@queue && !$augmented) {

                # Take an S vertex from the queue.
                my $v = pop(@queue);
                DBG("POP v=$v") if ($DBG);
                assert($label[$inblossom[$v]] == 1);

                # Scan its neighbours:
                foreach my $p (@{$neighbend[$v]}) {
                    # w is a neighbour to v
                    my $w = $endpoint[$p];
                    # ignore blossom-internal edges
                    next if ($inblossom[$v] == $inblossom[$w]);
                    # check whether edge has zero slack
                    my $kslack;
                    if (!$allowedge[$p>>1]) {
                        $kslack = slack($p>>1);
                        $allowedge[$p>>1] = ($kslack == 0);
                    }
                    if ($allowedge[$p>>1]) {
                        if ($label[$inblossom[$w]] == 0) {

lib/Graph/Matching.pm  view on Meta::CPAN

            }

            # Take action at the point where minimum delta occurred.
            DBG("delta$deltatype=$delta") if ($DBG);
            if ($deltatype == 1) { 
                # No further improvement possible; optimum reached.
                last;
            } elsif ($deltatype == 2) {
                # Use the least-slack edge to continue the search.
                $allowedge[$deltaedge>>1] = 1;
                my $v = $endpoint[$deltaedge];
                assert($label[$inblossom[$v]] == 1);
                push @queue, $v;
            } elsif ($deltatype == 3) {
                # Use the least-slack edge to continue the search.
                $allowedge[$deltaedge>>1] = 1;
                my $v = $endpoint[$deltaedge];
                assert($label[$inblossom[$v]] == 1);
                DBG("PUSH $v") if ($DBG);
                push @queue, $v;
            } elsif ($deltatype == 4) {
                # Expand the least-z blossom.
                expandblossom($deltablossom, 0);
            }

            # End of a this substage.
        }

lib/Graph/Matching.pm  view on Meta::CPAN


    }

    # Verify that we reached the optimum solution.
    verifyoptimum() if ($CHECK_OPTIMUM && $all_integer_weights);

    # Return %ret such that $ret[$v] is the vertex to which $v is paired.
    my %ret;
    for (my $v = 0; $v < $nvertex; $v++) {
        if ($mate[$v] != -1) {
            assert($endpoint[$mate[$endpoint[$mate[$v]]]] == $v);
            $ret{$nodelist[$v]} = $nodelist[$endpoint[$mate[$v]]];
        }
    }

    undef @nodelist;
    undef %nodemap;
    undef @endpoint;
    undef @neighbend;
    undef @mate;
    undef @label;
    undef @labelend;
    undef @inblossom;
    undef @blossomparent;
    undef @blossomchilds;
    undef @blossombase;
    undef @blossomendps;



( run in 0.657 second using v1.01-cache-2.11-cpan-2b1a40005be )