Pascal, работа со строками

[Magenta]

[Stilet]

Magenta

Слушай, задача в твоем условии не решаема. Проверку на вхождение все равно придется проверять, и проверка эта делается через IF, так что расслабься и купи препода.

[Аватар]

Решаема (если только s2 не палиндром, еще нюансы есть)

var s,s2,s3: String;
    i,j,cnt: Integer;
begin
  вводим s и s2
  s3:=s2+s;
  cnt:=0;
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);

[Magenta]

Сообщение от Аватар

Решаема (если только s2 не палиндром, еще нюансы есть)

var s,s2,s3: String;
    i,j,cnt: Integer;
begin
  вводим s и s2
  s3:=s2+s;
  cnt:=0;
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);

[FPaul]

Я не смотрел "50 оттенков", но мыслищи появляются:
1. Цикл заменить рекурсией.
2. IF заменить CASE

[Magenta]

Program Lab4_1;
 Uses
  Crt;
 var
  s,s2,s3:String;
  i,j,cnt:Integer;
 begin
  Clrscr;
  Writeln('Введите строку до 12 символов');
  readln(s);
  Writeln('Введите подстроку из трёх символов');
  readln(s2);
  s3:=s2+s;
  cnt:=0;
  Writeln('Обратный порядок следования символов');
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  i:=Pos(s2,s); j:=Byte(i=0)+Byte(i>0)*3+i; s3[j]:=s2[3]; s3[j+2]:=s2[1]; s:=Copy(s3,4,12); cnt:=cnt+Byte(i>0);
  Writeln(s3);
  Writeln('Количество вхождений = ',cnt);
  readln;
 end.

[Аватар]

вместо Writeln(s3);
Writeln(s);

[FPaul]

Если вызов самописной рекурсивной функции разрешён, то можно попробовать так

program SadoMazoStrings;

  function Recurse(S, SubS: string; var Sr: string): integer;
  var
    i, cnt: integer;
    c: char;

    procedure f;
    begin
      i := Pos(SubS, S);
      case i of
        0:
        begin
          Sr := Sr + S;
          exit;
        end;
        else
        begin
          Sr := Sr + Copy(S, 1, i - 1) + SubS[3] + SubS[2] + SubS[1];
          Delete(S, 1, i + 2);
          Inc(cnt);
          f;
        end;
      end;
    end;

  begin
    Sr  := '';
    cnt := 0;
    f;
    Recurse := cnt;
  end;

var
  Str, SubS, Sr: string;
begin
  Str  := 'abcbcbcabcbc';
  SubS := 'abc';
  writeln(Str);
  writeln(Recurse(Str, SubS, Sr));
  writeln(Sr);
end.

[Magenta]

Сообщение от Аватар

вместо Writeln(s3);
Writeln(s);

Получилось. Спасибо большое)

[FPaul]

Интересно, а зачем даются задачи на "грязные хаки"? Олимпийская подготовка?