aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad Sajid Anwar <Mohammad.Anwar@yahoo.com>2024-09-15 09:17:30 +0100
committerGitHub <noreply@github.com>2024-09-15 09:17:30 +0100
commit15eec3e6d320632cd0b822b427e62c993d4b8950 (patch)
treef978ec9649795a333d0f9838b1f0096927a44860
parenta8d34acbdf79ca37c067da1b66d792372b73d579 (diff)
parentd2c65435bbae2d980155bee8d4b2572e404e05b5 (diff)
downloadperlweeklychallenge-club-15eec3e6d320632cd0b822b427e62c993d4b8950.tar.gz
perlweeklychallenge-club-15eec3e6d320632cd0b822b427e62c993d4b8950.tar.bz2
perlweeklychallenge-club-15eec3e6d320632cd0b822b427e62c993d4b8950.zip
Merge pull request #10832 from DevSanti12/master
Late but better than never (added #283/284/285)
-rw-r--r--challenge-283/santiago-leyva/perl/ch-01.pl55
-rw-r--r--challenge-283/santiago-leyva/perl/ch-02.pl59
-rw-r--r--challenge-284/santiago-leyva/perl/ch-01.pl56
-rw-r--r--challenge-284/santiago-leyva/perl/ch-02.pl86
-rw-r--r--challenge-285/santiago-leyva/perl/ch-01.pl58
-rw-r--r--challenge-285/santiago-leyva/perl/ch-02.pl66
6 files changed, 380 insertions, 0 deletions
diff --git a/challenge-283/santiago-leyva/perl/ch-01.pl b/challenge-283/santiago-leyva/perl/ch-01.pl
new file mode 100644
index 0000000000..6431df3b2f
--- /dev/null
+++ b/challenge-283/santiago-leyva/perl/ch-01.pl
@@ -0,0 +1,55 @@
+=begin
+You are given an array of integers, @ints, where every elements appears more than once except one element.
+
+Write a script to find the one element that appears exactly one time.
+
+Example 1
+Input: @ints = (3, 3, 1)
+Output: 1
+Example 2
+Input: @ints = (3, 2, 4, 2, 4)
+Output: 3
+Example 3
+Input: @ints = (1)
+Output: 1
+Example 4
+Input: @ints = (4, 3, 1, 1, 1, 4)
+Output: 3
+=cut
+use strict;
+use Data::Dumper;
+
+
+my @inputs = ([3, 3, 1],[3, 2, 4, 2, 4],[1],[4, 3, 1, 1, 1, 4]);
+
+foreach(@inputs){
+ my $arr = $_;
+ my @A = @$arr;
+ my $result = findUnique(\@A);
+ print $result."\n";
+}
+
+sub findUnique {
+ my $array = shift;
+ my @nums = @$array;
+ my %seen;
+ my %deleted;
+ foreach(@nums){
+
+ if(exists($seen{$_})){
+ $seen{$_} += 1;
+ $deleted{$_} = 1;
+ delete $seen{$_};
+ }else{
+ if(!exists($deleted{$_})){
+ $seen{$_} = 1;
+ }
+ }
+ }
+
+ my @values = keys %seen;
+
+ return $values[0] if (@values);
+ return -1;
+
+} \ No newline at end of file
diff --git a/challenge-283/santiago-leyva/perl/ch-02.pl b/challenge-283/santiago-leyva/perl/ch-02.pl
new file mode 100644
index 0000000000..30b7ab6879
--- /dev/null
+++ b/challenge-283/santiago-leyva/perl/ch-02.pl
@@ -0,0 +1,59 @@
+=begin
+You are given an array of positive integers, @ints.
+
+Write a script to return true if for every index i in the range 0 <= i < size of array, the digit i occurs exactly the $ints[$i] times in the given array otherwise return false.
+
+Example 1
+Input: @ints = (1, 2, 1, 0)
+Ouput: true
+
+$ints[0] = 1, the digit 0 occurs exactly 1 time.
+$ints[1] = 2, the digit 1 occurs exactly 2 times.
+$ints[2] = 1, the digit 2 occurs exactly 1 time.
+$ints[3] = 0, the digit 3 occurs 0 time.
+Example 2
+Input: @ints = (0, 3, 0)
+Ouput: false
+
+$ints[0] = 0, the digit 0 occurs 2 times rather than 0 time.
+$ints[1] = 3, the digit 1 occurs 0 time rather than 3 times.
+$ints[2] = 0, the digit 2 occurs exactly 0 time.
+=cut
+use strict;
+use Data::Dumper;
+
+
+my @inputs = ([1, 2, 1, 0],[0, 3, 0]);
+
+foreach(@inputs){
+ my $arr = $_;
+ my @A = @$arr;
+ my $result = checkIndex(\@A);
+ print $result."\n";
+}
+
+sub checkIndex {
+ my $array = shift;
+ my @nums = @$array;
+
+ my %seen;
+ my %deleted;
+ foreach(@nums){
+
+ if(exists($seen{$_})){
+ $seen{$_} += 1;
+ }else{
+ $seen{$_} = 1;
+ }
+ }
+
+ my $i = 0;
+ foreach(@nums){
+ if(!exists($seen{$i}) and $seen{$i} != $_){
+ return 'false';
+ }
+ $i++;
+ }
+
+ return 'true';
+} \ No newline at end of file
diff --git a/challenge-284/santiago-leyva/perl/ch-01.pl b/challenge-284/santiago-leyva/perl/ch-01.pl
new file mode 100644
index 0000000000..27060bf1a2
--- /dev/null
+++ b/challenge-284/santiago-leyva/perl/ch-01.pl
@@ -0,0 +1,56 @@
+=begin
+You are given an array of integers, @ints.
+
+Write a script to find the lucky integer if found otherwise return -1. If there are more than one then return the largest.
+
+A lucky integer is an integer that has a frequency in the array equal to its value.
+
+Example 1
+Input: @ints = (2, 2, 3, 4)
+Output: 2
+Example 2
+Input: @ints = (1, 2, 2, 3, 3, 3)
+Output: 3
+Example 3
+Input: @ints = (1, 1, 1, 3)
+Output: -1
+=cut
+
+use strict;
+use Data::Dumper;
+
+
+my @inputs = ([2, 2, 3, 4],[1, 2, 2, 3, 3, 3],[1, 1, 1, 3]);
+
+foreach(@inputs){
+ my $arr = $_;
+ my @A = @$arr;
+ my $result = luckyNumber(\@A);
+ print $result."\n";
+}
+
+sub luckyNumber {
+ my $array = shift;
+ my @nums = @$array;
+
+ my %set;
+
+ foreach(@nums){
+ if(exists($set{$_})){
+ $set{$_} += 1;
+ }else{
+ $set{$_} = 1;
+ }
+ }
+
+ my @largest;
+ foreach(sort {$a <=> $b} keys %set){
+ if($set{$_} == $_){
+ push @largest,$_;
+ }
+ }
+
+ return $largest[-1] if (@largest);
+ return -1;
+
+} \ No newline at end of file
diff --git a/challenge-284/santiago-leyva/perl/ch-02.pl b/challenge-284/santiago-leyva/perl/ch-02.pl
new file mode 100644
index 0000000000..c2c454f4de
--- /dev/null
+++ b/challenge-284/santiago-leyva/perl/ch-02.pl
@@ -0,0 +1,86 @@
+=begin
+You are given two list of integers, @list1 and @list2. The elements in the @list2 are distinct and also in the @list1.
+
+Write a script to sort the elements in the @list1 such that the relative order of items in @list1 is same as in the @list2. Elements that is missing in @list2 should be placed at the end of @list1 in ascending order.
+
+Example 1
+Input: @list1 = (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5)
+ @list2 = (2, 1, 4, 3, 5, 6)
+Ouput: (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)
+Example 2
+Input: @list1 = (3, 3, 4, 6, 2, 4, 2, 1, 3)
+ @list2 = (1, 3, 2)
+Ouput: (1, 3, 3, 3, 2, 2, 4, 4, 6)
+Example 3
+Input: @list1 = (3, 0, 5, 0, 2, 1, 4, 1, 1)
+ @list2 = (1, 0, 3, 2)
+Ouput: (1, 1, 1, 0, 0, 3, 2, 4, 5)
+=cut
+
+use strict;
+use Data::Dumper;
+
+
+my @A = (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5);
+my @B = (2, 1, 4, 3, 5, 6);
+
+my @result = customSort(\@A,\@B);
+print join(" ",@result)."\n";
+
+my @A = (3, 3, 4, 6, 2, 4, 2, 1, 3);
+my @B = (1, 3, 2);
+my @result = customSort(\@A,\@B);
+print join(" ",@result)."\n";
+
+my @A = (3, 0, 5, 0, 2, 1, 4, 1, 1);
+my @B = (1, 0, 3, 2);
+my @result = customSort(\@A,\@B);
+print join(" ",@result)."\n";
+
+sub customSort {
+ my ($arr1,$arr2) = @_;
+
+ my @list1 = @$arr1;
+ my @list2 = @$arr2;
+
+ my %set1 = createSet(\@list1);
+ my @sorted;
+ foreach(@list2){
+ if(exists($set1{$_})){
+ push @sorted,$_;
+ if(($set1{$_}) > 1){
+ for(my $i=1;$i<(scalar($set1{$_}));$i++){
+ push @sorted,$_;
+ }
+ }
+ delete $set1{$_};
+ }
+ }
+
+ foreach(sort {$a<=>$b} keys %set1){
+ push @sorted,$_;
+ if(($set1{$_}) > 1){
+ for(my $i=1;$i<(scalar($set1{$_}));$i++){
+ push @sorted,$_;
+ }
+ }
+ }
+ #print join(" ",@sorted)."\n";
+ return @sorted;
+
+}
+
+sub createSet {
+ my $input = shift;
+ my @A = @$input;
+ my %_set;
+ foreach(@A){
+ if(exists($_set{$_})){
+ $_set{$_} += 1;
+ }else{
+ $_set{$_} = 1;
+ }
+ }
+
+ return %_set;
+}
diff --git a/challenge-285/santiago-leyva/perl/ch-01.pl b/challenge-285/santiago-leyva/perl/ch-01.pl
new file mode 100644
index 0000000000..3b1b1ce918
--- /dev/null
+++ b/challenge-285/santiago-leyva/perl/ch-01.pl
@@ -0,0 +1,58 @@
+=begin
+You are given a list of routes, @routes.
+
+Write a script to find the destination with no further outgoing connection.
+
+Example 1
+Input: @routes = (["B","C"], ["D","B"], ["C","A"])
+Output: "A"
+
+"D" -> "B" -> "C" -> "A".
+"B" -> "C" -> "A".
+"C" -> "A".
+"A".
+Example 2
+Input: @routes = (["A","Z"])
+Output: "Z"
+=cut
+
+use strict;
+use Data::Dumper;
+
+my @input = ([["B","C"], ["D","B"], ["C","A"]],[["A","Z"]]);
+
+foreach(@input){
+ my $arr = $_;
+ my @A = @$arr;
+ my $dead_end = findDeadEnd(\@A);
+ print $dead_end."\n";
+}
+
+sub findDeadEnd {
+ my $array = shift;
+ my @route = @$array;
+ my @origin;
+ my @destination;
+ my @deadend;
+ for(0..scalar @route-1){
+ push @origin, $route[$_][0];
+ }
+ for(0..scalar @route-1){
+ push @destination, $route[$_][1];
+ }
+
+ foreach my $i (@destination){
+ if( !(grep( /^$i$/, @origin)) ){
+ push @deadend, $i;
+ }
+
+ }
+
+ if(scalar @deadend > 1){
+ return "There are multiple routes with no outgoing connection";
+ }elsif(scalar @deadend == 0){
+ return "All routes have an outgoing connection";
+ }
+ return $deadend[0];
+
+}
diff --git a/challenge-285/santiago-leyva/perl/ch-02.pl b/challenge-285/santiago-leyva/perl/ch-02.pl
new file mode 100644
index 0000000000..6ebc42be82
--- /dev/null
+++ b/challenge-285/santiago-leyva/perl/ch-02.pl
@@ -0,0 +1,66 @@
+=begin
+Compute the number of ways to make change for given amount in cents. By using the coins e.g. Penny, Nickel, Dime, Quarter and Half-dollar, in how many distinct ways can the total value equal to the given amount? Order of coin selection does not matter.
+
+A penny (P) is equal to 1 cent.
+A nickel (N) is equal to 5 cents.
+A dime (D) is equal to 10 cents.
+A quarter (Q) is equal to 25 cents.
+A half-dollar (HD) is equal to 50 cents.
+Example 1
+Input: $amount = 9
+Ouput: 2
+
+1: 9P
+2: N + 4P
+Example 2
+Input: $amount = 15
+Ouput: 6
+
+1: D + 5P
+2: D + N
+3: 3N
+4: 2N + 5P
+5: N + 10P
+6: 15P
+Example 3
+Input: $amount = 100
+Ouput: 292
+=cut
+
+use strict;
+use Data::Dumper;
+
+use Test::More tests => 3;
+
+is(makeChange(9),2,'Test 1');
+is(makeChange(15),6,'Test 2');
+is(makeChange(100),292,'Test 3');
+
+
+my @amount = (9,15,100);
+
+foreach(@amount){
+ my $_last_coin;
+ my $combination = makeChange($_,$_last_coin);
+ print "Number of Combinations for $_ is: $combination\n";
+}
+
+sub makeChange {
+ my ($reamaining,$last_coin) = @_;
+ my $combinations = 0;
+ my @denomination = (1,5,10,25,50);
+ #print "$reamaining,$last_coin\n";
+ foreach my $coin (@denomination){
+ if($last_coin and $last_coin < $coin){
+ #print "$last_coin < $coin next\n";
+ last;
+ }elsif($coin == $reamaining){
+ $combinations += 1;
+ }elsif($coin < $reamaining){
+ $combinations += makeChange($reamaining-$coin,$coin);
+ }
+ }
+
+ return $combinations;
+
+} \ No newline at end of file