0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
1

Нужно переделать программу,написанную на Turbo Pascal в ту,чтобы работала на Pascal ABC.NET пожалуйста

23.11.2016, 13:28. Показов 1113. Ответов 2
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
program lab2;
 
uses
  Crt;
 
const
  Nmax = 15; { MAX element mnozestva A }
 
type
  T = Char; { Tip element mnozestva A }
  TPair = Record
    a, b: T;
  end;
  TSet = Array[1..Nmax] of T;
  TMatrix = Array[1..Nmax, 1..Nmax] of Byte;
 
procedure Sort(var A: TSet; const N: Integer);{ Sortirovka viborom po niubivaniy }
var
  i, j, k: Integer;
  tmp: T;
begin
  for i := 1 to N - 1 do begin
    k := i;
    for j := i + 1 to N do
      if A[j] < A[k] then k := j;
    tmp := A[i];
    A[i] := A[k];
    A[k] := tmp;
  end;
end;
 
function Search(const x: T; const A: TSet; const N: Integer): Integer;
{ Vozvrashenie index elementa x v A, esli elementa net to -1}
var
  i: Integer;
begin
  for i := 1 to N do
    if x = A[i] then begin
      Search := i;
      Exit;
    end;
  Search := -1;
end;
 
function Reflex(const M: TMatrix; const N: Integer): Boolean;{ proverka na reflexsivnost }
var
  i: Integer;
begin
  Reflex := False;
  for i := 1 to N do
    if M[i, i] = 0 then Exit;
  Reflex := True;
end;
 
function Symmetry(const M: TMatrix; const N: Integer): Boolean;{ proverka na semitrichnost }
var
  i, j: Integer;
begin
  Symmetry := False;
  for i := 1 to N - 1 do
    for j := i + 1 to N do
      if M[i, j] <> M[j, i] then Exit;
  Symmetry := True;
end;
 
function Antisymmetry(const M: TMatrix; const N: Integer): Boolean;{ proverka na antisimitrichnost }
var
  i, j: Integer;
begin
  Antisymmetry := False;
  for i := 1 to N do
    for j := 1 to N do
      if (i <> j) and (M[i, j] * M[j, i] <> 0) then Exit;
  Antisymmetry := True;
end;
 
function Transit(const M: TMatrix; const N: Integer): Boolean;
{ proverka na tranzivnost}
var
  i, j, k: Integer;
  S: TMatrix;
begin
  Transit := False;
  for i := 1 to N do
    for j := 1 to N do begin
      S[i, j] := 0;
      for k := 1 to N do
        S[i, j] := S[i, j] or M[i, k] and M[k, j];
    end;
  for i := 1 to N do
    for j := 1 to N do
       if M[i, j] < S[i, j] then Exit;
  Transit := True;
end;
 
procedure Keys; 
{ Vivod klavish }
begin
  ClrScr;
  WriteLn('Viberite deistvie');
  WriteLn;
  WriteLn('1 - spisok elementov mnozestva A');
  WriteLn('2 - spisok par binarnogo otnoshenia');
  WriteLn('3 - matrica binarnogo otnoseniya');
  WriteLn('4 - svoistva binarnogo otnosheniya');
  WriteLn('5 - izmenit 1 paru binarnogo otnosheniya');
  WriteLn('6 - udalit 1 paru binarnogo otnosheniya ');
  WriteLn('7 - dobavit paru binarnogo otnosheniya');
  WriteLn('0 - Ochistit konsol');
  WriteLn('Esc - Zavershit');
  WriteLn
end;
 
var
  i, j, N, k, z: Integer;
  x, y: T;  
  A: TSet;  
  M: TMatrix;
  P: Array[1..Nmax] of TPair;
  F: Boolean;
  v: Char;
begin
  ClrScr;
  WriteLn('Vvedite mnozestvo A -#cherez probel#-');
  N := 0;
  while not SeekEoLn do begin
    Inc(N);
    Read(A[N]);
  end;
  Sort(A, N);
  F := False;
  i := 1;
  while i < N do begin
    if A[i] = A[i + 1] then begin
      F := True;
      Dec(N);
      for j := i to N do
        A[j] := A[j + 1];
    end
    else
      Inc(i);
  end;
  if F then WriteLn('Povtoryayshiesa element udalen');
  for i := 1 to Nmax do
    for j := 1 to Nmax do
       M[i, j] := 0;
  WriteLn;
  WriteLn('Vvedite spisok par. Kazduy paru cherez probel, element par Probel');
  WriteLn(' Zavershenie vmesto vvoda par, vedite  Enter.');
  Reset(Input);
  k := 0;
  while not SeekEoLn do begin
    Read(x);
    if SeekEoLn then Reset(Input);
    ReadLn(y);
    if (Search(x, A, N) = -1) or (Search(y, A, N) = -1) then begin
       WriteLn('Element dolzen iz mnozestva A, eta para propushena');
       Continue;
    end;
    F := False;
    for i := 1 to k do
      if (P[i].a = x) and (P[i].b = y) then begin
         WriteLn('Para povtoryaetsa, Propusheno');
         F := True;
         Break;
      end;
    if F then Continue;
    M[Search(x, A, N), Search(y, A, N)] := 1;
    Inc(k);
    P[k].a := x;
    P[k].b := y;
  end;
  Keys;
  repeat
    v := ReadKey;
    case v of
    '1':
      begin
        WriteLn('Element mnozestva A:');
        for i := 1 to N do
          Write(A[i], ' ');
        WriteLn;
      end;
    '2':
      begin
        WriteLn('Spisok par binarnogo otnosheniya:');
        for i := 1 to k do
          WriteLn(i, '. (', P[i].a, ', ', P[i].b, ')');
      end;
    '3':
      begin
        WriteLn('Matrica binarnogo otnosheniya:');
        Write('    ');
        for i := 1 to N do
          Write(A[i]:3, ' ');
        WriteLn;
        for i := 1 to N do
        begin
          Write(A[i]:3, ' ');
          for j := 1 to N do
            Write(M[i, j]:3, ' ');
          WriteLn;
        end;
      end;
    '4':
      begin
        WriteLn('Videnoe othoshenie');
        if Symmetry(M, N)     then  WriteLn('Simmetrichno')     else WriteLn('ne Simmetrichno ');
        if Antisymmetry(M, N) then  WriteLn('Antisimmetrichno') else WriteLn('ne antisimetrichno');
        if Reflex(M, N)       then  WriteLn('reflixsivno')     else WriteLn('ne reflexsivno');
        if Transit(M, N)      then  WriteLn('trazivno®')     else WriteLn('ne tranzivno');
      end;
    '5':
      begin
        WriteLn('Nomer par kotoruy izmenit');
        {$I-}
        ReadLn(z);
        {$I+}
        while IOResult <> 0 do begin
          WriteLn('Neverno, zanovo');
          {$I-}
          ReadLn(z);
          {$I+}
        end;
        if (z > k) or (z < 1) then
          WriteLn('Par net')
        else begin
          WriteLn('Vvedite novoe znachenie par cherez probel`');
          Reset(Input);
          Read(x);
          if SeekEoLn then Reset(Input);
          ReadLn(y);
          if (Search(x, A, N) = -1) or (Search(y, A, N) = -1) then
            WriteLn('Znachenie dolzn bit iz mnozestva A')
          else begin
            F := False;
            for i := 1 to k do
              if (P[i].a = x) and (P[i].b = y) then begin
                WriteLn('eta para uze bila');
                F := True;
                Break;
              end;
            if not F then begin
              M[Search(P[z].a, A, N), Search(P[z].b, A, N)] := 0;
              P[z].a := x;
              P[z].b := y;
              M[Search(x, A, N), Search(y, A, N)] := 1;
              WriteLn('Izmeneno');
            end;
          end;
        end;
      end;
    '6':
      begin
        WriteLn('Nomer par udaleniya');
        {$I-}
        ReadLn(z);
        {$I+}
        while IOResult <> 0 do begin
          WriteLn('Vvedwno neverno, Zanovo');
          {$I-}
          ReadLn(z);
          {$I+}
        end;
        if (z > k) or (z < 1) then
          WriteLn('ЌҐв в Є®© Ї ал')
        else begin
          M[Search(P[z].a, A, N), Search(P[z].b, A, N)] := 0; { “¤ «пҐ¬ Ї аг Ё§ ¬ ваЁжл }
          Dec(k);
          for i := z to k do  { Udalenie par iz spiska P }
            P[i] := P[i + 1];
          WriteLn('Udaleno');
        end;
      end;
    '7':
      begin
        WriteLn('Vvedite paru elementa cherez probel');
        Reset(Input);
        Read(x);
        if SeekEoLn then Reset(Input);
        ReadLn(y);
        if (Search(x, A, N) = -1) or (Search(y, A, N) = -1) then
          WriteLn('Znachenie dolzno bit iz mnozestva A, ne dobavleno')
        else begin
          F := False;
          for i := 1 to k do
            if (P[i].a = x) and (P[i].b = y) then begin
              WriteLn('Eta para uze est');
              F := True;
              Break;
            end;
          if not F then begin
            Inc(k);
            P[k].a := x;
            P[k].b := y;;
            M[Search(P[k].a, A, N), Search(P[k].b, A, N)] := 1;
          end;
        end;
        if not F then WriteLn('Dobavleno');
      end;
      '0': Keys;
    end;
  until v = #27;
end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
23.11.2016, 13:28
Ответы с готовыми решениями:

