Merge pull request #5418 from adamcrussell/challenge-144

Challenge 144

3 files changed, 120 insertions, 0 deletions

diff --git a/challenge-144/adam-russell/blog.txt b/challenge-144/adam-russell/blog.txt
new file mode 100644
index 0000000000..2714c7814a
--- /dev/null
+++ b/challenge-144/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://www.rabbitfarm.com/cgi-bin/blosxom/2021/12/26/perl
diff --git a/challenge-144/adam-russell/perl/ch-1.pl b/challenge-144/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..7be66d5566
--- /dev/null
+++ b/challenge-144/adam-russell/perl/ch-1.pl
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+##
+# Write a script to generate all Semiprime numbers <= 100.  
+##
+use boolean; 
+use LWP::UserAgent;
+use constant N => 100; 
+use constant PRIME_URL => "http://primes.utm.edu/lists/small/100000.txt";
+
+sub get_primes{
+    my @primes;
+    my $ua = new LWP::UserAgent(
+        ssl_opts => {verify_hostname => 0}
+    );
+    my $response = $ua->get(PRIME_URL);
+    my @lines = split(/\n/,$response->decoded_content);
+    foreach my $line (@lines){
+        my @p = split(/\s+/, $line);
+        unless(@p < 10){
+            push @primes, @p[1..(@p - 1)];
+        }
+    }
+    return @primes;
+}
+
+sub factor{
+    my($n) = @_;
+    my @factors = ();
+    for  my $j (2 .. sqrt($n)){
+        if($j**2 == $n){  
+            push @factors, [$j, $j] if $j**2 == $n;
+            next; 
+        }
+        push @factors, [$j, $n / $j] if $n % $j == 0;
+    }
+    return @factors;
+}
+
+sub semiprime{
+    my($n, $primes) = @_;
+    my @factors = factor($n);
+    return false if @factors != 1;  
+    my @prime_factors = grep {$factors[0]->[0] == $_ || $factors[0]->[1] == $_} @{$primes};     
+    return true if @prime_factors == 2 || $prime_factors[0]**2 == $n; 
+    return false; 
+}
+
+sub semiprime_n{
+    my @primes = get_primes; 
+    for my $n (1 .. N){
+        print "$n " if semiprime($n, \@primes);   
+    } 
+    print "\n"; 
+}
+
+MAIN:{
+    semiprime_n;
+}
diff --git a/challenge-144/adam-russell/perl/ch-2.pl b/challenge-144/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..ad8871c2c6
--- /dev/null
+++ b/challenge-144/adam-russell/perl/ch-2.pl
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+##
+# You are given two positive numbers, $u and $v. Write a script to generate the
+# Ulam Sequence having at least 10 Ulam numbers where $u and $v are the first two 
+# Ulam numbers.    
+##
+use constant ULAM_LIMIT => 10;   
+
+sub ulam{
+    my($u, $v) = @_;    
+    my %pairs; 
+    my @ulam = ($u, $v); 
+    my $w = $u + $v;  
+    push @ulam, $w;  
+    $pairs{"$u,$v"} = $w; 
+    $pairs{"$u,$w"} = $u + $w; 
+    $pairs{"$v,$w"} = $v + $w; 
+    do{
+        my @sums = sort {$a <=> $b} grep{my $sum = $_; my @values = grep{$sum == $_} values %pairs; $sum if @values == 1 && $sum > $ulam[@ulam - 1]} values %pairs; 
+        my $u = $sums[0]; 
+        push @ulam, $u;
+        for my $pair (keys %pairs){
+            my($s, $t) = split(/,/, $pair);  
+            $pairs{"$s,$u"} = $s + $u;
+            $pairs{"$t,$u"} = $t + $u;
+        }   
+    }while(@ulam < ULAM_LIMIT);
+    return @ulam;  
+}
+
+MAIN:{
+    my @ulam;
+    @ulam = ulam(1, 2);   
+    {
+        print shift @ulam;
+        print ", ";
+        redo if @ulam > 1;
+    } 
+    print shift @ulam;
+    print "\n";
+
+    @ulam = ulam(2, 3);   
+    {
+        print shift @ulam;
+        print ", ";
+        redo if @ulam > 1;
+    } 
+    print shift @ulam;
+    print "\n";
+
+    @ulam = ulam(2, 5);   
+    {
+        print shift @ulam;
+        print ", ";
+        redo if @ulam > 1;
+    } 
+    print shift @ulam;
+    print "\n";
+}