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

Difference between two arrays

by rafl (Friar)
on Mar 22, 2006 at 11:44 UTC ( [id://538473]=perlquestion: print w/replies, xml ) Need Help??

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

Hello,

I searched for a solution to my problem on this site already, but for some reason all nodes I found talked about the synetric difference of two arrays, which is not what I want. Maybe the problem has another name?

However, here is the problem. There are two arrays given (array references in that case):

my $before = [qw(1 2 3 4 5 6 7 8 9 10)]; my $after = [qw(2 3 4 5 1 6 7 8 9 10)];

The first array always looks the same (ascending numbers from $x to $x + $y). The second array is based on the first array, but one element inside it was moved. In the code example I gave it was element 0 (value 1) that was moved to position 5. The rest of the elements in $after moved up and down automatically.

The operation that was executed on the array could be expressed that way in perl:

my $element = splice(@$after, 0, 1); #remove element 0; splice(@$after, 4, 0, $element); #insert element at offset 4

The question is how to find out which element was moved to which offset, given that you only know the array $before and $after.

TIA, Flo

Replies are listed 'Best First'.
Re: Difference between two arrays
by Roy Johnson (Monsignor) on Mar 22, 2006 at 15:31 UTC
    use strict; use warnings; my $before = [qw(1 2 3 4 5 6 7 8 9 10)]; my $after = [qw(1 2 3 4 6 7 5 8 9 10)]; # Find the first and last that are out of position my ($lo_1, $hi_1); for (0..$#$before) { if ($before->[$_] != $after->[$_]) { (defined $lo_1 ? $hi_1 : $lo_1) = $_; } } # If the first item is out of order relative to the one following it, # it has been moved from higher up; otherwise, the move was in the oth +er direction if ($after->[$lo_1+1] < $after->[$lo_1]) { print "Moved element $hi_1 to $lo_1\n"; } else { print "Moved element $lo_1 to $hi_1\n"; }

    Caution: Contents may have been coded under pressure.

      Thanks for your solution. It's pretty much what I was looking for. :-)

      But.. are you sure if that code works for any input data one could think of? Couldn't the

      $after->[$lo_1 + 1]

      result in an undefined value when $lo_1 equals $#{$after}?

      Cheers, Flo

        $lo_1 would never be the last index in the array, so no.

        The highest order change is either moving element index 8 to 9 or moving 9 to 8. In either case $lo_1 will be 8, and $lo_1 + 1 will be 9, and in range.

        I think the above is the best solution here.

        ---
        my name's not Keith, and I'm not reasonable.
Re: Difference between two arrays
by holli (Abbot) on Mar 22, 2006 at 12:48 UTC
    If the arrays are not too big, I'd use a hash based solution:
    my $i = $#{$before}; my %before = map { $before->[$_] => $_ } (0..$i); my %after = map { $after->[$_] => $_ } (0..$i); for (0..$i) { print "$before->[$_] has moved from $before{$before->[$_]} to $aft +er{$before->[$_]}\n" if $before{$before->[$_]} != $after{$before->[$_]}; } #output: #1 has moved from 0 to 4 #2 has moved from 1 to 0 #3 has moved from 2 to 1 #4 has moved from 3 to 2 #5 has moved from 4 to 3


    holli, /regexed monk/

      That's actually a solution that could work, but I think it's rather ugly. Not ugly, as in "the code is bad", but it doesn't calculate the best solution which would only be one movement that needs to be done to go from $before to $after. So instead of one operation I'd need to do $#{$before} operations which obviously sucks as soon as the list gets bigger.

      Cheers, Flo

Re: Difference between two arrays
by Corion (Patriarch) on Mar 22, 2006 at 12:11 UTC

    I'd go with the output Algorithm::Diff and post-process the deletions/inserts into moves (if you can be sure that there are only moves and no lone deletions or inserts).

      Using Algorithm::Diff or List::Compare was also one those solutions I came up with, but I still think it's a quite ugly solution. I would really appreciate some code that can live without the usage of huge (and slow!) modules like the two above.

      Cheers, Flo

Re: Difference between two arrays
by wfsp (Abbot) on Mar 22, 2006 at 12:03 UTC
    My take on this would be to start at the end and work backwords.

    #!/usr/bin/perl use warnings; use strict; my $before = [qw(1 2 3 4 5 6 7 8 9 10)]; my $after = [qw(2 3 4 5 1 6 7 8 9 10)]; my $len = @{$before}-1; for (reverse @{$before}){ print $before->[$len], "\t"; print $after->[$len], "\n"; last if $before->[$len] != $after->[$len]; $len--; } #$len++; print "offset: $len\n"; print "element: $after->[$len]\n";
    output:
    ---------- Capture Output ---------- > "c:\perl\bin\perl.exe" _new.pl 10 10 9 9 8 8 7 7 6 6 5 1 offset: 4 element: 1 > Terminated with exit code 0.

      This works if the element is moved to an offset that is larget than its initial position. But what if it's being moved towards the beginning of the array?

      Cheers, Flo

Re: Difference between two arrays
by Melly (Chaplain) on Mar 22, 2006 at 11:58 UTC

    As a suggestion, compare each element, starting at element 0 - as soon as you find a difference, you will know which element moved (untested)

    @before = qw(1 2 3 4 5); @after = qw(1 2 4 5 3); for($n=0; $n <= $#before; $n++){ if($before[$n] <> $after[$n]){ print "Element $n changed\n"; last; } }
    Tom Melly, tom@tomandlu.co.uk

      That won't work well in my case as the items can move forwards and backwards in the list. Also your solution only tells me which element changed and now how it changed.

      Cheers, Flo

Re: Difference between two arrays
by kwaping (Priest) on Mar 22, 2006 at 16:31 UTC
    My approach was slightly different. Since "The first array always looks the same (ascending numbers from $x to $x + $y)", I decided to ignore the first array completely and just focus on what's wrong in the second. Here's my code:
    #!/usr/bin/perl use strict; use warnings; my @array = (1,2,3,6,4,5,7,8,9); # UPDATED again, numeric sort my $smallest = (sort {$a <=> $b} @array)[0]; my $stored = shift @array; # UPDATED per bug report in reply # if ($stored != $smallest) { if ($stored != $smallest && $stored + 1 != $array[0]) { print "$stored appears to be in the wrong position\n"; exit; } foreach my $i (0 .. $#array) { if ($stored != $array[$i] - 1) { if ($array[$i] + 1 != $array[$i + 1]) { print "$array[$i] appears to be in the wrong position\n"; last; } } $stored = $array[$i]; }

    ---
    It's all fine and dandy until someone has to look at the code.
      I'm not sure your if ($stored ne $smallest) {...} is correct, for two reasons. Firstly, ne is for string comparisons and these are numbers so != would be better. Secondly, and more importantly, I think your logic might be a bit suspect. In the original post the 1 was moved further up the list so that 2 was the first element. Thus, your

      $smallest = (sort @array)[0];

      would give us 1 but your

      $stored = shift @array;

      would result in 2. Your condition would be met, your script exits with an error but the move is a valid one.

      I think the only constraints were that a) the numbers are consecutive and b) one element is moved to form the new list. Thus in a list of 1 to 9, the 7 could be moved to the front giving 7,1,2,3,4,5,6,8,9 which would also fail in your script.

      Cheers,

      JohnGG

        != would be better

        Noted and changed, thank you.

        but the move is a valid one

        Why do you think this is a valid move? The author's original post doesn't state anything like that, and the author's replies to other solutions suggests that this is not a valid move.

        Update: I see the bug you were referring to and have updated my code accordingly. Thanks!

        ---
        It's all fine and dandy until someone has to look at the code.
Re: Difference between two arrays
by TedPride (Priest) on Mar 22, 2006 at 18:50 UTC
    There are a number of possibilities: a) The number could have been moved to the edge of the array
    b) The number could have been swapped with the one next to it
    c) The number could have been moved to some other random position

    The problem is that you have to be able to test for all these and return the proper answer - preferably with a linear algorithm that does not require a hash. Here is my solution:

    use strict; use warnings; my ($l, $r, $before, $after); $before = [qw(1 2 3 4 5 6 7 8 9 10)]; while (<DATA>) { chomp; $after = [split / /]; for ($l = 0; $before->[$l] == $after->[$l]; $l++) {} for ($r = $#$before; $before->[$r] == $after->[$r]; $r--) {} if ($l == $r - 1) { print "Either $after->[$l] moved to position $l, or $after->[$ +r] to position $r.\n"; } elsif ($before->[$l] == $after->[$l+1]) { print "$after->[$l] moved to position $l\n"; } else { print "$after->[$r] moved to position $r\n"; } } __DATA__ 10 1 2 3 4 5 6 7 8 9 2 3 4 5 6 7 8 9 10 1 1 10 2 3 4 5 6 7 8 9 2 3 4 5 6 7 8 9 1 10 1 2 3 4 5 6 8 7 9 10
Re: Difference between two arrays
by injunjoel (Priest) on Mar 22, 2006 at 17:26 UTC
    Greetings,
    I liked the hash approach holli suggested.
    Here are my thoughts.
    #!/usr/bin/perl -w use strict; my $before = [qw(1 2 3 4 5 6 7 8 9 10)]; my $after = [qw(2 3 4 5 1 6 7 8 9 10)]; my %start; @start{@{$before}} = @{$after}; #every little shift. my %moved = map{ ($_ != $start{$_}) ? ($_, $start{$_}) : () }keys %start; #shifts larger than one. my %huge_offset = map{ (abs($_ - $start{$_}) > 1) ? ($_, $start{$_}) : () } keys %start; #lets check what we have... print "BEFORE:\t"; print "@$before\n"; print "AFTER:\t"; print "@$after\n"; print "\nOFFSETS:\n"; print "$moved{$_}: ".($start{$_}-1)." to ".($_ - 1)."\n" for( sort {$a +<=>$b} keys %moved); print "\nHUGE OFFSETS:\n"; print "$huge_offset{$_}: ".($start{$_}-1)." to ".($_ - 1)."\n" for( so +rt {$a<=>$b} keys %huge_offset);
    and the output.
    BEFORE: 1 2 3 4 5 6 7 8 9 10 AFTER: 2 3 4 5 1 6 7 8 9 10 OFFSETS: 2: 1 to 0 3: 2 to 1 4: 3 to 2 5: 4 to 3 1: 0 to 4 HUGE OFFSETS: 1: 0 to 4


    -InjunJoel
    "I do not feel obliged to believe that the same God who endowed us with sense, reason and intellect has intended us to forego their use." -Galileo
Re: Difference between two arrays
by unobe (Scribe) on Mar 23, 2006 at 11:28 UTC
    I actually got really interested in this problem and thought of trying to use a mathematical formula for what the sum of a sequential numbers is. Anyway, I came up with a solution which I think is elegant, and which uses what I discovered:
    use strict; use warnings; my @orig = (1..10); my @altered = ( [qw( 1 2 3 4 9 5 6 7 8 10)], [qw( 2 3 4 1 5 6 7 8 9 10)], [qw( 1 2 3 4 10 5 6 7 8 9)], [qw( 1 2 3 5 4 6 7 8 9 10)], [qw( 1 3 4 5 6 7 2 8 9 10)], [qw( 1 2 3 4 5 6 7 8 10 9)], [qw( 1 2 3 4 6 5 7 8 9 10)], ); for my $test (@altered) { my %count = (); my ($val, $flag) = (undef, $orig[0] == $test->[0]); for my $i (0..$#orig) { # keep track of what the nums in each array add up to $count{before} += $orig[$i]; $count{after} += $test->[$i]; if (($flag && ($count{before} != $count{after})) || (!$flag && ($count{before} == $count{after}))) { $val = ( $test->[$i] == $orig[$i+1]) ? $orig[$i] : $test->[$i]; last; } } print "$val moved between (@orig) and (@$test)\n"; }
    Basically, if the first numbers of each array are equal, look for when the array sums aren't equal. If the first numbers of each array aren't equal, look for when the array sums are equal. There's a special case in there (hence the ternary operator), but I can't explain it really. (Anyone else know why?) The last test case is ambiguous, since 5 and 6 are transposed and either (depending on if you're scanning left to right or right to left) could be said to have moved (this solution says 6 has moved). I actually really enjoyed doing this problem because I figured out something I didn't know before (in terms of math)*:
    The sum of a sequence of integers from x to x+n equals ((x+n)(x+n+1) - (x-1)(x))/2
    Hopefully it will be handy to know that some day :-)

    * or had forgotten.
Re: Difference between two arrays
by Anonymous Monk on Mar 23, 2006 at 03:51 UTC
    I think this is a little different approach. Since the original array was in ascending order to find the swapped elements we just need to find the descending step in the $after array. Once you have the location, you just need to determine if it moved right or left.
    my $after = [qw(2 3 4 1 5 6 7 8 9 10)]; for (my $i = 1; $i < scalar($after); $i++){ my $diff = after->[$i-1] - $after->[$i]; if($diff > 0){ if($diff > $i){ printf "$after->[$i-1] moved to position %d\n",($i-1); } else{ print "$after->[$i] moved to position $i\n"; } last; } }
    The output would be:
    1 moved to position 3
      This will work only for the elements which are removed in the front.
      my $before = [qw(1 2 3 4 5 6 7 8 9 10)]; my $after = [qw(1 2 4 3 5 6 7 8 9 10)]; $k=0; for($i=0;$i<=@$before;$i++) { for($j=$k;$j<=@$after;$j++) { if(@$before[$i] eq @$after[$j] and $i==$j) { $i++;$k++; } if(@$before[$i] eq @$after[$j] and $i!=$j) { print "element @$before[$i] is moved to the position ",$j ++1; $i=@$before+1; last; } } } __DATA__ element 3 is moved to the position 4
      Any comments to this code.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (5)
As of 2024-03-29 15:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found