Линейная вставка, Задача |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Линейная вставка, Задача |
Nikolay |
Сообщение
#1
|
Гость |
Пожалуйста, помогите!!!!
Без понятия как сделать, а уже скоро сдавать Линейная вставка 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 |
Сообщение
#2
|
Гость |
Делал когда-то (только демонстрационный режим):
Прикрепленные файлы visual_sort.pas ( 4.76 килобайт ) Кол-во скачиваний: 341 |
Nikolay |
Сообщение
#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. |
volvo |
Сообщение
#4
|
Гость |
Nikolay, а что собственно не устраивает? Я проверил "максимально неупорядоченный массив" - все прекрасно работает... В чем проблема?
|
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 откуда берутся???? |
volvo |
Сообщение
#6
|
Гость |
|
Nikolay |
Сообщение
#7
|
Гость |
какойбы не выберал, всё равно какието странные цифры
[IMG]C:\Documents and Settings\Николай\Рабочий стол\Безымянный.gif[/IMG] |
Nikolay |
Сообщение
#8
|
Гость |
незнаю как скрин кидать7
|
volvo |
Сообщение
#9
|
Гость |
Кнопка "Ответить" -> выбираешь файл...
|
Nikolay |
Сообщение
#10
|
Гость |
А может быть глюк в версиях Паскаля???
|
volvo |
Сообщение
#11
|
Гость |
Ну, тогда скажи какой версией пользуешься? У меня прекрасно работает на FPC 2.0.0 , Virtual Pascal , TP70 и BP7 ... У тебя что-то другое?
|
Nikolay |
Сообщение
#12
|
Гость |
у меня TP7.1
Добавлено (через 5 минут): exe можешь скинуть Добавлено (через 7 минут): У меня все версии Паскаля тормазят под ХР |
volvo |
Сообщение
#13
|
Гость |
Держи EXE от FPC, но у меня нет кириллицы, так что выбирать придется вслепую..
Прикрепленные файлы __vis_sor.rar ( 29.31 килобайт ) Кол-во скачиваний: 227 |
Nikolay |
Сообщение
#14
|
Гость |
как с программой так и с кирилицей всё в порядке, странно????
|
nikolay |
Сообщение
#15
|
Гость |
СПАСИБО
|
best place to buy viagra online |
Сообщение
#16
|
Гость |
Amitriptyline Online Uk
|
Текстовая версия | 21.12.2024 23:41 |