Линейная вставка, Задача Опции

[Nikolay]

Пожалуйста, помогите!!!!
Без понятия как сделать, а уже скоро сдавать

Линейная вставка

1. демонстрационный пошаговй режим сортировки;
Демонстрационный режим должен выдавать на экран информацию о текущем состоянии массива на каждом шаге: сравниваемые элементы выделять зеленым цветом, если они не являются инверсией и красным, если это инверсия. Результат перестаноки должен быть виден на следующей строке. Справа показано текущее количество сравнений и перестановок. Сравнить полученные ре-зультаты с оценками алгоритма.
Подготовить входные тестовые данные для демонстационного режима в виде констант-массивов размером n=10:
a) упорядоченный массив (нет инверсий);
b) максимально неупорядоченный массив: максимальное количество инверсий, рав-ное n(n-1);
c) пустой массив (n = 0);
d) массив со средней упорядоченностью: среднее количество инверсий, равное n(n-1)/2.


2. исследовательский режим сортировки.
Исследовательский режим сортировки должен быть выполнен для следующих размеров тестовых массивов и расчет производить по результатам 100 испытаний для сгенерированных целочислен-ных массивов (упорядоченных, среднее число инверсий, максимальное число инверсий):

Структура интерфейса исследовательского режима. Исходные данные можно задавать в виде констант. Вывод результатов - непрерывный - до окончания или прерывания по ESC. Полученные данные занести в таблицу.
Метод: ХХХХХХХХ ХХХХХХХХ.
Кол.элементов = 256 Кол.повторний = 100 Диапазон = 1000
Исходный порядок - Отсортированный(случайный, обратный)
Перемешивание = 128 (обмен местами упорядоченных пар = 2)
Мин. Средн. Макс.
Сравнений = ХХХХ ХХХХ ХХХХ
Перестановок = ХХХХ ХХХХ ХХХХ

[volvo]

Делал когда-то (только демонстрационный режим):

[Nikolay]

Я тут немного переделал, вроде должно работать, но ??? выдает какието числа???
может кто поможет?

Исходный код

uses crt;

Procedure GetUserInput;
Const
kbEsc = #27;
kbSpace = #32;
Var
ch: Char;
Begin
Repeat
ch := ReadKey;
If ch = kbEsc then
begin
GotoXY(1, 24);
WriteLn('breaking program');
Halt(100)
end;

While KeyPressed Do ReadKey
Until ch = kbSpace
End;


Const n = 10;
{ a: Array[1 .. n] Of Integer = (44, 55, 12, 42, 94, 18, 6, 67, 38, 78);}
b: Array[1 .. n] of Integer = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
c: Array[1 .. n] Of Integer = (9, 8, 7, 6, 5, 4, 3, 2, 1, 0);
d: Array[1 .. n] Of Integer = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
e: Array[1 .. n] Of Integer = (44, 55, 12, 42, 94, 18, 6, 67, 38, 78);
var a: array[1 .. n] of integer;

Procedure sel;
var sel :char;
temp : integer;
{a: array[1 .. n] of integer;}
begin
sel := readkey;
if sel= '1' then begin for temp:=1 to 10 do a[temp]:=b[temp];end;
if sel= '2' then begin for temp:=1 to 10 do a[temp]:=c[temp];end;
if sel= '3' then begin for temp:=1 to 10 do a[temp]:=d[temp];end;
if sel= '4' then begin for temp:=1 to 10 do a[temp]:=e[temp];end;

end;

Type
Index = 0..n;

Procedure PrintArray(Const s: String);
Var i: Index;
Begin
TextColor(LightGray);
For i := 1 To n Do
Write(a[i]:4);
{WriteLn(s:25);}
GetUserInput
End;


(*
Global variables
*)
Var
x: integer;
cnt_comp, cnt_swap: integer;
ToDo: boolean;

Type
TOperation =
(opSelect, opCompare, opMove);
Const
strAction: array[TOperation] of string =
( 'current selection',
'comparison',
'moving' );

Type
TMask =
(mskHidden, mskNormal, mskRed, mskGreen);
Const
OutputColor: Array[TMask] Of Integer =
(Black, LightGray, LightRed, LightGreen);

Var
show_mask:
Array[1 .. 2, 1 .. n] Of TMask;
show_values:
Array[1 .. 2, 1 .. n] Of Integer;


Procedure ShowByMask(Const s: String;
ival: Integer);

Procedure Scroll(x: Byte);
Var
i: Byte;
Begin
For i := 1 To x Do
WriteLn
End;

Const
scrollBy = 4;
Var
PosY: Integer;
m, k: Index;
Begin
PosY := WhereY;
If PosY > 22 Then
Begin
Scroll(scrollBy);
Dec(PosY, scrollBy - 2);
GotoXY(1, PosY);
End;

Writeln('i = ', ival);
PosY := WhereY;

For m := 1 to 2 do
For k := 1 to n do
Begin
GotoXY(Pred(k)*4 + 1, Pred(PosY + m));
TextColor( OutputColor[show_mask[m, k]] );
Write(show_values[m, k]:4)
End;

