Визуализация сортировки

WhiteP · Регистрация: 20.11.2012

Студворк — интернет-сервис помощи студентам

Доброго дня.

Занесло меня на старости лет обучаться в ВУЗ, и, как ни странно, программирование (начала) даются на паскале. Последний раз Паскаль (Делфи, точнее) я использовал лет 15 назад.

Подскажите, pls, все ли нормально для лабораторной, или желательно что-то изменить в структуре кода? После Си Паскаль "мылит" глаз. Не понятно как передается массив в процедуру - вроде var говорит передавать по ссылке, но при изменении массива в функции - вне ее пределов массив изначального вида...

Задание:

Напишите программу для графической иллюстрации сортировки массива алгоритмом простых включений. Массив изобразите в виде диаграммы — каждый элемент массива представляется в виде столбика, высота которого пропорциональна значению элемента. Визуализация сортировки сводится к показу массива после каждого перемещения элементов.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
program TestSort;
 
uses
  GraphABC;
 
const
  gridWidth = 900;
  gridHeight = 500;
  gridXMrg = 10;
  gridYMrg = 10;
  arrSize = 70;
  drawSpd = 10;
 
type
  GridDescriptor = record
    xLeft, xRight, yTop, yBottom, axisHeight, axisWidth: integer;
  end;
  arr = array[0..arrSize - 1] of integer;
 
var
  Grid: GridDescriptor;
  colMargin: integer;
  tstArr: arr;
  cnt: integer;
  max, rnd: integer;
 
procedure DrawGrid(x, y, w, h: integer; pRct: ^GridDescriptor);
var
  mX, mY: integer;
begin  
  mY := h div 8;
  mX := mY;
  
  SetWindowWidth(w + x * 2);
  SetWindowHeight(h + y * 2);  
  
  Pen.Color := clBlack;
  Pen.Width := 2;
  
  DrawRectangle(x, y + h, w + x, y);
  
  Pen.Color := RGB(20, 20, 20);
  Pen.Width := 1;
  
  Line(x + mX, y + h - mY, w + x - mX, y + h - mY);
  Line(x + mX, y + h - mY, x + mX, y + mY);
  
  Pen.Color := RGB(200, 200, 200);
  Pen.Style := DashStyle.Dash;
  
  Line(x + mX, h div 2 + y, w + x - mX, h div 2 + y);
  Line(x + mX, y + mY, w + x - mX, y + mY);
  
  Pen.Color := RGB(225, 225, 225);
  
  Line(x + mX, Round(y+0.75*h-0.5*mY), w + x - mX, Round(y+0.75*h-0.5*mY));
  Line(x + mX, Round(y+0.25*h+0.5*mY), w + x - mX, Round(y+0.25*h+0.5*mY)); 
  
  pRct^.xLeft := x + mX;
  pRct^.xRight := x + w - mX;
  pRct^.yTop := y + mY;
  pRct^.yBottom := y + h - mY;
  pRct^.axisHeight := pRct^.yBottom - pRct^.yTop;
  pRct^.axisWidth := pRct^.xRight - pRct^.xLeft;
end;
 
procedure DrawCol(n, width, height, margin: integer; pRct: ^GridDescriptor; active: boolean; clor:color);
var
  x1, y1, x2, y2: integer;
begin
  x1 := pRct^.xLeft + (width + margin) * n;
  y1 := pRct^.yBottom;
  x2 := x1 + width;
  y2 := y1 - height;
  
  Brush.Color := clor;  
  
  Pen.Color := clBlack;
  Pen.Width := 1;
  Pen.Style := DashStyle.Solid;
  
  FillRectangle(x1, y1, x2, y2);
  DrawRectangle(x1, y1, x2, y2);
end;
 
procedure VisualizeArrState(maxValue, actColNum, step: integer; var vArr: arr; finState:boolean);
var
  cnt: integer;
  normalized: real;
  str:string;
  clor:color;
begin
  Sleep(Round(1000/(drawSpd*10)));
  
  LockDrawing;
  Window.Clear;
  
  colMargin := 2;
  DrawGrid(gridXMrg, gridYMrg, gridWidth, gridHeight, @Grid);
  
  Brush.Color := RGB(220, 220, 220);
  if step<>-1 then begin
    str:='Search position for element with index '+step;
    TextOut(gridXMrg+10,gridYMrg+10,str);
    end
  else begin
    TextOut(gridXMrg+10,gridYMrg+10,'Array of '+arrSize +' elements is fully sorted');
    end;
    
  for cnt := 0 to arrSize - 1 do
  begin
    normalized := (vArr[cnt] / maxValue) * Grid.axisHeight;
    clor:=RGB(220,220,220);
    if actColNum=cnt then
      if finState=true then 
        clor:=RGB(100, 255, 100)
      else
        clor:=RGB(255, 100, 100);
      
    DrawCol(cnt, Trunc((Grid.axisWidth - (arrSize - 1) * colMargin)/arrSize), Round(normalized), colMargin, @Grid, cnt = actColNum,clor);
  end;  
  Redraw;  
