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

Re: merging two arrays with OR operation

by johngg (Canon)
on Mar 06, 2019 at 23:31 UTC ( [id://1230989]=note: print w/replies, xml ) Need Help??


in reply to merging two arrays with OR operation

Late to the party again but here's a solution that uses vec to construct bitstrings from the arrays that can be binary ORed to produce a result. The vector and the length of the original array are held in a hashref so that problems with reconstructing the array when the vector extends to a byte boundary can be avoided.

use 5.026;
use warnings;

my @array1 = ( 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1 );
my @array2 = ( 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1 );

my @arrayResult  = vec2array(
   vecORvec( array2vec( @array1 ), array2vec( @array2 ) )
   );

say join q{, }, @arrayResult;

sub array2vec
{
    my $rhVec       = {};
    $rhVec->{ len } = scalar @_;
    $rhVec->{ vec } = q{};

    vec( $rhVec->{ vec }, $_, 1 ) = $_[ $_ ]
       for 0 .. $rhVec->{ len } - 1;

    return $rhVec;
}

sub vec2array
{
    my @array = map {
       vec $_[ 0 ]->{ vec }, $_, 1
       } 0 .. $_[ 0 ]->{ len } - 1;

    return @array;
}

sub vecORvec
{
    my( $rhVec1, $rhVec2 ) = @_;
    my $rhNewVec;

    $rhNewVec->{ len } = $rhVec1->{ len };
    $rhNewVec->{ vec } = $rhVec1->{ vec } | $rhVec2->{ vec };

    return $rhNewVec;
}

[download]

The result.

0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1

[download]

I hope this is of interest.

Update: Added some sanity checking and confined the conversion of array to vector to the rule of false/true corresponding to bit values of 0 or 1 respectively. I also added AND and XOR routines, which along with OR will cope with vectors of differing length, and borrowed and adapted AnomalousMonk's test data.

use 5.026;
use warnings;

use Test::More qw{ no_plan };

my @ORtests = (
    q{degenerate case},
    [ [], [], [], ],
    q{simple cases},
    [ [ 0 ], [ 0 ], [ 0 ], ],
    [ [ 0 ], [ 1 ], [ 1 ], ],
    [ [ 1 ], [ 0 ], [ 1 ], ],
    [ [ 1 ], [ 1 ], [ 1 ], ],
    [ [ 5 ], [ 0 ], [ 1 ], ],
    [ [ q{x} ], [ 44 ], [ 1 ], ],
    q{complex cases},
    [ [ 0, 1, 0, 1, ],
      [ 0, 0, 1, 1, ],
      [ 0, 1, 1, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
    ],
    q{differing length cases},
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, ],
      [ 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
    ],
    );

say qq{\nOR tests\n};
foreach my $ORtest ( @ORtests )
{
    do { say $ORtest; next } unless ref $ORtest eq q{ARRAY};
    my( $raT1, $raT2, $raExpected ) = @$ORtest;
    my @got =
       vec2array( vecORvec( array2vec( @$raT1 ), array2vec( @$raT2 ) )
+ );
    is_deeply
       \ @got,
       $raExpected,
       qq{OR result - @got};
}

my @ANDtests = (
    q{degenerate case},
    [ [], [], [], ],
    q{simple cases},
    [ [ 0 ], [ 0 ], [ 0 ], ],
    [ [ 0 ], [ 1 ], [ 0 ], ],
    [ [ 1 ], [ 0 ], [ 0 ], ],
    [ [ 1 ], [ 1 ], [ 1 ], ],
    [ [ 5 ], [ 0 ], [ 0 ], ],
    [ [ q{x} ], [ 44 ], [ 1 ], ],
    q{complex cases},
    [ [ 0, 1, 0, 1, ],
      [ 0, 0, 1, 1, ],
      [ 0, 0, 0, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
    ],
    q{differing length cases},
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, ],
      [ 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, ],
    ],
    );

say qq{\nAND tests\n};
foreach my $ANDtest ( @ANDtests )
{
    do { say $ANDtest; next } unless ref $ANDtest eq q{ARRAY};
    my( $raT1, $raT2, $raExpected ) = @$ANDtest;
    my @got =
       vec2array( vecANDvec( array2vec( @$raT1 ), array2vec( @$raT2 ) 
+) );
    is_deeply
       \ @got,
       $raExpected,
       qq{AND result - @got};
}

my @XORtests = (
    q{degenerate case},
    [ [], [], [], ],
    q{simple cases},
    [ [ 0 ], [ 0 ], [ 0 ], ],
    [ [ 0 ], [ 1 ], [ 1 ], ],
    [ [ 1 ], [ 0 ], [ 1 ], ],
    [ [ 1 ], [ 1 ], [ 0 ], ],
    [ [ 5 ], [ 0 ], [ 1 ], ],
    [ [ q{x} ], [ 44 ], [ 0 ], ],
    q{complex cases},
    [ [ 0, 1, 0, 1, ],
      [ 0, 0, 1, 1, ],
      [ 0, 1, 1, 0, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, ],
    ],
    q{differing length cases},
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, ],
      [ 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, ],
    ],
    );

say qq{\nXOR tests\n};
foreach my $XORtest ( @XORtests )
{
    do { say $XORtest; next } unless ref $XORtest eq q{ARRAY};
    my( $raT1, $raT2, $raExpected ) = @$XORtest;
    my @got =
       vec2array( vecXORvec( array2vec( @$raT1 ), array2vec( @$raT2 ) 
+) );
    is_deeply
       \ @got,
       $raExpected,
       qq{XOR result - @got};
}


sub array2vec
{
    my $rhVec       = {};
    $rhVec->{ len } = scalar @_;
    $rhVec->{ vec } = q{};

    return $rhVec unless $rhVec->{ len };

    vec( $rhVec->{ vec }, $_, 1 ) = $_[ $_ ] ? 1 : 0
       for 0 .. $rhVec->{ len } - 1;

    return $rhVec;
}

sub vec2array
{
    return () unless $_[ 0 ]->{ len };

    my @array = map {
       vec $_[ 0 ]->{ vec }, $_, 1
       } 0 .. $_[ 0 ]->{ len } - 1;

    return @array;
}

sub vecANDvec
{
    my( $rhVec1, $rhVec2 ) = @_;
    my $rhNewVec           = { len => 0, vec => q{} };

    if ( $rhVec1->{ len } == $rhVec2->{ len } )
    {
        return $rhNewVec unless $rhVec1->{ len };
        $rhNewVec->{ len } = $rhVec1->{ len };
        $rhNewVec->{ vec } = $rhVec1->{ vec } & $rhVec2->{ vec };
    }
    elsif ( $rhVec1->{ len } > $rhVec2->{ len } )
    {
        $rhNewVec->{ len } = $rhVec1->{ len };
        vec( $rhVec2->{ vec }, $rhVec1->{ len } - 1, 1 ) = 0;
        $rhNewVec->{ vec } = $rhVec1->{ vec } & $rhVec2->{ vec };
    }
    else
    {
        $rhNewVec->{ len } = $rhVec2->{ len };
        vec( $rhVec1->{ vec }, $rhVec2->{ len } - 1, 1 ) = 0;
        $rhNewVec->{ vec } = $rhVec1->{ vec } & $rhVec2->{ vec };
    }

    return $rhNewVec;
}

sub vecORvec
{
    my( $rhVec1, $rhVec2 ) = @_;
    my $rhNewVec           = { len => 0, vec => q{} };

    if ( $rhVec1->{ len } == $rhVec2->{ len } )
    {
        return $rhNewVec unless $rhVec1->{ len };
        $rhNewVec->{ len } = $rhVec1->{ len };
        $rhNewVec->{ vec } = $rhVec1->{ vec } | $rhVec2->{ vec };
    }
    elsif ( $rhVec1->{ len } > $rhVec2->{ len } )
    {
        $rhNewVec->{ len } = $rhVec1->{ len };
        vec( $rhVec2->{ vec }, $rhVec1->{ len } - 1, 1 ) = 0;
        $rhNewVec->{ vec } = $rhVec1->{ vec } | $rhVec2->{ vec };
    }
    else
    {
        $rhNewVec->{ len } = $rhVec2->{ len };
        vec( $rhVec1->{ vec }, $rhVec2->{ len } - 1, 1 ) = 0;
        $rhNewVec->{ vec } = $rhVec1->{ vec } | $rhVec2->{ vec };
    }

    return $rhNewVec;
}

