Sunday, February 22, 2026

Was Fibonacci ever a Celebrity?

Task #1 is here: Perl Weekly Challenge 361, Task 1


#!/usr/bin/env perl

use v5.38;

my @inputs = ( 4, 12, 20, 96, 100, );

# We want to start with the largest Fibonacci numbers
# and work our way down, testing as we go, so I
# manually inverted the array
my @fibos = qw/89 55 34 21 13 8 5 3 2 1/;

foreach my $test_number ( @inputs ) {
    # Save a copy of current input for subsequent pretty-printing
    my $int = $test_number;

    # Don't waste time testing Fibonacci numbers unless they are 
    # less than or equal to the current input
    my @filtered = grep { $_ <= $test_number } @fibos;

    # When we find Fibonacci numbers we want to use then
    # we will stash them in here
    my @used = ();

    foreach my $fib ( @filtered ) {
        # Watch out; the value stored in $test_number changes
	    # each time we find another Fibonacci number
	    # to use
        my $diff = $test_number - $fib;

	    # First case: We found it, we're done; no need to test further
	    # stash this Fibonacci number and then get out of this
	    # inner foreach loop (so you can print the results for this input)
        if ( $diff == 0 ) {
            push( @used, $fib, );
	        last;
        }
	    # Second case: This Fibonacci number was too large to be used
	    # go get the next one, and keep searching
        elsif ( $diff < 0 ) {
            next;
        }
	    # Third case: Implicitly, $diff contains a number
	    # larger than zero
	    else {
	        # Two things, reset the value in $test_number,
	        # replacing it with the value in $diff
	        # AND, stash this Fibonacci number in the @used array,
	        # it's a keeper
            $test_number = $diff;
  	        push( @used, $fib, );
        }
    }

    print "Input: \$int = $int\n";
    print "Output: ";
    print join(",", @used), "\n\n";
    print "$int => ";
    print join(" + ", @used), "\n\n";

}

exit;

Task #2 is here: Perl Weekly Challenge 361, Task 2


#!/usr/bin/env perl

use v5.38;

# Each example is a community of people; some people know (or have heard of) other people, and some
# people are known by other people.  This data structure codes all of those relationships.
# Just because I know you, does not mean that you also know me.  The attribute of knowing is
# one-way, or assymetric.
# The challenge is to identify if a community contains a person with a specific pattern
# of such connections.  
my @communities = ( [[0, 0, 0, 0, 1, 0], [0, 0, 0, 0, 1, 0], [0, 0, 0, 0, 1, 0], [0, 0, 0, 0, 1, 0], [0, 0, 0, 0, 0, 0], [0, 0, 0, 0, 1, 0],],
                    [[0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1], [1, 0, 0, 0]],
                    [[0, 0, 0, 0, 0], [1, 0, 0, 0, 0], [1, 0, 0, 0, 0], [1, 0, 0, 0, 0], [1, 0, 0, 0, 0]],
                    [[0, 1, 0, 1, 0, 1], [1, 0, 1, 1, 0, 0], [0, 0, 0, 1, 1, 0], [0, 0, 0, 0, 0, 0], [0, 1, 0, 1, 0, 0], [1, 0, 1, 1, 0, 0]],
                    [[0, 1, 1, 0], [1, 0, 1, 0], [0, 0, 0, 0], [0, 0, 0, 0]], 
                    [[0, 0, 1, 1], [1, 0, 0, 0], [1, 1, 0, 1], [1, 1, 0, 0]]
                  );

my $example = 1;

foreach my $community ( @communities ) {
    my @people = $community->@*;

    # In some communities there are no people who do not know anyone
    # In other communities there are more than 1 person who do not know anyone
    # We are going to keep track of the number of people in this community who
    # do not know anyone else
    my $celeb = 0;

    # If we find someone who knows nobody else, then we are going to
    # store their name
    my $knows_nobody = 'no candidate';

    # A person's name is the index of their element in the @people array
    # So the first person we evaluate is always named zero, then the names
    # autoincrements
    my $name = 0;

    # In parallel, we are also going to explicitly keep track of who each person
    # is known by (a count)
    my %known_by = ();
    my $community_size = q{};
    
    foreach my $person ( @people ) {
        # The @connections array is analogous to a bit vector that stores whether or not
	    # This $person "knows" any of the other people in this community
        my @connections = $person->@*;

	    # The number of people a person knows will be the sum of the
	    # positions that contain a '1'
        my $count = scalar( grep { $_ > 0 } @connections );

	    # If we find a person who doesn't know anybody else, then they are a
	    # candidate to be celebrity in this community
        if ( $count == 0 ) {
	        # So we store their name (this value might get clobbered)
	        $knows_nobody = $name;    
            # And we keep a count of the total number of celebrity candidates in this community
            $celeb++;
        }	

	    $community_size = scalar( @connections );

	    # The celebrity will be known by all of the other people in
	    # this community, or: the community_size - 1
	    # Here, we use each person's name to store the total
	    # number of different people who know them
	    foreach my $people (0..$#people) {
            if ( $connections[$people] > 0 ) {
	            $known_by{$name}++;
	        }
        }
        $name++;
    }
    print "Example $example\n";

    # The only way to determine if there is a celebrity is if everyone else knows them
    # and the celebrity doesn't know anyone else.  A community can only have one celebrity
    if ( $celeb != 1 ) {
        print "Output: -1; no celebrity candidates in this Example community\n\n";
    }
    else {
        if ( $known_by{$knows_nobody} = $community_size -1 ) {
            print "Output: $knows_nobody is a celebrity in this Example!\n\n";
	    }
        else {
            print "Output: -1; it turns out celebrity candidate is not actually known by everyone else\n\n";
	    }
    }
    $example++;
}

exit;