sub reduc {
    my ($s) = @_ ;

    $s =~ tr/abcd//cd ;
    1 while $s =~ s/(.).*?\K\1+//g ;

    return $s ;
  } ;

  print reduc('1b22a7b3d3ccaacccbcccacccddcceqcc11oabepd'), "\n" ;
                     # badc
  print reduc('1b22w7b3d3ccsqcccbccc2cccddcceqcc11o9bepd'), "\n" ;
                     # bdc