I want to make a hash like :
$tree{$k1}->{$k2}-> ... {$kn} = 1;
I do not know how many $kj might are , or if they are defined , so I can not
have a fixed statement as the above.
For example if
$k1 = 'aa';
$k2 = undef;
$k3 = 'bb';
then hash should be
$tree{$k1}->{$k3}= 1;
Is there any "for" loop to codeit ?
On May 17, 7:22 am, "George"
> I want to make a hash like :
> $tree{$k1}->{$k2}-> ... {$kn} = 1;
> I do not know how many $kj might are , or if they are defined , so I can not
> have a fixed statement as the above.
>
> For example if
> $k1 = 'aa';
> $k2 = undef;
> $k3 = 'bb';
Any time you find yourself creating scalar variables named by
incrementing integers, that should be a giant red flag to you that you
need to stop and change your code so that it uses an array of values
instead.
> then hash should be
> $tree{$k1}->{$k3}= 1;
>
> Is there any "for" loop to codeit ?
Once you've made that change, this becomes possible:
$ perl -MData::Dumper -wle'
my @k = ("aa", undef, "bb");
my %team;
my $ref = \%team;
my $i = 0;
for my $level (@k) {
if (defined $level) {
if (++$i == $#k) {
$ref->{$level} = 1;
} else {
$ref->{$level} = {};
$ref = $ref->{$level};
}
}
}
print Dumper(\%team);
'
$VAR1 = {
'aa' => {
'bb' => 1
}
};
Note that you might have a slight problem if the last element of the
@k array is undefined. I leave the fix to that as an excercise to the
reader. :-)
Paul Lalli
On May 18, 7:03 am, Paul Lalli
> On May 17, 7:22 am, "George"
>
> > I want to make a hash like :
> > $tree{$k1}->{$k2}-> ... {$kn} = 1;
> > I do not know how many $kj might are , or if they are defined , so I can not
> > have a fixed statement as the above.
>
> > For example if
> > $k1 = 'aa';
> > $k2 = undef;
> > $k3 = 'bb';
>
> Any time you find yourself creating scalar variables named by
> incrementing integers, that should be a giant red flag to you that you
> need to stop and change your code so that it uses an array of values
> instead.
>
> > then hash should be
> > $tree{$k1}->{$k3}= 1;
>
> > Is there any "for" loop to codeit ?
>
> Once you've made that change, this becomes possible:
>
> $ perl -MData::Dumper -wle'
> my @k = ("aa", undef, "bb");
> my %team;
> my $ref = \%team;
> my $i = 0;
> for my $level (@k) {
> if (defined $level) {
> if (++$i == $#k) {
> $ref->{$level} = 1;
> } else {
> $ref->{$level} = {};
> $ref = $ref->{$level};
> }
> }}
>
> print Dumper(\%team);
> '
Whoops. Two bugs worked together to produce the correct results for
this specific test case. That code should actually be:
my @k = ("aa", undef, "bb");
my %team;
my $ref = \%team;
my $i = 0;
for my $level (@k) {
$i++;
if (defined $level) {
if ($i == $#k) {
$ref->{$level} = 1;
} else {
$ref->{$level} = {};
$ref = $ref->{$level};
}
}
}
Dear Paul Lalli,
Your idea , of
$ref->{$level} = {};
$ref = $ref->{$level};
was excellent , actually this is the key to the correct solution I
could not think. In order to make your code work with
final undef values , I change it to (and this is what I will use)
my @k = (undef,"aa", undef,"bb",undef);
my %team;
my $ref = \%team;
for (my $i=$#k;$i>=0;$i--)
{
defined $k[$i] || next;
for my $v (@k[0..$i-1])
{
$ref=$ref->{$v}={} if defined $v
}
$ref->{$k[$i]}=1;
last
}
print Dumper(\%team);
For the history before your reply I was endup up to
the following (of course I will not use it because of
the slow "eval" )
my $team;
my $Ev = '$team';
for my $v (@k){
$Ev.="->{\"$v\"}" if defined $v}
eval $Ev."=1;";
print Dumper($team);
George Bouras
Athens.
Oh , I forgot to say thank you very much !
>>>>> "G" == George
G> Dear Paul Lalli,
G> Your idea , of
G> $ref->{$level} = {};
G> $ref = $ref->{$level};
G> was excellent , actually this is the key to the correct solution I
G> could not think. In order to make your code work with
G> final undef values , I change it to (and this is what I will use)
check out my paper on autovivification
http://sysarch.com/Perl/autoviv.txt
G> my @k = (undef,"aa", undef,"bb",undef);
G> my %team;
G> my $ref = \%team;
G> for (my $i=$#k;$i>=0;$i--)
G> {
G> defined $k[$i] || next;
G> for my $v (@k[0..$i-1])
G> {
G> $ref=$ref->{$v}={} if defined $v
G> }
G> $ref->{$k[$i]}=1;
G> last
G> }
G> print Dumper(\%team);
look for the sub deep_hash_assign which does what you want. it is also
safer that your code (and paul's) as it checks each level to see if it
is a hash.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
It seems that the situation is deeper than what i thought at first sight.
All these examples work for one row of data, but only one piece
of code works for multiple key paths , the silliest one , with the evals ...
use Data::Dumper;
my @path=(
[undef,"a", undef,"b",undef],
[undef,"a", undef,"c",undef,"d"],
[undef,"A", undef,"B",undef],
[undef,"A", undef,"C",undef,"D"],
);
#################################
# The one of Paul Lalli, misses valid paths
#################################
my %team;
for ( @path )
{
my @k = @{$_};
my $ref = \%team;
for (my $i=$#k;$i>=0;$i--)
{
defined $k[$i] || next;
for my $v (@k[0..$i-1])
{
$ref=$ref->{$v}={} if defined $v
}
$ref->{$k[$i]}=1;
last
}
}
print Dumper(\%team);
#################################
# The one of Uri Guttman also miss keys
#################################
my $deep_ref2 = undef ;
for ( @path )
{
my @k = @{$_};
deep_hash_assign( \$deep_ref2, 1, @k ) ;
}
print Dumper $deep_ref2 ;
sub deep_hash_assign
{
my ($ref_ref,$val,@keys) = @_[0,1];
push(@keys,$_) for grep defined $_, @_[2..$#_];
return unless @keys;
foreach my $key (@keys)
{
my $ref = ${$ref_ref};
# this is the autoviv step
unless ( defined $ref )
{
$ref = { $key => undef };
${$ref_ref} = $ref;
}
# this checks we have a valid hash ref as a current value
unless ( ref $ref eq 'HASH' and exists( $ref->{ $key } ) )
{
warn "deep_hash_assign: not a hash ref at $key in @keys";
return
}
# this points to the next level down the hash tree
$ref_ref = \$ref->{$key}
}
${$ref_ref} = $val
}
#################################
# (unfortunately) only this works for multiple key paths
#################################
my $team;
for ( @path ) {
my @k = @{$_};
my $Ev = '$team';
for my $v (@k) {
$Ev.="->{\"$v\"}" if defined $v}
eval $Ev."=1;"}
print Dumper($team);
>>>>> "G" == George
G> #################################
G> # The one of Uri Guttman also miss keys
G> #################################
can you expand on that? it doesn't make any sense to me. show actual
input and output and why it is different than you expected. no need to
paste my code in there again.
G> my $deep_ref2 = undef ;
no need for the = undef. my scalars are always assigned undef by default.
G> for ( @path )
G> {
G> my @k = @{$_};
why the temp var? no need for it.
G> deep_hash_assign( \$deep_ref2, 1, @k ) ;
G> }
G> print Dumper $deep_ref2 ;
and where is the input/output? no way to tell if you have done the right
thing or what you expect the code to produce.
G> #################################
G> # (unfortunately) only this works for multiple key paths
G> #################################
what is a multiple key path? my code took multiple keys so what is
different? you haven't shown anything.
G> my $team;
G> for ( @path ) {
G> my @k = @{$_};
G> my $Ev = '$team';
G> for my $v (@k) {
G> $Ev.="->{\"$v\"}" if defined $v}
G> eval $Ev."=1;"}
G> print Dumper($team);
gack. that is so evil and wrong. and slow. and dangerous. if a key were
to have a close } and nasty code and then an open {, it would execute
the nasty code. this is why eval is a LAST resort and rarely actually
needed. do not use this if you care about code safety.
if you show why my sub didn't do what you wanted, i will show you how to
use it properly. it does assign deep hashes. you may not understand how
to use it correctly.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
the input is at the top of the previous reply
my @path=(
[undef,"a", undef,"b",undef],
[undef,"a", undef,"c",undef,"d"],
[undef,"A", undef,"B",undef],
[undef,"A", undef,"C",undef,"D"],
);
and the outpout is also there.
Well your code does not add the all the keys as it should ...
It is too much effort to run the 3 code blocks of
the previous reply.
$VAR1 = {
'A' => {
'C' => {
'D' => 1
},
'B' => 1
},
'a' => {
'c' => {
'd' => 1
},
'b' => 1
}
};
Only the eval can do it with the situation as far.
P.S. What I am doing with this (and almost
finished) is to built a virtual file system for my
users. Also users must be able to change its
hierarchy structure, on the fly. There is a
visualization also through a web gui.
This thing should run as fast is possible.
the input is at the top of the previous reply
my @path=(
[undef,"a", undef,"b",undef],
[undef,"a", undef,"c",undef,"d"],
[undef,"A", undef,"B",undef],
[undef,"A", undef,"C",undef,"D"],
);
and the outpout is also there.
Well your code does not add the all the keys as it should ...
It is too much effort to run the 3 code blocks of
the previous reply.
$VAR1 = {
'A' => {
'C' => {
'D' => 1
},
'B' => 1
},
'a' => {
'c' => {
'd' => 1
},
'b' => 1
}
};
Only the eval can do it with the situation as far.
P.S. What I am doing with this (and almost
finished) is to built a virtual file system for my
users. Also users must be able to change its
hierarchy structure, on the fly. There is a
visualization also through a web gui.
This thing should run as fast is possible.
the input is at the top of the previous reply
my @path=(
[undef,"a", undef,"b",undef],
[undef,"a", undef,"c",undef,"d"],
[undef,"A", undef,"B",undef],
[undef,"A", undef,"C",undef,"D"],
);
and the outpout is also there.
Well your code does not add the all the keys as it should ...
It is too much effort to run the 3 code blocks of
the previous reply.
$VAR1 = {
'A' => {
'C' => {
'D' => 1
},
'B' => 1
},
'a' => {
'c' => {
'd' => 1
},
'b' => 1
}
};
Only the eval can do it with the situation as far.
P.S. What I am doing with this (and almost
finished) is to built a virtual file system for my
users. Also users must be able to change its
hierarchy structure, on the fly. There is a
visualization also through a web gui.
This thing should run as fast is possible.
In article <1179753766.477243@athprx03>, George
wrote:
> It seems that the situation is deeper than what i thought at first sight.
> All these examples work for one row of data, but only one piece
> of code works for multiple key paths , the silliest one , with the evals ...
>
>
>
>
> use Data::Dumper;
>
> my @path=(
> [undef,"a", undef,"b",undef],
> [undef,"a", undef,"c",undef,"d"],
> [undef,"A", undef,"B",undef],
> [undef,"A", undef,"C",undef,"D"],
> );
[3 unsatisfactory candidate solutions snipped]
Try this one (I added a redundant path that causes problems if not
dealt with but may be unnecessary if your data does not contain such
entries):
#!/usr/local/bin/perl
use strict;
use warnings;
use Data::Dumper;
my @path=(
[undef, "a", undef, "b", undef],
[undef, "a", undef, "c", undef,"d"],
[undef, "A", undef, "B", undef],
[undef, "A", undef, "C", undef, "D"],
[undef, 'a', undef, 'b', undef, 'c'],
);
my %team;
for my $entry ( @path )
{
my($lastkey,$lastref);
my $ref = \%team;
for my $v ( @{$entry} ) {
next unless defined $v;
if( ref $ref eq 'HASH' ) {
if( ! exists $ref->{$v} ) {
$ref->{$v} = {};
}
}else{
$lastref->{$lastkey} = $ref = {};
}
$lastref = $ref;
$lastkey = $v;
$ref = $ref->{$v};
}
$lastref->{$lastkey} = 1;
}
print Dumper(\%team);
.... which gives ...
$VAR1 = {
'A' => {
'C' => {
'D' => 1
},
'B' => 1
},
'a' => {
'c' => {
'd' => 1
},
'b' => {
'c' => 1
}
}
};
--
Jim Gibson
Posted Via Usenet.com Premium Usenet Newsgroup Services
----------------------------------------------------------
** SPEED ** RETENTION ** COMPLETION ** ANONYMITY **
----------------------------------------------------------
http://www.usenet.com
Jim Gibson schreef:
> Try this one (I added a redundant path that causes problems if not
> dealt with but may be unnecessary if your data does not contain such
> entries):
>
>
> #!/usr/local/bin/perl
> use strict;
> use warnings;
> use Data::Dumper;
>
> my @path=(
> [undef, "a", undef, "b", undef],
> [undef, "a", undef, "c", undef,"d"],
> [undef, "A", undef, "B", undef],
> [undef, "A", undef, "C", undef, "D"],
> [undef, 'a', undef, 'b', undef, 'c'],
> );
>
> my %team;
> for my $entry ( @path )
> {
> my($lastkey,$lastref);
> my $ref = \%team;
> for my $v ( @{$entry} ) {
> next unless defined $v;
> if( ref $ref eq 'HASH' ) {
> if( ! exists $ref->{$v} ) {
> $ref->{$v} = {};
> }
> }else{
> $lastref->{$lastkey} = $ref = {};
> }
> $lastref = $ref;
> $lastkey = $v;
> $ref = $ref->{$v};
> }
> $lastref->{$lastkey} = 1;
> }
> print Dumper(\%team);
Variant:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my @paths = (
[undef,"a", undef,"b",undef],
[undef,"a", undef,"c",undef,"d"],
[undef,"A", undef,"B",undef],
[undef,"A", undef,"C",undef,"D"],
[undef,"a", undef,"b",undef,"c"],
);
my %team;
for my $entry (@paths) {
my ($ref, $lastref) = \%team;
for my $v (grep defined, @$entry) {
$lastref = $ref;
ref($ref->{$v}) or $ref->{$v} = {};
$ref = $ref->{$v};
}
$lastref->{(keys %$lastref)[0]} = 1;
}
print Dumper \%team;
--
Affijn, Ruud
"Gewoon is een tijger."
Thanks everyone for his replies, they were all valueble. Because the values
of course will not be 1 but "file names", I end up to the following code,
that does not ignore the values even if they are identicall.
George Bouras, Athens
use Data::Dumper;
my @path = (
[undef,"a", undef,"b",undef,"c"],
[undef,"a", undef,"b",undef],
[undef,"a", undef,"c",undef,"d"],
[undef,"A", undef,"B",undef],
[undef,"A", undef,"C",undef,"D"],
[undef,"A", undef,"C",undef,"D"],
[undef,"a", undef,"b",undef,"c"],
[undef,"A", undef,"B",undef],
[undef,"A"],
[undef,"A"],
[undef,"A", undef,"C",undef,"D"],
);
my $tree={};
foreach my $property (@path)
{
my $Ref=$tree;
for (my $i=$#{$property}; $i>=0; $i--)
{
next if ! defined $property->[$i];
for (my $j=0; $j<=$i-1; $j++)
{
next if ! defined $property->[$j];
$Ref->{$property->[$j]} = {} unless 'HASH' eq ref $Ref->{$property->[$j]};
$Ref = $Ref->{$property->[$j]};
}
push @{$Ref->{$property->[$i]}}, 1 unless 'HASH' eq ref
$Ref->{$property->[$i]};
last
}
}
print Dumper($tree);