Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Dualvar via table

by Dirk80 (Pilgrim)
on Jan 17, 2020 at 17:21 UTC ( #11111535=perlquestion: print w/replies, xml ) Need Help??

Dirk80 has asked for the wisdom of the Perl Monks concerning the following question:

I often have the case when reading a binary value from a file that it also has a textual representation. So I can use the dualvar functionality of Scalar::Util to solve this issue.

But that's not enough for me. Usually I have a corresponding table which contains the valid values and its representations. To avoid doing the same checks so often in code, I decided to tie the read scalar variable to a package which is doing these checks for me. Additionally on a change it shall always update the numeric and string context.

Here an example:

#!/usr/bin/perl use strict; use warnings; use My::DualVar; my %table = ( 1 => 'NORTH', 2 => 'SOUTH', 3 => 'EAST', 4 => 'WEST' ); # Case 1: Table num -> str print "Case 1: Dualvar via num2str table\n\n"; { my $direction = 2; My::DualVar->tie($direction, \%table); print_dualvar($direction); $direction = 4; print_dualvar($direction); $direction = 'NORTH'; print_dualvar($direction); } # Case 2: Table str -> num print "Case 2: Dualvar via str2num table\n\n"; { my $direction = 'SOUTH'; My::DualVar->tie($direction, reverse %table); print_dualvar($direction); $direction = 4; print_dualvar($direction); $direction = 'NORTH'; print_dualvar($direction); } sub print_dualvar { print "as num: " . ($_[0]+0) . "\n"; print "as str: $_[0]\n"; print "\n"; }

And here my written package:

package My::DualVar; use strict; use warnings; use Carp; use Scalar::Util qw( dualvar looks_like_number ); sub tie { # tie <class>, <scalar>, <arg1: scalar>, <arg2: table (hash or ref +hash)> tie $_[1], $_[0], $_[1], @_[2 .. $#_]; } sub TIESCALAR { my $class = shift; my $val = shift; croak "Given value is not defined" unless defined $val; my %table = @_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; croak "Given table is empty" if keys %table == 0; die "Given value $val is not in table" unless exists $table{$val}; # TODO: reject given table if values are not unique # Is there an efficient way to do this? my %reverse_table = reverse %table; my $impl; if( looks_like_number($val) ) { # num table, i.e. key: num, value: str while (my ($num, $str) = each %table) { croak "Key $num of given table is not a number" unless loo +ks_like_number($num); croak "Value $str of given table is not a string" if ref($ +str); } $impl = bless { '_val' => dualvar($val, $table{$val}), '_num_t +able' => \%table, '_str_table' => \%reverse_table }, $class; } else { # str table, i.e. key: str, value: num for my $num (values %table) { croak "Value $num of given table is not a number" unless l +ooks_like_number($num); } $impl = bless { '_val' => dualvar($table{$val}, $val), '_num_t +able' => \%reverse_table, '_str_table' => \%table }, $class; } return $impl; } sub FETCH { my ($impl) = @_; return $impl->{'_val'}; } sub STORE { my ($impl, $val) = @_; if( looks_like_number($val) ) { die "Invalid value $val" unless exists $impl->{'_num_table'}-> +{$val}; $impl->{'_val'} = dualvar($val, $impl->{'_num_table'}->{$val}) +; } else { die "Invalid value $val" unless exists $impl->{'_str_table'}-> +{$val}; $impl->{'_val'} = dualvar($impl->{'_str_table'}->{$val}, $val) +; } } 1;

This code is working. But I would be interested in your opinion. What could I do better?

And the second thing. Currently my code would work randomly if the values of the given table (hash) are not unique. Is there an efficient way to check whether the values of a hash are unique? Then I would reject such a hash

Or would there be a solution to return several values if the hash is not unique, e.g. key 2 and 5 would have value 'SOUTH'?

In numeric context it would not work. If I would set a dualvar variable to 'SOUTH', then I would have to return 2 or 5 in the FETCH-method. Perhaps in numeric context the smaller value should be returned.

In string context I think it is possible. Because I could give back a concatenated string and I still would have a scalar.

Replies are listed 'Best First'.
Re: Dualvar via table
by davido (Cardinal) on Jan 17, 2020 at 18:21 UTC

    I almost typed 90% of what LanX responded with, and even had some example code that was in some ways similar to his. Glad I checked before posting. I may include it at the bottom just as another demonstration.

    Here is my concern, and it's similar also to LanX's: Conceptually the scalar container has a payload, and it has the ability to represent that payload according to the context provided by the operators that are acting upon it. The fact that this data polymorphism is implemented by encapsulating a PV (string pointer), NV (floating point pointer), IV (integer value), and a few other internal buckets into the scalar is how Perl manages to make this polymorphism computationally efficient at the expense of some memory. Using these buckets that house the representations of the data contained in a scalar variable as multiple entities is risky because it assumes that the subset of Perl you know will be acting on this scalar variable will not cause any clobbering or other attempts to bring the representations into consistency. But this is a subset of Perl. There is only a subset of scalars that will qualify for this treatment, depending on how they're created and used elsewhere in the script.

    Whomever works with this variable needs to assure that they don't use parts of Perl that might have a problem with the inconsistency, and also make sure to be using the parts of Perl that do follow the PV/IV/NV internals pattern. That second part means not using tie. The first part means all bets are off if the variable passes through a module that implements XS XSubs in a way that are oblivious and possibly incompatible with dualvars. You are also taking serialization risks: If someone decides to compose your variable into a part of a structure that gets converted to JSON, all bets are off whether it will be treated as a string or a number. Well, that's maybe a little too glib, but different JSON encoders follow subtly different rules.

    I'm also not a tremendous fan of overloading in most code, as I've seen what it can become in languages where it is more prolific. It still involves a form of spooky action at a distance. It works out fairly well for Math::BigInt, and a few other places, though. So I wouldn't disqualify it completely. But I would prefer creating an object that has explicit accessors for the data and for the text. Nevertheless, overloading is at least a language feature for Perl rather than an implementation detail, and comes with better guarantees and simpler rules. So it's possibly a reasonable solution for you.

    All that said, here's the code that I was going to use as an example before noticing that LanX beat me to it:


    Dave

Re: Dualvar via table
by roboticus (Chancellor) on Jan 17, 2020 at 18:16 UTC

    Dirk80:

    It appears (from my casual reading) that each tie would create a new copy of the table, so extensive use may cost more time and memory than needed. So you might want to have a function in My::DualVar that creates the table, and then you can tie the table to variables as necessary. I haven't played with tying variables (much or recently), so I'm sure my syntax is (likely to be) wrong, but what I'm thinking is something that would give you usage something like:

    my %directions = ( 1=>'NORTH', 2=>'SOUTH', 3=>'EAST', 4=>'WEST' ); my $table_fwd = My::DualVar->new(%directions); my $table_rev = My::DualVar->new(reverse %directions); tie $direction, \$table_fwd; my ($dir, $dir2) = (4, 1); tie $dir, \$table_fwd; tie $dir2, \$table_fwd; print_dualvar($dir); ++$dir2; print_dualvar($dir2); tie $dir2, \$table_rev; for $dir2 (qw(SOUTH WEST EAST)) { $dir = $dir2 + 0; print_dualvar($dir); }

    I've thought a little about using the dual nature of variables in some perl code, but haven't actually taken the plunge. (What I was thinking was along the lines of parsing a file, and keeping the original representation of a number in the string section so that if calculations are unexpected, I can see what string led to the fault. As a terrible example, suppose I was reading the number part of a street address into a variable (using a stupid technique):

    use strict; no warnings; # !!! my @addresses = ( "1141 Tennessee Avenue", "12E10th Street" ); for (@addresses) { my $house_number = $_+0; print "House# across the street is ", $house_number+1, "\n"; print "DEBUG: Original house number '$house_number'\n\n"; }

    Which prints:

    $ perl t.pl House# across the street is 1142 DEBUG: Original house number '1141' House# across the street is 120000000001 DEBUG: Original house number '120000000000'

    Where I would want to see:

    House# across the street is 1142 DEBUG: Original house number '1141 Tennessee Avenue' House# across the street is 120000000001 DEBUG: Original house number '12E10th Street'

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

      > I've thought a little about using the dual nature of variables in some perl code, but haven't actually taken the plunge

      I'm not sure if it's a good idea. Perl is adjusting the slots to each other depending on use history.

      Hence you'd magically loose information, and I'm not aware of a way to inhibit this.

      That's awfully hard to debug if it happens.

      (will add an example later)

      update
      Playing around, look at what happens at line 7

      DB<3> use Scalar::Util qw(dualvar); DB<4> $v = dualvar 137, 'Buster'; DB<5> p "$v" Buster DB<6> p 0+$v 137 DB<7> p $v++ # read string, increment number Buster DB<8> p $v++ # what...? 138 DB<9> p "$v" 139 DB<10>

      after incrementing $v, i.e. changing it in numeric context, the string-slot is adjusted to the number-slot°

      So can this only happen when I change one of the slots?

      If yes, shouldn't such dualvars always been made readonly, too?

      Hope you understand my worries.

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

      update

      °) or some flags are changed. Who knows....

      FWIW: a very good article from Brian here: https://www.effectiveperlprogramming.com/2011/12/create-your-own-dualvars/

        LanX:

        Yeah, it could be problematic. I haven't put any thought into its ramifications.

        ...roboticus

        When your only tool is a hammer, all problems look like your thumb.

Re: Dualvar via table
by AnomalousMonk (Bishop) on Jan 17, 2020 at 20:26 UTC

    I share the concerns of others about mixing too much Perl majick together: the result may blow up in your (or your maintainer's) face in very unexpected ways. But as to some tangential questions...

    Is there an efficient way to check whether the values of a hash are unique?
    c:\@Work\Perl\monks>perl -wMstrict -le "my %h = qw(a 1 b 2 c 3 d 1); ;; my %r = reverse %h; keys %r == keys %h or die qq{hash @{[ %h ]} not unique}; " hash c 3 a 1 b 2 d 1 not unique at -e line 1.
    ... a solution to return several values if the hash is not unique ...
    The general approach to maintaining several values for a hash key is an anonymous array. Maybe something like:
    c:\@Work\Perl\monks>perl -wMstrict -le "use Data::Dump qw(dd); ;; my %h = ( a => [ 1 ], b => [ 2, 99, 88 ], c => [ 3 ], d => [ 1, 99 ] ); ;; my %r; for my $hk (keys %h) { push @{ $r{$_} }, $hk for @{ $h{$hk} }; } dd \%r; " { 1 => ["a", "d"], 2 => ["b"], 3 => ["c"], 88 => ["b"], 99 => ["b", "d +"] }
    Update: Note that this inversion approach for multi-value hashes is not round-tripable unless you consider the arrays of values to be unordered lists:
    c:\@Work\Perl\monks>perl -wMstrict -le "use Test::More 'no_plan'; use Test::NoWarnings; ;; use Data::Dump qw(dd); ;; my %h = ( a => [ 1 ], b => [ 2, 99, 88 ], c => [ 3 ], d => [ 1, 99 ] ); ;; my %r = invert(%h); dd \%r; ;; my %rr = invert(%r); dd \%rr; ;; is_deeply \%rr, \%h, 'round trip'; ;; done_testing; ;; exit; ;; sub invert { my %h = @_; my %r; for my $hk (keys %h) { push @{ $r{$_} }, $hk for @{ $h{$hk} }; } return %r; } " { 1 => ["a", "d"], 2 => ["b"], 3 => ["c"], 88 => ["b"], 99 => ["b", "d +"] } { a => [1], b => [99, 88, 2], c => [3], d => [99, 1] } not ok 1 - round trip # Failed test 'round trip' # at -e line 1. # Structures begin differing at: # $got->{b}[0] = '99' # $expected->{b}[0] = '2' 1..1 ok 2 - no warnings 1..2 # Looks like you failed 1 test of 2.


    Give a man a fish:  <%-{-{-{-<

      Thank you all so much. I never used the tie-functionality before. So I thought this could be a thing to use it. The same applies for dualvar. But now I see that this could be dangerous and too much magic.

      So I was thinking a lot about all your answers. And now I took into account that the table is given only once (at compile time) to the class and not for each variable. I'm rejecting multi dimensionsal hashes. And I see that the tie functionality can be well replaced by the overload functionality via use overload '""' => \&str, '0+' => \&num, fallback => 1;.

      Here my new suggestion, which seems to work fine:

      Main program:

      #!/usr/bin/perl use strict; use warnings; use FindBin qw($Bin); use Cwd qw(abs_path); BEGIN{ unshift(@INC, abs_path("$Bin")) } my %table; BEGIN { %table = ( 1 => 'NORTH', 2 => 'SOUTH', 3 => 'EAST', 4 => 'WEST'); } use My::GenDualVar "Direction", %table; my $direction = Direction->new(2); $direction->set('WEST'); print $direction->num() . "\n"; print $direction->str() . "\n"; print $direction->hex() . "\n"; # should work if overloading is active #print $direction . "\n"; #print $direction+0 . "\n";

      Package My::GenDualVar:

      package My::GenDualVar; use strict; use warnings; use Carp; use Scalar::Util qw( looks_like_number ); no strict "refs"; sub import { croak "Parameters are missing. " . "Parameters have to be the name of the to be generated class a +nd " . "an unique one dimensional table (hash) with numbers as keys a +nd strings as values" unless @_ >= 3; my $class = shift; my $new_class = shift; my %num_table = @_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; croak "Given table is empty" if keys %num_table == 0; my %str_table = reverse %num_table; keys %str_table == keys %num_table or croak qq{Given table @{[ %nu +m_table ]} is not unique}; while (my ($num, $str) = each %num_table) { croak "Key $num of given table is not a number" unless looks_l +ike_number($num); croak "Value $str of given table is not a string" if ref($str) +; } eval qq{package $new_class;\n} . q{use overload '""' => \&str, '0+' => \&num, fallback => 1;}; My::GenDualVar->generate_new_for($new_class, \%num_table, \%str_ta +ble); My::GenDualVar->generate_set_for($new_class, \%num_table, \%str_ta +ble); My::GenDualVar->generate_num_for($new_class); My::GenDualVar->generate_str_for($new_class); My::GenDualVar->generate_hex_for($new_class); } sub generate_new_for { my ($class, $new_class, $ref_num_table, $ref_str_table) = @_; *{"${new_class}::new"} = sub { my ($class, $val) = @_; my $self = bless { '_num_table' => $ref_num_table, '_str_table +' => $ref_str_table }, $class; $self->set($val); return $self; } } sub generate_set_for { my ($class, $new_class, $ref_num_table, $ref_str_table) = @_; *{"${new_class}::set"} = sub { my ($self, $val) = @_; if( looks_like_number($val) ) { croak "Invalid number $val in set method of class " . ref( +$self) . ". " . "Valid numbers are " . join(", ", sort{$a <=> $b} keys + %{$self->{'_num_table'}}) unless exists $self->{'_num_table'}->{$val}; $self->{'_num'} = $val; $self->{'_str'} = $self->{'_num_table'}->{$val}; } else { croak "Invalid string $val in set method of class " . ref( +$self) . ". " . "Valid strings are " . join(", ", sort keys %{$self->{ +'_str_table'}}) unless exists $self->{'_str_table'}->{$val}; $self->{'_num'} = $self->{'_str_table'}->{$val}; $self->{'_str'} = $val; } } } sub generate_num_for { my ($class, $new_class) = @_; *{"${new_class}::num"} = sub { my ($self) = @_; return $self->{'_num'}; } } sub generate_str_for { my ($class, $new_class) = @_; *{"${new_class}::str"} = sub { my ($self) = @_; return $self->{'_str'}; } } sub generate_hex_for { my ($class, $new_class) = @_; *{"${new_class}::hex"} = sub { my ($self) = @_; return sprintf("%#x", $self->{'_num'}); } } 1;
Re: Dualvar via table
by LanX (Cardinal) on Jan 17, 2020 at 17:32 UTC
    Concerning your code ... TL;DR ... sorry!

    But

    > This code is working. But I would be interested in your opinion. What could I do better?

    dualvar means fiddling with internals, especially if you need to tie it with even more magic, too.

    I'd reserve this approach for really hard to achieve stuff or temporary tricks (like for debugging)

    IMHO using OOP together with overload for stringification and numification (see overload# String, numeric, boolean, and regexp conversions ) offers a much better interface and is easier to maintain. (untested!°)

    HTH! :)

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

    update

    °) see Cookbook section in overload for an example

    # Two-face Scalars # Put this in two_face.pm in your Perl library directory: package two_face; # Scalars with separate string and # numeric values. sub new { my $p = shift; bless [@_], $p } use overload '""' => \&str, '0+' => \&num, fallback => 1; sub num {shift->[1]} sub str {shift->[0]} # Use it as follows: require two_face; my $seven = two_face->new("vii", 7); printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1; print "seven contains 'i'\n" if $seven =~ /i/; # (The second line creates a scalar which has both a string value, and + a numeric value.) This prints: seven=vii, seven=7, eight=8 seven contains 'i'

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://11111535]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2020-09-25 02:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I don’t succeed, I …










    Results (136 votes). Check out past polls.

    Notices?