Merge pull request #3037 from PerlBoy1967/branch-for-challenge-092

Task 1 & 2

3 files changed, 195 insertions, 0 deletions

diff --git a/challenge-092/perlboy1967/perl/Interval.pm b/challenge-092/perlboy1967/perl/Interval.pm
new file mode 100755
index 0000000000..fe003c2a5d
--- /dev/null
+++ b/challenge-092/perlboy1967/perl/Interval.pm
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 092
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-092/
+#
+# Task 2 - Insert Interval - 'Interval class'
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+package Interval;
+
+use v5.16;
+use strict;
+use warnings;
+
+use Scalar::Util qw(looks_like_number);
+use Carp qw(confess);
+
+sub new {
+  my ($class,$v1,$v2) = @_;
+
+  confess "'$v1' is not a number"
+    unless defined $v1 and looks_like_number($v1);
+  confess "'$v2' is not a number"
+    unless defined $v2 and looks_like_number($v2);
+
+  my @data = sort { $a <=> $b } ($v1, $v2);
+
+  bless \@data, $class;
+}
+
+sub min {
+  my ($this,$v) = @_;
+  $this->[0] = $v if (defined $v);
+  $this->[0];
+}
+
+sub max {
+  my ($this,$v) = @_;
+  $this->[1] = $v if (defined $v);
+  $this->[1];
+}
+
+sub contains { 
+  my ($this, $v) = @_;
+  return ($v >= $this->min and $v <= $this->max ? 1 : 0);
+} 
+
+sub overlaps {
+  my ($this, $that) = @_;
+  return ($this->contains($that->min)
+          or 
+          $this->contains($that->max));
+}
+
+sub cmp {
+  my ($this, $that) = @_;
+  return ($this->min <=> $that->min
+          or
+          $this->max <=> $that->max);
+}
+
+sub string {
+  my ($this) = @_;
+  return sprintf('(%d,%d)', $this->min, $this->max);
+}
+  
+1;
diff --git a/challenge-092/perlboy1967/perl/ch-1.pl b/challenge-092/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..7aadea5c20
--- /dev/null
+++ b/challenge-092/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 092
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-092/
+#
+# Task 1 - Isomorphic Strings
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use Data::Printer;
+
+# Unbuffered STDOUT
+$|++;
+
+@ARGV = ('abc','zyx')
+  unless @ARGV;
+
+my ($A,$B) = @ARGV;
+
+die "Please provide two strings equal length strings"
+  unless (defined $A and defined $B and length($A) == length($B));
+
+printf "Input: ('%s','%s')\n", $A, $B;
+printf "Output: %d\n", isIsomorphicString($A,$B);
+
+sub isIsomorphicString {
+  my ($a,$b) = @_;
+
+  my @a = split(//, $a);
+  my @b = split(//, $b);
+
+  my %m;
+  my $r = 1;
+  foreach my $a (@a) {
+    my $c = shift(@b);
+    $m{$a} //= $c;
+    if ($m{$a} ne $c) {
+      $r = 0; last;
+    }
+  }
+
+  return $r;
+}
+
diff --git a/challenge-092/perlboy1967/perl/ch-2.pl b/challenge-092/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..984f81a682
--- /dev/null
+++ b/challenge-092/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 092
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-092/
+#
+# Task 2 - Insert Interval
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use Interval;
+use List::Util qw(min max);
+
+# Unbuffered STDOUT
+$|++;
+
+while(<DATA>) {
+  chomp;
+  next if /#/;
+  my @d = split(/\s+/);
+  my @i = map { Interval->new(split(/,/,$_)) } @d;
+  my $n = pop(@i);
+
+  Print('Input', @i, $n);
+
+  my $ext = 0;
+  my @o = map {
+    # Extend when overlaps
+    if ($_->overlaps($n)) {
+      $_ = Interval->new(min($_->min,$n->min),
+                         max($_->max,$n->max));
+      $ext++;
+    }
+    $_;
+  } @i;
+
+  push(@o, $n) unless $ext;
+
+  @o = sort { $a->cmp($b) } @o;
+
+  my $i = 0;
+  while ($i <= scalar(@o) - 2) {
+    # splice overlapping entries
+    if ($o[$i]->overlaps($o[$i+1])) {
+      splice(@o, $i, 2, 
+           Interval->new(min($o[$i]->min,$o[$i+1]->min),
+                         max($o[$i]->max,$o[$i+1]->max)));
+    } else {
+      $i++;
+    }
+  }
+
+  Print('Output', @o);
+}
+  
+sub Print {
+  my ($label,@val) = @_;
+
+  if ($label eq 'Input') {
+    my $n = pop(@val);
+    printf "%s \$S = %s; \$N = %s\n", 
+           $label, join(', ',map { $_->string } @val), $n->string;
+  } else {
+    printf "%s %s\n",
+           $label, join(', ',map { $_->string } @val);
+  }
+}
+
+# Test data
+__DATA__
+1,4 8,10		2,6
+1,2 3,7 8,10		5,8
+1,5 7,9			10,11
+3,4 5,6 8,10		0,1
+3,4 8,10 5,6		1,3
+3,4 8,10 5,6		1,12