sub vecXORvec
{
    my( $rhVec1, $rhVec2 ) = @_;
    my $rhNewVec           = { len => 0, vec => q{} };

    if ( $rhVec1->{ len } == $rhVec2->{ len } )
    {
        return $rhNewVec unless $rhVec1->{ len };
        $rhNewVec->{ len } = $rhVec1->{ len };
        $rhNewVec->{ vec } = $rhVec1->{ vec } ^ $rhVec2->{ vec };
    }
    elsif ( $rhVec1->{ len } > $rhVec2->{ len } )
    {
        $rhNewVec->{ len } = $rhVec1->{ len };
        vec( $rhVec2->{ vec }, $rhVec1->{ len } - 1, 1 ) = 0;
        $rhNewVec->{ vec } = $rhVec1->{ vec } ^ $rhVec2->{ vec };
    }
    else
    {
        $rhNewVec->{ len } = $rhVec2->{ len };
        vec( $rhVec1->{ vec }, $rhVec2->{ len } - 1, 1 ) = 0;
        $rhNewVec->{ vec } = $rhVec1->{ vec } ^ $rhVec2->{ vec };
    }

    return $rhNewVec;
}

[download]

The test results.


OR tests

degenerate case
ok 1 - OR result - 
simple cases
ok 2 - OR result - 0
ok 3 - OR result - 1
ok 4 - OR result - 1
ok 5 - OR result - 1
ok 6 - OR result - 1
ok 7 - OR result - 1
complex cases
ok 8 - OR result - 0 1 1 1
ok 9 - OR result - 0 1 1 1 0 1 1 1 1 1 1 1
differing length cases
ok 10 - OR result - 0 1 1 1 0 1 1 1 1 1 1 1
ok 11 - OR result - 0 1 1 1 0 1 1 1 1 1 1 1

AND tests

degenerate case
ok 12 - AND result - 
simple cases
ok 13 - AND result - 0
ok 14 - AND result - 0
ok 15 - AND result - 0
ok 16 - AND result - 1
ok 17 - AND result - 0
ok 18 - AND result - 1
complex cases
ok 19 - AND result - 0 0 0 1
ok 20 - AND result - 0 0 0 1 0 1 0 1 0 1 1 1
differing length cases
ok 21 - AND result - 0 0 0 1 0 1 0 1 0 1 0 0
ok 22 - AND result - 0 0 0 1 0 1 0 1 0 1 0 0

XOR tests

degenerate case
ok 23 - XOR result - 
simple cases
ok 24 - XOR result - 0
ok 25 - XOR result - 1
ok 26 - XOR result - 1
ok 27 - XOR result - 0
ok 28 - XOR result - 1
ok 29 - XOR result - 0
complex cases
ok 30 - XOR result - 0 1 1 0
ok 31 - XOR result - 0 1 1 0 0 0 1 0 1 0 0 0
differing length cases
ok 32 - XOR result - 0 1 1 0 0 0 1 0 1 0 1 1
ok 33 - XOR result - 0 1 1 0 0 0 1 0 1 0 1 1
1..33

[download]

Possibly a waste of time but feeping creaturism can be fun :-)

Update 2: Took repetitive code out of the three comparison routines, (vecANDvec(), vecORvec(), vecXORvec()), and moved it into vecANYvec() which is passed a coderef telling it which operation to do. All tests still pass.

use 5.026;
use warnings;

use Test::More qw{ no_plan };

my @ORtests = (
    q{degenerate case},
    [ [], [], [], ],
    q{simple cases},
    [ [ 0 ], [ 0 ], [ 0 ], ],
    [ [ 0 ], [ 1 ], [ 1 ], ],
    [ [ 1 ], [ 0 ], [ 1 ], ],
    [ [ 1 ], [ 1 ], [ 1 ], ],
    [ [ 5 ], [ 0 ], [ 1 ], ],
    [ [ q{x} ], [ 44 ], [ 1 ], ],
    q{complex cases},
    [ [ 0, 1, 0, 1, ],
      [ 0, 0, 1, 1, ],
      [ 0, 1, 1, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
    ],
    q{differing length cases},
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, ],
      [ 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
    ],
    );

say qq{\nOR tests\n};
foreach my $ORtest ( @ORtests )
{
    do { say $ORtest; next } unless ref $ORtest eq q{ARRAY};
    my( $raT1, $raT2, $raExpected ) = @$ORtest;
    my @got =
       vec2array( vecORvec( array2vec( @$raT1 ), array2vec( @$raT2 ) )
+ );
    is_deeply
       \ @got,
       $raExpected,
       qq{OR result - @got};
}

my @ANDtests = (
    q{degenerate case},
    [ [], [], [], ],
    q{simple cases},
    [ [ 0 ], [ 0 ], [ 0 ], ],
    [ [ 0 ], [ 1 ], [ 0 ], ],
    [ [ 1 ], [ 0 ], [ 0 ], ],
    [ [ 1 ], [ 1 ], [ 1 ], ],
    [ [ 5 ], [ 0 ], [ 0 ], ],
    [ [ q{x} ], [ 44 ], [ 1 ], ],
    q{complex cases},
    [ [ 0, 1, 0, 1, ],
      [ 0, 0, 1, 1, ],
      [ 0, 0, 0, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
    ],
    q{differing length cases},
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, ],
      [ 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, ],
    ],
    );

