diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2019-09-10 11:49:25 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2019-09-10 11:49:25 +0100 |
| commit | a5ef24e38a44fce84503a7ead9a41c9be86e678c (patch) | |
| tree | 59ef660347e241f75f91fca6d22d685b40c7e906 | |
| parent | 7aa8bbf7b6cd04405aa700267eefb5f5e4dd196b (diff) | |
| parent | 6b0b91b957e4e3c3e0c37dbd703ffaa09ebcdd23 (diff) | |
| download | perlweeklychallenge-club-a5ef24e38a44fce84503a7ead9a41c9be86e678c.tar.gz perlweeklychallenge-club-a5ef24e38a44fce84503a7ead9a41c9be86e678c.tar.bz2 perlweeklychallenge-club-a5ef24e38a44fce84503a7ead9a41c9be86e678c.zip | |
Merge pull request #614 from Doomtrain14/master
Added perl5 solution for task#2
| -rw-r--r-- | challenge-025/yet-ebreo/perl5/ch-1.pl | 47 | ||||
| -rw-r--r-- | challenge-025/yet-ebreo/perl5/ch-2.pl | 70 |
2 files changed, 98 insertions, 19 deletions
diff --git a/challenge-025/yet-ebreo/perl5/ch-1.pl b/challenge-025/yet-ebreo/perl5/ch-1.pl index da34b43d10..070363d90c 100644 --- a/challenge-025/yet-ebreo/perl5/ch-1.pl +++ b/challenge-025/yet-ebreo/perl5/ch-1.pl @@ -13,12 +13,12 @@ use 5.010; my $start_run = time(); -my @names = qw(bagon audino baltoy banette bidoof braviary bronzor carracosta charmeleon cresselia croagunk darmanitan deino emboar emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask); +my @names = qw(bagon audino baltoy banette bidoof braviary bronzor carracosta charmeleon cresselia croagunk darmanitan deino emboar emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask); my %hash; -my $longest_string; my $max_length = 0; my $length = 0; +my @chain; #First I need to group each name (in @names) by the starting letter #so that I dont have to filter out @names in each iteration @@ -41,9 +41,9 @@ for my $name (@names) { #The first argumet is the starting name #The second argument is the name sequence in string format which would start as blank string. # - I know there is probably a better approach but this is where I ended up with - #Last argument is an array from our Hashes of Array (%hash), this to limit the iterations + #Last argument is an array from our Hashes of Array (%hash), this is to limit the iterations #to names starting with the last letter of the first argument ($name) only instead of - #going through @names and checking if it starts with X letter + #going through @names and checking if it starts with <X> letter &iter($name, "", @{$hash{$last_char}} ); } @@ -62,33 +62,42 @@ sub iter { #Only do computation when name list is empty if (!@m_name_list) { #from what I understand the task was asking for the longest sequence, - #I assumed that it referes to the highes number of names in a valid sequence (not character count) + #I assumed that it referes to the highes number of names/chain in a valid sequence (not character count) my $length = $m_name_arr=~y/>//; - if ($length > $max_length) { - $longest_string = $m_name_arr; + if ($length >= $max_length) { + push @{$chain[$length]}, $m_name_arr; $max_length = $length; } } } -#Print the longes sequence -say "longest Sequence is: $longest_string"; -say "Number of Names: $max_length"; +#Print the longest sequence +#Print all when they are tied +say "Sequence:"; +for my $seq (@{$chain[-1]}) { + say "$seq\n"; +} +say "Highest chain count: $#chain"; +say "Number of Sequence found: $#{$chain[-1]}"; my $run_time = time() - $start_run; say "Run Time: $run_time sec"; =begin -longest Sequence is: > machamp > petilil > landorus > scrafty > yamask > kricketune > emboar > registeel > loudred > darmanitan > nosepass > simisear > relicanth > heatmor > rufflet > trapinch > haxorus > seaking > girafarig > gabite > exeggcute > emolga > audino -Number of Names: 23 -Run Time: 5 sec +#Sample output +Sequence: +> machamp > petilil > landorus > scrafty > yamask > kricketune > emboar > registeel > loudred > darmanitan > nosepass > simisear > relicanth > heatmor > rufflet > trapinch > haxorus > seaking > girafarig > gabite > exeggcute > emolga > audino +.. +> machamp > pinsir > rufflet > trapinch > heatmor > remoraid > darmanitan > nosepass > starly > yamask > kricketune > exeggcute > emboar > registeel > landorus > simisear > relicanth > haxorus > seaking > girafarig > gabite > emolga > audino -#Note: -The sequence below also has 23 names but the first occurence of the highest # of names will be the only one reflected. -Also the result above is the longest in terms of number of characters. - -longest Sequence is: > machamp > pinsir > rufflet > trapinch > heatmor > remoraid > darmanitan > nosepass > starly > yamask > kricketune > exeggcute > emboar > relicanth > haxorus > simisear > registeel > landorus > seaking > girafarig > gabite > emolga > audino -Number of Names: 23 +> machamp > pinsir > rufflet > trapinch > heatmor > remoraid > darmanitan > nosepass > starly > yamask > kricketune > exeggcute > emboar > relicanth > haxorus > simisear > registeel > landorus > seaking > girafarig > gabite > emolga > audino +Highest chain count: 23 +Number of Sequence found: 1247 Run Time: 5 sec + +#Note(s): +- There are actually 1247 sequences with 23 chain counts. I decided to print them all. +- I am surprised with the speed compared to other algorithms. +- I appreciate the challenges for this week, they are actually challenging. Thanks! =cut diff --git a/challenge-025/yet-ebreo/perl5/ch-2.pl b/challenge-025/yet-ebreo/perl5/ch-2.pl new file mode 100644 index 0000000000..6d9003b689 --- /dev/null +++ b/challenge-025/yet-ebreo/perl5/ch-2.pl @@ -0,0 +1,70 @@ +# Create script to implement Chaocipher. Please checkout wiki page for more information +# Visualizing it using rotating disk is a bit difficult, here's a video illustration of the algo +# https://www.youtube.com/watch?v=0tL9A69olRc , that helped me understand it + +use strict; +use warnings; +use 5.010; + +#It should be okay to modify the zenith/nadir (0 to $wheelsize) +use constant ZENITH => 0; +use constant NADIR => 13; + +#Initialize wheels (chaocipher with bigger wheels!) +my @pt = "7bqkj9l2hOWyzA8SLPEtRvBwUQVmxa45g ufspeTF1KHd0DrGMCZoJXi3YIN6nc"=~/./g; +my @ct = "vEDclCHZYeWo9drb6Jnkf5MRXOt UgN4Fi231GzQIx7sPaLK8TBuVpA0yjShqwm"=~/./g; + +my $wheel_size = $#pt; + +die "Usage:\n\tch-2.pl <-d|e> \"<string to encrypt>\"\n\n" if @ARGV<2; +my $encrypt = $ARGV[0] eq '-e'; +my $text_string = $ARGV[1]; + +# This function rotate the given array or a portion of the given array +# Rotation count is defined by $r +# The whole array will be rotated by default +# but the range can be specified in $from and $to variable +sub rot { + my ($r,$array, $from, $to) = @_; + $r %= ($wheel_size+1); + return if $r == 0; + if (!(defined $to && defined $from)) { + @{$array} = (@{$array}[$r..$#{$array}], @{$array}[0..~-$r]); + } else { + $r += $from; + @{$array} = (@{$array}[0..~-$from], @{$array}[$r..$to], @{$array}[$from..~-$r],@{$array}[$to+1..$#{$array}]); + } +} + +sub cipher { + my ($text,$enc,$ret) = @_; + + for my $c ($text=~/./g) { + #find where $c is in the plain text @pt + #grep wont stop when first occurence was found + my $pt_pos = (grep {($enc?$pt[$_]:$ct[$_]) eq $c} 0..$wheel_size)[0]; + + #Get the character from the cipher text in that position + $ret .= $enc?$ct[$pt_pos]:$pt[$pt_pos]; + + #rotate @pt and @ct from $pt to ZENITH + &rot($pt_pos-ZENITH, \@pt); + &rot($pt_pos-ZENITH, \@ct); + + #permute @ct: move the char in ZENITH + 1 to NADIR + &rot(1,\@ct,ZENITH+1,NADIR); + + #permute @pt: rotate1 then move the char in ZENITH + 2 to NADIR + &rot(1,\@pt); + &rot(1,\@pt,ZENITH+2,NADIR); + } + return $ret; +} +say &cipher($text_string,$encrypt); +=begin +perl .\ch-2.pl -e "a quick brown fox jumps over lazy dog" +gFv4ujqOyIPdTk5I9bKrYUXY4DwkCtV27vpk9 + +perl .\ch-2.pl -d "gFv4ujqOyIPdTk5I9bKrYUXY4DwkCtV27vpk9" +a quick brown fox jumps over lazy dog +=cut |
