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.

With regex based solution, I always need explanation otherwise you spend good amount of time to get your head around if it is a complex one. Here you even have DIY tool to test it as well. Great work.

This review may cover either or both challenges for this week.

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');
}

6 lines of code

Output from script

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