Требуется написать программу, определяющую, можно ли выполнить данное задание

Ася74

Помогите решить задачу! "Васю попросили написать, проверяющую можно ли получить строку T только лишь удалением символов из строки S. Он не смог выполнить эту сложную задачу и попросил Вас помочь ему. Требуется написать программу, определяющую, можно ли выполнить такое задание. Причем во входном файле дана одна исходная строка S и восемь различных вариантов строки T. Ваша программа должна для каждого из них определить, можно ли получить такую строку только лишь удалением символов из строки S. Все эти восемь примеров независимы друг от друга."Формат входных данных: Входной текстовый файл b.in содержит в первой строке исходную строку S. Последующие 8 строк содержат различные варианты строки T. Гарантируется, что все 8 примеров отличаются от исходной строки S. Формат выходных данных: b.out должен содержать 8 строк. В каждой из них должно быть написано слово 'Yes' если соответствующую строку можно получить только лишь удалением символов из S и слово 'No', если нельзя.
2 ответа

Ася74

Var f,g:text;
    A,B:array[0..255] of byte;//здесь будет хранится кол-во вхождений каждой буквы
    s:string;
    c:boolean;
    i:byte;
Begin
    Assign(f,'b.in');Reset(f);
    Assign(g,'b.out');Rewrite(g);
    readln(f,s);
    For i:=1 to Length(s) do
     inc(A[ord(s[i])]);//заносим в массив A кол-во вхождений каждого символа 1-ой строки
    While not Eof(f) do
     Begin
      readln(f,s);//считываем очередную строку из файла
      c:=true;//препологаем что из строки S можно получить строку T
      For i:=0 to 255 do
       B[i]:=0;//обнуляем массив B
      For i:=1 to Length(s) do //от начала до конца строки проходимся
       inc(B[ord(s[i])]);//заносим в массив B кол-во вхождений каждого символа строки T
      For i:=1 to Length(s) do
       if not (A[ord(s[i])]>=B[ord(s[i])]) then
       //если кол-во входящих в строку S символов меньше чем кол-во входящих
       //в строку T то значит нельзя получить строку T из S                                                                                                              
        c:=false;
      if c then writeln(g,s+'Yes') //если наше преположение осталось истинным то записываем строку и Yes
       else writeln(g,s+'No'); //иначе строка+No
     End;
     writeln('Результаты записаны в b.out');
     Close(f);Close(g);
     readln;
End.
Ну вот у меня так получилось)Может у кого то есть другие алгоритмы решения)


Ася74

var
  s, t: string;
  i, j, k: integer;
  f, h: text;
 
begin
  assign(f, 'b.in');
  assign(h, 'b.out');
  reset(f);
  rewrite(h);  
  readln(f, s);
  for k := 1 to 8 do
  begin
    readln(f, t);
    j := 1; i := 0;        
    repeat
      inc(i);
      if s[i] = t[j] then inc(j)
    until (j > length(t)) or (i = length(s));    
    if j > length(t) then writeln(h, 'yes') else writeln(h, 'no')
  end;
  close(f); close(h);  
end.
Проверяйте.