Peter
Peter Campbell Smith

Similar words and
a rather strange ordering

Weekly challenge 233 — 4 September 2023

Week 233 - 4 Sep 2023

Task 2

Task — Frequency sort

You are given an array of integers. Write a script to sort the given array in increasing order based on the frequency of the values. If multiple values have the same frequency then sort them in decreasing order.

Examples


Example 1
Input: @ints = (1,1,2,2,2,3)
Output: (3,1,1,2,2,2)

'3' has a frequency of 1
'1' has a frequency of 2
'2' has a frequency of 3

Example 2
Input: @ints = (2,3,1,3,2)
Output: (1,3,3,2,2)

'2' and '3' both have a frequency of 2, so they are 
sorted in decreasing order.

Example 3
Input: @ints = (-1,1,-6,4,5,-6,1,4,1)
Output: (5,-1,4,4,-6,-6,1,1,1)

Analysis

This is a little tricky, especially as negative numbers are allowed.

A good first step seemed to be to create an array @freq such that $freq[$j] contains the number of times $j occurs in @ints.

But of course that won't work if $j is negative. So let's find the minimum ($min) value of $j and set $freq[$j - $min] to the number of times $j occurs in @ints. While we're at it, let's get $max, which is the difference between the min and max values of $j.

Now let's start from the answer and work back. We need an array - but let's make it a hash - that we can sort by increasing $freq[$j] and within that by decreasing $j. We can do that by creating a hash key like aaaaaa_bbbbbb where aaaaaa is $freq[$j] and bbbbbb is $max minus $j, both left-padded with zeroes to make a 6-digit number.

We can then do a sort keys loop over the hash to retrieve the items in the order we want: that is, increasing $freq[$j] and within a given $freq[$j], decreasing $j. From those we can push onto an @output array each value of $j, $freq[$j] times - and that's the solution.

Try it 

Try running the script with any input, for example:
-1, 1, -6, 4, 5, -6, 1, 4, 1


Script


#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-09-04
use utf8;     # Week 233 task 2 - Frequency sort
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

frequency_sort(1, 1, 2, 2, 2, 3);
frequency_sort(2, 3, 1, 3, 2);
frequency_sort(-1, 1, -6, 4, 5, -6, 1, 4, 1);
frequency_sort(0, 0, 0, 0, -10, -5, -5 );

# bigger list
my @ints;
for (0 .. 50) {
    push @ints, int(rand(30)) - 15;
}
frequency_sort(@ints);

sub frequency_sort {
    
    my (@ints, @sorted, @freq, $j, %items, $f, $v, @output, $min, $max);
    
    @ints = @_;
    @sorted = sort { $a <=> $b } @ints;
    $min = $sorted[0];   # can be -ve
    $max = $sorted[-1] - $min;
    
    # get frequency of each distinct number: $freq[$j] is the frequency of ($j - $min)
    $freq[$_ - $min] ++ for @ints;
    
    # create $items{'aaaaaa|bbbbbb'} where aaaaaa is the frequency of $j and bbbbbb is $max - $j
    for $j (0 .. scalar @freq - 1) {
        next unless $freq[$j];
        $items{sprintf('%06d_%06d', $freq[$j], $max - $j)} = 1;
    }
    
    # sort by key to create output array
    for $j (sort keys %items) {
        $j =~ m|(\d+)_(\d+)|;
        ($f, $v) = ($1 + 0, $max + $min - $2);
        push @output, $v for 1 .. $f;
    }   
    
    say qq[\nInput:  \@ints = (] . join(', ', @ints) . ')';
    say qq[Output: (] . join(', ', @output) . ')';
}

Output


Input:  @ints = (1, 1, 2, 2, 2, 3)
Output: (3, 1, 1, 2, 2, 2)

Input:  @ints = (2, 3, 1, 3, 2)
Output: (1, 3, 3, 2, 2)

Input:  @ints = (-1, 1, -6, 4, 5, -6, 1, 4, 1)
Output: (5, -1, 4, 4, -6, -6, 1, 1, 1)

Input:  @ints = (0, 0, 0, 0, -10, -5, -5)
Output: (-10, -5, -5, 0, 0, 0, 0)

Input:  @ints = (9, 9, 12, 4, 1, 11, 8, -6, -7, -2, -1, 
   9, -6, 8, -13, -10, 8, -1, -3, 6, 4, -13, -13, 14, -12, 
   4, 14, -14, -4, 14, 8, -2, 4, -7, 5, -9, 4, 9, 4, -4, 
   -14, 12, 8, 8, 5, 14, 0, 12, -15, -2, -1)
Output: (11, 6, 1, 0, -3, -9, -10, -12, -15, 5, 5, -4, 
   -4, -6, -6, -7, -7, -14, -14, 12, 12, 12, -1, -1, -1, 
  -2, -2, -2, -13, -13, -13, 14, 14, 14, 14, 9, 9, 9, 9, 
   8, 8, 8, 8, 8, 8, 4, 4, 4, 4, 4, 4)