CODEWITHSUNDEEP
perlrecursion
VSe
VSe

Reputation: 929

Recursive function in perl

I have a file like

abc->bcd, efg, hij
bcd->ijk, lmn, ipl
efg->kfg, iop, nkl
lmn->opq, stv, imn

the nested output should be created from this like

abc
 bcd
  ijk
  lmn
    opq
    stv
    imn
    ipl
 efg
   kfg
   iop
   nkl
 hij

I am not very sure how to handle this in perl with recursive function to find any level of nesting. Anyone's help much appreciated.

I have tried with following code, but it gives only one level

my $k = 0;
while ($k <=$#array1)
{
 if ($array1[$k]=~m/(.[^->]*)->(.[^\n]*)/)
 {
   $val = $1;
   $val1 = $2;
   push @check, $val;
   print $val;
   my @array2=split /,/,$val1;
   foreach my $newid (@array2)
    {
    push @check1, $newid;
    print $newid, "\n";
    }
 }
 $k++;

}

Upvotes: 0

Views: 282

Answers (2)

Borodin
Borodin

Reputation: 126752

It's another directed graph! They seem popular recently

You need the Graph module, which will allow you to build a tree of edges and vertices (nodes and connections) and then traverse it to obtain your printout

This program does exactly that with your sample data. Once the graph is built, I test whether it's cyclic to avoid an endless loop and then call my recursive subroutine print_vertex for all source vertices

A source vertex is one that has successors but no predecessors (children but no parent). So it's a root of the tree. I've used a for loop in case the data has more than one root, but your data has only one such vertex: abc

use strict;
use warnings 'all';
use feature 'say';

use Graph;

my $g = Graph->new(directed => 1);

while ( <DATA> ) {
    my ($from, @to) = /[^\s>,-]+/g;
    $g->add_edge($from, $_) for @to;
}

if ( my @cycle = $g->find_a_cycle ) {
    die sprintf "Graph contains a cycle: %s\n", join(' >> ', @cycle, $cycle[0]);
}

print_vertex($_) for $g->source_vertices;


sub print_vertex {
    my ($v, $indent) = (@_, 0);
    printf "%s%s\n", '  ' x $indent, $v;
    print_vertex($_, $indent+1) for $g->successors($v);
}


__DATA__
abc->bcd, efg, hij
bcd->ijk, lmn, ipl
efg->kfg, iop, nkl
lmn->opq, stv, imn

output

abc
  efg
    iop
    kfg
    nkl
  bcd
    lmn
      stv
      opq
      imn
    ijk
    ipl
  hij

Upvotes: 4

cdlane
cdlane

Reputation: 41905

... when I try this, the order has changed in the output...can you help me on how to retain the orders?

Recursive solution in pure Perl sans module:

use strict;
use warnings;

my %children;
my $patriarch;

while (<DATA>) {
    chomp;
    my ($parent, @children) = split /[->, ]+/;
    $children{$parent} = \@children;
    $patriarch = $parent unless defined $patriarch;
}

sub print_family {
    my ($parent, $indentation) = (@_, '');

    print($indentation, $parent, "\n");

    if (exists($children{$parent})) {
        foreach my $child (@{$children{$parent}}) {
            &print_family($child, $indentation . "\t");
        }
    }
}

&print_family($patriarch)

__DATA__
abc->bcd, efg, hij
bcd->ijk, lmn, ipl
efg->kfg, iop, nkl
lmn->opq, stv, imn

Produces:

abc
    bcd
        ijk
        lmn
            opq
            stv
            imn
        ipl
    efg
        kfg
        iop
        nkl
    hij

Upvotes: 1

Related Questions