Task — Find celebrity

You are given a binary matrix (m x n). Write a script to find the celebrity, return -1 when none found. A celebrity is someone, everyone knows and knows nobody.

Examples

Example 1
Input: @party = (
            [0, 0, 0, 0, 1, 0],  # 0 knows 4
            [0, 0, 0, 0, 1, 0],  # 1 knows 4
            [0, 0, 0, 0, 1, 0],  # 2 knows 4
            [0, 0, 0, 0, 1, 0],  # 3 knows 4
            [0, 0, 0, 0, 0, 0],  # 4 knows NOBODY
            [0, 0, 0, 0, 1, 0],  # 5 knows 4
       );
Output: 4

Example 2
Input: @party = (
            [0, 1, 0, 0],  # 0 knows 1
            [0, 0, 1, 0],  # 1 knows 2
            [0, 0, 0, 1],  # 2 knows 3
            [1, 0, 0, 0]   # 3 knows 0
       );
Output: -1

Example 3
Input: @party = (
            [0, 0, 0, 0, 0],  # 0 knows NOBODY
            [1, 0, 0, 0, 0],  # 1 knows 0
            [1, 0, 0, 0, 0],  # 2 knows 0
            [1, 0, 0, 0, 0],  # 3 knows 0
            [1, 0, 0, 0, 0]   # 4 knows 0
       );
Output: 0

Example 4
Input: @party = (
            [0, 1, 0, 1, 0, 1],  # 0 knows 1, 3, 5
            [1, 0, 1, 1, 0, 0],  # 1 knows 0, 2, 3
            [0, 0, 0, 1, 1, 0],  # 2 knows 3, 4
            [0, 0, 0, 0, 0, 0],  # 3 knows NOBODY
            [0, 1, 0, 1, 0, 0],  # 4 knows 1, 3
            [1, 0, 1, 1, 0, 0]   # 5 knows 0, 2, 3
       );
Output: 3

Example 5
Input: @party = (
            [0, 1, 1, 0],  # 0 knows 1 and 2
            [1, 0, 1, 0],  # 1 knows 0 and 2
            [0, 0, 0, 0],  # 2 knows NOBODY
            [0, 0, 0, 0]   # 3 knows NOBODY
       );
Output: -1

Example 6
Input: @party = (
            [0, 0, 1, 1],  # 0 knows 2 and 3
            [1, 0, 0, 0],  # 1 knows 0
            [1, 1, 0, 1],  # 2 knows 0, 1 and 3
            [1, 1, 0, 0]   # 3 knows 0 and 1
      );
Output: -1

Analysis

We are looking for row $i of all zeroes which intersects column $i of all ones.

There is an interesting metaphysical question as to whether the celebrity knows themself (so knows someone in the room) or doesn't (so is unknown to someone in the room), so let's ignore the cell where the row and column intersect.

A little thought reveals that there can only be one celeb in the party, so we can stop when we find one.

And I might mention that I don't get invited to many parties with a celebrity guest, which is just as well because I probably wouldn't know them.

Try it 

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2026-02-16
use utf8;     # Week 361 - task 2 - Find celebrity
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

find_celebrity([[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]]);
find_celebrity([[0, 1, 0, 0],
                [0, 0, 1, 0],
                [0, 0, 0, 1],
                [1, 0, 0, 0]]);
find_celebrity([[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]]);

sub find_celebrity {
    
    my ($matrix, $party, $person, $celeb, $knows, $known_by);
    
    # initialise
    $matrix = $_[0];
    $party = @$matrix;
    
    # loop over guests
    P: for $person (0 .. $party - 1) {
        $celeb = $person;
        
        # who do they know?
        for $knows (0 .. $party - 1) {
    
            # not a celeb if they know someone
            next if $person == $knows;
            if ($matrix->[$person]->[$knows]) {
                $celeb = -1;
                next P;
            }
        }
            
        # who knows them?
        for $known_by (0 .. $party - 1) {
            
            # not a celeb if the aren't known by someone
            next if $person == $known_by;
            unless ($matrix->[$known_by]->[$person]) {
                $celeb = -1;
                next P;
            }           
        }
        
        # found one!
        last if $celeb > 0;
    }
    
    say ''; print_matrix(qq[Input: ], $matrix);
    say qq[Output: ] . ($celeb >= 0 ? qq[person $celeb] : 'nobody') . q[ is a celebrity];
}

sub print_matrix {
    
    my ($legend, $matrix, $j);

    # format matrix
    ($legend, $matrix) = @_;
    for $j (0 .. @$matrix - 1) {
        print qq{$legend [} . join(', ', @{$matrix->[$j]}) . qq(]);
        say $j == @$matrix - 1 ? '' : ', ';
        $legend = ' ' x length($legend);
    }
}

Output

Input:  [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]
Output: person 4 is a celebrity

Input:  [0, 1, 0, 0], 
        [0, 0, 1, 0], 
        [0, 0, 0, 1], 
        [1, 0, 0, 0]
Output: nobody is a celebrity

Input:  [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]
Output: person 3 is a celebrity