Помогите пожалуйста решить задачку!!! Только прошли тему, а въехать не получается, но на неделе надо сдать! очень прошу, буду благодарна
В символьной матрице 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..его надо создать или измениить прогу?
Создать его будет непросто... Если убрать (закомментировать) все вызовы TextColor (их там типа три штуки) и ClrScr, то можно убрать CRT вообще. Правда, такого блистательного вида (которым всегда отличаются проги klem4 ) уже не будет, увы..
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.