Perl Weekly Challenge: Triplets Prime

From disappointing to worse: not only can’t I come up with a musical theme for this week, I just discovered that I didn’t submit my pull request for last week’s solutions, so they didn’t count. 😭

This week I have to make sure I get my entries in on time.


Task 1: Arithmetic Triplets

You are given an array (3 or more members) of integers in increasing order and a positive integer.

Write a script to find out the number of unique Arithmetic Triplets satisfying the following rules:

a) i < j < k
b) nums[j] - nums[i] == diff
c) nums[k] - nums[j] == diff

Example 1

Input: @nums = (0, 1, 4, 6, 7, 10)
       $diff = 3
Output: 2

Index (1, 2, 4) is an arithmetic triplet because both  7 - 4 == 3 and 4 - 1 == 3.
Index (2, 4, 5) is an arithmetic triplet because both 10 - 7 == 3 and 7 - 4 == 3.

Example 2

Input: @nums = (4, 5, 6, 7, 8, 9)
       $diff = 2
Output: 2

(0, 2, 4) is an arithmetic triplet because both 8 - 6 == 2 and 6 - 4 == 2.
(1, 3, 5) is an arithmetic triplet because both 9 - 7 == 2 and 7 - 5 == 2.

Approach

Ok, we have two pieces of input: a list of integers in increasing order, and a target difference. We’re looking for three-element increasing order subsets from the list where the difference between the first and second and the second and third elements match the target difference.

It seems the most straightforward way to identify these triplets is to find pairs where the difference is the target difference, and then build triplets from those pairs.

Raku

sub findTriplets($diff, @nums) {
  my $count = 0;
  my $details = q{};
  for 0 .. @nums.elems - 3 -> $i {
    for $i + 1 .. @nums.elems - 2 -> $j {
      next unless @nums[$j] - @nums[$i] == $diff;
      for $j + 1 .. @nums.elems - 1 -> $k {
        next unless @nums[$k] - @nums[$j] == $diff;
        $count++;
        $details ~= "($i, $j, $k) is an arithmetic triplet "
          ~  "because both @nums[$k] - @nums[$j] = $diff "
          ~  "and @nums[$j] - @nums[$i] = $diff\n";
      }
    }
  }
  return ($count, $details);
}

Once again, I find myself chafing that I need to use @nums.elems - 1 to get the index of the last element in a Raku array. In Perl, it’s much easier.

View the entire Raku script for this task on GitHub.

Perl

sub findTriplets {
  my($diff, $nums) = @_;
  my $count = 0;
  my $details = q{};
  foreach my $i ( 0 .. $#$nums - 2 ) {
    foreach my $j ( $i + 1 .. $#$nums - 1 ) {
      next unless $nums->[$j] - $nums->[$i] == $diff;
      foreach my $k ( $j + 1 .. $#$nums ) {
        next unless $nums->[$k] - $nums->[$j] == $diff;
        $count++;
        $details .= "($i, $j, $k) is an arithmetic triplet "
          .  "because both $nums->[$k] - $nums->[$j] = $diff "
          .  "and $nums->[$j] - $nums->[$i] = $diff\n";
      }
    }
  }
  return ($count, $details);
}

View the entire Perl script for this task on GitHub.

Python

def findTriplets(diff, nums):
    count = 0
    details = ''
    for i in range(0, len(nums) - 2):
        for j in range(i + 1, len(nums) - 1):
            if not nums[j] - nums[i] == diff:
                continue
            for k in range(j + 1, len(nums)):
                if not nums[k] - nums[j] == diff:
                    continue
                count += 1
                details += (
                    f"({i}, {j}, {k}) is an arithmetic " +
                    f"triplet because both " +
                    f"{nums[k]} - {nums[j]} = {diff} and " +
                    f"{nums[j]} - {nums[i]} = {diff}\n"
                )
    return count, details

This screwed me up for a little while because my indentation on the innermost portion where I was counting results wasn’t properly lined up. This is one of my big complaints about Python: the lack of block delimiters, and all blocks being defined by indentation.

View the entire Python script for this task on GitHub.


Task 2: Prime Order

You are given an array of unique positive integers greater than 2.

Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.

Example 1

Input: @int = (11, 8, 27, 4)
Output: (11, 4, 8, 27)

Prime factors of 11 => 11
Prime factors of  4 => 2, 2
Prime factors of  8 => 2, 2, 2
Prime factors of 27 => 3, 3, 3

Example 2 (added by me)

Input: @int = (2, 4, 8, 12, 11)
Output: (2, 11, 4, 8, 12)

Prime factors of  2 => 2
Prime factors of 11 => 11
Prime factors of  4 => 2, 2
Prime factors of  8 => 2, 2, 2
Prime factors of 12 => 2, 2, 3