end;
 
procedure VisInsertionSort(var vArr: arr);
var
  i, j, index: integer;
begin
  for i := 1 to arrSize - 1 do
  begin
    index := vArr[i];
    j := i;
    while ((j > 0) and (vArr[j - 1] > index)) do
    begin
      vArr[j] := vArr[j - 1];
      VisualizeArrState(max, j, i, vArr, false);
      j := j - 1;
    end;
    vArr[j] := index;
    VisualizeArrState(max, j,i, vArr,true);
  end;
  VisualizeArrState(max, -1,-1, vArr, false);
end;
 
begin
  max := 0;
  for cnt := 0 to arrSize - 1 do
  begin
    rnd := random(30000);
    tstArr[cnt] := rnd;
    if rnd > max then
      max := rnd;
  end;   
  VisInsertionSort(tstArr);
end.

@Sun Serega · 06.03.2021, 16:16

Объясните подробнее, где вы что меняете и как именно выражается то, что

Сообщение от WhiteP

при изменении массива в функции - вне ее пределов массив изначального вида

Вообще желательно чтоб вы нашли минимальный код. Раз у вас уже есть опыт в других языках - это должно быть не сложно.

---

Тем временем в остальном по коду:

Сообщение от WhiteP

вроде var говорит передавать по ссылке

Pascal
1
pRct: ^GridDescriptor

Это

C++
1
GridDescriptor* pRct

Тем временем

Pascal
1
var pRct: GridDescriptor

Это

C++
1
GridDescriptor& pRct

Но пишете вы в разделе языка PascalABC.Net, а раз это .Net язык, так же как C# - использование указателей это плохо и не безопасно.

В частности, передача указателя на элемент массива имеет неприятные сайдэффекты (если не заблокировать его явным образом). А получить указатель на весь массив (то есть указатель на ссылку на область памяти элементов) вообще нельзя, потому что сборщик мусора, управляющий ссылками, не может проверить на что указывает обычный указатель (который не обёртка-ссылка).

var-параметры это ссылки, поэтому принимать ссылку на ссылку (как массив var-параметром) можно. Но если вы изменяете только элементы, а не саму переменную массива - это излишне.

---

Дальше - надо понимать что статические массивы в PascalABC.Net это обёртка на динамическими. При том морально устаревшая. Используйте только динамические массивы:

Pascal
1
2
3
4
5
var a: array of byte;
SetLength(a, 5); // SetLength может использоваться для выделения новых массивов, но его основное использование - выделить новый массив, скопировав в него элементы старого из этой же переменной, поэтому он не так эффективен
 
var b: array of byte := new byte[5];
var c := new byte[5]; // Автовыведение типа, так же как [INLINE]auto с = new byte[5][/INLINE] в C++

Кроме всего прочего, динамические массивы не надо объявлять в type, чтоб их можно было передать параметром.

Хотя вообще у статических массивов есть применение - когда индексаторы это не числа:

Pascal
1
2
3
4
5
6
## var a: array['a'..'z'] of integer;
foreach var ch in ReadString do
  a[ch] += 1;
for var ch := 'a' to 'z' do
  if a[ch]<>0 then
    $'Символ {ch} встречается {a[ch]} раз'.Println;