say qq{\nAND tests\n};
foreach my $ANDtest ( @ANDtests )
{
    do { say $ANDtest; next } unless ref $ANDtest eq q{ARRAY};
    my( $raT1, $raT2, $raExpected ) = @$ANDtest;
    my @got =
       vec2array( vecANDvec( array2vec( @$raT1 ), array2vec( @$raT2 ) 
+) );
    is_deeply
       \ @got,
       $raExpected,
       qq{AND result - @got};
}

my @XORtests = (
    q{degenerate case},
    [ [], [], [], ],
    q{simple cases},
    [ [ 0 ], [ 0 ], [ 0 ], ],
    [ [ 0 ], [ 1 ], [ 1 ], ],
    [ [ 1 ], [ 0 ], [ 1 ], ],
    [ [ 1 ], [ 1 ], [ 0 ], ],
    [ [ 5 ], [ 0 ], [ 1 ], ],
    [ [ q{x} ], [ 44 ], [ 0 ], ],
    q{complex cases},
    [ [ 0, 1, 0, 1, ],
      [ 0, 0, 1, 1, ],
      [ 0, 1, 1, 0, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, ],
    ],
    q{differing length cases},
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, ],
      [ 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, ],
    ],
    [ [ 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, ],
      [ 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, ],
      [ 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, ],
    ],
    );

say qq{\nXOR tests\n};
foreach my $XORtest ( @XORtests )
{
    do { say $XORtest; next } unless ref $XORtest eq q{ARRAY};
    my( $raT1, $raT2, $raExpected ) = @$XORtest;
    my @got =
       vec2array( vecXORvec( array2vec( @$raT1 ), array2vec( @$raT2 ) 
+) );
    is_deeply
       \ @got,
       $raExpected,
       qq{XOR result - @got};
}


sub array2vec
{
    my $rhVec       = {};
    $rhVec->{ len } = scalar @_;
    $rhVec->{ vec } = q{};

    return $rhVec unless $rhVec->{ len };

    vec( $rhVec->{ vec }, $_, 1 ) = $_[ $_ ] ? 1 : 0
       for 0 .. $rhVec->{ len } - 1;

    return $rhVec;
}

sub vec2array
{
    return () unless $_[ 0 ]->{ len };

    my @array = map {
       vec $_[ 0 ]->{ vec }, $_, 1
       } 0 .. $_[ 0 ]->{ len } - 1;

    return @array;
}

sub vecANYvec
{
    my( $rhVec1, $rhVec2, $rcOper ) = @_;
    my $rhNewVec           = { len => 0, vec => q{} };

    if ( $rhVec1->{ len } == $rhVec2->{ len } )
    {
        return $rhNewVec unless $rhVec1->{ len };
        $rhNewVec->{ len } = $rhVec1->{ len };
    }
    elsif ( $rhVec1->{ len } > $rhVec2->{ len } )
    {
        $rhNewVec->{ len } = $rhVec1->{ len };
        vec( $rhVec2->{ vec }, $rhVec1->{ len } - 1, 1 ) = 0;
    }
    else
    {
        $rhNewVec->{ len } = $rhVec2->{ len };
        vec( $rhVec1->{ vec }, $rhVec2->{ len } - 1, 1 ) = 0;
    }
    $rhNewVec->{ vec } = $rcOper->( $rhVec1->{ vec }, $rhVec2->{ vec }
+ );

    return $rhNewVec;
}

sub vecANDvec
{
    my( $rhVec1, $rhVec2 ) = @_;
    return vecANYvec(
       $rhVec1,
       $rhVec2,
       sub { return $_[ 0 ] & $_[ 1 ] }
       );
}

sub vecORvec
{
    my( $rhVec1, $rhVec2 ) = @_;
    return vecANYvec(
       $rhVec1,
       $rhVec2,
       sub { return $_[ 0 ] | $_[ 1 ] }
       );
}

sub vecXORvec
{
    my( $rhVec1, $rhVec2 ) = @_;
    return vecANYvec(
       $rhVec1,
       $rhVec2,
       sub { return $_[ 0 ] ^ $_[ 1 ] }
       );
}

[download]

Cheers,

JohnGG

In Section Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://1230989]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others learning in the Monastery: (5)
As of 2024-04-18 15:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found