Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Checking whether two variables have the same structure

by Corion (Pope)
on Apr 09, 2002 at 15:55 UTC ( #157755=perlquestion: print w/ replies, xml ) Need Help??
Corion has asked for the wisdom of the Perl Monks concerning the following question:

Yesterday in the Chatterbox, Ovid asked for a quick solution to see if two references $r1 and $r2 pointed to the same kind of structure, that is, to a HoH or AoH or whatever. My first hack at a solution was to suggest to useData::Dumper and to throw away all actual data, if the remaining strings were equal, then $r1 and $r2 surely pointed to the same kind of structure.

This solution has many fallacies, as both $r1 and $r2 might point to arrays of different size, but the kind of structure would still be considered the same by me.

The second solution I suggested was to compute the "signature" for each structure, that is, to compute a string that described the structure. For example, a reference to an array which contains scalars would have the signature rAoS, and an array which contains references to hashes would have the signature AoH. This kind of signature only makes sense when all elements of a container (be it a hash or an array) are of the same type, but if they aren't, there is not much sense in talking of "structure" anyway.

After having computed this signature, it's just a matter of comparing the two signatures as strings to see whether the structures have the same kind.

If you have interesting points to make or an alternative approach that handles classes and code or is more robust/more elegant, I invite you to share !

#!/usr/bin/perl -w use strict; # Create a descriptive string of what a structure actually is. # This works for structures described by the RE ([AH]o)*[S], # where A means array, H means hash and S means scalar # (and everything ends with a scalar obviously, or a class # or a code reference - a case I don't cover). my %letter = ( ARRAY => "A", HASH => "H", SCALAR => "S", REF => "r", ); sub describe { my ($struct) = @_; my $element; my $result; if (ref $struct) { #print "Got",ref $struct; if (defined $letter{ref $struct}) { # Yehaaw, we know it : $result = $letter{ref $struct}; if (ref $struct eq "REF") { $result = $result . describe( $$struct ); }elsif (ref $struct eq "ARRAY") { if (@$struct) { $element = describe($$struct[0]); foreach (@$struct) { if (describe($_) ne $element) { $element = "[]"; last; }; }; } else { $element = "?"; }; $result .= "o$element"; } elsif (ref $struct eq "HASH") { my @keys = keys (%$struct); if (@keys) { $element = describe($struct->{$keys[0]}); foreach (@keys) { if (describe($struct->{$_}) ne $element) { $element = "{}"; last; }; }; } else { element = "?"; }; $result .= "o$element"; } elsif (ref $struct eq "SCALAR") { $result = "oS"; }; } else { $result = "?"; }; } else { $result = "S"; }; return $result; }; my $foo = "bar"; my $bar = [qw(foo bar baz)]; my $baz = {foo => "bar", baz => "quux"}; my $x = [ {foo => "bar", baz => "quux"}, {foo => "bar", baz => "quux"}, {foo => "bar", baz => "quux"}, ]; my $y = { foo => ["bar","quux"], baz => ["quux","bar"], }; print q("foo" -> ),describe("foo"),"\n"; print q(\\$foo -> ),describe(\$foo),"\n"; print q($bar -> ),describe($bar),"\n"; print q(\\$bar -> ),describe(\$bar),"\n"; print q($baz -> ),describe($baz),"\n"; print q(\\$baz -> ),describe(\$baz),"\n"; print q($x -> ),describe($x),"\n"; print q(\\$x -> ),describe(\$x),"\n"; print q($y -> ),describe($y),"\n"; print q(\\$y -> ),describe(\$y),"\n";
perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ; # The $d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider ($c = $d->accept())->get_request(); $c->send_response( new #in the HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' # web

Comment on Checking whether two variables have the same structure
Select or Download Code
Re: Checking whether two variables have the same structure
by broquaint (Abbot) on Apr 09, 2002 at 16:43 UTC
    Here's a rather more simple (but no less lengthy ;-) attempt at creating a data structure signature.
    package Data::AsString; require Carp; use strict; use warnings; use overload q("") => sub { shift->as_string() }; sub new { my $class = shift; my $self = {}; $self->{struct} = shift; $self->{info} = { depth => 0 }; return bless $self, $class; } sub as_string { my $self = shift; $self->{'ref'} = $self->_traverse($self->{struct}); $self->{string} = $self->_collapse_info(); return $self->{string}; } sub _traverse { my $self = shift; my $ds = shift; my @values = (); if(ref($ds) eq 'HASH') { @values = values %$ds; } elsif(ref($ds) eq 'ARRAY') { @values = @$ds; } else { Carp::croak("can't iterate through a ".ref($ds)); } foreach my $el (@values) { if(ref($el) eq 'HASH' or ref($el) eq 'ARRAY') { my $key = "#".$self->{info}->{depth}; push @{$self->{info}->{$key}}, ref($el); $self->{info}->{depth}++; push @{$self->{info}->{$key}}, $self->_traverse($el); $self->{info}->{depth}--; } } return ref $ds; } sub _collapse_info { my $self = shift; my $str = substr($self->{'ref'}, 0, 1); for my $lvl (sort grep /^#\d+/, keys %{$self->{info}}) { my %uniq = (); $uniq{$_}++ for @{$self->{info}->{$lvl}}; my @type = keys %uniq; if(@type > 1) { Carp::carp("data is not homogeneous at depth $lvl"); $str .= '['.join("o", map { substr($_, 0, 1) } @type).']'; } else { $str .= 'o' . substr($type[0], 0, 1); } } return $str; } qq(and I'm spent); package main; use Data::AsString; my $data = { foo => { one => [qw(x y z)] }, bar => { two => [qw(a b c)] } }; my $sig = Data::AsString->new($data); print "signature of \$data is $sig\n";

    HTH

    broquaint

Re: Checking whether two variables have the same structure
by derby (Abbot) on Apr 09, 2002 at 18:23 UTC
    ++ to Corion and broquaint but just TMTOWTDI mode Inline::C:

    #!/usr/bin/perl use Inline C; use strict; my $foo = "bar"; my $bar = [qw(foo bar baz)]; my $baz = {foo => "bar", baz => "quux"}; my $x = [ {foo => "bar", baz => "quux"}, {foo => "bar", baz => "quux"}, {foo => "bar", baz => "quux"}, ]; my $y = { foo => ["bar","quux"], baz => ["quux","bar"], }; print q("foo" -> ), describe("foo"), "\n"; print q(\\$foo -> ), describe(\$foo), "\n"; print q($bar -> ), describe($bar), "\n"; print q(\\$bar -> ), describe(\$bar), "\n"; print q($baz -> ), describe($baz), "\n"; print q(\\$baz -> ), describe(\$baz), "\n"; print q($x -> ), describe($x), "\n"; print q(\\$x -> ), describe(\$x), "\n"; print q($y -> ), describe($y), "\n"; print q(\\$y -> ), describe(\$y), "\n"; __END__ __C__ SV* describe( SV *var ) { SV *tmp; if( ! SvROK( var ) ) { return( newSVpvf( "%s", "S" ) ); } else { switch( SvTYPE( SvRV(var) ) ) { case SVt_PVAV: tmp = describe( av_pop( (AV *)SvRV(var) ) ); return( newSVpvf( "Ao%s", SvPV( tmp, PL_na ) ) ); case SVt_PVHV: tmp = describe( hv_iterval( (HV *)SvRV(var), hv_iternext( (HV *)SvRV(var) ) ) ); return( newSVpvf( "Ho%s", SvPV( tmp, PL_na ) ) ); case SVt_PVCV: return( newSVpvf( "%s", "C" ) ); case SVt_PVGV: return( newSVpvf( "%s", "G" ) ); case SVt_PVMG: return( newSVpvf( "%s", "B" ) ); case SVt_RV: tmp = describe( SvRV(var) ); return( newSVpvf( "r%s", SvPV( tmp, PL_na ) ) ); case SVt_IV: case SVt_NV: case SVt_PV: return( newSVpvf( "%s", "oS" ) ); default: return( newSVpvf( "?" ) ); } } }

    -derby

Re: Checking whether two variables have the same structure
by George_Sherston (Vicar) on Apr 09, 2002 at 19:18 UTC
    Data Dumper is *everyone's* friend (though you'd want to make sure that the default output for your version is the same as for mine):
    use Data::Dumper; sub tell_structure { (my $string = Dumper(shift)) =~ s/\$VAR1 = //; my %regexes = ( qr/^\[\s*/ => 'array', qr/^\{\s*'\w*' => / => 'hash', qr/^'\w*',*\n/ => 'value', ); my @result; my $regex = join "|", keys %regexes; OUTER: while ($string =~ /$regex/) { for my $regex (keys %regexes) { if ($string =~ s/$regex//s) { last OUTER if $regexes{$regex} eq 'value'; push @result, $regexes{$regex}; last; } } } return @result; }
    Then you can compare the contents of two returned arrays to determine whether the structures referenced are the same. Or you cd use this to tell you what you've got:
    sub print_results { if (@_ == 0) { print "This data structure is a scalar"; } else { if ($_[0] eq 'array') { print "This data structure is an array"; } else { print "This data structure is a hash"; } shift; for (@_) { if ($_ eq 'hash') { print ' of hashes'; } elsif ($_ eq 'array') { print ' of arrays'; } } } print "!\n"; }


    George Sherston
Re: Checking whether two variables have the same structure
by elusion (Curate) on Apr 09, 2002 at 19:20 UTC
    Here is my solution. Although not as in depth, I think it's quite simpler. Expanding it wouldn't be too hard. Right now it only checks for arrays and hashes.
    #!/usr/bin/perl use strict; my $ref1 = [ { key => [ [ "foo" ] ] } ]; my $ref2 = [ [ { key => [ "bar" ] } ] ]; my $ref3 = [ { key => [ [ "baz" ] ] } ]; sub type { my $obj = shift; my $type; START: if (ref($obj) eq "HASH") { $type .= "oH"; $obj = [values(%$obj)]->[0]; goto START; } elsif (ref($obj) eq "ARRAY") { $type .= "oA"; $obj = $obj->[0]; goto START; } $type =~ s/^o//; return $type; } sub compare { my $obj1 = shift; my $obj2 = shift; my $type1 = type($obj1); my $type2 = type($obj2); return $type1 eq $type2 ? 1 : 0; } print type($ref1); # Returns AoHoAoA print compare($ref1, $ref2); # Returns 0 print compare($ref1, $ref3); # Returns 1

    elusion : http://matt.diephouse.com

Re: Checking whether two variables have the same structure
by hossman (Prior) on Apr 10, 2002 at 07:30 UTC
    1. For some reason, using your code I get...
         ...
         \$foo -> oS
         ...
      
      which doesn't seem quite right.

    2. I gotta side with George_Sherston on this one, It's all about Data::Dumper. Here's what I can up with for generating the grammer described (I think it can handle any case the orriginal post did)...
      sub my_describe { my $s = Dumper(@_); $s =~ s/\'[^\']*\'//g; # eliminate scalars $s =~ s/[^\[\{\'\\]//g; # cut to the heart of the structure # + because we only care about one member of hashes/arrays $s =~ s/\[+/Ao/g; $s =~ s/\{+/Ho/g; $s =~ s/\\+/r/g; return $s . "S"; }
    UPDATE: I just realized this can't handle something really basic: \\\\\\$foo. Oh well, that's why version numbers were invented

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://157755]
Approved by Zaxo
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (4)
As of 2014-07-25 23:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (175 votes), past polls