Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Линейная вставка
Автор: Nikolay 30.11.2005 3:10
Пожалуйста, помогите!!!!
Без понятия как сделать, а уже скоро сдавать 
Линейная вставка
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 30.11.2005 3:22
Делал когда-то (только демонстрационный режим):
Прикрепленные файлы
visual_sort.pas ( 4.76 килобайт )
Кол-во скачиваний: 313
Автор: Nikolay 1.12.2005 3:36
Я тут немного переделал, вроде должно работать, но ??? выдает какието числа???
может кто поможет?
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 1.12.2005 3:45
Nikolay, а что собственно не устраивает? Я проверил "максимально неупорядоченный массив" - все прекрасно работает... В чем проблема?
Автор: Nikolay 1.12.2005 4:01
если повторение то не читать
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 1.12.2005 4:03
Не знаю, откуда они у тебя берутся. Вот как это же выглядит у меня:
Ты какой режим выбрал?
Автор: Nikolay 1.12.2005 4:13
какойбы не выберал, всё равно какието странные цифры
[IMG]C:\Documents and Settings\Николай\Рабочий стол\Безымянный.gif[/IMG]
Автор: Nikolay 1.12.2005 4:14
незнаю как скрин кидать7
Автор: volvo 1.12.2005 4:15
Кнопка "Ответить" -> выбираешь файл...
Автор: Nikolay 1.12.2005 4:26
А может быть глюк в версиях Паскаля???
Автор: volvo 1.12.2005 4:28
Ну, тогда скажи какой версией пользуешься? У меня прекрасно работает на FPC 2.0.0 , Virtual Pascal , TP70 и BP7 ... У тебя что-то другое?
Автор: Nikolay 1.12.2005 4:36
у меня TP7.1
Добавлено (через 5 минут):
exe можешь скинуть
Добавлено (через 7 минут):
У меня все версии Паскаля тормазят под ХР
Автор: volvo 1.12.2005 4:52
Держи EXE от FPC, но у меня нет кириллицы, так что выбирать придется вслепую.. 
Прикрепленные файлы
__vis_sor.rar ( 29.31 килобайт )
Кол-во скачиваний: 200
Автор: Nikolay 1.12.2005 5:03
как с программой так и с кирилицей всё в порядке, странно????
Автор: nikolay 1.12.2005 5:04
СПАСИБО
Автор: best place to buy viagra online 1.11.2021 21:38
Amitriptyline Online Uk