(это вся программа, ## заменяет begin-end.)

---

Кроме того - вы как в си пишете, так?

C++
1
2
3
4
5
6
int i;
 
int main()
{
    for (i = 0; i<5; ++i)
}

Или так?

C++
1
2
3
4
int main()
{
    for (int i = 0; i<5; ++i)
}

В паскале всё работает так же:

Pascal
1
2
3
4
5
var i: integer;
 
begin
  for i := 0 to 4 do
end.

И

Pascal
1
2
3
begin
  for var i := 0 to 4 do
end.

В первом случае переменная хранится в куче, во втором - на стеке. Попробуйте угадать что лучше.
Вам об этом уже говорит компилятор. Нечего игнорировать предупреждения.

И это касается не только переменной цикла. Все переменные лучше объявлять после begin и как можно ближе к первому использованию.

Добавлено через 4 минуты
P.S. И выкиньте строчку с program, она у вас ничего не делает. С тем же успехом можно поставить комментарий:

Pascal
1
// Программа TestSort

WhiteP · 09.03.2021, 07:03 **[ТС]**

Сообщение от Sun Serega

Но пишете вы в разделе языка PascalABC.Net, а раз это .Net язык, так же как C# - использование указателей это плохо и не безопасно.

Изначально тему создал в PascalABC, но модератор перенес сюда. Наверное, какие-то особенности выдали использование .Net версии. Специфические для .Net инструкции и расширения использовать нельзя.

Вообще, в методичке к лабораторным работам есть вот такой текст:

Для решения задач, приведенных ниже, используется модуль GRAPH, этот модуль не может быть использован для написания программ в системе PascalABС, так как для данной системы разработан модуль GRAPHABC, процедуры и функции которого не всегда совпадают с процедурами и функциями модуля GRAPH. В примерах 8 и 9 данного раздела
приводятся программы, использующие модуль GRAPHABC, также примеры использования данного модуля можно посмотреть в разделе Помощь системы программирования PascalABC.

откуда я сделал вывод, что можно использовать GraphABC.

Что-то нужно поменять в коде, если нужно использовать классический Паскаль (за исключением графического модуля)? Насколько я понял - Ваши комментарии выше в основном относятся как раз к доп.возможностям именно PascalABC (переменнные в цикле for, переменные внутри блока).

@Puporev · 09.03.2021, 07:21

Сообщение от WhiteP

одератор перенес сюда. Наверное, какие-то особенности выдали использование .Net версии

Да, такие строки как

Pascal
1
2
3
4
5
6
Pen.Color := clBlack;
Pen.Width := 2;
DrawRectangle(x, y + h, w + x, y);
Pen.Color := RGB(20, 20, 20);
Pen.Width := 1;
Pen.Style := DashStyle.Dash;

позволили мне перенести тему в раздел АВС.net.
Не хотите писать на .net, пишите на простом АВС, но не мешайте их.

WhiteP · 09.03.2021, 08:02 **[ТС]**

Сообщение от Puporev

Да, такие строки как

Точно, благодарю. Нашел на этом форуме ссылку на PascalABC без .Net, код поправил.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
program TestSort;
 
uses
  GraphABC;
 
const
  gridWidth = 900;
  gridHeight = 500;
  gridXMrg = 10;
  gridYMrg = 10;
  arrSize = 150;
  drawSpd = 100;
 
type
  GridDescriptor = record
    xLeft, xRight, yTop, yBottom, axisHeight, axisWidth: integer;
  end;
  arr = array[0..arrSize - 1] of integer;
 
var
  Grid: GridDescriptor;
  colMargin: integer;
  tstArr: arr;
  cnt: integer;
  max, rnd: integer;
 
procedure DrawGrid(x, y, w, h: integer; pRct: ^GridDescriptor);
var
  mX, mY: integer;
begin
  mY := h div 8;
  mX := mY;
  
  SetBrushColor(RGB(255,255,255));
 
  SetWindowWidth(w + x * 2);
  SetWindowHeight(h + y * 2);
 
  SetPenColor(RGB(0,0,0));
  SetPenWidth(2);
 
  Rectangle(x, y + h, w + x, y);
 
  SetPenColor(RGB(20, 20, 20));
  SetPenWidth(1);
 
  Line(x + mX, y + h - mY, w + x - mX, y + h - mY);
  Line(x + mX, y + h - mY, x + mX, y + mY);
 
  SetPenColor(RGB(200, 200, 200));
  SetPenStyle(psDot);
 
  Line(x + mX+1, h div 2 + y, w + x - mX-1, h div 2 + y);
  Line(x + mX+1, y + mY, w + x - mX-1, y + mY);
 
  SetPenColor(RGB(225, 225, 225));
 
  Line(x + mX+1, Round(y+0.75*h-0.5*mY), w + x - mX-1, Round(y+0.75*h-0.5*mY));
  Line(x + mX+1, Round(y+0.25*h+0.5*mY), w + x - mX-1, Round(y+0.25*h+0.5*mY));
 
  pRct^.xLeft := x + mX;
  pRct^.xRight := x + w - mX;
  pRct^.yTop := y + mY;
  pRct^.yBottom := y + h - mY;
  pRct^.axisHeight := pRct^.yBottom - pRct^.yTop;
  pRct^.axisWidth := pRct^.xRight - pRct^.xLeft;
end;
 
procedure DrawCol(n, width, height, margin: integer; pRct: ^GridDescriptor; active: boolean; clor:integer);
var
  x1, y1, x2, y2: integer;
begin
  x1 := pRct^.xLeft + (width + margin) * n;
  y1 := pRct^.yBottom;
  x2 := x1 + width;
  y2 := y1 - height;
 
  SetBrushColor(clor);
 
  SetPenColor(RGB(0,0,0));
  SetPenWidth(1);
  SetPenStyle(psSolid);
 
  FillRect(x1, y1, x2, y2);
  Rectangle(x1, y1, x2, y2);
end;
 
procedure VisualizeArrState(maxValue, actColNum, step: integer; var vArr: arr; finState:boolean);
var
  cnt: integer;
  normalized: real;
  str:string;
  clor:integer;
begin
  Sleep(Round(1000/(drawSpd*10)));
 
  LockDrawing;
  ClearWindow();
 
  colMargin := 2;
  DrawGrid(gridXMrg, gridYMrg, gridWidth, gridHeight, @Grid);
 
  SetBrushColor( RGB(220, 220, 220));
  if step<>-1 then begin
    str:='Search position for element with index '+IntToStr(step);
    TextOut(gridXMrg+10,gridYMrg+10,str);
    end
  else begin
    TextOut(gridXMrg+10,gridYMrg+10,'Array of '+IntToStr(arrSize) +' elements is fully sorted');
    end;
 
  for cnt := 0 to arrSize - 1 do
  begin
    normalized := (vArr[cnt] / maxValue) * Grid.axisHeight;
    clor:=RGB(220,220,220);
    if actColNum=cnt then
      if finState=true then
        clor:=RGB(100, 255, 100)
      else
        clor:=RGB(255, 100, 100);
 
    DrawCol(cnt, Trunc((Grid.axisWidth - (arrSize - 1) * colMargin)/arrSize), Round(normalized), colMargin, @Grid, cnt = actColNum,clor);
  end;
  Redraw;
end;
 
procedure VisInsertionSort(var vArr: arr);
var
  i, j, index: integer;
begin
  for i := 1 to arrSize - 1 do
  begin
    index := vArr[i];
    j := i;
    while ((j > 0) and (vArr[j - 1] > index)) do
    begin
      vArr[j] := vArr[j - 1];
      VisualizeArrState(max, j, i, vArr, false);
      j := j - 1;
    end;
    vArr[j] := index;
    VisualizeArrState(max, j,i, vArr,true);
  end;
  VisualizeArrState(max, -1,-1, vArr, false);
end;
 
begin
  max := 0;
  for cnt := 0 to arrSize - 1 do
  begin
    rnd := random(30000);
    tstArr[cnt] := rnd;
    if rnd > max then
      max := rnd;
  end;
  VisInsertionSort(tstArr);
end.

@Puporev · 09.03.2021, 08:31

Программа выполняет поставленную задачу, и лезть в код не зная задумок автора не хочется. Я бы тлько поменял оттенки серого на какие-то номальные цвета и выровнял графическое окно по центру экрана.

Pascal
1
2
3
SetWindowWidth(w + x * 2);
SetWindowHeight(h + y * 2);
CenterWindow;//вставить это

А если например упрощать код, то я как-то писал такое(ссылку на тему не нашел).

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
uses graphABC;
const n=20; //размер массива
type stb=record //тип столбец=запись
         x,y,h,c:integer //поля координаты левого нижнего угла, высота и цвет
         end;
     mas=array[1..n] of stb;//тип массива
procedure draw(st:stb;w:integer); //рисование 1 столбика, w-ширина
begin
setbrushcolor(st.c);//сплошная заливка указанным цветом
rectangle(st.x,st.y-st.h,st.x+w,st.y);//закрашенный прямоугольник
end;
//процедра смены высоты и цвета столбиков
procedure swap(var a:stb;b:stb);
begin
a.h:=b.h;
a.c:=b.c;
end;
var arr:mas;
    i,j,p,k,w,y:integer;
    xx:stb;//переменная для обмена столбцов
begin
randomize;
setwindowsize(800,500);
centerwindow;
w:=windowwidth div n;//ширина столбцов с учетом отступов слева и справа
y:=windowheight-50;//основание столбцов
for i:=1 to n do //присвоение значений
 begin
  arr[i].y:=y;//координата низа
  arr[i].h:=10+random(y-20);//высота
  arr[i].x:=(i-1)*w;//координата левой стороны
  arr[i].c:=clrandom;//цвет
  draw(arr[i],w)//рисование столбца
 end;
lockdrawing;
for i:=2 to n do
 begin
  clearwindow;
  swap(xx,arr[i]);
  j:=1;//смотрим что слева от него
  while (j<i)and(xx.h>arr[j].h) do inc(j);//пока все меньше данного, идем вперед
  if j<i then
   begin
    for p:=i-1 downto j do//нашли меньший, сдвигаем массив от этого элемента-1
    swap(arr[p+1],arr[p]);
    swap(arr[j],xx);
   end;
  sleep(500); //после каждого шага задержка
  for k:=1 to n do
  draw(arr[k],w); //рисование нового массива
  redraw;
 end;
unlockdrawing;
setbrushstyle(bsClear);
setfontcolor(clRed);
setfontsize(12);
setfontstyle(fsBold);
textout(windowwidth div 2-150,20,'Сортировка завершена');
end.

@Sun Serega · 09.03.2021, 11:18

Сообщение от WhiteP

Изначально тему создал в PascalABC

PascalABC это древнейшая версия PascalABC.Net, перед тем как он был переписан на .Net . И эта версия давно официально не существует, оригинальные разработчики давно удалили все его следы и заменили на PascalABC.Net, поэтому PascalABC можно скачать только пиратский.

Я сомневаюсь что у проверяющих будет пиратский компилятор. Поэтому - кто вам сказал что современные фичи для вашей работы запрещены? При чём так, что Pen.Color := clBlack; проходило незамеченным, а как дело зашло за более эффективное объявление переменных - так уже нельзя.

И не мешайте всё в одну кучу, var-параметры лучше параметров-указателей и потому - что вы пишете на паскале, а не на чистом си без плюсов. На паскале никто в своём уме не пишет так:

Pascal
1
2
3
4
5
6
7
8
9
##
 
procedure p1(i: ^integer);
begin
  i^ := 5;
end;
 
var i := 5;
p1(@i);

Просто потому что так проще:

Pascal
1
2
3
4
5
6
7
8
9
##
 
procedure p1(var i: integer);
begin
  i := 5;
end;
 
var i := 5;
p1(i);

И считая что вы всё равно будете компилировать компилятором PascalABC.Net - указатели остаются небезопасными, независимо от того, верите ли вы в новые стандарты. Как минимум такая ситуация:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
type
  r1 = record
    b: byte;
    o: string[16];
  end;
  
procedure p1(a: ^r1) := exit;
 
begin
  var a: r1;
  p1(@a);
end.

Компилируется ради совместимости с устаревшим кодом, но приводит к утечкам памяти, потому что нечего использовать указатели в .Net, не понимая что делаете.

@Puporev · 09.03.2021, 11:20

Сообщение от Sun Serega

оригинальные разработчики давно удалили все его следы

А у нас есть.
https://www.cyberforum.ru/atta... 1448354644

Новые блоги и статьи Все статьи Все блоги /
Хочу заставить корпорации вкладываться в здоровье сотрудников: делаю мат модель здравосохранения anaschu 22.03.2026 e7EYtONaj8Y Z4Tv2zpXVVo https:/ / github. com/ shumilovas/ med2. git	1С: Программный отбор элементов справочника по группе Maks 22.03.2026 Установка программного отбора элементов справочника "Номенклатура" из модуля формы документа. В качестве фильтра для отбора справочника служит группа номенклатуры. Отбор по наименованию группы. . .	Как я обхитрил таблицу Word Alexander-7 21.03.2026 Когда мигает курсор у внешнего края таблицы, и нам надо перейти на новую строку, а при нажатии Enter создается новый ряд таблицы с ячейками, то мы вместо нервных нажатий Энтеров мы пишем любые буквы. . .	Krabik - рыболовный бот для WoW 3.3.5a AmbA 21.03.2026 без регистрации и смс. Это не торговля, приложение не содержит рекламы. Выполняет свою непосредственную задачу - автоматизацию рыбалки в WoW - и ничего более. Однако если админы будут против -. . .
1С: Программный отбор элементов справочника по значению перечисления Maks 21.03.2026 Установка программного отбора элементов справочника "Сотрудники" из модуля формы документа. В качестве фильтра для отбора служит значение перечислений. / / Событие "НачалоВыбора" реквизита на форме. . .	Переходник USB-CAN-GPIO Eddy_Em 20.03.2026 Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .	Оттенки серого Argus19 18.03.2026 Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .	SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip

Визуализация сортировки

Решение