Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Символы

Автор: gyrosa 28.11.2007 23:55

Помогите пожалуйста решить задачку!!! Только прошли тему, а въехать не получается, но на неделе надо сдать! очень прошу, буду благодарна smile.gif give_rose.gif


В символьной матрице MT(K,L), K≤10, L≤18 в каждой строке определить наибольшую длину небуквенной серии (в строке может быть несколько небуквенных серий). Вывести исходную матрицу и рядом с каждой строкой – полученные значения длин серий. Преобразовать матрицу так, чтобы ее строки располагались в порядке возрастания длин небуквенных серий. Дополнительных матриц не использовать. Вывести преобразованную матрицу. Небуквенная серия – последовательность небуквенных символов, ограниченная буквенными символами или началом (концом) строки.

Автор: klem4 29.11.2007 0:30

uses crt;

const
N = 10;
M = 18;

type
TSymbMatrix = array [1..N, 1..M] of Char;

procedure Create(var mx: TSymbMatrix);
var
i, j: Byte;
begin
randomize;
for i := 1 to n do
for j := 1 to m do
mx[i, j] := chr(48 + random(75));
end;

function GetMaxSeqLen(const mx: TSymbMatrix; const row: Byte): Byte;
var
len, max_len, i: Byte;
begin
max_len := 0;

i := 1;

while (i <= m) do begin
while (i <= m) and (upcase(mx[row, i]) in ['A'..'Z']) do
inc(i);
if i <= m then begin
len := 0;
while (i <= m) and not (upcase(mx[row, i]) in ['A'..'Z']) do begin
inc(i);
inc(len);
end;
if len > max_len then
max_len := len;
end;
end;

GetMaxSeqLen := max_len;
end;

procedure Print(const mx: TSymbMatrix);
var
i, j: Byte;
begin
writeln;
for i := 1 to n do begin
writeln;
for j := 1 to m do begin
if upcase(mx[i, j]) in ['A'..'Z'] then TextColor(White) else TextColor(LightRed);
write(mx[i, j]:2);
end;
TextColor(Green); write(GetMaxSeqLen(mx, i):4);
end;
end;

procedure SwapRows(var mx: TSymbMatrix; const row_a, row_b: Byte);
var
i: Byte;
temp: Char;
begin
for i := 1 to m do begin
temp := mx[row_a, i];
mx[row_a, i] := mx[row_b, i];
mx[row_b, i] := temp;
end;
end;

procedure Sort(var mx: TSymbMatrix);
var
i, j: Byte;
begin
for i := n downto 2 do
for j := 1 to i - 1 do
if not(GetMaxSeqLen(mx, j) <= GetMaxSeqLen(mx, j + 1)) then
SwapRows(mx, j, j + 1);
end;

var
sMx: TSymbMatrix;
begin
clrscr;

Create(sMx);
Print(sMx);

Sort(sMx);
Print(sMx);

readln;
end.

Автор: gyrosa 29.11.2007 1:33

Огромное спасибо!!! но маленький ворос, у меня не пашет модуль crt..его надо создать или измениить прогу?

Автор: Ozzя 29.11.2007 13:16

Что значит "не пашет"?
Если "error 200", то см. в FAQ.

Автор: Lapp 29.11.2007 14:16

Цитата(gyrosa @ 28.11.2007 21:33) *

у меня не пашет модуль crt..его надо создать или измениить прогу?

Создать его будет непросто... smile.gif
Если убрать (закомментировать) все вызовы TextColor (их там типа три штуки) и ClrScr, то можно убрать CRT вообще. Правда, такого блистательного вида (которым всегда отличаются проги klem4 smile.gif) уже не будет, увы..