Add challenge-081's ch-1, ch-2 solution in Perl

6 files changed, 207 insertions, 57 deletions

diff --git a/challenge-081/andinus/README b/challenge-081/andinus/README
index 825903731b..13354ca364 100644
--- a/challenge-081/andinus/README
+++ b/challenge-081/andinus/README
@@ -1,5 +1,5 @@
                             ━━━━━━━━━━━━━━━
-                             CHALLENGE 080
+                             CHALLENGE 081
 
                                 Andinus
                             ━━━━━━━━━━━━━━━
@@ -8,104 +8,155 @@
 Table of Contents
 ─────────────────
 
-1 Task 1 - Smallest Positive Number Bits
-.. 1.1 Perl
-2 Task 2 - Count Candies
-.. 2.1 Perl
+1. Task 1 - Common Base String
+.. 1. Perl
+2. Task 2 - Frequency Sort
+.. 1. Perl
 
 
 
 
 
-1 Task 1 - Smallest Positive Number Bits
-════════════════════════════════════════
+1 Task 1 - Common Base String
+═════════════════════════════
 
-  You are given unsorted list of integers `@N'.
+  You are given 2 strings, `$A' and `$B'.
 
-  Write a script to find out the smallest positive number missing.
+  Write a script to find out common base strings in `$A' and `$B'.
+
+        A substring of a string $S is called base string if
+        repeated concatenation of the substring results in the
+        string.
 
 
 1.1 Perl
 ────────
 
-  • Program: [file:perl/ch-1.pl]
+  • Program: <file:perl/ch-1.pl>
+
+  We will break `$A' & check if any subset of `$A' join to make `$B'. To
+  speed up the process we only break `$A' by common divisors of both
+  `$A' & `$B'.
 
-  We take input from `@ARGV', sort it & remove all inputs less than 2.
-  We check if the smallest positive number is 2.
+  I assume that the length of `$B' is greater than `$A' in later parts
+  so we make sure that it's true.
   ┌────
-  │ my @sorted = sort { $a <=> $b } @ARGV;
-  │
-  │ # Print 1 if there are no positive numbers in @sorted.
-  │ print "1\n" and exit 0 if $sorted[$#sorted] < 1;
+  │ my $A = shift @ARGV;
+  │ my $B = shift @ARGV;
   │
-  │ while (my $arg = shift @sorted) {
-  │     next if $arg < 2;
-  │     print "2\n" and exit 0 unless $arg == 2;
-  │     last;
+  │ # We assume length($B) is greater than length($A).
+  │ unless (length($B) > length($A)) {
+  │     my $tmp = $A;
+  │     $A = $B;
+  │     $B = $tmp;
   │ }
   └────
 
-  Now we are sure the smallest positive number is not 1 or 2 & `@sorted'
-  doesn't contain any number less than 2, infact it doesn't contain any
-  number less than 3.
+  If the strings have different sets of characters then common base
+  string cannot exists so we exit early.
+  ┌────
+  │ # Check if common base string is even possible.
+  │ my (%chars_in_A, %chars_in_B);
+  │ $chars_in_A{$_} = 1 foreach split //, $A;
+  │ $chars_in_B{$_} = 1 foreach split //, $B;
+  │ foreach my $char (sort keys %chars_in_A) {
+  │     last if exists $chars_in_B{$char} ;
+  │     print "No common base string.\n" and exit 0
+  │ }
+  └────
 
-  We loop from `3 ... $sorted[$#sorted] + 1' & then over `@sorted'
-  array. The first number from the array is dropped if it's equal to
-  `$num'. If not then `$num' is the smallest positive number, we print
-  it & exit the `MAIN' loop.
+  Get all the common divisors of `$A' & `$B'.
+  ┌────
+  │ # Get all common divisors.
+  │ my %divisors_of_A = divisors(length($A));
+  │ my %divisors_of_B = divisors(length($B));
+  │ my @common_divisors;
+  │ foreach my $num (sort { $a <=> $b } keys %divisors_of_A) {
+  │     push @common_divisors, $num
+  │         if exists $divisors_of_B{$num};
+  │ }
+  │
+  │ # Returns all divisors of a number.
+  │ sub divisors {
+  │     my $n = shift @_;
+  │     my %divisors;
+  │     foreach my $i ( 1 ... $n){
+  │         if ($n % $i == 0) {
+  │             $divisors{$i} = 1;
+  │         }
+  │     }
+  │     return %divisors;
+  │ }
+  └────
 
-  This won't print the smallest positive number if the user passed
-  consecutive set of numbers, we just add `print "$num\n"' at the end to
-  cover this case.
+  We check if any subset of `$A' joins to make `$B'.
   ┌────
-  │ MAIN: foreach my $num (3 ... $sorted[$#sorted] + 1) {
-  │     foreach (@sorted) {
-  │         shift @sorted and next MAIN if $num == $_;
-  │         print "$num\n" and last MAIN;
+  │ my @common;
+  │
+  │ foreach my $num (@common_divisors){
+  │     my $tmp;
+  │     my $base = substr($A, 0, $num);
+  │     foreach (1 ... length($B) / $num) {
+  │         $tmp .= $base;
   │     }
-  │     # Print the last element if it was a continous series of positive
-  │     # numbers.
-  │     print "$num\n";
+  │     push @common, $base if $tmp eq $B;
   │ }
+  │
+  │ print "No common base string.\n" and exit 0
+  │     unless scalar @common;
+  │ print join(', ', @common), "\n";
   └────
 
 
-2 Task 2 - Count Candies
-════════════════════════
+2 Task 2 - Frequency Sort
+═════════════════════════
 
-  You are given rankings of `@N' candidates.
+  You are given file named input.
 
-  Write a script to find out the total candies needed for all
-  candidates. You are asked to follow the rules below:
+  Write a script to find the frequency of all the words.
 
-  1. You must given at least one candy to each candidate.
-  2. Candidate with higher ranking get more candies than their mmediate
-     neighbors on either side.
+  It should print the result as first column of each line should be the
+  frequency of the the word followed by all the words of that frequency
+  arranged in lexicographical order. Also sort the words in the
+  ascending order of frequency.
+
+  For the sake of this task, please ignore the following in the input
+  file: `. " ( ) , 's --'
 
 
 2.1 Perl
 ────────
 
-  • Program: [file:perl/ch-2.pl]
+  • Program: <file:perl/ch-2.pl>
 
-  Giving at least one day to all candidates.
+  Swap unwanted characters with a space.
   ┌────
-  │ my $candies = scalar @ARGV;
+  │ my $file = path(shift @ARGV)->slurp;
+  │
+  │ $file =~ s/(--|'s)/ /g;
+  │ $file =~ s/[."(),]+/ /g;
+  │ $file =~ s/  / /g;
+  │ $file =~ s/\n/ /g;
   └────
 
-  Handling first & last index, we do this outside the loop to keep it
-  simple.
+  Get frequency of each word.
   ┌────
-  │ $candies++ if $ARGV[0] > $ARGV[1];
-  │ $candies++ if $ARGV[$#ARGV] > $ARGV[$#ARGV - 1];
+  │ my %words;
+  │ foreach my $word (split / /, $file) {
+  │     $words{$word} = 1 and next unless exists $words{$word};
+  │     $words{$word}++;
+  │ }
   └────
 
-  Loop handles rest of the entries.
+  Format the output.
   ┌────
-  │ foreach my $index (1 ... $#ARGV - 1) {
-  │     $candies++ if $ARGV[$index] > $ARGV[$index - 1];
-  │     $candies++ if $ARGV[$index] > $ARGV[$index + 1];
+  │ my %out;
+  │ foreach my $word (sort keys %words) {
+  │     my $freq = $words{$word};
+  │     push @{$out{$freq}}, $word;
   │ }
   │
-  │ print "$candies\n";
+  │ foreach my $freq (sort { $a <=> $b} keys %out) {
+  │     print "$freq ", join(' ', @{$out{$freq}}, "\n");
+  │ }
   └────
diff --git a/challenge-081/andinus/blog-1.txt b/challenge-081/andinus/blog-1.txt
new file mode 100644
index 0000000000..e29de6f856
--- /dev/null
+++ b/challenge-081/andinus/blog-1.txt
@@ -0,0 +1 @@
+https://andinus.tilde.institute/pwc/challenge-081/#orgec70af1
diff --git a/challenge-081/andinus/blog-2.txt b/challenge-081/andinus/blog-2.txt
new file mode 100644
index 0000000000..bd35ae9dfe
--- /dev/null
+++ b/challenge-081/andinus/blog-2.txt
@@ -0,0 +1 @@
+https://andinus.tilde.institute/pwc/challenge-081/#orgea1463f
diff --git a/challenge-081/andinus/perl/ch-1.pl b/challenge-081/andinus/perl/ch-1.pl
new file mode 100755
index 0000000000..08749ad0d9
--- /dev/null
+++ b/challenge-081/andinus/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+die "usage: ./ch-1.pl <string> <string>"
+    unless scalar @ARGV == 2;
+
+my $A = shift @ARGV;
+my $B = shift @ARGV;
+
+# We assume length($B) is greater than length($A).
+unless (length($B) > length($A)) {
+    my $tmp = $A;
+    $A = $B;
+    $B = $tmp;
+}
+
+# Check if common base string is even possible.
+my (%chars_in_A, %chars_in_B);
+$chars_in_A{$_} = 1 foreach split //, $A;
+$chars_in_B{$_} = 1 foreach split //, $B;
+foreach my $char (sort keys %chars_in_A) {
+    last if exists $chars_in_B{$char} ;
+    print "No common base string.\n" and exit 0;
+}
+
+# Get all common divisors.
+my %divisors_of_A = divisors(length($A));
+my %divisors_of_B = divisors(length($B));
+my @common_divisors;
+foreach my $num (sort { $a <=> $b } keys %divisors_of_A) {
+    push @common_divisors, $num
+        if exists $divisors_of_B{$num};
+}
+
+# Returns all divisors of a number.
+sub divisors {
+    my $n = shift @_;
+    my %divisors;
+    foreach my $i ( 1 ... $n){
+        if ($n % $i == 0) {
+            $divisors{$i} = 1;
+        }
+    }
+    return %divisors;
+}
+
+my @common;
+
+foreach my $num (@common_divisors){
+    my $tmp;
+    my $base = substr($A, 0, $num);
+    foreach (1 ... length($B) / $num) {
+        $tmp .= $base;
+    }
+    push @common, $base if $tmp eq $B;
+}
+
+print "No common base string.\n" and exit 0
+    unless scalar @common;
+print join(', ', @common), "\n";
diff --git a/challenge-081/andinus/perl/ch-2.pl b/challenge-081/andinus/perl/ch-2.pl
new file mode 100755
index 0000000000..0f17acb868
--- /dev/null
+++ b/challenge-081/andinus/perl/ch-2.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Path::Tiny;
+
+die "usage: ./ch-1.pl <file path>"
+    unless scalar @ARGV == 1;
+
+my $file = path(shift @ARGV)->slurp;
+
+$file =~ s/(--|'s)/ /g;
+$file =~ s/[."(),]+/ /g;
+$file =~ s/  / /g;
+$file =~ s/\n/ /g;
+
+my %words;
+foreach my $word (split / /, $file) {
+    $words{$word} = 1 and next unless exists $words{$word};
+    $words{$word}++;
+}
+
+my %out;
+foreach my $word (sort keys %words) {
+    my $freq = $words{$word};
+    push @{$out{$freq}}, $word;
+}
+
+foreach my $freq (sort { $a <=> $b} keys %out) {
+    print "$freq ", join(' ', @{$out{$freq}}, "\n");
+}
diff --git a/challenge-081/andinus/perl/file.txt b/challenge-081/andinus/perl/file.txt
new file mode 100644
index 0000000000..37001629ad
--- /dev/null
+++ b/challenge-081/andinus/perl/file.txt
@@ -0,0 +1,3 @@
+West Side Story
+
+The award-winning adaptation of the classic romantic tragedy "Romeo and Juliet". The feuding families become two warring New York City gangs, the white Jets led by Riff and the Latino Sharks, led by Bernardo. Their hatred escalates to a point where neither can coexist with any form of understanding. But when Riff's best friend (and former Jet) Tony and Bernardo's younger sister Maria meet at a dance, no one can do anything to stop their love. Maria and Tony begin meeting in secret, planning to run away. Then the Sharks and Jets plan a rumble under the highway--whoever wins gains control of the streets. Maria sends Tony to stop it, hoping it can end the violence. It goes terribly wrong, and before the lovers know what's happened, tragedy strikes and doesn't stop until the climactic and heartbreaking ending.