Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Разное
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 16.09.2010, 14:03
AlexKos AlexKos вне форума
Прохожий
 
Регистрация: 03.07.2010
Сообщения: 5
Репутация: 10
По умолчанию Преобразование массивов. Помогите!

Собственно вопрос не по делфи, а по поскалю, хотя синтаксис у них идентичный, так что вот:

Сделал задачу, в которой нужно найти элементы <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.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 14:28.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter