Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Pair of items

by artist (Parson)
on Jul 29, 2003 at 19:39 UTC ( #278953=perlquestion: print w/replies, xml ) Need Help??

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

Dear Monks,
I have some items in array. Each item is group of 3 numbers. I like to find pair of items where no similar number between 2 items. For example [1,2,3] and [5,6,7] is ok but [1,2,3] and [2,4,6] is not ok. Any module would be useful also.

Thanks,
artist

Replies are listed 'Best First'.
Re: Pair of items
by dragonchild (Archbishop) on Jul 29, 2003 at 20:07 UTC
    To compare any two groups, you'd do something like:
    sub is_ok { my ($x, $y) = @_; my (%x, %y); @x{@$x} = 1; @y{@$y} = 1; foreach my $k (keys %x) { return 0 if exists $y{$k}; } return 1; }
    Put in a loop, as necessary. Lather, rinse, repeat. A few notes:
    1. This will work with groups of arbitrary size and will also work with groups of different sizes.
    2. It will also work with groups that contain arbitrary data.
    3. It will throw warnings if any of the elements are undef.
    4. It does string comparisons, so 2, 4, 6 and 1.0, 2.0, 3.0 may or may not be ok. I will leave numeric comparisons as an exercise for the reader.

    ------
    We are the carpenters and bricklayers of the Information Age.

    Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

    Please remember that I'm crufty and crochety. All opinions are purely mine and all code is untested, unless otherwise specified.

      Tweakism to get something like this:
      sub is_ok { my ($x, $y) = @_; my %x; @x{@$x} = 1; return !grep { exists($x{$_}) } @$y; }
      You seem to create a hash and then just iterate over its keys, instead of just using the straight list. Here I just make one hash and use the other list raw.

      grep is used to produce a list of matches, which is then negated, so that it returns a true value if there are no matches.
      Quantum::Superpositions offers an elegant solution:
      use Quantum::Superpositions; my $list1 = [1,2,3]; my $list2 = [4,5,6]; print "No common items" if all(@$list1) != all(@$list2);
      Basically, if all of the elements in list1 are not equal to all of the elements in list2, that will print "No Common Items"

      HTH

      -Tom

        And, that is the solution I would propose in Perl6.

        However, Quantum::Superpositions is not a core module nor is it meant to be used in production code. It's a plaything conceived in the bowels of TheDamian's mind that hasn't been thoroughly tested. *shrugs* TMTOWDI

        ------
        We are the carpenters and bricklayers of the Information Age.

        The idea is a little like C++ templates, except not quite so brain-meltingly complicated. -- TheDamian, Exegesis 6

        Please remember that I'm crufty and crochety. All opinions are purely mine and all code is untested, unless otherwise specified.

Re: Pair of items
by swkronenfeld (Hermit) on Jul 29, 2003 at 20:10 UTC
    artist,

    A better problem description is necessary. Do you just want to find any pair of items with no similar numbers? Do you want to continue to find them after the first one? If so, can you use the same item in multiple matches? Assuming the answers to the questions are yes, yes, and no, here's a basic skeleton for your code, using dragonchild's above subroutine

    for(my $i=0; $i<@array; $i++) { next if(!$array[$i]); for(my$j=0; $j<@array; $j++) { next if($i == $j); next if(!$array[$j]); if(is_ok($array[$i], $array[$j]) { print "Found a match, $array[$i], $array[$j]"; $array[$i] = $array[$j] = ""; } } }
    edit: originally had next if(!$i) and next if(!$j) which dragonchild pointed out to me. Corrected above (next if(!$array[$i]))
Re: Pair of items
by tadman (Prior) on Jul 29, 2003 at 20:21 UTC
    If you're only using three at a time, you could always do this:
    sub is_ok { $_[0][0] != $_[1][0] && $_[0][0] != $_[1][1] && $_[0][0] != $_[1][2] && $_[0][1] != $_[1][0] && $_[0][1] != $_[1][1] && $_[0][1] != $_[1][2] && $_[0][2] != $_[1][0] && $_[0][2] != $_[1][1] && $_[0][2] != $_[1][2]; }
    Very rudimentary, but at the same time, this "unrolled" version is way faster than any list or hash based operation. Using a quick Benchmark test, it was 80% faster than other bits posted here.
      While faster, it is more prone to error should there be any change in requirements. It also needs a helluvalot of commenting so that your maintenance programmer(s) (which could very well be you!) don't make a well-meaning change and screw it up.

      Like all optimizations, it should be done only if that section of code has been identified as a bottleneck through profiling. (Never use analysis as the only source of information when profiling. Using a profiler is the only way to truly know where your bottlenecks are.)

      ------
      We are the carpenters and bricklayers of the Information Age.

      Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

      Please remember that I'm crufty and crochety. All opinions are purely mine and all code is untested, unless otherwise specified.

        I agree that it's awfully simplistic, but there are occasions, like bioinformatics, which might use a routine like this in some capacity. I've just given two different versions for comparision and discussion/argument and whatnot.

        I'd go for the hash based approach.

        However, even a function that's intentionally crippled like that can be made "safe" by naming it something like compare_triplets or what have you. You'd have to be pretty daring to feed a function like that anything but what's expected, though of course, even this precaution may not protect you from the inevitable.
Re: Pair of items
by husker (Chaplain) on Jul 29, 2003 at 21:15 UTC
    Sounds like a simple intersection to me. If so, the Set::Array module might fit your needs.
•Re: Pair of items
by merlyn (Sage) on Jul 30, 2003 at 14:04 UTC
    If you know the items are always sorted, there's a routine that's likely to be faster than anything else shown here as I post this:
    my $ok = no_common_item_in_these_numeric_sorted_lists( [1, 2, 3], [2, 4, 6] ); sub no_common_item_in_these_numeric_sorted_lists { my @x = @{+shift}; # these are copies my @y = @{+shift}; ## presuming numeric sorted while (@x or @y) { shift @x, next if not @y or $x[0] < $y[0]; shift @y, next if not @x or $x[0] > $y[0]; return 0; # not ok - we found an identical item } return 1; # ok - we found no identical items }

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

      I believe that'd have to be:
      while (@x and @y) {
      Otherwise it goes into an infinite loop if every element in @x is less than every element in @y.
        No, if every element of @x is less than the first element of @y, then all of @x first gets nibbled element by element because of the first statement within the loop, then all of @y gets nibbled element by element because of the second statement within the loop, and then we drop out of the loop.

        Perhaps you're arguing that I can optimize that to "and". Probably true. But it doesn't break even when it's an "or", unless I'm missing something.

        I constructed this loop by thinking about loop invariants, a very valuable tool. In this case, we know that no pair of equal numbers can ever get shifted off the lists, and yet we are shifting while we are looping, so we're always moving closer to either an equal pair, or two empty lists.

        -- Randal L. Schwartz, Perl hacker
        Be sure to read my standard disclaimer if this is a reply.

Re: Pair of items
by fglock (Vicar) on Jul 29, 2003 at 20:37 UTC

    Note: this would fail if you had repeated numbers inside an item, like (1,1,2).

    use strict; my (@a, @b); @a = (1,2,3); @b = (5,6,7); { my %test; @test{@a,@b}=1; print scalar keys %test == 6 ? 'ok' : 'not'; } # ok @a = (1,2,3); @b = (2,4,6); { my %test; @test{@a,@b}=1; print scalar keys %test == 6 ? 'ok' : 'not'; } # not
Re: Pair of items
by PhiRatE (Monk) on Jul 30, 2003 at 06:29 UTC
    What are your performance requirements? you said "some items in an array", which indicates to me that you're talking 10 or 20, which means that the solutions provided are fine. If you start talking about large sets however, you're going to get in real trouble iterating over the whole lot doing is_ok's, you want to cull out all the unavailable options as soon as possible so you can pick the first available one straight off. To do this you have a quick setup phase like this:
    for ($ref=0; $ref<$#items; $ref++) { for (@{$items[$ref]}) { if (!$contains{$_}) { $contains{$_} = [$ref]; } else { push @{ +$contains{$_}}, $ref; } } }
    This gives you a hash of arrays called %contains, which maps numbers to the index of the items array of an element containing that number. From this, you can determine all pairs which are acceptable partners like this:
    sub get_pairs { my %invalids = (); my @valids = (); for $number (@_) { for $id (@{$contains{$number}}) { $invalids{$id} = 1; } } for ($id=0; $id < $#items; $id++) { push @valids, $items[$id]; } return @valids; } @all_matches = get_pairs(2,3,4)
    You can of course get a single acceptable pair much faster by just scanning up the possible ids until you reach one that isn't invalid.

    You gain significant improvements using this method in instances where you have a *lot* of comparisons, and when you need all available matches. For a smal number of comparisons the setup cost for this method is probably not worth it.

    All code is example only, hasn't been tested etc and doesn't properly scope or anything. Hopefully the point is fairly obvious.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (5)
As of 2022-12-01 06:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?