Building a training set of tags for perl5

[ErikSchierboom]

Hello lovely maintainers 👋

We've recently added "tags" to student's solutions. These express the constructs, paradigms and techniques that a solution uses. We are going to be using these tags for lots of things including filtering, pointing a student to alternative approaches, and much more.

In order to do this, we've built out a full AST-based tagger in C#, which has allowed us to do things like detect recursion or bit shifting. We've set things up so other tracks can do the same for their languages, but its a lot of work, and we've determined that actually it may be unnecessary. Instead we think that we can use machine learning to achieve tagging with good enough results. We've fine-tuned a model that can determine the correct tags for C# from the examples with a high success rate. It's also doing reasonably well in an untrained state for other languages. We think that with only a few examples per language, we can potentially get some quite good results, and that we can then refine things further as we go.

I released a new video on the Insiders page that talks through this in more detail.

We're going to be adding a fully-fledged UI in the coming weeks that allow maintainers and mentors to tag solutions and create training sets for the neural networks, but to start with, we're hoping you would be willing to manually tag 20 solutions for this track. In this post we'll add 20 comments, each with a student's solution, and the tags our model has generated. Your mission (should you choose to accept it) is to edit the tags on each issue, removing any incorrect ones, and add any that are missing. In order to build one model that performs well across languages, it's best if you stick as closely as possible to the C# tags as you can. Those are listed here. If you want to add extra tags, that's totally fine, but please don't arbitrarily reword existing tags, even if you don't like what Erik's chosen, as it'll just make it less likely that your language gets the correct tags assigned by the neural network.

---

To summarise - there are two paths forward for this issue:

1. You're up for helping: Add a comment saying you're up for helping. Update the tags some time in the next few days. Add a comment when you're done. We'll then add them to our training set and move forward.
2. You not up for helping: No problem! Just please add a comment letting us know :)

If you tell us you're not able/wanting to help or there's no comment added, we'll automatically crowd-source this in a week or so.

Finally, if you have questions or want to discuss things, it would be best done on the forum, so the knowledge can be shared across all maintainers in all tracks.

Thanks for your help! 💙

---

Note: Meta discussion on the forum

[ErikSchierboom]

Exercise: leap

Code

use 5.18.2;
use strict;
use warnings;

package Leap;

our $VERSION = '1.000';

use Exporter 5.57 qw(import);

our @EXPORT_OK = qw(is_leap);

sub is_leap {
    my $year = shift(@_);

    if ($year % 400 == 0) {
        return 1;
    } elsif (($year % 4 == 0) && ($year % 100 != 0)) {
        return 1;
    } else {
        return 0;
    }
}

Tags:

construct:boolean
construct:decimal
construct:elsif
construct:if
construct:logical-and
construct:number
construct:package
construct:return
construct:string
construct:subroutine
construct:use
construct:variable
construct:visibility
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic

[ErikSchierboom]

Exercise: raindrops

Code

package Raindrops;
use strict;
use warnings;

sub convert {
    my $n = shift;
    my $out;

    $out .= "Pling" if $n % 3 == 0;
    $out .= "Plang" if $n % 5 == 0;
    $out .= "Plong" if $n % 7 == 0;
    $out ? $out : $n;
}

1;

Tags:

construct:assignment
construct:if
construct:method
construct:number
construct:package
construct:subroutine
construct:ternary
construct:use-directive
construct:variable
construct:visibility-modifiers
paradigm:imperative
paradigm:object-oriented

[ErikSchierboom]

Exercise: hamming

Code

use strict;
use warnings;

use Test::More;

my $module = $ENV{EXERCISM} ? 'Example' : 'Hamming';

plan tests => 11;

ok -e "$module.pm", "Missing $module.pm" or BAIL_OUT "You need to create file: $module.pm";
eval "use $module";
ok !$@, "Cannot load $module" or BAIL_OUT "Cannot load $module. Does it compile? Does it end with 1;?";
can_ok $module, 'compute' or BAIL_OUT "Missing package $module; or missing sub compute()?";

my $sub = \&{"$module" . "::compute"}; 
is $sub->('A', 'A'), 0, "identical strands";
is $sub->('AG', 'CT'), 2, "completely different strands";
is $sub->('AT', 'CT'), 1, "one hamming distance";
is $sub->('GGACG', 'GGTCG'), 1, "one hamming distance, longer strands";
is $sub->('AAAG', 'AAA'), 0, "ignore extra length on 1st strand";
is $sub->('AAA', 'AAAG'), 0, "ignore extra length on 2nd strand";
is $sub->('GATACA', 'GCATAA'), 4, "4 hamming distance";
is $sub->('GGACGGATTCTG', 'AGGACGGATTCT'), 9, "9 hamming distance"

Tags:

construct:string-interpolation
construct:boolean
construct:eval
construct:expression
construct:hash
construct:implicit-conversion
construct:indexing
construct:invocation
construct:method
construct:number
construct:or
construct:ternary
construct:use
construct:variable
construct:visibility-modifiers
paradigm:imperative
paradigm:functional
paradigm:reflective
paradigm:declarative
technique:boolean-logic
technique:exceptions
technique:higher-order

[ErikSchierboom]

Exercise: hamming

Code

use 5.18.2;
use strict;
use warnings;


package Hamming;

our $VERSION = '1.000';

use Exporter 5.57 qw(import);

our @EXPORT_OK = qw(compute);

sub compute {
    my ($dna1, $dna2) = @_;

    my @s1 = split(//, $dna1);
    my @s2 = split(//, $dna2);

    my $dist = 0;

    my $cmp = @s1 < @s2 ? scalar(@s1) : scalar(@s2);

    for(my $i=0; $i < scalar($cmp); $i++) {
        unless ($s1[$i] eq $s2[$i]) {
            $dist++;
        }
    }
    return $dist;
}

Tags:

construct:class
construct:for-loop
construct:if
construct:indexing
construct:package
construct:scalar
construct:subroutine
construct:ternary
construct:use-directive
construct:variable
construct:visibility-modifiers
paradigm:object-oriented
paradigm:imperative
paradigm:functional
technique:looping

[ErikSchierboom]

Exercise: proverb

Code

package Proverb;
use strict;
use warnings;

sub proverb {
    my ( $param, $qualifier ) = @_;
    my $out = '';

    my $f = $param->[0];
    $f = "$qualifier $f" if $qualifier;

    while ( my $p = shift @$param ) {
        last unless my $q = $param->[0];
        $out .= "For want of a $p the $q was lost.\n";
    }

    $out .= "And all for the want of a $f.";
}

1;

Tags:

construct:assignment
construct:string
construct:if
construct:indexing
construct:last
construct:loop
construct:package
construct:subroutine
construct:use-directive
construct:variable
construct:while-loop
paradigm:imperative
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: roman-numerals

Code

package Decimal;
use strict;
use warnings;

sub new {
    my ($class, $num) = @_;
    bless {num => $num}, $class
}

sub to_roman {
    my ($self) = shift;
    my $roman;
    while ( $self->{num} ) {
        if ( $self->{num} >= 1000 ) {
            $roman .= "M";
            $self->{num} -= 1000
        }
        elsif ( $self->{num} >= 900 ) {
            $roman .= "CM";
            $self->{num} -= 900
        }
        elsif ( $self->{num} >= 500 ) {
            $roman .= "D";
            $self->{num} -= 500
        }
        elsif ( $self->{num} >= 400 ) {
            $roman .= "CD";
            $self->{num} -= 400
        }
        elsif ( $self->{num} >= 100 ) {
            $roman .= "C";
            $self->{num} -= 100
        }
        elsif ( $self->{num} >= 90 ) {
            $roman .= "XC";
            $self->{num} -= 90
        }
        elsif ( $self->{num} >= 50 ) {
            $roman .= "L";
            $self->{num} -= 50
        }
        elsif ( $self->{num} >= 40 ) {
            $roman .= "XL";
            $self->{num} -= 40
        }
        elsif ( $self->{num} > 10 ) {
            $roman .= "X";
            $self->{num} -= 10
        }
        elsif ( $self->{num} >= 9 ) {
            $roman .= "IX";
            $self->{num} -= 9
        }
        elsif ( $self->{num} >= 5 ) {
            $roman .= "V";
            $self->{num} -= 5
        }
        elsif ( $self->{num} >= 4 ) {
            $roman .= "IV";
            $self->{num} -= 4
        }
        elsif ($self->{num} > 0 ) {
            $roman .= "I";
            $self->{num} -= 1
        }
    }
    return $roman
}

1;

Tags:

construct:assignment
construct:bless
construct:class
construct:if
construct:method
construct:number
construct:package
construct:parameter
construct:return
construct:string
construct:subroutine
construct:use
construct:variable
construct:while-loop
construct:word
paradigm:imperative
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: atbash-cipher

Code

package Cipher;
use strict;
use warnings FATAL => 'all';
use v5.10;
use List::Util qw|max|;

sub alphabet { state $alphabet = join '', 'a' .. 'z'; }
sub reverse_alphabet { state $reverse_alphabet = join '', reverse 'a' .. 'z'; }

sub cipher { my ($str, $alphabet, $reverse_alphabet) = @_;
    my $split_into_5_letter_words = 5 < max map { length } split ' ', $str;

    $str = lc $str;
    $str =~ s/\s+//g;
    $str = join '', $str =~ /(\w+)/g;

    if ($split_into_5_letter_words) {
        $str = reverse $str;
        $str = split_str_every_nth_character_with($str, 5, ' ');
        $str = reverse $str;
    }

    eval "\$str =~ tr/$alphabet/$reverse_alphabet/, 1" || die $@;

    $str;
}

sub split_str_every_nth_character_with { my ($str, $n, $separator) = @_;
    $n         //= 3;
    $separator //= ' ';
    1 while $str =~ s/^(\w+)(\w{$n})/$1$separator$2/;
    $str;
}

sub encode { my ($str) = @_;
    cipher($str, alphabet(), reverse_alphabet());
}

sub decode { my ($str) = @_;
    cipher($str, reverse_alphabet(), alphabet());
}

1;

Tags:

construct:string-interpolation
construct:assignment
construct:camelcase
construct:die
construct:eval
construct:expression
construct:function
construct:if
construct:invocation
construct:lambda
construct:list
construct:method
construct:number
construct:optional-parameter
construct:package
construct:parameter
construct:regular-expression
construct:return
construct:state-variable
construct:string
construct:substitution
construct:sub
construct:ternary
construct:throw
construct:use
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:exceptions
technique:higher-order-functions
technique:looping
technique:regular-expression
uses:List::Util

[ErikSchierboom]

Exercise: accumulate

Code

package Accumulate;
use strict;
use warnings;

sub accumulate {
    my ( $input, $function ) = @_;
    my $output = [];

    $output->[ ++$#{$output} ] = $function->($_) for @$input;

    $output;
}

1;

Tags:

construct:assignment
construct:for-loop
construct:function
construct:implicit-return
construct:indexing
construct:invocation
construct:list
construct:method
construct:number
construct:package
construct:parameter
construct:perl
construct:subroutine
construct:use-directive
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: crypto-square

Code

package Crypto;
use strict;
use warnings;

sub new {
    my ( $class, $plaintext ) = @_;
    bless \$plaintext => $class;
}

sub normalize_plaintext {
    ${ +shift } =~ tr/A-Z/a-z/r =~ tr/a-z0-9//cdsr;
}

sub size {
    my ( $norm, $sq ) = ( shift->normalize_plaintext, 0 );

    ++$sq while $sq**2 < length $norm;
    $sq;
}

sub plaintext_segments {
    my $self = shift;

    [ unpack "(A@{[ $self->size ]})*", $self->normalize_plaintext ];
}

sub normalize_ciphertext {
    my $seg = shift->plaintext_segments;

    $_ = [ split // ] for @$seg;

    join ' '    => unpack "(A@{[ scalar @$seg ]})*",
        join '' => map { $_ || ' ' } _mesh(@$seg);
}

sub ciphertext {
    shift->normalize_ciphertext =~ tr/a-z0-9//cdsr;
}

sub _mesh {
    my $max = -1;
    $max < $#$_ and $max = $#$_ foreach @_;
    map {
        my $ix = $_;
        map $_->[$ix], @_;
    } 0 .. $max;
}

1;

Tags:

construct:assignment
construct:attribute
construct:blessed
construct:class
construct:constructor
construct:expression
construct:for
construct:foreach
construct:implicit-return
construct:index
construct:invocation
construct:join
construct:lambda
construct:length
construct:list
construct:logical-and
construct:map
construct:method
construct:number
construct:package
construct:parameter
construct:range
construct:return
construct:shift
construct:string
construct:subroutine
construct:tr
construct:transliteration
construct:tuple
construct:use
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:higher-order-functions
technique:looping

[ErikSchierboom]

Exercise: simple-cipher

Code

package Cipher {

    our @alphabet = 'a'..'z';

    sub new {
        my( $class, $key ) = @_;

        $key //= 'a';

        die "ArgumentError" if $key =~ /[^a-z]/ or not length $key;

        return bless [ map { ord($_) - ord 'a' } split '', $key ], $class;
    }

    sub encode {
        my( $self, $text ) = @_;

        $text = lc $text;
        $text =~ s/[^a-z]//g;

        my $i = 0;
        return join '',
            map { $alphabet[$_ % @alphabet] }
            map { $self->[$i++ % @$self ] + $_ + @alphabet}
            map { ord( $_ ) - ord 'a' }
            split '', $text;
    }

    sub decode {
        my( $self, $text ) = @_;

        my $clone = [ map { -$_ } @$self ];

        (bless $clone, __PACKAGE__)->encode($text);
    }

};

1;

Tags:

construct:add
construct:assignment
construct:blessed
construct:class
construct:constructor
construct:die
construct:divide
construct:expression
construct:field
construct:if
construct:index
construct:invocation
construct:join
construct:lambda
construct:list
construct:map
construct:method
construct:number
construct:optional
construct:or
construct:package
construct:parameter
construct:pattern
construct:return
construct:short
construct:split
construct:string
construct:subtract
construct:throw
construct:using
construct:variable
construct:visibility
paradigm:functional
paradigm:object-oriented
technique:exceptions
technique:higher-order-functions
technique:regular-expression
uses:List<T>
uses:Regex

[ErikSchierboom]

Exercise: pig-latin

Code

package PigLatin;
use strict;
use warnings FATAL => 'all';
use v5.10;
use List::Util qw|none|;

sub _translate { my ($word) = @_;
    state $exceptions = exceptions();
    return $exceptions->{$word} if exists $exceptions->{$word};

    my $vowels     = join '', @{ vowels() };
    my $consonants = join '', @{ consonants() };

    return "${word}ay" if $word =~ /^[$vowels]/;
    $word =~ s/([$consonants]+u?)([$vowels$consonants]+)/$2$1ay/;
    return $word;
}

sub exceptions {
    state $e = {
        'thrush' => 'ushthray',
        'run'    => 'unray',
        'yttria' => 'yttriaay',
        'xray'   => 'xrayay',
    };
}

sub alphabet   { state $a = ['a' .. 'z']; };
sub vowels     { state $v = [qw|a e i o u|]; };
sub consonants {
    state $c = [
        grep {
            my $alphabet_letter = $_;
            none {
                my $vowel = $_;
                $vowel eq $alphabet_letter;
            } @{ vowels() }
        } @{ alphabet() }
    ];
}

sub translate { my ($text) = @_;
    join ' ', map { _translate($_) } split ' ', $text;
}

1;

Tags:

construct:string-interpolation
construct:assignment
construct:if
construct:indexing
construct:invocation
construct:join
construct:list
construct:map
construct:named-argument
construct:number
construct:package
construct:pattern
construct:qw
construct:regular-expression
construct:return
construct:state-variable
construct:subroutine
construct:use-directive
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:higher-order-functions
technique:regular-expression
uses:List::Util

[ErikSchierboom]

Exercise: wordy

Code

package Wordy;

use warnings;
use strict;


my %operators = ( plus             => '+',
                  minus            => '-',
                  'multiplied by'  => '*',
                  'divided by'     => '/',
                );

my $INTEGER = qr/-?[0-9]+/;


sub answer {
    my $question = shift;
    die 'ArgumentError' unless 'What is ' eq substr $question,  0, 8, q()
                        and           '?' eq substr $question, -1, 1, q();

    my $answer = $question;

    $answer    =~ s{($INTEGER)\ (.+?)\         ($INTEGER)}
                   {"$1         $operators{$2} $3"       }exe for 1, 2;

    die 'ArgumentError' unless $answer =~ /^-?[0-9]+$/;
    return $answer
}

__PACKAGE__

Tags:

construct:and
construct:assignment
construct:die
construct:for:loop
construct:hash
construct:invocation
construct:method
construct:number
construct:package
construct:pattern
construct:qr
construct:return
construct:string
construct:substitution
construct:subtraction
construct:ternary
construct:unless
construct:use-directive
construct:value
construct:variable
construct:visibility-modifiers
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:exceptions
technique:looping
technique:regular-expression
uses:Wordy

[ErikSchierboom]

Exercise: nucleotide-count

Code

package NucleotideCount;

use strict;
use warnings;

our %NUCLEOTIDES = qw(A 1 C 1 G 1 T 1);

sub new {
    my $class = shift;
    (bless {dna => shift}, $class)->_init();
}

sub _init {
    my $self = shift;

    my $valid = join('', keys %NUCLEOTIDES);
    die "Invalid DNA" unless $self->{dna} =~ m<^[$valid]*$>;
    
    return $self;
}

sub count {
    my $self = shift;
    my $what = shift;

    die "Invalid Nucleotide" unless $NUCLEOTIDES{$what};
    return $self->{dna} =~ s/$what/$what/g || 0;
}

sub nucleotide_counts {
    my $self = shift;

    return { map { $_ => $self->count($_) } keys %NUCLEOTIDES };
}

1;

Tags:

construct:bless
construct:die
construct:hash
construct:invocation
construct:join
construct:map
construct:method
construct:number
construct:package
construct:pattern
construct:qw
construct:return
construct:string
construct:substitution
construct:sub
construct:unless
construct:use strict
construct:use warnings
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:object-oriented
technique:exceptions
technique:higher-order-functions
technique:regular-expression
uses:InvocableMethod
uses:Regex

[ErikSchierboom]

Exercise: binary-search

Code

package BinarySearch;

sub is_list_strings{
	my $list = shift;
	for(@$list){
		return 0 if $_ =~ /^[^a-zA-Z]+$/ 
	}
	return 1;
}

sub is_sorted_list{
	my $list = shift;
	my $list_of_strings = is_list_strings($list);
	for(0..$#$list-1){
		if($list_of_strings){
			return 0 if ($list->[$_] cmp $list->[$_+1]) == 1; 
		} else {
			return 0 if $list->[$_] > $list->[$_+1];
		}
	}
	return 1;
}

sub binary_search{
	my ($key, $list) = @_;
	my ($left, $right) = (0, scalar @$list - 1);
	die "List must be sorted" if ! is_sorted_list($list);
	my $is_string_array = is_list_strings($list);

	while($right >= $left){
		my $mid = int ($left + ($right - $left) / 2);
		
		if($is_string_array){
			return $mid if $$list[$mid] eq $key;
			$right = $mid - 1 if ($key cmp $$list[$mid]) == -1;
			$left = $mid + 1 if ($key cmp $$list[$mid]) == 1;
		} else {
			return $mid if $$list[$mid] == $key;
			$right = $mid - 1 if $key < $$list[$mid];
			$left = $mid + 1 if $key > $$list[$mid];
		}
	}
	return undef
}
1;

Tags:

construct:add
construct:assignment
construct:divide
construct:equivalence
construct:for
construct:if
construct:implicit-conversion
construct:indexing
construct:invocation
construct:list
construct:method
construct:number
construct:package
construct:parameter
construct:pattern
construct:return
construct:string
construct:subtract
construct:subtraction
construct:ternary
construct:variable
construct:while-loop
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:looping
uses:Regex

[ErikSchierboom]

Exercise: meetup

Code

package Meetup;
use strict;
use warnings;

use DateTime;

my $_t = 'teenth';
my $_l = 'last';

my %_weekdays = ( monday => 1,
                  tuesday => 2,
                  wednesday => 3,
                  thursday => 4,
                  friday => 5,
                  saturday => 6,
                  sunday => 7 );

my %_orders = ( first => 1,
                second => 2,
                third => 3,
                fourth => 4 );

sub new {
    my ($class, $month, $year) = @_;
    bless { month => $month,
            year  => $year }, $class
}

sub day {
    my ($self, $weekday, $which) = @_;
    my $date = DateTime->new( year  => $self->{year},
                              month => $self->{month},
                              day   => 1 );
    if ($which !~ /$_t|$_l/) {
        my $dow = $date->day_of_week();
        $date->add( days  => ( $_weekdays{$weekday} - $dow + 7 ) % 7,
                    weeks => $_orders{$which} - 1 );
        return $date
    } else {
        $date = DateTime->last_day_of_month( year => $self->{year},
                                             month => $self->{month} )
            if ($which =~ /$_l/);
        $date->add( days => 12 ) if ($which =~ /$_t/);
        while (1) {
            return $date if ($date->day_of_week == $_weekdays{$weekday});
            $date->add( days => 1 )      if ($which =~ /$_t/);
            $date->subtract( days => 1 ) if ($which =~ /$_l/)
        }
    }
}

1;

Tags:

construct:add
construct:assignment
construct:blessed-reference
construct:class
construct:constructor
construct:date-time
construct:hash
construct:if
construct:indexing
construct:invocation
construct:method
construct:number
construct:package
construct:parameter
construct:pattern
construct:return
construct:string
construct:subtract
construct:use
construct:variable
construct:visibility-modifiers
construct:while-loop
paradigm:imperative
paradigm:object-oriented
technique:looping
uses:DateTime
uses:DateTime::Duration

[ErikSchierboom]

Exercise: saddle-points

Code

package Matrix;

use strict;
use warnings;

use List::Util qw/max min/;

sub new {
	# Finds saddle points in a matrix
	my ($class, $matrixLines) = @_;
	my @matrix = map {$_ = [split " ", $_]} split "\n", $matrixLines;
	bless \@matrix, $class;
}

sub rows {
	# A row of the matrix
	my ($self, $rowNum) = @_;
	return $self->[$rowNum];
}

sub columns {
	# A column of the matrix
	my ($self, $colNum) = @_;
	return [map { $self->[$_]->[$colNum] } (0..$#$self)];
}

sub saddle_points {
	# Finds all points that are the biggest in there row and smallest in there column
	my $self = shift;
	my @saddlePoints;
	foreach my $rowNum (0..$#$self) {
		foreach my $colNum (0..$#{$self->[$rowNum]}) {
			next unless $self->[$rowNum]->[$colNum] == min @{$self->columns($colNum)};
			next unless $self->[$rowNum]->[$colNum] == max @{$self->rows($rowNum)};
			push @saddlePoints, [$rowNum, $colNum];
		}
	}
	return \@saddlePoints;
}

1;

Tags:

construct:bless
construct:class
construct:comment
construct:foreach
construct:invocation
construct:list
construct:map
construct:method
construct:number
construct:package
construct:parameter
construct:qw
construct:return
construct:string
construct:sub
construct:subroutine
construct:throw
construct:unless
construct:use
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:object-oriented
technique:exceptions
technique:looping

[ErikSchierboom]

Exercise: all-your-base

Code

package AllYourBase;
use strict;
use warnings;

sub convert_base {
  my ($input_digits, $input_base, $output_base) = @_;
  die "base must be greater than 1" if $input_base <= 1 or $output_base <= 1;
  my $base_10_num = 0;
  my @output_digits;

  # convert input_digits to base 10
  my @reversed_digits = reverse @{$input_digits};
  for (my $i = 0; $i < scalar @reversed_digits; $i++) {
    my $digit = $reversed_digits[$i];
    die "negative digit not allowed" if $digit < 0;
    die "digit equal of greater than the base" if $digit >= $input_base;
    $base_10_num += $digit * ($input_base ** $i);
  }

  push @output_digits, 0 if $base_10_num == 0;

  #convert base 10 number to output_base digits
  while ($base_10_num > 0) {
    use integer;
    unshift @output_digits, ($base_10_num % $output_base);
    $base_10_num /= $output_base;
  }

  return \@output_digits;
}

1;

Tags:

construct:assignment
construct:boolean
construct:die
construct:expression
construct:for
construct:if
construct:indexing
construct:invocation
construct:list
construct:logical-or
construct:loop
construct:method
construct:multiply
construct:number
construct:package
construct:parameter
construct:return
construct:scalar
construct:string
construct:subroutine
construct:throw
construct:use-directive
construct:variable
construct:visibility-modifiers
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic
technique:exceptions
technique:looping

[ErikSchierboom]

Exercise: all-your-base

Code

package AllYourBase;
use strict;
use warnings;
use List::Util qw/any/;

sub convert_base {
    my ($digits, $from_base, $to_base) = @_;
    my @digits = @{ $digits };
    die "Input error: base must be greater than 1!\n"
        if $from_base < 2 or $to_base < 2;
    die "Input error: negative digit not allowed!\n"
        if any { $_ < 0 } @digits;
    die "Input error: digit equal of greater than the base!\n"
        if any { $_ >= $from_base } @digits;
    my $num = digits_to_num($from_base, @digits);
    return num_to_digits($to_base, $num);
}

sub digits_to_num {
    my ($base, @digits) = @_;
    my $sum = 0;
    my $place = 1;
    for my $digit (reverse @digits) {
        $sum += $digit * $place;
        $place *= $base;
    }
    return $sum;
}

sub num_to_digits {
    my ($base, $num) = @_;
    return [0]
        if $num == 0;
    my @digits;
    while ( $num > 0 ) {
        unshift @digits, $num % $base;
        $num = int( $num / $base );
    }
    return \@digits;
}

1;

Tags:

construct:assignment
construct:boolean
construct:divide
construct:double
construct:for
construct:floating-point-number
construct:if
construct:implicit-conversion
construct:indexing
construct:invocation
construct:list
construct:logical-or
construct:loop
construct:method
construct:multiply
construct:number
construct:package
construct:parameter
construct:perl
construct:return
construct:string
construct:subroutine
construct:throw
construct:use-directive
construct:variable
construct:visibility-modifiers
construct:while-loop
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:boolean-logic
technique:exceptions
technique:looping

[ErikSchierboom]

Exercise: binary

Code

package Binary;

use strict;
use warnings;

sub new {
    my $class = shift;
    my $binary = shift;

    $binary =~ s/[^01]/0/g;

    return bless \$binary, $class;
}

sub to_decimal {
    my $self = shift;

    my( $i, $sum );
    $sum += 2**$i++ * $_ for reverse split //, $$self;
    return $sum;
}

1;

Tags:

construct:class
construct:method
construct:package
construct:regular-expression
construct:return
construct:substitution
construct:subtraction
construct:use
construct:variable
construct:visibility-modifiers
paradigm:object-oriented
technique:regular-expression
uses:Binary

[ErikSchierboom]

Exercise: two-fer

Code

#!/usr/bin/perl -w


print "What would you like to say to Bob. \n "; 
my $sentence = <STDIN>; 
chomp ($sentence);      
if ($sentence =~ /^\s*$/){                           
    print "Fine be that way!\n"; 
}elsif ($sentence =~ /^[A-Z\s]+$/){
    print "Whoa, chill out!\n"; 
}elsif ($sentence =~ /^[A-Z\s]+\?$/ ){
    print "Calm Down. I know what im doing.\n"; 
}elsif ($sentence =~ /\?$/){ 
    print "Sure.\n"; 
}else{
    print "Whatever.\n";
}

Tags:

construct:assignment
construct:backreference
construct:command
construct:if
construct:input
construct:invocation
construct:method
construct:pattern
construct:print
construct:readme
construct:regex
construct:regular-expression
construct:variable
construct:word
paradigm:imperative
paradigm:reflective
technique:regular-expression

[ErikSchierboom]

This is an automated comment

Hello 👋 Next week we're going to start using the tagging work people are doing on these. If you've already completed the work, thank you! If you've not, but intend to this week, that's great! If you're not going to get round to doing it, and you've not yet posted a comment letting us know, could you please do so, so that we can find other people to do it. Thanks!