|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Преобразование массивов. Помогите!
Собственно вопрос не по делфи, а по поскалю, хотя синтаксис у них идентичный, так что вот:
Сделал задачу, в которой нужно найти элементы <1 и >5, а остальные элементы перевести в массив D с указанием количества элементов в нем. Начало я сделал, а вот при переводе в массив D с указанием индексов - работает через так сказать... Бывает, что программу как то странно глючит. То левые числа появляются, то текст пропадает и вообще бред показывает, то ещё че-нибудь... Вот код: Код:
program pp; uses crt; var a:array[1..10,1..10] of integer; b,c,d:array[1..10] of integer; m,n,i,j,k,i1,j1,i2,j2,a1,b1,i3,j3,d1:integer; begin clrscr; write('‚ Єў*¤а*в*®¬ ¬*бЁўҐ A(m,n) **©вЁ >5 Ё <1, * ®бв*«м*лҐ ЇҐаҐўҐбвЁ ў D б гЄ*§**ЁҐ¬ Є®«-ў* н«Ґ¬Ґ*в®ў ў *Ґ¬.'); gotoxy(2,3); write('ўўҐ¤ЁвҐ Є®« бва®Є: '); readln(m); n:=m; writeln; writeln('ўўҐ¤ЁвҐ ¬*ваЁжг'); for i:=1 to n do for j:=1 to m do begin gotoxy(j*5,i+5); read(a[i,j]); end; {Џ…ђ…ѓЋЌџ…Њ ЊЂ‘‘?‚ ‚ Ћ„ЌЋЊ…ђЌ›‰} writeln; writeln(' ќ«Ґ¬Ґ*вл Ў®«миҐ 5:'); writeln; for i:=1 to n do for j:=1 to m do begin i2:=i; j2:=j; d[k]:=a[i,j]; b[k]:=a[i,j]; if b[k] > 5 then begin write(' ',b[k],';'); a1:=a1+1; end; end; for i:=1 to n do for j:=1 to m do begin if (b[k] <5) and (b[k] >1) Then b[k]:=d[k]; end; begin writeln; {writeln(' Љ®«ЁзҐбвў® н«Ґ¬Ґ*в®ў >5: ', a1);} end; writeln; writeln(' ќ«Ґ¬Ґ*вл ¬Ґ*миҐ 1:'); writeln; for i:=1 to n do for j:=1 to m do begin k:=k+1; c[k]:=a[i,j]; i1:=i; j1:=j; if c[k] < 1 then begin write(' ',c[k],';'); b1:=b1+1; end; end; begin writeln; d1:=0; {writeln(' Љ®«-ў® н«Ґ¬Ґ*в®ў <1 :',b1);} {writeln('‚ᥣ® н«Ґ¬Ґ*в®ў ў ¬*ббЁўҐ: ',a1+b1);} writeln('Њ*ббЁў D: '); for i:=1 to n do for j:=1 to m do begin k:=k+1; if (a[i,j] > 1) and (a[i,j] < 5) then begin d[k]:=a[i,j]; write(' ',d[k]); d1:=d1+1; end; end; writeln; writeln('Массив D: ',d1); end; readkey; end. Вторая программа - это сортировка выше главной диагонали. Вообще писал её не я... Проблема в том, что она сортирует все странно... 1 строка сортируется по возрастанию, а остальные по убыванию O_o Так же в сортированной матрице обрезается 1 столб, если матрица не квадратная (скажем 4X3) Код:
program sort; uses CRT; var i, j: byte; ar: array[1 .. 15, 1 .. 15] of integer; n1,m1 : integer; bufSize : integer; procedure geij(val: integer; var vi, vj: byte); var i, j: byte; begin for i := 1 to n1 do for j := i + 1 to n1 do begin if val > 1 then dec(val) else begin vi := i; vj := j; exit; end; end; end; function getval(ix: byte): integer; var i, j: byte; begin geij(ix, i, j); getval := ar[i, j]; end; procedure setval(ix: byte; val: integer); var i, j: byte; begin geij(ix, i, j); ar[i, j] := val; end; procedure QSort(n: integer); procedure sort(m1, l: integer); var i, j: byte; x, buf: integer; begin i := m1; j := l; x := getval((m1 + l) div 2); repeat while getval(i) < x do inc(i); while getval(j) > x do dec(j); if i <= j then begin buf := getval(i); setval(i, getval(j)); setval(j, buf); inc(i); dec(j) end until i > j; if m1 < j then sort(m1, j); if i < l then sort(i, l) end; begin sort(1, n1); end; begin clrscr; write('‘®авЁа®ўЄ* ўлиҐ Ј«*ў*®© ¤Ё*Ј®**«Ё.'); gotoxy(2,3); write('ўўҐ¤ЁвҐ Є®« бва®Є Ё бв®«Ўж®ў: '); read(n1); readln(m1); bufSize := (n1 * pred(n1)) div 2; writeln('ўўҐ¤ЁвҐ ¬*ваЁжг'); for i:=1 to n1 do for j:=1 to m1 do begin gotoxy(j*5,i+5); read(ar[i,j]); end; QSort(bufSize); writeln; writeln('‘®авЁа®ў****п ¬*ваЁж*. ‚лиҐ Ј«. ¤Ё*Ј®**«Ё:'); for i := 1 to N1 do begin for j := 1 to n1 do write(ar[i, j]:5); writeln; end; readkey; end. |