С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
Basek
2 / 2 / 2
Регистрация: 11.11.2010
Сообщений: 87
1

Добавить возможность сортировки вектора по возрастанию и убыванию

05.12.2010, 10:29. Просмотров 831. Ответов 10
Метки нет (Все метки)

Методы сортировки,при запуске выдает ошибку,не могу разобраться (
Прошу отредактировать и доработать(если возможно),чтобы можно было выбрать не только метод сортировки, но и тип(по возрастанию - убыванию). Заранее спасибо =)

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
Program Sortirovka;
Uses crt;
Const   n = 10;                                         {размер массива}
                m_min = -50; m_max = 50;                                {диапазон значений элементов массива }
Type Vec = Array [1..n] Of Integer;
Var     i,Metod: Byte;
      a : Vec;
        vivod: Text;                                    {файловая переменная}
 
Procedure Init(m: Word; elem_min, elem_max: Integer; Var vector: Vec);
Var i: Byte;
Begin
  Randomize;                                       {запуск генератора случайных чисел}
  For i:=1 To m Do
  {задание элементов массива случайными числами
   в диапазоне от  elem_min  до  elem_max}
    vector[i]:=elem_max - Random(elem_max - elem_min +1);
End;
 
Procedure Sort_obmen(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
        temp: Integer;
Begin
  For i := m DownTo 2 Do
    For j := 1 To i - 1 Do
 If  (vector[j] > vector[j+1]) Then
 
          Begin
            temp := vector[j];
                  vector[j] := vector[j+1];
            vector[j+1]:= temp;
          End;
End;
 
Procedure Sort_vstavka(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
        temp: Integer;
Begin
  For i := 2 To m Do
    Begin
         temp := vector[i];
         j := i - 1;
      k := 1;
 While (j > 0) Do
   If (vector[i] > vector[j]) Then
          Begin
            k := j + 1;
            j := 0;
          End
             Else j := j - 1;
         For j := i DownTo k + 1 Do
           vector[j] := vector[j - 1];
         vector[k] := temp;
    End;
End;
 
Procedure Sort_vybor(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
        temp: Integer;
Begin
  For i := 1 To m-1 Do
    Begin
      k := i;
         temp := vector[i];
 For j := i + 1 To m Do
   If  (vector[j] < temp) Then
          Begin
            temp := vector[j];
            k:= j;
          End;
        vector[k] := vector[i];
           vector[i] := temp;
         End;
End;
 
Procedure Sort_saker(m: Word; Var vector: Vec);
Var  n, i, k, j, d: Byte;
     temp: Integer;
Begin
  For k:=n-1 Downto 1 Do { k - количество сравниваемых пар }
    Begin
      i:=i+d;
      For j:=1 to k Do
        Begin
          If (vector[i]-vector[i+d])*d < 0 then
             Begin temp:=vector[i];
                   vector[i]:=vector[i+d];
                   vector[i+d]:=temp;
             End;
           i:=i+d;
         End;
       d:=-d;
     End;
End;
 
Procedure Sort_Hoar(m, bottom, top: Word; Var vector: Vec);
Var     i, j: Word;
     Str: Boolean;
        temp: Integer;
Begin
  i := bottom;
  j := top;
  str := False;
  While (i < j) Do
    Begin
      If (vector[i] > vector[j]) Then
        Begin
          temp := vector[i];
          vector[i] := vector[j];
          vector[j] := temp;
          str := Not(str);
        End;            {If}
      If (str)
        Then i := i + 1
        Else j := j - 1;
    End;                        {While}
  If (i > 1) And ((i - 1) > bottom)
    Then Sort_Hoar(m, bottom, i - 1, vector);
  If (j < (m - 1)) And ((j + 1) < top)
    Then Sort_Hoar(m, j + 1, top, vector);
End;
 
Begin
  ClrScr;
  Assign(vivod,'C:\1\vivod.txt');
  ReWrite(vivod);                   {   открытие текстового файла для записи }
  Init(n, m_min, m_max, a);         {   инициализация массива }
  Writeln(vivod, 'Исходный вектор:');
  For i:=1 To n Do
    Write(vivod, a[i]:5);
  WriteLn(vivod);
  case Metod of
  1: Sort_obmen(n, a);
  2: Sort_vstavka(n, a);
  3: Sort_vybor(n, a);
  4: Sort_saker(n,a);
  5: Sort_Hoar(n, 1, n, a); { сортировка элементов массива }
  Writeln(vivod, 'Отсортированный вектор:');
  For i:=1 To n Do
    Write(vivod, a[i]:5);
  WriteLn(vivod);
  Close(vivod);                   { закрытие текстового файла  }
  writeln('Требуется лишь нажать Enter и перейти по данному пути в текстовый документ : ');
  writeln('C:\1\vivod.txt');
  ReadLn;
End.
Добавлено через 1 час 35 минут
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 Prostoi_vybor;
Uses crt;
Const   n = 10;                             {размер массива}
        m_min = -50; m_max = 50;                {диапазон значений элементов массива }
Type Vec = Array [1..n] Of Integer;
Var     i,Metod: Byte;
      a : Vec;
        vivod: Text;                        {файловая переменная}
 
Procedure Init(m: Word; elem_min, elem_max: Integer; Var vector: Vec);
Var i: Byte;
Begin
  Randomize;                               {запуск генератора случайных чисел}
  For i:=1 To m Do
  {задание элементов массива случайными числами
   в диапазоне от  elem_min  до  elem_max}
    vector[i]:=elem_max - Random(elem_max - elem_min +1);
End;
 
Procedure Sort_obmen(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
    temp: Integer;
Begin
  For i := m DownTo 2 Do
    For j := 1 To i - 1 Do
 If  (vector[j] > vector[j+1]) Then
 
          Begin
            temp := vector[j];
          vector[j] := vector[j+1];
            vector[j+1]:= temp;
          End;
End;
 
Procedure Sort_vstavka(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
    temp: Integer;
Begin
  For i := 2 To m Do
    Begin
     temp := vector[i];
     j := i - 1;
      k := 1;
 While (j > 0) Do
   If (vector[i] > vector[j]) Then
          Begin
            k := j + 1;
            j := 0;
          End
         Else j := j - 1;
     For j := i DownTo k + 1 Do
       vector[j] := vector[j - 1];
     vector[k] := temp;
    End;
End;
 
Procedure Sort_vybor(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
    temp: Integer;
Begin
  For i := 1 To m-1 Do
    Begin
      k := i;
     temp := vector[i];
 For j := i + 1 To m Do
   If  (vector[j] < temp) Then
          Begin
            temp := vector[j];
            k:= j;
          End;
        vector[k] := vector[i];
       vector[i] := temp;
     End;
End;
 
Procedure Sort_saker(m: Word; Var vector: Vec);
Var  n, i, k, j, d: Byte;
     temp: Integer;
Begin
  For k:=n-1 Downto 1 Do { k - количество сравниваемых пар }
    Begin
      i:=i+d;
      For j:=1 to k Do
        Begin
          If (vector[i]-vector[i+d])*d < 0 then
             Begin temp:=vector[i];
                   vector[i]:=vector[i+d];
                   vector[i+d]:=temp;
             End;
           i:=i+d;
         End;
       d:=-d;
     End;
End;
 
Procedure Sort_Hoar(m, bottom, top: Word; Var vector: Vec);
Var     i, j: Word;
     Str: Boolean;
    temp: Integer;
Begin
  i := bottom;
  j := top;
  str := False;
  While (i < j) Do
    Begin
      If (vector[i] > vector[j]) Then
        Begin
          temp := vector[i];
          vector[i] := vector[j];
          vector[j] := temp;
          str := Not(str);
        End;        {If}
      If (str)
        Then i := i + 1
        Else j := j - 1;
    End;            {While}
  If (i > 1) And ((i - 1) > bottom)
    Then Sort_Hoar(m, bottom, i - 1, vector);
  If (j < (m - 1)) And ((j + 1) < top)
    Then Sort_Hoar(m, j + 1, top, vector);
End;
 
Begin
  ClrScr;
  Assign(vivod,'C:\1\vivod.txt');
  ReWrite(vivod);               {   открытие текстового файла для записи }
  Init(n, m_min, m_max, a);     {   инициализация массива }
  Writeln(vivod, 'Исходный вектор:');
  For i:=1 To n Do
    Write(vivod, a[i]:5);
  WriteLn(vivod);
  writeln('Введите номер метода:');
  writeln('1 - Пузырьком');
  writeln('2 - Метод простых включений(вставок)');
  writeln('3 - Метод простого выбора');
  writeln('4 - Шейкерная сортировка');
  writeln('5 - Быстрая сортировка(по алгоритму разделения Хоара)');
  readln(metod);
  case Metod of
  1: Sort_obmen(n, a);
  2: Sort_vstavka(n, a);
  3: Sort_vybor(n, a);
  4: Sort_saker(n,a);
  5: Sort_Hoar(n, 1, n, a);
  else writeln('Больше методов тока за деньги!')
  end;{ сортировка элементов массива }
  Writeln(vivod, 'Отсортированный вектор:');
  For i:=1 To n Do
    Write(vivod, a[i]:5);
  WriteLn(vivod);
  Close(vivod);               { закрытие текстового файла  }
  writeln('Требуется лишь нажать Enter и перейти по данному пути в текстовый документ : ');
  writeln('C:\1\vivod.txt');
  ReadLn;
End.

Осталось только доработать!)
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
05.12.2010, 10:29
Ответы с готовыми решениями:

Разработать подпрограммы сортировки одномерного массива по возрастанию и убыванию.
Разработать подпрограммы сортировки одномерного массива по возрастанию и...

Написать программу сортировки элементов массива по возрастанию или убыванию
Написать программу сортировки элементов массива по возрастанию или убыванию...

Описать две процедуры сортировки одномерного массива длинной N по убыванию и по возрастанию
Прошу помочь, определить что неправильно, выдает ошибку.. я путаюсь в...

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

Расположить элементы в первом массиве по возрастанию, а во втором элементе по убыванию, используя одну процедуру сортировки
помогите пожалуйста с 2умя программами в Паскале, 1)Дана последовательность...

10
Basek
2 / 2 / 2
Регистрация: 11.11.2010
Сообщений: 87
07.12.2010, 16:52  [ТС] 2
Помогите с доработкой кода!!!
Нужно добавить возможность сортировки вектора по возрастанию и убыванию.
Пожалуйста,срочно надо!


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 Prostoi_vybor;
Uses crt;
Const   n = 10;                                         {размер массива}
                m_min = -50; m_max = 50;                                {диапазон значений элементов массива }
Type Vec = Array [1..n] Of Integer;
Var     i,Metod: Byte;
      a : Vec;
        vivod: Text;                                    {файловая переменная}
 
Procedure Init(m: Word; elem_min, elem_max: Integer; Var vector: Vec);
Var i: Byte;
Begin
  Randomize;                                       {запуск генератора случайных чисел}
  For i:=1 To m Do
  {задание элементов массива случайными числами
   в диапазоне от  elem_min  до  elem_max}
    vector[i]:=elem_max - Random(elem_max - elem_min +1);
End;
 
Procedure Sort_obmen(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
        temp: Integer;
Begin
  For i := m DownTo 2 Do
    For j := 1 To i - 1 Do
 If  (vector[j] > vector[j+1]) Then
 
          Begin
            temp := vector[j];
                  vector[j] := vector[j+1];
            vector[j+1]:= temp;
          End;
End;
 
Procedure Sort_vstavka(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
        temp: Integer;
Begin
  For i := 2 To m Do
    Begin
         temp := vector[i];
         j := i - 1;
      k := 1;
 While (j > 0) Do
   If (vector[i] > vector[j]) Then
          Begin
            k := j + 1;
            j := 0;
          End
             Else j := j - 1;
         For j := i DownTo k + 1 Do
           vector[j] := vector[j - 1];
         vector[k] := temp;
    End;
End;
 
Procedure Sort_vybor(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
        temp: Integer;
Begin
  For i := 1 To m-1 Do
    Begin
      k := i;
         temp := vector[i];
 For j := i + 1 To m Do
   If  (vector[j] < temp) Then
          Begin
            temp := vector[j];
            k:= j;
          End;
        vector[k] := vector[i];
           vector[i] := temp;
         End;
End;
 
Procedure Sort_saker(m: Word; Var vector: Vec);
Var  n, i, k, j, d: Byte;
     temp: Integer;
Begin
  For k:=n-1 Downto 1 Do { k - количество сравниваемых пар }
    Begin
      i:=i+d;
      For j:=1 to k Do
        Begin
          If (vector[i]-vector[i+d])*d < 0 then
             Begin temp:=vector[i];
                   vector[i]:=vector[i+d];
                   vector[i+d]:=temp;
             End;
           i:=i+d;
         End;
       d:=-d;
     End;
End;
 
Procedure Sort_Hoar(m, bottom, top: Word; Var vector: Vec);
Var     i, j: Word;
     Str: Boolean;
        temp: Integer;
Begin
  i := bottom;
  j := top;
  str := False;
  While (i < j) Do
    Begin
      If (vector[i] > vector[j]) Then
        Begin
          temp := vector[i];
          vector[i] := vector[j];
          vector[j] := temp;
          str := Not(str);
        End;            {If}
      If (str)
        Then i := i + 1
        Else j := j - 1;
    End;                        {While}
  If (i > 1) And ((i - 1) > bottom)
    Then Sort_Hoar(m, bottom, i - 1, vector);
  If (j < (m - 1)) And ((j + 1) < top)
    Then Sort_Hoar(m, j + 1, top, vector);
End;
 
Begin
  ClrScr;
  Assign(vivod,'C:\1\vivod.txt');
  ReWrite(vivod);                   {   открытие текстового файла для записи }
  Init(n, m_min, m_max, a);         {   инициализация массива }
  Writeln(vivod, 'Исходный вектор:');
  For i:=1 To n Do
    Write(vivod, a[i]:5);
  WriteLn(vivod);
  writeln('Введите номер метода:');
  writeln('1 - Пузырьком');
  writeln('2 - Метод простых включений(вставок)');
  writeln('3 - Метод простого выбора');
  writeln('4 - Шейкерная сортировка');
  writeln('5 - Быстрая сортировка(по алгоритму разделения Хоара)');
  readln(metod);
  case Metod of
  1: Sort_obmen(n, a);
  2: Sort_vstavka(n, a);
  3: Sort_vybor(n, a);
  4: Sort_saker(n,a);
  5: Sort_Hoar(n, 1, n, a);
  else writeln('Больше методов тока за деньги!')
  end;{ сортировка элементов массива }
  Writeln(vivod, 'Отсортированный вектор:');
  For i:=1 To n Do
    Write(vivod, a[i]:5);
  WriteLn(vivod);
  Close(vivod);                   { закрытие текстового файла  }
  writeln('Требуется лишь нажать Enter и перейти по данному пути в текстовый документ : ');
  writeln('C:\1\vivod.txt');
  ReadLn;
End.
Добавлено через 3 часа 53 минуты
Puporev, help with this problem,please!)
0
Puporev
Модератор
55506 / 42594 / 29444
Регистрация: 18.05.2008
Сообщений: 100,754
08.12.2010, 10:59 3
Цитата Сообщение от Basek Посмотреть сообщение
Нужно добавить возможность сортировки вектора по возрастанию и убыванию.
Так это нужно все процедуры дублировать, а в меню метод в каждый пункт добавить по 2 подпункта.
0
Basek
2 / 2 / 2
Регистрация: 11.11.2010
Сообщений: 87
08.12.2010, 11:19  [ТС] 4
Можешь сформировать код?
Ну пожжжжаллллуйста!!!)))
0
Puporev
Модератор
55506 / 42594 / 29444
Регистрация: 18.05.2008
Сообщений: 100,754
08.12.2010, 11:22 5
Делать больше нефиг кроме как на общественных началах ковыряться в неизвестно чьем(явно не автора темы) коде...
0
Basek
2 / 2 / 2
Регистрация: 11.11.2010
Сообщений: 87
08.12.2010, 11:24  [ТС] 6
=) Сортировки я из учебника взял и все!
Остальное сам,а в них разобраться не могу - вот поэтому сюда и выложил!
0
Basek
2 / 2 / 2
Регистрация: 11.11.2010
Сообщений: 87
09.12.2010, 10:35  [ТС] 7
Тема все еще актуальна!)
0
Basek
2 / 2 / 2
Регистрация: 11.11.2010
Сообщений: 87
13.12.2010, 14:03  [ТС] 8
Помогите люди добрые!
0
xxxANDRUXAxxx
8 / 7 / 2
Регистрация: 10.12.2009
Сообщений: 103
27.12.2010, 09:44 9
Помогите с темой!
Мне тоже подобное надо!
Заранее благодарен!
0
Напильнег
481 / 119 / 17
Регистрация: 30.09.2010
Сообщений: 473
27.12.2010, 14:02 10
Цитата Сообщение от Puporev Посмотреть сообщение
Цитата Сообщение от Basek
Нужно добавить возможность сортировки вектора по возрастанию и убыванию.
Так это нужно все процедуры дублировать...
Не нужно - направление сортировки можно передавать параметром, пусть будет dir: integer;. Сначала проверяем, что dir равен 1 или -1 (или приводим к этому), далее внутре процедуры сортировки меняем все выражения типа
Pascal
1
  if (a[i]>a[i+1]) then ...
на
Pascal
1
  if (a[i]-a[i+1])*dir>0 then ...
и вуаля!
1
Basek
2 / 2 / 2
Регистрация: 11.11.2010
Сообщений: 87
30.12.2010, 13:08  [ТС] 11
Как исправить я понял!
А вот остальное - туго!
Можешь исправленный код написать?Пожалуйста.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Procedure Sort_obmen(m: Word; Var vector: Vec);
Var     i, j, k: Byte;
        temp: Integer;
Begin
  For i := m DownTo 2 Do
    For j := 1 To i - 1 Do
 If if (vector[i]-vector[i+1])*dir>0 then
 
          Begin
            temp := vector[j];
                  vector[j] := vector[j+1];
            vector[j+1]:= temp;
          End;
End;
0
30.12.2010, 13:08
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
30.12.2010, 13:08

Отсортировать элементы вектора, на нечетных местах - по убыванию, на четных местах - по возрастанию
дан вектор размера n состоящий из целых положительных и отрицательных элементов...

Упорядочены ли координаты вектора по убыванию.
Дан вектор х=(х1, х2, ...,хn). Написать программу, которая проверяет,...

Сортировка по убыванию и возрастанию
Ввести одномерный массив и вывести его. Найти в массиве max и часть до него...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru