The Bear's Den

Enter at your own risk

29 May 2026 Challenge 375

Common Beauty

Task 1: Single Common Word

Submitted by: Mohammad Sajid Anwar

You are given two array of strings.

Write a script to return the number of strings that appear exactly once in each of the two given arrays. String comparison is case sensitive.

Example 1

Input: @array1 = ("apple", "banana", "cherry")
       @array2 = ("banana", "cherry", "date")
Output: 2

Example 2

Input: @array1 = ("a", "ab", "abc")
       @array2 = ("a", "a", "ab", "abc")
Output: 2

"a" appears once in @array1 but appears twice in @array2, therefore, not counted.

Example 3

Input: @array1 = ("orange", "lemon")
       @array2 = ("grape", "melon")
Output: 0

Example 4

Input: @array1 = ("test", "test", "demo")
       @array2 = ("test", "demo", "demo")
Output: 0

Example 5

Input: @array1 = ("Hello", "world")
       @array2 = ("hello", "world")
Output: 1

String comparison is case sensitive.

Solution

This task can be generalized to an arbitrary number of arrays.

Perl

Use singleton to remove any strings that appear more than once in a single array, use listcmp to identify the appearance of each string over all arrays and use pairmap to select those that appear in all of them. The result is the list of single common words in list context or their count in scalar context.

To pass array refs as argumtents to listcmp, its prototype has to be circumvented.

use strict;
use warnings;
use List::MoreUtils qw(singleton listcmp);
use List::Util 'pairmap';

sub scw {
    pairmap {@$b == @_ ? $a : ()} &listcmp(map [singleton @$_], @_);
}

See the full solution to task 1.

J

The J solution is similar, though it is cut a bit differently.

Using named parts to build the final tacit verb:

Finally, apply singleton within each boxed array, find all unique items over all arrays, calculate the table of in_box over all pairs of unique item and array and count the all-one rows.

single_common_word =: _(adverb define)
   singleton =. (1&=@#)/.~ # ~.@]
   uniq_over_boxes =. ~.@:;
   in_box =. ] e. >@[
   count_all =. +/@:(*./)

   ([: count_all ] in_box"0/ uniq_over_boxes)@:(singleton&.>) f. : [:
)

   single_common_word (<'apple'; 'banana'; 'cherry'), (<'banana'; 'cherry'; 'date')
2

See the full solution.

Task 2: Find K-Beauty

Submitted by: Mohammad Sajid Anwar

You are given a number and a digit (k).

Write a script to find the K-Beauty of the given number. The K-Beauty of an integer number is defined as the number of substrings of given number when it is read as a string has length of ‘k’ and is a divisor of given number.

Example 1

Input: $num = 240, $k = 2
Output: 2

Substring with length 2:
24: 240 is divisible by 24
40: 240 is divisible by 40

Example 2

Input: $num = 1020, $k = 2
Output: 3

Substring with length 2:
10: 240 is divisible by 10
02: 240 is divisible by 2
20: 240 is divisible by 20

Example 3

Input: $num = 444, $k = 2
Output: 0

Substring with length 2:
First "44": 444 is not divisible by 44
Second "44": 444 is not divisible by 44

Example 4

Input: $num = 17, $k = 2
Output: 1

Substring with length 2:
17: 17 is divisible by 17

Example 5

Input: $num = 123, $k = 1
Output: 2

Substring with length 1:
1: 123 is divisible by 1
2: 123 is not divisible by 2
3: 123 is divisible by 3

Solution

The K-Beauty is not the property of a number but of its digit representation. Generalizing the task to an arbitrary base.

Perl

Convert the number to a digit string in the given base, slide over substrings having length k, convert back to an integer and check if it divides the original number evenly. Substrings that evaluate to zero have to be treated specially.

The result is the list of found divisors in list context or their count in scalar context.

use strict;
use warnings;
use Math::Prime::Util qw(fromdigits todigitstring);
use experimental 'signatures';

sub beauty ($num, $k, $base) {
    grep 0 + $_ && !($num % fromdigits($_, $base)),
        todigitstring($num, $base) =~ /(?=(.{$k}))./g;
}

See the full solution to task 2.

J

Implementing the solution as an adverb that generates a tacit verb for a given base. It works almost exactly as the Perl version with one simplification: “modulo zero” is permitted in J.

beauty =: adverb define
   to_digits =. m&#.inv
   from_digits =. m&#.
   divisible =. -.@*@|~
   sum =. +/

   [: : ([: sum ] divisible [ from_digits\ to_digits@]) f.
)

Examples in bases 10 and 2:

   2 (10 beauty) 1020
3
   4 (2 beauty) 30030
10

The base-2 example in detail:

See the full solution.