aboutsummaryrefslogtreecommitdiff
path: root/challenge-116/athanasius/perl/ch-2.pl
blob: 802c44308bc176ed80aaa661527c80537565af2c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
#!perl

###############################################################################
=comment

Perl Weekly Challenge 116
=========================

TASK #2
-------
*Sum of Squares*

Submitted by: Mohammad Meraj Zia

You are given a number $N >= 10.

Write a script to find out if the given number $N is such that sum of squares
of all digits is a perfect square. Print 1 if it is otherwise 0.

Example

 Input: $N = 34
 Output: 1 as 3^2 + 4^2 => 9 + 16 => 25 => 5^2

 Input: $N = 50
 Output: 1 as 5^2 + 0^2 => 25 + 0 => 25 => 5^2

 Input: $N = 52
 Output: 0 as 5^2 + 2^2 => 25 + 4 => 29

=cut
###############################################################################

#--------------------------------------#
# Copyright © 2021 PerlMonk Athanasius #
#--------------------------------------#

#==============================================================================
=comment

Input Argument $N
-----------------
Although it is probably intended that $N be an integer, this is not explicitly
stated in the Task Description and is not really necessary. This script accepts
any real number >= 10, and includes any digits following the decimal point
along with the digits that come before. The decimal point (if any) is ignored.
For example:

    Input:  $N = 14.22
    Output: 1 as 1^2 + 4^2 + 2^2 + 2^2 = 1 + 16 + 4 + 4 = 25 = 5^2

Output
------
The required output (1 or 0) is followed by an explanation as per the Examples.
If this explanation is not wanted, the constant $SHOW should be set to a false
value.

Algorithm
---------
This is straightforward: split $N into its component digits, square each digit,
and sum the squares. The sum is itself a perfect square if and only if its
square root is an integer.

=cut
#==============================================================================

use strict;
use warnings;
use Const::Fast;
use Regexp::Common qw( number );

const my $SHOW  => 1;
const my $USAGE =>
"Usage:
  perl $0 <N>

    <N>    A number greater than or equal to 10\n";

#------------------------------------------------------------------------------
BEGIN
#------------------------------------------------------------------------------
{
    $| = 1;
    print "\nChallenge 116, Task #2: Sum of Squares (Perl)\n\n";
}

#==============================================================================
MAIN:
#==============================================================================
{
    my $N       = parse_command_line();

    print "Input:  \$N = $N\n";

    my @digits  = grep { !/\./ } split //, $N;
    my @squares = map { $_ * $_ } @digits;
    my $sum     = 0;
       $sum    += $_ for @squares;
    my $root    = perfect_square_root( $sum );

    printf 'Output: %d', $root ? 1 : 0;

    if ($SHOW)
    {
        my $terms   = join ' + ', map { "$_^2" } @digits;
        my $squares = join ' + ',                @squares;

        print ' as ' . join( ' = ', $terms, $squares, $sum ) . 
              ($root ? " = $root^2" : ' which is not a perfect square');
    }

    print "\n";
}

#------------------------------------------------------------------------------
sub perfect_square_root
#------------------------------------------------------------------------------
{
    my ($N)   = @_;
    my  $root = int( sqrt( $N ) + 0.5 );

    # Return the square root if $N is a perfect square, or undef otherwise

    return ($root * $root) == $N ? $root : undef;
}

#------------------------------------------------------------------------------
sub parse_command_line
#------------------------------------------------------------------------------
{
    my $args = scalar @ARGV;
       $args == 1 or error( "Expected 1 command line argument, found $args" );

    my $N = $ARGV[ 0 ];
       $N =~ / ^ $RE{num}{real} $ /x
                  or error( qq["$N" is not a valid real number] );
       $N +=  0;                                  # Normalize: e.g., 010 --> 10
       $N >= 10   or error( "$N is less than 10" );

    return $N;
}

#------------------------------------------------------------------------------
sub error
#------------------------------------------------------------------------------
{
    my ($message) = @_;

    die "ERROR: $message\n$USAGE";
}

###############################################################################