I have a sorting problem that I do not know how to solve.
The description is that there are a number of different fruits arranged in rows that are stacked above each other.
Each row will have a limited number of the fruits and there will only be one of each fruit in each row. There may also be one or more positions in the row that are blank.
The task is to re-arrange the positions of the fruits in each row so that columns contain as much of the same fruit as possible.
The positions of the blanks does not matter at all.
The possible 16 fruits are listed below
Apple
Hawthorn
Pear
Apricot
Peach
Nectarines
Plum
Cherry
Currant
Gooseberry
Grapefruit
Kiwi
Rhubarb
Pawpaw
Melon
Figs

The Perl lines below
Defined the fruits including blanks with a b
Set the number of rows and columns in the display – note the number of columns must be less than the number of fruit
Randomly loads the fruit in each row so that any fruit only appears once in each row
Has two subs which:
1. Prints out the display contents as a comma separated list – this can be used in an Excel spreadsheet to more clearly see the positions of the fruit
2. Prints out the current hash of fruits so that this can be used an standard data
I would greatly value any comments about how to do the sort that I need.
If this were amplified by code that tackled the issue that would be brilliant!
use strict;

my (@fr, $fr_num, %fr_cur, %dis, $row_num, $col_num, $jr, $jc, $random
+_fr, $stored);

#========================================
#
# sub print_out_display
#
# this prints out to the screen a comma seperated list of the fruits i
+n each row
#
# argument 1 referecne to the hash holding the fruit positions
#
#=========================================

sub print_out_display($) {

my ($ref_dis) = @_;
my ($jr, $jc);
print "\nPositions of fruit\n\n";

print ",";
foreach $jc (sort {$a <=> $b} keys %{$ref_dis->{0}}) {
    print "$jc,";
}

print "\n";
foreach $jr (sort {$a <=> $b} keys %$ref_dis) {
    print "$jr,";
    foreach $jc (sort {$a <=> $b} keys %{$ref_dis->{$jr}}) {

        print "$ref_dis->{$jr}{$jc},";
    }

    print "\n";
}
}

#========================================
#
# sub store_display
#
# this prints out to the screen a comma seperated list of the hash and
+ its values
# so this could be used repeatedly as standard data
#
# argument 1 reference to the hash holding the fruit positions
#
#=========================================

sub store_display($) {

my ($ref_dis) = @_;
my ($jr, $jc);
print "\nHash giving the positions of fruit\n";

foreach $jr (sort {$a <=> $b} keys %$ref_dis) {

    foreach $jc (sort {$a <=> $b} keys %{$ref_dis->{$jr}}) {

        print "\$dis{$jr}{$jc} = '$ref_dis->{$jr}{$jc}';\n";
    }
}
}

# this is the list of fruit there can only be one of each fruit in any
+ one row
# b is a blank - there can be more that one of these in a row

$fr[0] = 'Apple';
$fr[1] = 'Hawthorn';
$fr[2] = 'Pear';
$fr[3] = 'Apricot';
$fr[4] = 'Peach';
$fr[5] = 'Nectarines';
$fr[6] = 'Plum';
$fr[7] = 'Cherry';
$fr[8] = 'Currant';
$fr[9] = 'Gooseberry';
$fr[10] = 'Grapefruit';
$fr[11] = 'Kiwi';
$fr[12] = 'Rhubarb';
$fr[13] = 'Pawpaw';
$fr[14] = 'Melon';
$fr[15] = 'Figs';
$fr[16] = 'b';
$fr_num = scalar(@fr);
# set the number of columns - this must be less than the number of rea
+l fruits + 1 for a blank
# with the data above it must be less than 17
$col_num = 10;

# set the number of rows
$row_num = 8;

# load the intial position of the fruit
# do this row by row
for($jr = 0; $jr < $row_num; $jr ++) { 

# for each column in the row randomly select a fruit
# undef the hash that holds the fruit used in the current row - blnaks
+ are not stored in this hash as there can be more than one
    undef %fr_cur;
    for($jc = 0; $jc < $col_num; $jc ++) {

        $stored = 'no';

        while($stored eq 'no') {

            $random_fr = $fr[rand @fr];

            if($random_fr ne 'b') {

                if(! exists($fr_cur{$random_fr})) {

                    $dis{$jr}{$jc} = $random_fr;
                    $fr_cur{$random_fr} = 1;
                    $stored = 'yes';
                }
            } else {
                    $dis{$jr}{$jc} = $random_fr;
                    $stored = 'yes';
            }
        }
    }
}        
        
print_out_display(\%dis);

store_display(\%dis);

[download]

In reply to A 2D Sorting problem by merrymonk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.