Паскаль-программа, которая продуцирует цепочки в трёхсимвольном алфавите с записью их в файл... Опции

[sergey121212]

Создать Паскаль-программу, которая будет продуцировать цепочки в трёхсимвольном алфавите с записью их в файл, причем длина L цепочек ограничена: 4 <= L <= 8. Содержит одно сочетание «аb», заканчивается на «b» и символы «b» и «с» не стоят рядом Общее количество цепочек в файле должна быть не больше 20.

Вот что получилось сделал чтобы было ограничивалась от 4 до 8 и сделал чтобы было не больше 20 , но не могу сделать чтобы "Содержит одно сочетание «аb», заканчивается на «b»(сделал) и символы «b» и «с» не стоят рядом"

Код

Program pr01;
uses Crt;
const
  alf: string = 'ABC';
  n = 20;
type
  mass = array [1..n] of string;
function InMass(a: mass; s: string): boolean;
var
  i: integer;
begin
  InMass := False;
  for i := 1 to n do begin
    if a[i] = s then begin
      InMass := True;
      exit;
    end;
  end;
end;
function P(l: integer): string;
var
  i: integer;
  st: string;
begin
  st := '';
  for i := 1 to l do begin
    st := st + alf[random(length(alf))+1];
  end;
  P := st;
end;
var
  i,j,l1,l2,l3: integer;
  s: mass;
  st: string;
begin
  ClrScr;
  Randomize;
  i := 1;
  while i <= n do begin
    l1 := random(5)+3;
    st := P(l1)+'B';
    if InMass(s, st) then continue;

    s[i] := st;
    i := i + 1;
  end;

  for i := 1 to n do begin
    for j := i to n do begin
      if length(s[i]) > length(s[j]) then
      begin
        st := s[i];
        s[i] := s[j];
        s[j] := st;
      end;
    end;
  end;
  
  for i := 1 to n do begin
    write(i:2,' ');
    Write(s[i]);
    writeln(' len=',length(s[i]));
  end;
end.

[Федосеев Павел]

Я не зарегистрирован на форуме, но вопрос заинтересовал.

Мне видится решение в следующем...

Общие соображения:
1) исходя из "заканчивается на «b»" получаем цепочку вида 'x...xB'
2) исходя из "символы «b» и «с» не стоят рядом" получаем цепочку вида 'x...xAB'
3) исходя из "символы «b» и «с» не стоят рядом" и "Содержит одно сочетание «аb»" получим, что символ 'B' или больше не встречается в цепочке или стоит самым первым, т.е. 'BAx...xAB', 'BBAx...xAB' или 'x...xAB' (где x - символы 'A' или 'C').

Таким образом, цепочки из L символов формируются так:
1) символ 1 выбирается из алфавита "ABC"
2) символы со 2 по L-2 формируются из алфавита на два символа "AB" или "AC" в зависимости от значения предыдущего символа. Формируются случайно или перебором (цикл или рекурсия)
3) два последних символа (L-1, L) принимаются равными 'AB'

Примерно, так

...
  пусть RandomChar возвращает случайный символ из строки-параметра
...
  S[1]:=RandomChar('ABC');
  for i:=2 to L-2 do begin
    if S[i-1]='B' then
      NextChar:=RandomChar('AB')
    else
      NextChar:=RandomChar('AC');
    S:=S+NextChar;
  end;
  S:=S+'AB';

Но, мне кажется, что есть алгоритм пооптимальнее.

[TarasBer]

В конце тоже может быть сколько угодно B
То есть строка имеет вид

B...BA...AB...B
Крайние троеточия состоят только из B, среднее - из A и C

[sergey121212]

А можете пожалуйста написать полный код программы т.к. что то не получается?

Добавлено через 16 мин.
не работает RandomChar

Добавлено через 16 мин.
Также мне нужно чтобы строки на повторялись вот задание


Создать Паскаль - программу, которая будет продуцировать цепочки в трьохсимвольному алфавите с записью их в файл, причем длина L цепочек ограничено: 4 <= L <= 8; для каждой цепочки, отобранного в файл, должно выполняться условие Содержит одно сочетание «аb», заканчивается на «b» и символы «b» и «с» не стоят рядом Общее количество цепочек в файле должна быть не более 20

Вот что я сделал, но никак не могу разобраться что делать с повторами помогите если не сложно

Код

program pr01;

uses crt;
var n,i,k,r1,r2:integer; s:string;  f1,f2:boolean;  f:file of string;
begin randomize; clrscr;
assign(f,'f.txt');
rewrite(f);
      write('n=');
      readln(n);
      writeln;
      k:=0;
      for i:=1 to n do
      begin if ((i-1)mod 20)=0 then k:=k+1;
            s:='b';
            r2:=random(5);
            f1:=false;
            f2:=false;
            repeat begin
                   r1:=random(3);
                   if ((r1=0)and(length(s)<7)and(f1=false)) then begin s:='c'+'a'+s;
                                                                        f1:=true;
                                                                  end;
                   if ((r1=1)and(f2=false)) then begin f1:=false;
                                                       f2:=true;
                                                       s:=s+'c';
                                                 end;
                   if r1=2 then begin f1:=false;
                                      s:=s+'b';
                                end;
                   end until ((length(s)>3+r2));
            begin
            insert('b',s, pos('bc',s));
            delete(s, pos('bc',s),2);
            insert('a',s, pos('cb',s));
             delete(s, pos('cb',s),2);  end;
            writeln(s);write(f,s);
      end;

  close(f);
end.

[TarasBer]

> не работает RandomChar

Ну дык сам напиши же.

[sergey121212]

так помоги написать

[sergey121212]

Вот сделал наконец-то

Код

uses crt;
var r1,p,n,r2,k,i,m:integer;
l:array[1..100] of string;
s,t:string;
f:file of string;
begin   clrscr;
assign(f,'f.txt');
rewrite(f);
randomize;
l[1]:='';
k:=1; n:=0;
repeat
begin
r2:=random(5)+2;
p:=r2;
if r2<>0 then
begin
s:='';
m:=0;
repeat
begin
r1:=random(4);
if (r1=0) and (length(s)<6) and (m=0) then
begin
m:=m+1;
s:=s+'ab';
t:='b'
end;
if (r1=1) and (t<>'b') then begin t:='c'; s:=s+'c'; end;
if (r1=2) and (length(s)<6) then begin t:='a'; s:=s+'a'; end;
if (r1=3) and (t<>'c') and (t<>'a') then begin t:='b'; s:=s+'b'; end;
end;
until ((length(s)>r2));
if (m>0) and (t<>'c') and (t<>'a') then s:=s+'b' else s:='';
end;
for i:=1 to k do
if s<>l[i] then n:=n+1;
if n=k then
begin
k:=k+1;
l[k]:=s;
write(f,l[k]);
end;
n:=0;
end;
until k>20;
writeln;
writeln;
writeln('Нужные слова : ');;
reset(f);
for i:=1 to k-1 do
begin
read(f,l[i]);
writeln(l[i]);
end;
close(f);
end.