Task — Broken keys

You have a broken keyboard which sometimes types a character more than once. You are given an intended string and the actual typed string. Write a script to find out if the actual typed string is meant by the intended string.

Examples

Example 1
Input: $name = "perl", $typed = "perrrl"
Output: true
Here "r" is pressed 3 times instead of 1 time.

Example 2
Input: $name = "raku", $typed = "rrakuuuu"
Output: true

Example 3
Input: $name = "python", $typed = "perl"
Output: false

Example 4
Input: $name = "coffeescript", $typed = "cofffeescccript"
Output: true

Analysis

This is easily solved by using a constructed regular expression. For each letter $x in the intended string, we need [$x]+ in the regular expression, so for example perl yields [p]+[e]+[r]+[l]+.

This works because the regular expression backtracks until it finds a match or determines that no match is possible. So for example if the intended word is perrl and the typed word is perrl, the argument of the m|| will be [p]+[e]+[r]+[r]+[l]+. On the first pass, the first [r]+ will match rr in the typed string, but the second [r]+ will then fail. But the matching algorithm will backtrack and match the first [r]+ with just a single r, and second [r]+ will match the second r.

Try it 

Try running the script with any input:

Your $correct =

example: answers

Your $wrong =

example: aansssweeeersssss

⤡

#!/usr/bin/perl

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

use v5.26;    # The Weekly Challenge - 2025-03-17
use utf8;     # Week 313 - task 1 - Broken keys
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

broken_keys('perl', 'perrrl');
broken_keys('raku', 'rrakuuuu');
broken_keys('python', 'perl');
broken_keys('coffeescript', 'cofffeescccript');
broken_keys('perrl', 'perl');
broken_keys('perrl', 'perrl');
broken_keys('perl', 'perlperl');

sub broken_keys {
    
    my ($correct, $wrong, $pattern);
    
    ($correct, $wrong) = @_;
    
    # build a regular expression
    $pattern .= qq/[$_]+/ for split('', $correct);
    
    # use it to produce output
    say qq[\nInput:  \$correct = '$correct', \$wrong = '$wrong'];
    say qq[Output: ] . ($wrong =~ m|^$pattern$| ? 'true' : 'false');
}

Output

Input:  $correct = 'perl', $wrong = 'perrrl'
Output: true

Input:  $correct = 'raku', $wrong = 'rrakuuuu'
Output: true

Input:  $correct = 'python', $wrong = 'perl'
Output: false

Input:  $correct = 'coffeescript', 
    $wrong = 'cofffeescccript'
Output: true

Input:  $correct = 'perrl', $wrong = 'perl'
Output: false

Input:  $correct = 'perrl', $wrong = 'perrl'
Output: true

Input:  $correct = 'perl', $wrong = 'perlperl'
Output: false