CY's Post on PWC#060: Numbers with Headache
This is a part of Perl Weekly Challenge(PWC) #060 and the followings are related to my solution. If you want to challenge yourself on Perl, go to https://perlweeklychallenge.org, code the latest challenges, submit codes on-time (by GitHub or email) if possible, before reading my blog post
Do tell me if I am wrong or you strongly oppose my statements!
Task #1: Excel Column
Firstly we observe that 16384 < 263 = 17576 . Therefore there are at most 3 alphabets for the spreedsheet nomenclature. Knowing the cases to handle are not massive, I handle the cases with some subroutines named AtoOne, AtoZero and OnetoA.
The in-production testing line is for (1..3000) {print (numtoExcelCol($_),"\n"} and the finalized testing line is for (1..$MAX) {print($_,"\n") unless $_ == excelcoltoNum(numtoExcelCol($_));} .Task #2 Find Numbers
The original task makes me feel it is an exercise for using the module Math::Combinatorics .
Afterall, hence I modify the following more mathematically interesting task for myself:
Write a script that accepts a list of non-necessarily-to-be-unique digits (@L) and two positive numbers $X and $Y.
The script should print all possible numbers made by concatenating the items from @L, whose length is exactly $X but value is less than $Y.
Example
Input:
@L=(0,1,2,5);$X=2;$Y=21;
Output: 10,11,12, 15, 20
It will be a bit fun challenging and we have to do optimization when $X and $Y is both large (in two different senses)...
Example
Input:
(But, for fun, $X has to equal to length($Y) now.)@L=(0, 1, 1 , 1, 1 , 1 ,1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 5, 6);$Y=13179794;
On my poor laptop, it spends about 33~34 sec to output the 45451 solutions , from 10111111 to 13165444, by a "brute-force"-styled script.
May To Be Continued (if the author has time before Monday, and reflect whether this modification of problem statement is really that interesting 😅)... # written on Friday night
--------------------------------------
#written on Monday early morning BEGIN
Hi All! I have just finished coding my targeted coding task. It spent about 2~3 sec for $Y=13179794 and @L = (0, 1, 1 , 1, 1 , 1 ,1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 5, 6); now.
#END □
use strict;
use Math::Combinatorics;
#my @L = (0,1,1, 2, 3, 5);
#my $Y = 247;
my @L = (0, 1, 1 , 1, 1 , 1 ,1,1 , 1, 1, 2, 3, 4, 4, 4, 4, 5, 6);
my $Y = 13179794;
#my $Y = 131797;
#my $Y = 13;
#my $Y = 34;
my $X = length($Y);
my @freq = myfreq(@L);
my @combo = ();
my @ydigits = split //, $Y;
($X <= $#L and $freq[0] != $X) or die "no solution, too few non-zero digits";
sub myfreq {
my @box = map {0} (0..9);
for (@_) {$box[$_]++};
return @box;
}
sub removed {
my $unpopular = shift @_;
my @list = @_;
for (split //, $unpopular) { $list[$_]-- if $list[$_] > 0 ;}
return @list;
}
sub findall {
my $item = shift @_;
my @list = @_;
for (split //, $item) {
if ($list[$_] > 0) {
$list[$_]--;
}
elsif ($list[$_] == 0) {
return 0;
}
}
return 1;
}
my $i = 1;
my $ship = "";
running(1,1);
for $i (2..$X-1) {
$ship .= $ydigits[$i-2];
if (findall($ship, @freq)) {
running(0,$i)
};
}
$i = $X;
$ship .= $ydigits[$X-2];
for my $p (0..9) {
if (findall($ship, @freq) and $p < $ydigits[$X-1]) {
my @tailfreq = removed($ship, @freq);
if ($tailfreq[$p] != 0) {
push @combo, $ship.$p;
}
}
}
sub running {
my $starter = $_[0];
my $j = $_[1];
for (my $temp = $starter; $temp < $ydigits[$j-1]; $temp++) {
my @tailfreq = @freq;
if ($ship ne "") { @tailfreq = removed($ship, @freq) };
if ($tailfreq[$temp] != 0) {
@tailfreq = removed( $temp ,@tailfreq );
my $a = Math::Combinatorics->new(
count=>$X-$j,
data => [(0..9)],
frequency => [@tailfreq]
);
while (my @elems = $a->next_multiset) {
my @newfreq = myfreq(@elems);
my $c = Math::Combinatorics->new(
count=>$X-$j,
data=> [(0..9)],
frequency => [@newfreq]
);
while (my @b = $c->next_string) {
push @combo, ( $ship.$temp.(join "" , @b) ) ;
}
}
}
}
}
print join "\n" , sort @combo;
print "\n";
This blog is inactive and replaced by https://e7-87-83.github.io/coding/blog.html ; but I post highly Perl-related posts here.
Leave a comment