view release on metacpan or  search on metacpan

t/03rand.t  view on Meta::CPAN

  # workaround for bug in Graph::Directed
  $g->delete_vertex( 0 );

  return Graph::Feather->new(
    vertices => [ $g->vertices ],
    edges => [ $g->edges ],
  )
}

sub random_path_between {
  my ($g, $start, $final, $max_length) = @_;

  my $dbh = $g->{dbh};

  return unless grep {
    $_ eq $final
  } $start, $g->all_successors($start);

  $max_length //= 1_000;

  my $sth = $dbh->prepare(q{
    WITH RECURSIVE random_path(pos, vertex) AS (
      SELECT 0 AS pos, ? AS vertex
      UNION ALL
      SELECT
        random_path.pos + 1 AS pos,
        (SELECT Edge.dst
        FROM Edge
        WHERE Edge.src = random_path.vertex

t/03rand.t  view on Meta::CPAN

      WHERE next IS NOT NULL
    )
    SELECT vertex
    FROM random_path
    LIMIT ?
  });

  while (1) {

    my @path = map { @$_ } $dbh->selectall_array($sth,
      {}, $start, $max_length);

    my @endpoints = indexes { $_ eq $final } @path;
    my $last_elem = random_element( @endpoints );

    next unless defined $last_elem;

    splice @path, $last_elem + 1;

    return @path;
  }
}

sub random_dfa_path {
  my ($dfa, $start_id, $max_length, @accepting) = @_;

  my $dbh = $dfa->_dbh;

#  return unless grep {
#    $_ eq $final
#  } $start, $g->all_successors($start);

  $max_length //= 1_000;

  my $sth = $dbh->prepare(q{
    WITH RECURSIVE random_dfa_path(pos, state) AS (
      SELECT 0 AS pos, ? AS state
      UNION ALL
      SELECT
        random_dfa_path.pos + 1 AS pos,
        (SELECT Transition.dst
        FROM Transition
        WHERE Transition.src = random_dfa_path.state

t/03rand.t  view on Meta::CPAN

    SELECT state
    FROM random_dfa_path
    LIMIT ?
  });

  my %accepting = map { $_ => 1 } @accepting;

  while (1) {

    my @path = map { @$_ } $dbh->selectall_array($sth,
      {}, $start_id, $max_length);

    my @endpoints = indexes { %accepting{$_} } @path;
    my $last_elem = random_element( @endpoints );

    next unless defined $last_elem;

    splice @path, $last_elem + 1;

    return @path;
  }