IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Линейная вставка, Задача
сообщение
Сообщение #1


Гость






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

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

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


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

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


Гость






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


Прикрепленные файлы
Прикрепленный файл  visual_sort.pas ( 4.76 килобайт ) Кол-во скачиваний: 245
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






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

Исходный код
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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Nikolay, а что собственно не устраивает? Я проверил "максимально неупорядоченный массив" - все прекрасно работает... В чем проблема?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






если повторение то не читать
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 откуда берутся????
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






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

Ты какой режим выбрал?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






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


Гость






незнаю как скрин кидать7
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Кнопка "Ответить" -> выбираешь файл...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






А может быть глюк в версиях Паскаля???
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






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


Гость






у меня TP7.1

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

Добавлено (через 7 минут):
У меня все версии Паскаля тормазят под ХР
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гость






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


Прикрепленные файлы
Прикрепленный файл  __vis_sor.rar ( 29.31 килобайт ) Кол-во скачиваний: 132
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






как с программой так и с кирилицей всё в порядке, странно????
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






СПАСИБО
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






Amitriptyline Online Uk
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 17.01.2022 2:57
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name