TextColor(LightGray);
Gotoxy(n*4 + 1, Pred(WhereY)); Write(s:25);
GotoXY(79, Succ(WhereY));
WriteLn;

GetUserInput
End;

Procedure ShowStep(op: TOperation;
i, j: Integer);
Var
m, k: Index;
Begin
Case op of
opSelect:
For k := 1 To n Do
Begin
If k = i Then
Begin
show_mask[1, k] := mskHidden;
show_mask[2, k] := mskNormal
End
Else
Begin
show_mask[1, k] := mskNormal;
show_mask[2, k] := mskHidden
End;

show_values[1, k] := a[k];
show_values[2, k] := a[k]
End;

opCompare:
Begin
Inc(cnt_comp);

For k := 1 to n do
Begin
If i = k then
If x < a[j] Then show_mask[2, k] := mskRed
Else show_mask[2, k] := mskGreen;

If j = k Then
If x < a[j] Then show_mask[1, k] := mskRed
Else show_mask[1, k] := mskGreen;

show_values[1, k] := a[k];
show_values[2, k] := a[k]
End;

For k := 1 To n Do
If k <> i Then show_mask[2, k] := mskHidden;

show_mask[1, Succ(j)] := mskHidden;
show_values[2, i] := x;
End;

opMove:
Begin
Inc(cnt_swap);
For k := 1 to n do
Begin
show_mask[1, k] := mskNormal;
show_mask[2, k] := mskHidden;

show_values[1, k] := a[k];
End;

show_mask[1, Succ(j)] := mskHidden;
show_mask[2, i] := mskNormal;
show_values[2, i] := x;
End
End;

ShowByMask(strAction[op], i)
End;


Function isLess(index_i, index_j,
i, j: Integer): Boolean;
Begin
isLess := (i < j);

If ToDo Then
ShowStep( opSelect, index_i, index_j );
If index_j > 0 Then
ShowStep( opCompare, index_i, index_j )
End;


(*
main sorting procedure ...
*)
Procedure Insert;
Var
i, j : Index;
Begin
cnt_comp := 0; cnt_swap := 0;
For i := 1 To n do
Begin
x := a[i];

ToDo := True;
j := Pred(i);
While isLess(i, j, x, a[j]) Do
Begin
ToDo := False;
a[Succ(j)] := a[j]; Dec(j);
ShowStep(opMove, i, j)
End;
a[Succ(j)] := x;

(*
j:= i-1;
while x < a[j] do
begin
a[j+1]:= a[j]; j:= j-1;
end;
a[j+1]:= x;
*)

WriteLn( 'i = ', i );
PrintArray('insertion')

End;
End;


Begin
{ ClrScr;}
writeln ('выбор массива');
writeln ('1 упорядоченный массив');
writeln ('2 максимально неупорядоченный массив');
writeln ('3 пустой массив');
writeln ('4 массив со средней упорядоченностью');

sel;

PrintArray( 'Initial array' );


Insert;

WriteLn( 'Total comparisons: ', cnt_comp );
WriteLn( 'Total movings: ', cnt_swap );

ReadLn
End.

[volvo]

Nikolay, а что собственно не устраивает? Я проверил "максимально неупорядоченный массив" - все прекрасно работает... В чем проблема?

[Nikolay]

если повторение то не читать
0 1 2 3 4 5 6 7 8 9 Initial array
i = 1
0 1 2 3 4 5 6 7 8 9 current selection
0 1 2 3 4 5 6 7 8 9
i = 1
69 1 2 3 4 5 6 7 8 9 moving
0 1 2 3 4 5 6 7 8 9
i = 1
69 1 2 3 4 5 6 7 8 9 moving
0 1 2 3 4 5 6 7 8 9


какието непонятные числа 69 откуда берутся????

[volvo]

Не знаю, откуда они у тебя берутся. Вот как это же выглядит у меня:


Ты какой режим выбрал?

[Nikolay]

какойбы не выберал, всё равно какието странные цифры
[IMG]C:\Documents and Settings\Николай\Рабочий стол\Безымянный.gif[/IMG]

[Nikolay]

незнаю как скрин кидать7

[volvo]

Кнопка "Ответить" -> выбираешь файл...

[Nikolay]

А может быть глюк в версиях Паскаля???

[volvo]

Ну, тогда скажи какой версией пользуешься? У меня прекрасно работает на FPC 2.0.0 , Virtual Pascal , TP70 и BP7 ... У тебя что-то другое?

[Nikolay]

у меня TP7.1

Добавлено (через 5 минут):
exe можешь скинуть

Добавлено (через 7 минут):
У меня все версии Паскаля тормазят под ХР

[volvo]

Держи EXE от FPC, но у меня нет кириллицы, так что выбирать придется вслепую..

[Nikolay]

как с программой так и с кирилицей всё в порядке, странно????

[nikolay]

СПАСИБО