const Nmax=1000000;
var
 s:array[0..Nmax-1] of char;
 z,ans,rans:array[0..Nmax-1] of longint;
 N,M,i,L,R,last,len:longint;
 ch:char;

function min(x,y:longint):longint;
begin
 if(x>y) then x:=y;
 min:=x;
end;

procedure Init;
begin
 N:=-1;
 read(ch);
 while(ord(ch)>=ord('a'))and(ord(ch)<=ord('z')) do begin
  inc(N);
  s[N]:=ch;
  read(ch);
 end;
 readln;

 inc(N);
 M:=0;
 s[N]:='#';
 read(ch);
 while(ord(ch)>=ord('a'))and(ord(ch)<=ord('z')) do begin
  inc(N);
  inc(M);
  s[N]:=ch;
  read(ch);
 end;
end;

BEGIN
 Init;

 z[0]:=N;
 L:=0;
 R:=0;

 for i:=1 to N do
 begin
  if(i<=R) then z[i]:=min(z[i-l],R-i+1)
  else z[i]:=0;
   while(i+z[i]<=N)and(s[i+z[i]]=s[z[i]]) do inc(z[i]);
   if(i+z[i]-1>R)and(z[i]>0) then begin
    R:=i+z[i]-1;
    L:=i;
   end;
 end;

 len:=0;
 last:=N;
 R:=0;
 i:=N;
 while(i>=N-M) do begin
  if(z[i]>=last-i+1) then begin
   inc(r);
   ans[r]:=i;
   rans[r]:=last;
   inc(len,last-i+1);
   last:=i-1;
  end;
  dec(i);
 end;

 if(len<M) then writeln('Yes')
 else begin
  writeln('No');
  for i:=r downto 1 do begin
   for l:=ans[i] to rans[i] do write(s[l]);
   write(' ');
  end;
 end;
END.

В чём баг хз.Уже сколько пытаюсь сдать-всегда WA3!
Решал так:s1 и s2-входные строки,создаю строку s1#s2,вычисляю z-функцию для s=s1#s2,иду с конца строки до символа # и пытаюсь "покрыть" "не покрытые" символы. Если всю строку покрыл,то ответ No,иначе Yes