diff options
| -rwxr-xr-x | challenge-289/peter-meszaros/perl/ch-1.pl | 65 | ||||
| -rwxr-xr-x | challenge-289/peter-meszaros/perl/ch-2.pl | 82 | ||||
| -rwxr-xr-x | challenge-289/peter-meszaros/tcl/ch-1.tcl | 65 | ||||
| -rwxr-xr-x | challenge-289/peter-meszaros/tcl/ch-2.tcl | 104 |
4 files changed, 316 insertions, 0 deletions
diff --git a/challenge-289/peter-meszaros/perl/ch-1.pl b/challenge-289/peter-meszaros/perl/ch-1.pl new file mode 100755 index 0000000000..68bec67d76 --- /dev/null +++ b/challenge-289/peter-meszaros/perl/ch-1.pl @@ -0,0 +1,65 @@ +#!/usr/bin/env perl +# +=head1 Task 1: Third Maximum + +Submitted by: Mohammad Sajid Anwar + +You are given an array of integers, @ints. + +Write a script to find the third distinct maximum in the given array. If third +maximum doesn't exist then return the maximum number. + +=head2 Example 1 + + Input: @ints = (5, 6, 4, 1) + Output: 4 + + The first distinct maximum is 6. + The second distinct maximum is 5. + The third distinct maximum is 4. + +=head2 Example 2 + + Input: @ints = (4, 5) + Output: 5 + + In the given array, the third maximum doesn't exist therefore returns the + maximum. + +=head2 Example 3 + + Input: @ints = (1, 2, 2, 3) + Output: 1 + + The first distinct maximum is 3. + The second distinct maximum is 2. + The third distinct maximum is 1. + +=cut + +use strict; +use warnings; +use Test2::V0 -no_srand => 1; +use Data::Dumper; +use List::Util qw/uniqint/; + +my $cases = [ + [[5, 6, 4, 1], 4, 'Example 1'], + [[4, 5], 5, 'Example 2'], + [[1, 2, 2, 3], 1, 'Example 3'], +]; + +sub third_maximum +{ + my $l = shift; + + my @l = uniqint sort {$b <=> $a} @$l; + return $l[2] // $l[0]; +} + +for (@$cases) { + is(third_maximum($_->[0]), $_->[1], $_->[2]); +} +done_testing(); + +exit 0; diff --git a/challenge-289/peter-meszaros/perl/ch-2.pl b/challenge-289/peter-meszaros/perl/ch-2.pl new file mode 100755 index 0000000000..5b173883e7 --- /dev/null +++ b/challenge-289/peter-meszaros/perl/ch-2.pl @@ -0,0 +1,82 @@ +#!/usr/bin/env perl +# +=head1 Task 2: Jumbled Letters + +Submitted by: Ryan Thompson + +An Internet legend dating back to at least 2001 goes something like this: + + Aoccdrnig to a rscheearch at Cmabrigde Uinervtisy, it deosn't mttaer in + waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is taht the + frist and lsat ltteer be at the rghit pclae. The rset can be a toatl mses + and you can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid + deos not raed ervey lteter by istlef, but the wrod as a wlohe. + +This supposed Cambridge research is unfortunately an urban legend. However, the +effect has been studied. For example-and with a title that probably made the +journal's editor a little nervous-Raeding wrods with jubmled lettres: there is +a cost by Rayner, White, et. al. looked at reading speed and comprehension of +jumbled text. + +Your task is to write a program that takes English text as its input and +outputs a jumbled version as follows: + + 1. The first and last letter of every word must stay the same + 2. The remaining letters in the word are scrambled in a random order (if + that happens to be the original order, that is OK). + 3. Whitespace, punctuation, and capitalization must stay the same + 4. The order of words does not change, only the letters inside the word + +So, for example, "Perl" could become "Prel", or stay as "Perl," but it could +not become "Pelr" or "lreP". + +I don't know if this effect has been studied in other languages besides +English, but please consider sharing your results if you try! + +=cut + +use strict; +use warnings; +use Test2::V0 -no_srand => 1; +use Data::Dumper; +use List::Util qw/shuffle/; + +my $cases = [ + ['But I must explain to you how all this mistaken idea of denouncing + pleasure and praising pain was born and I will give you a complete + account of the system, and expound the actual teachings of the great + explorer of the truth, the master-builder of human happiness. No one + rejects, dislikes, or avoids pleasure itself, because it is pleasure, + but because those who do not know how to pursue pleasure rationally + encounter consequences that are extremely painful. Nor again is there + anyone who loves or pursues or desires to obtain pain of itself, + because it is pain, but because occasionally circumstances occur in + which toil and pain can procure him some great pleasure. To take a + trivial example, which of us ever undertakes laborious physical + exercise, except to obtain some advantage from it? But who has any + right to find fault with a man who chooses to enjoy a pleasure that has + no annoying consequences, or one who avoids a pain that produces no + resultant pleasure?', undef, 'Example 1'], +]; + +sub jumbled_letters +{ + my $txt = shift; + + my @words = split /\s+/, $txt; + for my $w (@words) { + next if length($w) == 1; + my @w = split('', $w); + my $i = ($w[-1] =~ /[\.!\?,:]/) ? 2 : 1; + $w = join '', $w[0], shuffle(@w[1 .. $#w-$i]), @w[$#w+1-$i .. $#w]; + } + print join ' ', @words, "\n"; + return undef; +} + +for (@$cases) { + is(jumbled_letters($_->[0]), $_->[1], $_->[2]); +} +done_testing(); + +exit 0; diff --git a/challenge-289/peter-meszaros/tcl/ch-1.tcl b/challenge-289/peter-meszaros/tcl/ch-1.tcl new file mode 100755 index 0000000000..198801fe48 --- /dev/null +++ b/challenge-289/peter-meszaros/tcl/ch-1.tcl @@ -0,0 +1,65 @@ +#!/usr/bin/env tclsh +# +# Task 1: Third Maximum +# +# Submitted by: Mohammad Sajid Anwar +# +# You are given an array of integers, @ints. +# +# Write a script to find the third distinct maximum in the given array. If third +# maximum doesn’t exist then return the maximum number. +# +# Example 1 +# +# Input: @ints = (5, 6, 4, 1) +# Output: 4 +# +# The first distinct maximum is 6. +# The second distinct maximum is 5. +# The third distinct maximum is 4. +# +# Example 2 +# +# Input: @ints = (4, 5) +# Output: 5 +# +# In the given array, the third maximum doesn't exist therefore returns the +# maximum. +# +# Example 3 +# +# Input: @ints = (1, 2, 2, 3) +# Output: 1 +# +# The first distinct maximum is 3. +# The second distinct maximum is 2. +# The third distinct maximum is 1. +# + +package require tcltest + +set cases { + {{5 6 4 1} 4 "Example 1"} + {{4 5} 5 "Example 2"} + {{1 2 2 3} 1 "Example 3"} +} + +proc third_maximum {l} { + + set lsorted [lsort -integer -decreasing -unique $l] + set v [lindex $lsorted 2] + if {$v == {}} { + set v [lindex $lsorted 0] + } + return $v +} + +tcltest::configure -verbose {pass} +foreach case $cases { + tcltest::test [lindex $case 2] {} { + third_maximum [lindex $case 0] + } [lindex $case 1] +} + +exit 0 + diff --git a/challenge-289/peter-meszaros/tcl/ch-2.tcl b/challenge-289/peter-meszaros/tcl/ch-2.tcl new file mode 100755 index 0000000000..ec4b9b7add --- /dev/null +++ b/challenge-289/peter-meszaros/tcl/ch-2.tcl @@ -0,0 +1,104 @@ +#!/usr/bin/env tclsh +# +# Task 2: Jumbled Letters +# +# Submitted by: Ryan Thompson +# +# An Internet legend dating back to at least 2001 goes something like this: +# +# Aoccdrnig to a rscheearch at Cmabrigde Uinervtisy, it deosn’t mttaer in +# waht oredr the ltteers in a wrod are, the olny iprmoetnt tihng is taht the +# frist and lsat ltteer be at the rghit pclae. The rset can be a toatl mses +# and you can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid +# deos not raed ervey lteter by istlef, but the wrod as a wlohe. +# +# This supposed Cambridge research is unfortunately an urban legend. However, the +# effect has been studied. For example—and with a title that probably made the +# journal’s editor a little nervous—Raeding wrods with jubmled lettres: there is +# a cost by Rayner, White, et. al. looked at reading speed and comprehension of +# jumbled text. +# +# Your task is to write a program that takes English text as its input and +# outputs a jumbled version as follows: +# +# 1. The first and last letter of every word must stay the same +# 2. The remaining letters in the word are scrambled in a random order (if +# that happens to be the original order, that is OK). +# 3. Whitespace, punctuation, and capitalization must stay the same +# 4. The order of words does not change, only the letters inside the word +# +# So, for example, “Perl” could become “Prel”, or stay as “Perl,” but it could +# not become “Pelr” or “lreP”. +# +# I don’t know if this effect has been studied in other languages besides +# English, but please consider sharing your results if you try! +# +package require tcltest + +set cases { + {{But I must explain to you how all this mistaken idea of denouncing + pleasure and praising pain was born and I will give you a complete + account of the system, and expound the actual teachings of the great + explorer of the truth, the master-builder of human happiness. No one + rejects, dislikes, or avoids pleasure itself, because it is pleasure, + but because those who do not know how to pursue pleasure rationally + encounter consequences that are extremely painful. Nor again is there + anyone who loves or pursues or desires to obtain pain of itself, + because it is pain, but because occasionally circumstances occur in + which toil and pain can procure him some great pleasure. To take a + trivial example, which of us ever undertakes laborious physical + exercise, except to obtain some advantage from it? But who has any + right to find fault with a man who chooses to enjoy a pleasure that has + no annoying consequences, or one who avoids a pain that produces no + resultant pleasure?} {} "Example 1"} +} + +proc shuffle {list} { + set n [llength $list] + for {set i 1} {$i < $n} {incr i} { + set j [expr {int(rand() * $n)}] + set temp [lindex $list $i] + lset list $i [lindex $list $j] + lset list $j $temp + } + return $list +} + +proc jumbled_letters {txt} { + + set words [regexp -inline -all -- {\S+} $txt] + + for {set i 0} {$i < [llength $words]} {incr i} { + set w [lindex $words $i] + if {[string length $w] == 1} { + continue + } + set ll [split $w {}] + set lastl [lindex $ll end] + + if [regexp {[\.!\?,:]} $lastl] { + set p 2 + } else { + set p 1 + } + set len [llength $ll] + incr len -1 + lset words $i [join [list \ + [lindex $ll 0] \ + [join [shuffle [lrange $ll 1 [expr $len - $p]]] {}] \ + [join [lrange $ll [expr $len + 1 - $p] $len] {}]\ + ] {}] + } + puts [join $words] + return {} +} + +tcltest::configure -verbose {pass} +foreach case $cases { + tcltest::test [lindex $case 2] {} { + jumbled_letters [lindex $case 0] + } [lindex $case 1] +} + +exit 0 + |