Perl Weekly Challenge 060

ch-1.p

number_column-label(X, L):-
    number_column-label(X, "", L).
number_column-label(0, L, L).    
number_column-label(X, C, L):-
    (X > 26) ->
        string_concat(C, "A", CAlpha),
        number_column-label(X - 26, CAlpha, L);
    M is rem(X, 26), 
    N is X - 26,
    max_list([N, 0], X0),
    number_chars(M, [A0|_]),
    char_code(A0, C0),
    A is C0 + 16,
    char_code(Alpha, A),   
    string_concat(C, Alpha, CAlpha),
    number_column-label(X0, CAlpha, L).
    
column-label_number(X, L):-
    string_chars(L, Chars),
    column-label_number(X, 0, Chars).
column-label_number(X, X, []).    
column-label_number(X, C, [A | T]):-
    (A = 'A') ->
        C0 is C + 26,
        column-label_number(X, C0, T);
    char_code(A, Alpha),    
    A0 is Alpha - 16,
    number_chars(C0, [A0]),
    C1 is C + C0,
    column-label_number(X, C1, T).    

main:-
    number_column-label(5, S0),
    writeln(S0),
    number_column-label(28, S1),
    writeln(S1),
    number_column-label(80, S2),
    writeln(S2),
    number_column-label(30, S3),
    writeln(S3),
    column-label_number(X, S3),
    writeln(X),
    halt.

ch-1.pl

use strict;
use warnings;
##
# Write a script that accepts a number and returns 
# the Excel Column Name it represents and vice-versa.
## 
sub number_to_column{
    my($n) = @_;
    my $s = "";
    while($n > 0){
        $s .= "A" if $n > 26;
        $s .= chr($n + 64) if $n < 26; 
        $n -= 26; 
    } 
    return $s; 
}

sub column_to_number{
    my($s) = @_;
    my $n = 0;
    for my $c (split(//, $s)){
        $n += 1 if $c eq "A" && length($s) == 1;
        $n += 26 if $c eq "A" && length($s) != 1;
        $n += ord($c) - 64 if $c ne "A";
    } 
    return $n; 
}

MAIN:{
    print number_to_column(28) . "\n"; 
    print number_to_column(80) . "\n"; 
    print number_to_column(30) . "\n"; 
    print column_to_number("A") . "\n"; 
    print column_to_number("Z") . "\n"; 
    print column_to_number("AB") . "\n"; 
    print column_to_number("AAAZ") . "\n"; 
}  

ch-2.p

number_digits(X, L):-
    number_digits(X, 0, L).       
number_digits(0, L, L):- !, true.    
number_digits(X, S, A):- 
    L is S + 1,
    Z is div(X, 10),
    number_digits(Z, L, A).

number_list(X, L):-
    number_list(X, [], L).       
number_list(0, L, L):- !, true.    
number_list(X, S, A):- 
    Z is rem(X, 10),
    Y is div(X, 10),
    number_list(Y, [Z|S], A).    

list_number(L, N):-
    list_number(L, 0, N).
list_number([], N, N).    
list_number([Digit| T], Sum, N):-
    length(T, D),
    S is Sum + (Digit * (10 ^ D)),
    list_number(T, S, N).
    
permutation(List,[H|Permutation]):-delete(H,List,Rest),permutation(Rest,Permutation).
permutation([],[]).
   
delete(X,[X|T],T).
delete(X,[H|T],[H|NT]):-delete(X,T,NT).

combinations_of_length(_,[]).
combinations_of_length([X|T],[X|Combinations]):-
    combinations_of_length([X|T],Combinations).
combinations_of_length([_|T],[X|Combinations]):-
    combinations_of_length(T,[X|Combinations]).
    
find_numbers(Digits, Length, Max, Matches):-
    length(L, Length),
    combinations_of_length(Digits,L),
    permutation(L,LP),
    find_numbers(LP, Length, Max, [], Matches).

find_numbers([], _, _,Matches, Matches).
find_numbers(Digits, Length, Max, Acc, Matches):- 
    list_number(Digits, X),
    number_digits(X, L),
    L = Length,
    X < Max,
    find_numbers([], Length, Max, [X|Acc], Matches).
    
find_numbers_test:-
    setof(Matches, find_numbers([0,1,2,5], 2, 21, Matches), All_Matches),
    writeln(All_Matches),
    halt.

ch-2.pl

use strict;
use warnings;
##
# Write a script that accepts list of positive numbers 
# and two positive numbers, a number of digits and a 
# maximum value. The script should print all possible 
# numbers made by concatenating the numbers from the 
# list whose length is exactly the number of digits
# and value is less than the maximum.
##
use List::MoreUtils q/uniq/;
use Math::Prime::Util q/forperm/;;
use Algorithm::Combinatorics q/combinations_with_repetition/;

sub find_numbers{
    my($numbers, $digits, $maximum) = @_;
    my @results; 
    my @combinations = combinations_with_repetition($numbers, $digits);    
    for my $c (@combinations){
        forperm {
            my @p = @{$c}[@_]; 
            my $i = 0;
            my $d = pop @p;
            my $sum = 0;
            while(defined($d)){
                $sum += ($d * (10 ** $i));
                $i++;  
                $d = pop @p;
            }        
            push @results, $sum if($sum < $maximum && length($sum) == $digits); 
        }@{$c};        
    }  
    return uniq sort {$a <=> $b} @results;
}

MAIN:{
    my @results = find_numbers([0,1,2,5], 2, 21); 
    print "@results";
}