Оставить в строке только первое и последнее вхождение цифр каждого слова

begin
  var S := ReadLnString('S =');
  var W := S.ToWords; // Разбить на отдельные слова
  S := '';
  for var i := 0 to W.Length-1 do
    begin
      for var c := #48 to #57 do // Каждую цифру поотдельности
        begin
          var f := W[i].IndexOf(c) + 1; // Позиция цифры слева
          var l := W[i].LastIndexOf(c) + 1; // Позиция цифры справа
          if (f > 0) and (l > f) then // Встречается цифра и не менее двух раз
            begin
              W[i][f] := #0; W[i][l] := #0; // Заменим перую и последнюю на подстановочный символ
              W[i] := W[i].Replace(c, '').Replace(#0, c); // Удалим все остальные и вернём подстановочные
            end;
        end;
      S += #32 + W[i]; // Соберём строку заново
    end;
  S := S.TrimStart(#32);
  WriteLn('S = ' + S);
end.

var
  L: List<KeyValuePair<integer, integer>> := new List<KeyValuePair<integer, integer>>;
 
begin
  var s: string := '100001 555111';
  var wrd: string;
  
  for var i: integer := 1 to s.Length do
  begin
    if (s[i] = ' ') or (i = s.Length) then
    begin
      wrd := wrd + (i = s.Length ? '' + s[i] : '');
      L.Add(new KeyValuePair<integer, integer>(i + ord(i = s.Length) - wrd.Length - 1, wrd.Length));
      wrd := '';
    end
    else wrd := wrd + s[i];
  end;
  
  L.Reverse;
  foreach var pair in L do
  begin
    wrd := s.Substring(pair.key, pair.value);
    for var i: integer := wrd.Length downto 1 do
      wrd := wrd.Remove(pred(i), ord((wrd.IndexOf(wrd[i]) < pred(i)) and (wrd.LastIndexOf(wrd[i]) > pred(i))));
    s := s.Remove(pair.key, pair.value).Insert(pair.key, wrd);
  end;
  writeln(s);
end.