mercoledì 10 maggio 2017

Diamonds in Perl

A diamond ascii is a geometric structure represented as, ehm, a diamond. For example, in the case of letters it becomes something like:


      a
    b  b
   c    c
  d      d
 e        e
f          f
 e        e
  d      d
   c    c
    b  b
     a

How hard can it be to build a Perl program to represent a diamond like the above one?
Well, not so much hard, but we have to observe some geometric properties:

  • the diamond is simmetric (in the sense it becomes and ends with the same letters), but the
    central row is reproduced only once (that is, the f appears only on one line, not two!);
  • each letter or couple of letters is vertically centered around the number of letters in the whole diamond, that is
    the letter a (vertical centre) is shifted to right of 6 chars (the total number of letters is a..f = 6);
  • each couple of letters has a left and right position, and both are equally distant from the vertical
    centre of the diamond.

Ok, so here it comes my shorter solution:



#!env perl

use v5.20;

my @letters = qw( a b c d e f );

my %index;
@index{ @letters } = ( 0 .. $#letters );


    say {*STDOUT}
  " " x ( $#letters - $index{ $_ } )
 , $_
 , " " x ( $index{ $_ } * 2 )
 ,( $index{ $_ } > 0 ? $_ : '' )
     for  ( ( @letters, reverse @letters[ 0 .. $#letters - 1 ] ) );

Allow me to explain it in all its pieces.


First of all, @letters contains the letters to be printed in the right order, and this of course could come from user's input, a sequence, an array slice, or whatever, it does not mind here. Since I have to place letters depending on where they are in the array of @letters, I need to have an handy way to get the index within the array for each letter, so I build up an hash where the keys are the letters themselves and the values are the positions of such letters. In other words, $index{a} = 0, $index{f] = 5 and so on.


Finally, I print a line every time I need with say. Let's dissect the say statement:

  • " " x ( $#letters - $index{ $_ } ) shifts to right a number of spaces required to reach the vertical centre or the right distance from it, in other words it is the left position. For example, for the letter a it comes
    down to 5 - 0 = 5, while for b it comes to 5 - 1 = 4 and so on.
  • then I print $_ that is the current char;
  • then I move again to the right of " " x ( $index{ $_ } * 2 ), that is in the case of a nothing, in the case of b by 2, and so on;
  • then if required I print again the char. Here "required" means the char is not the first one (i.e., not the one at index 0), since that is the only one character printed exactly one time per line.

The say is repeated over the whole @letters array, so this produces the first part of the diamond:


      a
    b  b
   c    c
  d      d
 e        e
f          f

then I need to get the bottom, so I need to iterate over the reverse @letters with the exception of the last element, that is I need to iterate over a reversed slice of @letters with the missing f: reverse @letters[ 0 .. $#letters - 1 ] ). This provides me the whole bottom of the diamond.

Nessun commento: