IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

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


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской

Репутация: -  0  +


Создать Паскаль-программу, которая будет продуцировать цепочки в трёхсимвольном алфавите с записью их в файл, причем длина 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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

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

Общие соображения:
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';



Но, мне кажется, что есть алгоритм пооптимальнее.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской

Репутация: -  0  +


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

Добавлено через 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.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской

Репутация: -  0  +


так помоги написать
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской

Репутация: -  0  +


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

Код

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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.05.2024 9:26
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name