Нужно переделать программу,написанную на Turbo Pascal в ту,чтобы работала на Pascal ABC.NET пожалуйста
program lab3; uses Crt; const Output_File_Name = 'output.txt'; { ima faila dlya vivoda...

Можно как-то переделать код из Turbo Pascal чтобы он работал в pascal abc.net?
Сделайте пожалуйста, я просто не вникаю uses Graph, Crt; var grDriver: integer; grMode:...

Нужно перевести программу с Turbo Pascal в Pascal ABC.NET
Вот есть программный код , но он для турбо паскаля, помогите перевести его в АБС.NET Program...

Нужно перевести код из Turbo Pascal в Pascal ABC.NET
Доброго времени суток. На форуме находил похожие темы, но к сожалению так и не смог разобраться....

2
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
32989 / 21295 / 8180
Регистрация: 22.10.2011
Сообщений: 36,588
Записей в блоге: 8
23.11.2016, 13:32 2
Задание озвучь. Никому это на фиг не нужно, разбираться без задания в коде, если его больше 300 строк.
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
23.11.2016, 13:43  [ТС] 3
Дано конечное множество A. Требуется сгенерировать все возможные перестановки его элементов в лексикографическом порядке (по материалам главы 1, п. 1.3.6, и главы 2, п. 2.2.1). Требования к заданию множества – в нем не должно быть повторяющихся элементов, кроме того, удобнее использовать или только буквы, или только цифры.
Программа должна сначала упорядочить все элементы заданного множества по возрастанию (это первый – минимальный – набор), затем – посредством МИНИМАЛЬНО ВОЗМОЖНЫХ ПЕРЕСТАНОВОК! – сгенерировать последовательно возрастающие (лексикографически) наборы, вплоть до последнего, в котором все элементы упорядочены по убыванию.
Следует оценивать количество возможных перестановок и в случае, если они не поместятся на экран, выполнять их вывод в файл с выдачей на экран соответствующей информации для пользователя и выполнять поэкранный вывод с ожиданием нажатия клавиши.
Дополнительно: Предоставить пользователю возможность выбора другого варианта работы программы, в котором за исходную точку упорядочивания наборов выбирается не минимальный набор, а набор в таком порядке, как он задан пользователем.
Возможный алгоритм решения (Пример: множество А={1, 2, 3, 4, 5, 6}, |A| = n):
Предположим, что уже построено m наборов. Тогда для получения m+1-го набора:
1. Выполняется проверка последнего (m-го) набора на наличие в его конце некоторого количества символов, упорядоченных по убыванию – пусть это символы ak+1…an.
 3 5 2 6 4 1 – k=3, символы с 4-го по 6-й упорядочены по убыванию.
2. Если такое k найдено, то поменять местами k-й элемент и наименьший элемент из ak+1…an, больший этого ak.
В нашем примере это 2 и 4:  3 5 4 6 2 1 (это промежуточный набор).
3. После шага 2 упорядочить элементы с k+1-го до последнего по возрастанию. Получен очередной набор  выдать его на печать.
 3 5 4 1 2 6.
4. Если на шаге 1 ответ отрицательный, то поменять местами 2 последних элемента и выдать на печать полученный набор. В частности, после шага 3 это неизбежное действие, т.к. все последние элементы были размещены по возрастанию  целесообразно после выполнения ш.3 задавать признак его выполнения, который будет анализироваться (и сбрасываться) на шаге 1. После шага 3 было  3 5 4 1 2 6  выдать  3 5 4 1 6 2 .
Если был набор  3 5 2 6 1 4  выдать  3 5 2 6 4 1 .
5. Если полученный набор не последний (упорядоченный по убыванию), то возврат на шаг 1. В противном случае конец работы.



КОД РАБОТАЕТ ВЕРНО ТОЛЬКО В ПАСКАЛЬ ТУРБО а мне нужно в абс.нет
0
23.11.2016, 13:43
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
23.11.2016, 13:43
Помогаю со студенческими работами здесь

Переделайте, пожалуйста, программу из Turbo pascal в ABC pascal
Помогите, пожалуйста, перевести из PASCAL TURBO в PASCAL ABC Program ProgInt; Uses Crt,...

Turbo Pascal, Pascal ABC, Free Pascal, PascalABC.NET - в чем разница?
Всем привет, решил изучать Паскаль, но на форуме увидел 4 его версии - Turbo Pascal, Pascal ABC,...

Различия трансляторов Pascal ABC.Net и Turbo/Borland Pascal
Пожалуйста, объясните различия между компиляторами Pascal ABC.Net и Turbo/Borland Pascal

Перевод программы с Turbo Pascal на Pascal ABC.NET
написала программу в паскаль турбо на рабочем компьютере. перенесла в паскаль авсNet так как дома...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru