diff options
| -rw-r--r-- | challenge-307/jeanluc2020/blog-1.txt | 1 | ||||
| -rw-r--r-- | challenge-307/jeanluc2020/blog-2.txt | 1 | ||||
| -rwxr-xr-x | challenge-307/jeanluc2020/perl/ch-1.pl | 66 | ||||
| -rwxr-xr-x | challenge-307/jeanluc2020/perl/ch-2.pl | 86 |
4 files changed, 154 insertions, 0 deletions
diff --git a/challenge-307/jeanluc2020/blog-1.txt b/challenge-307/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..9132caa1d0 --- /dev/null +++ b/challenge-307/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-307-1.html diff --git a/challenge-307/jeanluc2020/blog-2.txt b/challenge-307/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..bc0d1dce3d --- /dev/null +++ b/challenge-307/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-307-2.html diff --git a/challenge-307/jeanluc2020/perl/ch-1.pl b/challenge-307/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..73bb81a019 --- /dev/null +++ b/challenge-307/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,66 @@ +#!/usr/bin/env perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-307/#TASK1 +# +# Task 1: Check Order +# =================== +# +# You are given an array of integers, @ints. +# +# Write a script to re-arrange the given array in an increasing order and +# return the indices where it differs from the original array. +# +## Example 1 +## +## Input: @ints = (5, 2, 4, 3, 1) +## Output: (0, 2, 3, 4) +## +## Before: (5, 2, 4, 3, 1) +## After : (1, 2, 3, 4, 5) +## +## Difference at indices: (0, 2, 3, 4) +# +## Example 2 +## +## Input: @ints = (1, 2, 1, 1, 3) +## Output: (1, 3) +## +## Before: (1, 2, 1, 1, 3) +## After : (1, 1, 1, 2, 3) +## +## Difference at indices: (1, 3) +# +## Example 3 +## +## Input: @ints = (3, 1, 3, 2, 3) +## Output: (0, 1, 3) +## +## Before: (3, 1, 3, 2, 3) +## After : (1, 2, 3, 3, 3) +## +## Difference at indices: (0, 1, 3) +# +############################################################ +## +## discussion +## +############################################################ +# +# Create the sorted array, then comapre the two arrays by index. +# Remember all positions where the two arrays differ. + +use v5.36; + +check_order(5, 2, 4, 3, 1); +check_order(1, 2, 1, 1, 3); +check_order(3, 1, 3, 2, 3); + +sub check_order { + my @ints = @_; + say "Input: (" . join(", ", @ints) . ")"; + my @sorted = sort {$a<=>$b} @ints; + my @result = (); + foreach my $i (0..$#ints) { + push @result, $i if $ints[$i] != $sorted[$i]; + } + say "Output: (" . join(", ", @result) . ")"; +} diff --git a/challenge-307/jeanluc2020/perl/ch-2.pl b/challenge-307/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..ec9e8500ca --- /dev/null +++ b/challenge-307/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,86 @@ +#!/usr/bin/env perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-307/#TASK2 +# +# Find Anagrams +# ============= +# +# You are given a list of words, @words. +# +# Write a script to find any two consecutive words and if they are anagrams, +# drop the first word and keep the second. You continue this until there is no +# more anagrams in the given list and return the count of final list. +# +## Example 1 +## +## Input: @words = ("acca", "dog", "god", "perl", "repl") +## Output: 3 +## +## Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god" +## => ("acca", "god", "perl", "repl") +## Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl" +## => ("acca", "god", "repl") +# +## Example 2 +## +## Input: @words = ("abba", "baba", "aabb", "ab", "ab") +## Output: 2 +## +## Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba" +## => ("baba", "aabb", "ab", "ab") +## Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb" +## => ("aabb", "ab", "ab") +## Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab" +## => ("aabb", "ab") +# +############################################################ +## +## discussion +## +############################################################ +# +# As long as the length of the array keeps changing, check if two consecutive +# words are anagrams. If so, remove the first word and continue. Once the +# length of the array no longer changes, we can output the length. + +use v5.36; + +find_anagrams("acca", "dog", "god", "perl", "repl"); +find_anagrams("abba", "baba", "aabb", "ab", "ab"); + +sub find_anagrams (@words) { + say "Input: (" . join(", ", @words) . ")"; + my $len = scalar(@words); + my $oldlen = 1 + $len; + while($oldlen != $len) { + my @tmp = (); + foreach my $i (0..$#words) { + if(is_anagram($words[$i], $words[$i+1])) { + push @tmp, @words[$i+1..$#words]; + last; + } else { + push @tmp, $words[$i]; + } + } + @words = @tmp; + $oldlen = $len; + $len = scalar(@words); + } + say "Output: $len"; +} + +sub is_anagram($word1, $word2) { + my $w1; + my $w2; + return 0 unless defined $word2; + return 0 if length($word1) != length($word2); + foreach my $c (split//,$word1) { + $w1->{$c}++; + } + foreach my $c (split//,$word2) { + $w2->{$c}++; + } + foreach my $c (keys %$w1) { + return 0 if $w1->{$c} != $w2->{$c}; + } + return 1; +} |