Approach

Ok, so first we need to find the prime factors of a given integer. I had to look this up, but the algorithm to find the prime factors of N is:

  • Divide by 2 as many times as possible, checking to see if the remainder is 0
  • Loop from 3 to sqrt(N), dividing and checking to see if the remainder is 0
  • If the remaining number is still > 2, it’s a prime

Once we have a list of the prime factors, we need to sort by list size and numbers in the list.

Raku

First, the prime factor algorithm:

sub findPrimeFactors(Int $number) {
  my @factors;
  my $num = $number;
  while ( $num % 2 == 0 ) {
    @factors.push(2);
    $num /= 2;
  }
  for 3 .. sqrt($num).Int -> $i {
    while ( $num % $i == 0 ) {
      @factors.push($i);
      $num /= $i;
    }
  }
  if ($num > 2) {
    @factors.push($num);
  }
  return @factors;
}

Because we’re assigning to $num, I want it to be a copy of what we get passed in so we don’t change that variable. Now we use that to sort the numbers:

sub sortByPrimeFactors(@int) {
  my %primeFactors;
  # calculate the prime factors for each number
  for @int -> $n {
    %primeFactors{$n} = findPrimeFactors($n);
  }
  # now sort the numbers
  my @sorted = @int.sort({
    # first, sort by number of factors
    %primeFactors{$^a} <=> %primeFactors{$^b}
    ||
    # then sort by the value of the factors
    listCompare(%primeFactors{$^a}, %primeFactors{$^b})
  });
  # now build the output
  my $factors = q{};
  for @sorted -> $n {
    $factors ~= sprintf 'Prime factors of %2d => ', $n;
    $factors ~= %primeFactors{$n}.join(', ') ~ "\n";
  }
  return @sorted, $factors;
}

sub listCompare(@a, @b) {
  # this is only getting called if both lists
  # have the same number of elements
  my $i = 0;

  # compare the corresponding element from each
  # list until they're unequal
  while ($i < @a.elems && @a[$i] == @b[$i]) {
    $i++;
  }
  # if we ran off the end of the list, set $i to 0
  $i = 0 if $i >= @a.elems;

  return @a[$i] <=> @b[$i];
}

It isn’t an issue in the only example given, so I added another example where it would be an issue: if both lists of factors have the same number of elements, we need to compare the list items one by one until we get an inequality. 8 and 12 are perfect numbers for this, because their factor lists are (2, 2, 2) and (2, 2, 3), respectively, and we have to compare them out to the last element to find a difference.

View the entire Raku script for this task on GitHub.

Perl

The Perl solution is pretty much exactly the same.

sub findPrimeFactors {
  my $num = shift;
  my @factors;
  while ( $num % 2 == 0 ) {
    push @factors, 2;
    $num /= 2;
  }
  foreach my $i ( 3 .. int(sqrt($num)) ) {
    while ( $num % $i == 0 ) {
      push @factors, $i;
      $num /= $i;
    }
  }
  if ($num > 2) {
    push @factors, $num;
  }
  return @factors;
}

sub sortByPrimeFactors {
  my @int = @_;
  my %primeFactors;
  # calculate the prime factors for each number
  foreach my $n ( @int ) {
    $primeFactors{$n} = [ findPrimeFactors($n) ];
  }
  # now sort the numbers
  my @sorted = sort {
    # first, sort by number of factors
    $#{$primeFactors{$a}} <=> $#{$primeFactors{$b}}
    ||
    # then sort by the value of the factors
    listCompare($primeFactors{$a}, $primeFactors{$b})
  } @int;
  # now build the output
  my $factors = q{};
  foreach my $n ( @sorted ) {
    $factors .= sprintf 'Prime factors of %2d => ', $n;
    $factors .= join(', ', @{$primeFactors{$n}}) . "\n";
  }
  return \@sorted, $factors;
}

sub listCompare($a, $b) {
  # this is only getting called if both lists
  # have the same number of elements
  my $i = 0;

  # compare the corresponding element from each
  # list until they're unequal
  while ($i <= $#{$a} && $a->[$i] == $b->[$i]) {
    $i++;
  }
  # if we ran off the end of the list, set $i to 0
  $i = 0 if $i > $#{$a};

  return $a->[$i] <=> $b->[$i];
}

View the entire Perl script for this task on GitHub.

Python

import math

def findPrimeFactors(num):
    factors = []
    while num % 2 == 0:
        factors.append(2)
        num /= 2

    for i in range(3, int(math.sqrt(num))):
        while num % i == 0:
            factors.append(i)
            num /= i

    if num > 2:
        factors.append(int(num))

    return factors

def sortByPrimeFactors(nums):
    primeFactors = {}
    # calculate the prime factors for each number
    for n in nums:
        primeFactors[n] = findPrimeFactors(n)
    # now sort the numbers
    sorted_list = sorted(nums,
                         key=lambda x: (
                             len(primeFactors[x]),
                             primeFactors[x]
                         )
                        )

    # now build the output
    factors = ''
    for n in sorted_list:
        factors += f'Prime factors of {n:2d} => '
        as_list = ', '.join(
            map(lambda i: str(i), primeFactors[n])
        )
        factors += as_list + '\n'

    return sorted_list, factors

View the entire Python script for this task on GitHub.


Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-241/packy-anderson

The Massacree Revisited… again

With the news breaking that there was a seven hour gap in Trump’s phone logs on January 6, 2021, I got to thinking about the 18 minute and 20 second gap in the Nixon tapes, which, of course, made me think of Alice’s Restaurant: The Massacree Revisited. I wanted to quote the additional lyrics, but, much to my annoyance, even lyrics sites that claimed to have the lyrics to The Massacre Revisited, they all had the lyrics to the original Alice’s Restaurant.

So here, without further ado, is the ADDITIONAL lyric at the end of The Massacre Revisited.

Continue reading

Make it Bigger!

Make it bigger!
That’s right, it’s bigger!
I just built this thing like half an hour ago!

Neil Patrick Harris – 2013 Tony Awards

Since David Willis has been offering magnets as premiums in his Dumbing of Age Kickstarter campaigns, I’ve been getting all of them. First, they lived on my refrigerator. Then I bought a 2-ft x 3-ft magnetic whiteboard to display them. This hung in my office, but then I moved to another house, and I stopped having my own office, so the whiteboard was stuffed in a corner in the basement puppet workshop.

Then two things happened: I got the magnets with Willis’ TENTH book… and I finally got a new closet for Christmas.

Continue reading

Don’t claim copyright unless you ACTUALLY made something

One of my friends, Roy Atkinson, used to make a living as a singer/songwriter. I love the songs he wrote, and while I missed getting to hear him sing when he retired from being a musician, I loved getting to geek out with him talking about his new career in computers.

But today, he noticed something on the internet: someone was claiming one of his songs as their own.  Now, the person isn’t attempting to make any money off the song, but when I did a search on the lyrics, that site was the only one that came up. Nowhere was there any reference to Roy’s 1982 album “Beginnings and Ends”, where this song is track 4 on side 1.

The dude was claiming to have written the song for a woman he met, and had the audacity to write:

(Song is copyrighted) **Please don’t steal**
“Another Bottle of Wine” -for [woman’s handle redacted]

I could not allow that to stand.

So I went to the Internet Archive, and I found an archive of the song lyrics and guitar tablature from another friend’s cover of the song in 1994 that was captured by the Wayback Machine off my website in January 1998.  Hopefully, here it will get a little Google love and that plagiarist’s bad copy of the lyrics won’t be the only hit in Google, and my friend can get the credit he deserves.

Pay the Bill in the Morning
by Roy Atkinson
as sung by Dennis D’Asaro.


Dennis capoed 3 (in C) when he played this 1 Dec 94. It is rekeyed here to be in D (capo 1)
Transcription thanks to Alan Catelli (catela@rpi.edu).


D         D/F#          Bm
It was a casual conversation
G      A                D
In a casual kind of a place
G      A            D      Bm
Just a passing fasination
G             Bm                           A
Though I must say she had an interesting face

She was a small town girl, a bit lonesome;
I was one of the boys in the band.
Small town girls, good Lord, I've know some;
I was getting tired of the one night stands...

I said:

Chorus
 D              A                Bm    Bm/A
"Bring us down another bottle of wine, Maria;
G            A                D
Let us have another hour of time.
G       A                 D            G    Em
I'll go home when I can stand to be alone,
              Bm                   A
But here and now I'm doing just fine...
                D
Bring me some wine..."

She said that she had a man in the service;
I said, "Well, I've got a woman back home."
She said, "You're looking kinda nervous."
I said, "Yeah, I'd really rather be gone."

She said, "Well, you can't help what your feeling;
And, my friend, neither can I:
Sometimes you can't touch the ceiling
Even if you're reaching for the sky."

And she said,
Chorus

Well, I guess I know what your thinking:
And, my friend, you're thinking it wrong.
If you think what I'd been drinking
Made me want to take the girl home.

Sometimes you pay the bill in the morning
For the place where your spending the night.
You can't say you had no warning
When deep in your heart you know it ain't right...

Chorus

Sometimes, its something she says that's worth keeping...
Sometimes, its something you read in her smile...
Lets you go home, spend the night sleeping,
Sometimes, that's what you need for a while.

Sometimes you pay the bill in the morning
For the bed where your spending the night.
Please don't say you never had warning
When deep in your heart you know it ain't right...

Chorus (ad libbed)

 

Oi. I hate finding out I’ve been hacked late in the evening…

Earlier this evening, I got an email from Google saying that they’d added a new administrator to one of the domains I have.

Except I didn’t make anyone an administrator.

It seems that someone had used some of the security holes in WordPress to set up a shadow website inside one of my idle websites, and they’d just told Google they were an administrator by putting a verification HTML file in the web root.

I’ve removed the file, disabled the idle website, and gone through patching the security holes in my WordPress websites.  I’d rather not be hosting a site that’s providing page-ranks for spammy Chinese and Japanese websites.

Now time for sleep.

GNU Terry Pratchett

In Terry Pratchett’s Discworld series, the clacks are a series of semaphore towers loosely based on the concept of the telegraph. Invented by an artificer named Robert Dearheart, the towers could send messages “at the speed of light” using standardized codes. Three of these codes are of particular import:

  • G: send the message on
  • N: do not log the message
  • U: turn the message around at the end of the line and send it back again

When Dearheart’s son John died due to an accident while working on a clacks tower, Dearheart inserted John’s name into the overhead of the clacks with a “GNU” in front of it as a way to memorialize his son forever (or for at least as long as the clacks are standing.)

“A man is not dead while his name is still spoken.”
Going Postal, Chapter 4 prologue

Keeping the legacy of Sir Terry Pratchett alive forever.

For as long as his name is still passed along the Clacks*, Dᴇᴀᴛʜ can’t have him.

http://www.gnuterrypratchett.com/

Boosting the signal

WorldVentures Marketing, LLC
Phone: (972) 805-5100
Fax: (972) 767-3139
5360 Legacy Dr STE 300 Bldg 1, Plano, TX 75024-3135

WorldVentures describes itself as “the world’s largest direct seller of curated group travel, with more than 120,000 Independent Representatives in over 24 countries and we are still growing.”

But other people describe WorldVentures differently. Some press has been unflattering.  Bloggers and commentators openly call it a scam or a scheme. The Better Business Bureau gives it a B- (the Better Business Bureau site says in big bold letters “This Business is not BBB Accredited”).

Now they’re suing a blogger who, after encountering a WorldVentures marketeer, had the temerity to write a post in her blog entitled “WorldVentures: This Is NOT The Way To Travel The World”.

Now she’s being sued by WorldVentures. Read more about it here:
Popehat Signal: Help A Blogger Threatened By A Multi-Level Marketer WorldVentures

Will WorldVentures sue me, too, for linking to this story?  We’ll find out.

Just so folks know…

I’ve created an easy-to-remember URL for our YouTube Channel: http://playhouse.packay.com/.  It’s a lot easier to give out to people than “youtube dot com slash channels slash… um, capital U capital C lower-case r capital B lower-case r dash… um…”

I’m also linking here so Google will pick up on the link and increase the pagerank of the channel. Not that my little blog will do much, but every little bit counts.

Starting on my second puppet build!

Well, that’s not entirely true: I’ve helped Kay out with puppets for Shrek and Little Shop, so I’ve been building puppets since Kay and I made Rudy, but this is the second puppet I’m building for me.

It started back in May when we were shopping for material for the puppets for Shrek. Alfred’s Fabric Center in Albany, NY, was going out of business, and they were selling a lot of fabric at half-off.  I saw a bolt of bright green fur that didn’t have much left on it, so I brought it up front and told them I’d take all that was left of it.  If I recall correctly, it ran $16 and change.

For a few days I thought about what I wanted to make with the green fur, and I decided it was going to be another monster, a little girl this time. Kay and Jen both have little kid characters, and I’m stuck (geez, I’m stuck with a puppet!) playing the adult to everyone else’s little kid, so I wanted to make a younger character to get in on all the fun they’re having.

I decided that I’d name her Violet, because when she was born she had violet fur, but soon afterward the violet fur started falling out and coming in green. She goes by “Vi” now (“call me Violet and you die!”), and she’s just eight years old.

Anyway, over the weekend, Kay cut up some foam using the patterns she used to make Ket, adding some spacers to make the head a little wider.  Then she cut up the fur using the same patterns, reminded me how to do the Henson Stitch, and set me to work stitching fur while she crafted arms and a torso.

A partially stitched head, arms and a torso.

A partially stitched head, arms and a torso.

It will take at least another week or two for me to stitch up all the fur, especially because I can only do it at home in the evenings, but I’ve told Kay that I really want to do the stitching on Vi myself, mostly because she did so much work on Rudy(she finished up Rudy’s long seams on the sewing machine before she built the foam structure of his head and finished him off) and I want to feel like I did more work on Vi.

So, stay tuned. It may be a little while before I have another update on Vi, but it’ll be worth the wait.