concatenating hierarchical paths from the root

user_6867048 0
Viewed 109

I have an address file that is like below

$ cat hier.dat
/City-A/Streetx/House1,100
/City-B/Streety/House2,200
$

I need to generate more lines by expanding the hierarchy from the beginning. The required output is

/City-A,100
/City-A/Streetx,100
/City-A/Streetx/House1,100
/City-B,200
/City-B/Streety,200
/City-B/Streety/House2,200

The below perl command looks logically correct but it is not giving the correct results

$ perl -F, -lane ' $s="";  while($F[0]=~/\G\/.+?\//g) {$s.=$&; print $s.",".$F[1] } ' hier.dat
/City-A/,100
/City-B/,200

Any other shell solution is also welcome!

perl
3 Answers

EDIT: By using regex with awk, could you please try following.

awk '
BEGIN{
  FS=OFS=","
}
{
  val=""
  while(match($1,/^\/[^/]*/)){
    val=(val?val:"")substr($0,RSTART,RLENGTH)
    print val,$NF
    $0=substr($0,RSTART+RLENGTH)
  }
}
'  Input_file

In case you are ok with awk, could you please try following, written and tested with shown samples in GNU awk.

awk '
BEGIN{
  FS="[/,]"
  OFS="/"
}
{
  val=""
  for(i=2;i<NF;i++){
    val=(val?val:"")OFS $i
    print val","$NF
  }
}'  Input_file

Explanation: Adding detailed explanation for above.

awk '                       ##Starting awk program from here.
BEGIN{                      ##Starting BEGIN section of this program from here.
  FS="[/,]"                 ##Setting field separator as / OR , here.
  OFS="/"                   ##Setting output field separator as / here.
}
{
  val=""                    ##Nullifying val here.
  for(i=2;i<NF;i++){        ##Going through fields of current line from 2nd field to 2nd last field.
    val=(val?val:"")OFS $i  ##Creating val with current field value and keep concatenating it in its own value.
    print val","$NF         ##Printing val comma and last field here.
  }
}
' Input_file                ##Mentioning Input_file name here.

Output for shown sample will be as follows.

/City-A,100
/City-A/Streetx,100
/City-A/Streetx/House1,100
/City-B,200
/City-B/Streety,200
/City-B/Streety/House2,200
user_58665800

If you're not picky about the order, a single solution is to keep removing from the end until you can't.

do { print join ",", @F } while $F[0] =~ s{^.+\K/[^/]*\z}{}

$ perl -F, -lane'do { print join ",", @F } while $F[0] =~ s{^.+\K/[^/]*\z}{}' hier.dat
/City-A/Streetx/House1,100
/City-A/Streetx,100
/City-A,100
/City-B/Streety/House2,200
/City-B/Streety,200
/City-B,200

Of course, that's easy to correct.

do { push @a, join ",", @F } while $F[0] =~ s{^.+\K/[^/]*\z}{};
print for reverse splice @a

$ perl -F, -lane'
   do { push @a, join ",", @F } while $F[0] =~ s{^.+\K/[^/]*\z}{};
   print for reverse splice @a
' hier.dat
/City-A,100
/City-A/Streetx,100
/City-A/Streetx/House1,100
/City-B,200
/City-B/Streety,200
/City-B/Streety/House2,200

"Fun" alternative:

$F[0] =~ m{
   ^ (?: /[^/]++ )+?
   (?{ print join ",", $&, $F[1] })
   (*FAIL)
}x

$ perl -F, -lane'$,=",";$F[0]=~m{^(/[^/]++)+?(?{print$&,$F[1]})(?!)}' hier.dat
/City-A,100
/City-A/Streetx,100
/City-A/Streetx/House1,100
/City-B,200
/City-B/Streety,200
/City-B/Streety/House2,200
user_5899240

Works for your small set of input tests:

perl -ne'@a=($_);unshift@a,$_ while s|(.+)/.*,|$1,|;print@a' /tmp/test.data

Or:

perl -ne'@a=($_);unshift@a,$_ while s|(.+)/.*,|$1,|;print@a' <<.
/City-A/Streetx/House1,100
/City-B/Streety/House2,200
.

Result:

/City-A,100
/City-A/Streetx,100
/City-A/Streetx/House1,100
/City-B,200
/City-B/Streety,200
/City-B/Streety/House2,200
user_8499670
Related