, пришлось попросить помощи Вот в с раширением *doc http://ork.53535.ru/drawling.doc по-другому не могу
Program Kursovik;
var
i, j, x, k, n : Integer;
a, b : array[1..1000] of Char;
s: string;
begin
writeln('Vvedite stroku: ');
readln(s);
i:=1; j:=1; k:=0; x:=0;
repeat
x := x + 1;
a[x]:=s[x];
until x = length(s);
while not (i > x) do
begin
if not (( ( ord(a[i-1])>159 ) and (ord(a[i-1])<176) ) or ((ord(a[i-1])>223) and (ord(a[i-1])<240))) then
if a[i] = 'р' then
if a[i+1] = 'а' then
if a[i+2] = 'к' then
if not ((( ord(a[i+3])>159 ) and (ord(a[i+3])<176) ) or ((ord(a[i+3])>223) and (ord(a[i+3])<240))) then
begin
b[j] := 'щ';
b[j+1] := 'у';
b[j+2] := 'к';
b[j+3] := 'а';
i := i + 3;
j := j + 4;
end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
end;
write('Resoult massiv:');
repeat
k := k + 1;
write(b[k]);
until k = j;
readln;
end.
not (( ( ord(a[i-1])>159 ) and (ord(a[i-1])<176) ) or ((ord(a[i-1])>223) and (ord(a[i-1])<240)))
not (
((ord(a[i-1])>159) and (ord(a[i-1])<176))
or
((ord(a[i-1])>223) and (ord(a[i-1])<240))
)
not (, если я не ошибаюсь...
a[i-1] in [#160 .. #175, #224 .. #239]
)
uses crt;
var
s : array[1..80] of char;
temp : string;
n,i,p : byte;
begin
clrscr;
write('n='); readln(n);
temp := '';
for i := 1 to n do begin
readln(s[i]);
temp := temp + s[i];
end;
writeln;
writeln(temp);
p := pos('рак', temp);
if p = 0 then writeln('N0')
else begin
delete(temp, p,3);
insert('щука',temp, p);
for i := 1 to length(temp) do
s[i] := temp[i];
inc(n);
end;
writeln;
for i := 1 to n do
write(s[i]);
readln;
end.
uses crt;
const
fish : array [0..3] of char = ('щ','у','к','а');
var
s : array[1..80] of char;
n,i,j : byte;
begin
clrscr;
write('n='); readln(n);
FillChar(s, sizeof(s),0);
for i := 1 to n do readln(s[i]);
writeln;
for i := 1 to n do write(s[i]);
{$r-}
i := 1;
while(i<=n-2) do
if (s[i] = 'р') and (s[i+1]='а') and (s[i+2]='к') then begin
for j := n + 1 downto i do s[j] := s[j-1];
for j := 0 to 3 do
s[i+j] := fish[j];
inc(i,4);
inc(n);
end
else inc(i);
writeln;
for i := 1 to n do write(s[i]);
readln
end.
Program Kursovik;
var
i, j, x, k, n : Integer;
a, b : array[1..1000] of Char;
s: string;
begin
writeln('Введите строку: ');
readln(s);
i:=1; j:=1; k:=0; x:=0;
repeat
x := x + 1;
a[x]:=s[x];
until x = length(s);
while not (i > x) do
begin
if not (a[i-1] in [#160.. #175, #224..#239]) then
if a[i] = 'р' then
if a[i+1] = 'а' then
if a[i+2] = 'к' then
if not (a[i+3] in [#160.. #175, #224..#239]) then
begin
b[j] := 'щ';
b[j+1] := 'у';
b[j+2] := 'к';
b[j+3] := 'а';
i := i + 3;
j := j + 4;
end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
else begin b[j] := a[i]; i := i + 1; j := j + 1; end
end;
write('Результат: ');
repeat
k := k + 1;
write(b[k]);
until k = j;
readln;
end.
const
alpha = [#160.. #175, #224..#239];
var
s: string;
p, start: integer;
begin
write('s = '); readln(s);
p := 0;
repeat
start := p;
p := start + pos('рак', copy(s, start + 1, 255));
if
(
(p <> start)
and
((p = 1) or ( (p > 1) and not(s[p-1] in alpha)))
and
((p + 2 = length(s)) or ((p + 2 < length(s)) and not(s[p+3] in alpha)))
) then
begin
delete(s, p, 3);
insert('щука', s, p);
end;
until p = start;
writeln(s);
end.
alpha = [#48..#57, #160.. #175, #224..#239];
, алгоритм был сделан под мою задачу, переделывать что ли .. даже и не знаю . Да и вообще с pos, delete ... плохо знакома. И поэтому сама программа не так понятна
uses crt;
const
fish : array [0..3] of char = ('щ','у','к','а');
limits = [#0..#32,'.',',','!','?',':','"'];
var
s : array[1..80] of char;
n,i,j : byte;
begin
clrscr;
write('n='); readln(n); // количество элементов в массиве
FillChar(s, sizeof(s),0);
for i := 1 to n do readln(s[i]); // посимвольный ввод строки
writeln;
for i := 1 to n do write(s[i]); // вывод строки на экран
{$r-} // отключение проверки выхода за границы массива
i := 1;
while(i<=length(s)-2) do begin (* внешний цикл до момента достижения
i = length(s) -2, так как это последнй шанс когда там может находиться слово РАК *)
while(i<=length(s)-2) and (s[i] in limits)
do inc(i); // проходим по массиву пока не найдем букву
if (i<=length(s)-2) and (s[i] = 'р') and (s[i+1]='а') and (s[i+2]='к') and (s[i+3] in limits) then begin
(* Если начиная с найденной буквы следует слово РАК и за ним следует НЕ буква или оно стоит в конце массива,
то сдвигаем все символы на один элемент вправо и
начиная с символа хранащего букву Р слова РАК вставляем слово ЩУКА
*)
for j := n + 1 downto i do s[j] := s[j-1];
for j := 0 to 3 do
s[i+j] := fish[j];
inc(i,4); // проскакивае далее по массиву через добавленое слово ЩУКА
inc(n); (* длина массива увеличилась на единицу, так как щука длинее рака на один символ)
*)
end
(* Если найденная группа букв НЕ слово рак с пробелом до и после него или
стоящее в конце строки, то идем по массиву дальше пока не закончится этот набор букв или строка
*)
else repeat
inc(i);
until (s[i] in limits) or (i=length(s)-2);
end;
writeln;
for i := 1 to n do write(s[i]); // выводм результат на экран.
readln
end.
const
r='rak';
h='hyka';
var
s: string;
begin
writeln('Enter string: ');
readln(s);
while pos(r,s)<>0 do begin
insert(h,s,pos(r,s));
delete(s,pos(r,s),3);
end;
writeln(s); readln
end.
Program Kursovik;
{$R+}
const
r='rak';
h='hyka';
var
s: string;
c:array[1..5] of char;
begin
c[1]:='r';
c[2]:='a';
c[3]:='k';
c[4]:='1';
c[5]:='2';
s:=c;
writeln('Enter string: ');
{ readln(s);}
while pos(r,s)<>0 do begin
insert(h,s,pos(r,s));
delete(s,pos(r,s),3);
end;
writeln(s); readln
end.
Сколько еще вариантов решения надо предложить, чтобы это НАКОНЕЦ-ТО устроило автора темы???
