Peter
Peter Campbell Smith

Lucky relatives

Weekly challenge 284 — 26 August 2024

Week 284: 26 Aug 2024

Task 2

Task — Relative sort

You are given two list of integers, @list1 and @list2. The elements in @list2 are distinct and also in @list1. Write a script to sort the elements in @list1 such that the relative order of items in @list1 is same as in @list2. Elements that are missing in @list2 should be placed at the end of @list1 in ascending order.

Examples


Example 1
Input: @list1 = (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5)
       @list2 = (2, 1, 4, 3, 5, 6)
Output: (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)

Example 2
Input: @list1 = (3, 3, 4, 6, 2, 4, 2, 1, 3)
       @list2 = (1, 3, 2)
Output: (1, 3, 3, 3, 2, 2, 4, 4, 6)

Example 3
Input: @list1 = (3, 0, 5, 0, 2, 1, 4, 1, 1)
       @list2 = (1, 0, 3, 2)
Output: (1, 1, 1, 0, 0, 3, 2, 4, 5)

Analysis

The first observation in this challenge relates to the meaning of 'distinct', which I would take to mean that no two elements had the same value. However, in the examples, while the elements of @list2 are (what I would call) distinct, those in @list1 are not, and it is this lack of distinctness that makes the challenge slightly awkward.

My algorithm looks like this:

  • Loop over the values in @list2
  • Within that loop, loop over @list1
  • When we find matching items in the two lists, append that item to @list3
  • ... and undefine it in @list1

So now we have all the elements from @list1 that match an item in @list2 in the right order in @list3. We then loop over @list1 again, skipping over any undefined items and appending the rest into @list4.

The required output then comprises @list3 followed by sorted @list4.

I note that the challenge states 'integers' but the examples are all positive integers. However, my solution works equally for negative or zero numbers.

Try it 

Try running the script with any input:



example: 1, 2, 3, 4, 5, 6, 7



example: 5, 4, 3, 2, 1

Script


#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2024-08-26
use utf8;     # Week 284 - task 2 - Relative sort
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

relative_sort([2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5], [2, 1, 4, 3, 5, 6]);
relative_sort([3, 3, 4, 6, 2, 4, 2, 1, 3], [1, 3, 2]);
relative_sort([3, 0, 5, 0, 2, 1, 4, 1, 1], [1, 0, 3, 2]);

sub relative_sort {
    
    my (@list1, @list2, @list3, @list4, $j, $k);
    @list1 = @{$_[0]};
    @list2 = @{$_[1]};
    say qq[\nInput:  \@list1 =  (] . join(', ', @list1) . ')';
    
    # loop over @list2
    for $j (0 .. @list2 - 1) {
        for $k (0 .. @list1 - 1) {
            next unless defined $list1[$k];
            
            # move any matching items in @list1 to @list3
            if ($list2[$j] == $list1[$k]) {
                push @list3, $list1[$k];
                $list1[$k] = undef;
            }
        }
    }
    # move any non-matching items into @list4
    for $k (0 .. @list1 - 1) {
        push @list4, $list1[$k] if defined $list1[$k];
    }
    
    # concatenate @list3 and sorted @list4
    push @list3, sort {$a <=> $b} @list4;
    
    say qq[ \@list2 =  (] . join(', ', @list2) . ')';
    say qq[Output:           (] . join(', ', @list3) . ')';
}

Output


Input:  @list1 =  (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5)
	@list2 =  (2, 1, 4, 3, 5, 6)
Output:           (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)

Input:  @list1 =  (3, 3, 4, 6, 2, 4, 2, 1, 3)
	@list2 =  (1, 3, 2)
Output:           (1, 3, 3, 3, 2, 2, 4, 4, 6)

Input:  @list1 =  (3, 0, 5, 0, 2, 1, 4, 1, 1)
	@list2 =  (1, 0, 3, 2)
Output:           (1, 1, 1, 0, 0, 3, 2, 4, 5)

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain