Форум программистов, компьютерный форум, киберфорум
PascalABC.NET
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.88/8: Рейтинг темы: голосов - 8, средняя оценка - 4.88
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31

Как в программу вставить функцию assign, чтобы она работала?

06.12.2016, 07:26. Показов 1834. Ответов 15
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
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
const
  Nmax = 100;  { Максемальное колличество элементов множества  }
 
type
  T = Char; {тип элемента множества}
  TSet = Array[1..Nmax] of T; { Множество}
procedure Sort(var A: TSet; const N: Integer);
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;
 
{ Ввести множество  }
procedure Set_Input(var A: TSet; var N: Integer);
var
  i, j: Integer;
  tmp: T;
  F: Boolean;
begin
  Reset(Input);
  N := 0;
  while not SeekEoLn (Input) do begin
    Inc(N);
    Read(Input, 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 + 1 to N do
        A[j] := A[j + 1];
    end
    else
      Inc(i);
  end;
  if F then WriteLn('Повторяющийся элемент удален');
end;
procedure Print(const A: TSet; const N: Integer);{Вывод множества}
var
  i: Integer;
begin
  for i := 1 to N do
    Write(A[i], ' ');
  if N = 0 then Write('Пустое множество');
  WriteLn;
end;
procedure Print_Sets(const A, B: TSet; const N, M: Integer);
var
  i: Integer;
begin
  WriteLn;
  Write('Множество A:  ');
  for i := 1 to N do
    Write(A[i], ' ');
  WriteLn;
  Write('Множество B:  ');
  for i := 1 to M do
    Write(B[i], ' ');
  WriteLn;
end;
procedure Union(var U: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Определение множества A и B }
var
  i, j: Integer;
begin
  i := 1;
  j := 1;
  k := 0;
  while (i <= N) or (j <= M) do
    if (j <= M) and (i <= N) and (A[i] = B[j]) then begin
      Inc(k);
      U[k] := A[i];
      Inc(i);
      Inc(j);
    end
    else if (j > M) or (i <= N) and (A[i] < B[j]) then begin
      Inc(k);
      U[k] := A[i];
      Inc(i);
    end
    else begin
      Inc(k);
      U[k] := B[j];
      Inc(j);
    end;
end;
procedure Product(var P: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Пересечение множеств A и B }
var
  i, j, W: Integer;
begin
  i := 1;
  j := 1;
  k := 0;
  while (i <= N) and (j <= M) do
    if (A[i] = B[j]) then begin
      Inc(k);
      P[k] := A[i];
      Inc(i);
      Inc(j);
    end
    else if A[i] < B[j] then
      Inc(i)
    else
      Inc(j);
end;
procedure Diff(var D: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Разность множеств  A и B}
var
  i, j: Integer;
begin
  i := 1;
  j := 1;
  k := 0;
  while (i <= N) and (j <= M) do
    if A[i] = B[j] then begin
      Inc(i);
      Inc(j);
    end
    else if A[i] < B[j] then begin
      Inc(k);
      D[k] := A[i];
      Inc(i);
    end
    else if A[i] > B[j] then
      Inc(j);
  while (i <= N) and (j > M) do begin
    Inc(k);
    D[k] := A[i];
    Inc(i);
  end;
end;
function Incl(const A, B: TSet; const N, M: Integer): Boolean; {Проверка на вхождение  A в B}
var
  i, j: Integer;
begin
  Incl := False;
  if N > M then Exit;
  i := 1;
  j := 1;
  while (i <= N) and (j <= M) and (A[i] >= B[j]) do
    if A[i] > B[j] then
      Inc(j)
    else if A[i] = B[j] then begin
      Inc(i);
      Inc(j);
    end;
  Incl := i - 1 = N;
end;
procedure Keys; {Вывод клавиш}
begin
  ClrScr;
  WriteLn('Введите номер желаемого действия:');
  WriteLn;
  WriteLn('1 - Ввод множества A');
  WriteLn('2 - Ввод множества B');
  WriteLn('3 - Проверка вхождения A в B');
  WriteLn('4 - вывести обьеденение множеств A и B');
  WriteLn('5 - Вывести пересечение множиств  A и B');
  WriteLn('6 - Вывести азность A \ B');
  WriteLn('0 - Очистка');
  WriteLn('Esc - ВЫХОД');
  WriteLn;
end;
 
var
  N, M, K: Integer;
  A, B, C: TSet;
  v: Char;
begin
  Keys;
  N := 0;
  M := 0;
  repeat
    v := ReadKey;
    if v in ['3'..'6'] then Print_Sets(A, B, N, M);
    case v of
      '1':
        begin
          WriteLn('Введите множество A:');
          Set_Input(A, N);
          WriteLn('Complet');
          WriteLn;
        end;
      '2':
        begin
          WriteLn('Введите множество B:');
          Set_Input(B, M);
          WriteLn('Complet');
          WriteLn;
        end;
      '3': if Incl(A, B, N, M) then WriteLn('A входит в B') else WriteLn('A Не входит в  B');
      '4':
        begin
          WriteLn('Объеденение A и B:');
          Union(C, K, A, B, N, M);
          Print(C, K);
        end;
      '5':
        begin
          WriteLn('Пересечение множеств A and B:');
          Product(C, K, A, B, N, M);
          Print(C, K);
        end;
      '6':
        begin
          WriteLn('Разность множеств A \ B:');
          Diff(C, K, A, B, N, M);
          Print(C, K);
        end;
      '0': Keys;
    end;
  until v = #27;
end.
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
06.12.2016, 07:26
Ответы с готовыми решениями:

Как переделать программу так чтобы она работала в виде процесса а не формы
Здравствуйте. Подскажите пожалуйста как переделать программу так чтобы она работала в виде процесса, а не формы? И что там писать вместо...

Задача про кирпич - как можно написать компактнее программу, чтобы она работала?
Sub Кирпич() a = InputBox(&quot;Ширина кирпича a&quot;) b = InputBox(&quot; Высота кирпича b&quot;) c = InputBox(&quot; Длина кирпича c&quot;) x =...

Как записать программу на HDD, чтобы она осталась и работала даже после форматирования
Привет. Как записать программу на HDD, чтобы она осталась и работала даже после форматирования? Или может программу можно прописать в...

15
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 07:40
А напишите-ка текст задания, похоже Вы что-то не то делаете. Например зачем сортировать множество? В нем элементы всегда по порядку.
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
06.12.2016, 08:24  [ТС]
Работа № 1.Множества и операции над ними
Написать программу, в которой для конечных упорядоченных множеств реализовать все основные операции ( , \) с помощью алгоритма типа слияния (по материалам главы 1, п.1.2). Допустима организация множеств в виде списка или в виде массива.
Работа программы должна происходить следующим образом:
1. На вход подаются два упорядоченных множества A и B (вводятся с клавиатуры, элементы множеств – буквы латинского алфавита).
2. После ввода множеств выбирается требуемая операция (посредством текстового меню, вводом определенного символа в ответ на запрос – выбор по желанию автора). Операции: вхождение A B, A B, A B, A\B (дополнительно: B\A, A B, B A).
3. Программа посредством алгоритма типа слияния определяет результат выбранной операции и выдает его на экран с необходимыми пояснениями. Одновременно с результатом на экране должны присутствовать и исходные множества.
4. Возврат на п.2 (выбор операции).
5. Завершение работы программы – из п.2 (например, по ESC).
Дополнительно: предусмотреть возможность возврата не только к выбору операции (п.2), но и к вводу новых множеств (п.1). Выход в таком случае должен быть возможен из любого пункта (1 или 2).
Замечание: Исходные множества не должны содержать повторяющихся элементов (при обработке входных данных такие элементы следует удалять). Если исходные множества не упорядочены, нужно отсортировать их по возрастанию. Только после такой обработки над множествами возможно выполнять требуемые операции.
0
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 08:42
Цитата Сообщение от antipenko_dasha Посмотреть сообщение
На вход подаются два упорядоченных множества A и B
Множества всегда упорядочены, например вводится множество из файла, где записаны латинские буквы.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var m:set of char;
     input:text;
     c:char;
..................................
assign(input,'1.txt');
reset(input);
m:=[];
while not seekeof(f) do//может быть не одна строка
 begin
  read(f,c);
  if c in['A'..'Z','a'..'z'] then m:=m+[c];//пропускаем ненужные символы, типа конец строки и переход на новую строку
 end;
close(f);
writeln('Множество А');
for c:='A' to 'z' do
if c in m then write(c);
writeln;
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
06.12.2016, 08:51  [ТС]
так куда вставить не пойму чтоб все работало???Получается мне нужо лишнее убрать??
0
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 08:58
Задание написано на все случаи жизни и явно не для АВС.net, где есть множества любого типа, а не только set of byte, set of char, множества перечислимого типа. А для типа char и в других Паскалях не нужны списки или массивы, так как элементов не более 256.
Подумайте и уберите лишнее. И не понял зачем Вам файлы, в задании про них ничего нет.
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
06.12.2016, 09:02  [ТС]
потому что программа выдает ошибку
Миниатюры
Как в программу вставить функцию assign, чтобы она работала?  
0
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 09:04
Цитата Сообщение от antipenko_dasha Посмотреть сообщение
потому что программа выдает ошибку
Да мне пофиг, я спросил зачем файлы?
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
06.12.2016, 09:05  [ТС]
отвечаю что ошибку выдает та написано через assign нужно.
0
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 09:13
Вот пример процедуры ввода множества из файла.
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
type TSet = set of char; // Множество
// Ввести множество из файла
procedure Set_Input(var A: TSet; var Input:text;S:string);
var c:char;
begin
assign(input,'1.txt'); //файл в папке с программой
reset(input);
A:=[];
while not seekeof(input) do//может быть не одна строка
 begin
  read(input,c);
  if c in['A'..'Z','a'..'z'] then A:=A+[c];//пропускаем ненужные символы, типа конец строки и переход на новую строку
 end;
close(input);
writeln(S);
for c:='A' to 'z' do
if c in A then write(c);
writeln;
end;
var a:TSet;
    f:text;
begin
Set_Input(a,f,'Множество А');
end.
Добавлено через 1 минуту
Текстовый файл создай там где программа, типа такого
bhghghfbhjbhDFDFDF
GYGHJGHTRREWQE
vvggvgvgvg4545454
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
06.12.2016, 09:18  [ТС]
Все равно не вводиться множество А и В...что не так???Все операции выполняются а множество не приниматься (((
0
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 09:22
Застрелись, или учись думать и писать программы.
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
06.12.2016, 09:24  [ТС]
ГРУБО!!!
0
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 09:30
Так ввести 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
uses crt;
type TSet = set of char; // Множество
// Ввести множество из файла
procedure Set_Input(var A: TSet; var Input:text;fname,S:string);
var c:char;
begin
assign(input,fname); //файл в папке с программой
reset(input);
A:=[];
while not seekeof(input) do//может быть не одна строка
 begin
  read(input,c);
  if c in['A'..'Z','a'..'z'] then A:=A+[c];//пропускаем ненужные символы, типа конец строки и переход на новую строку
 end;
close(input);
writeln(S);
for c:='A' to 'z' do
if c in A then write(c);
writeln;
end;
var a,b:TSet;
    f:text;
begin
Set_Input(a,f,'1.txt','Множество А');
Set_Input(b,f,'2.txt','Множество B');
end.
Вложения
Тип файла: rar Множества.rar (853 байт, 4 просмотров)
0
0 / 0 / 0
Регистрация: 16.05.2016
Сообщений: 31
06.12.2016, 09:36  [ТС]
Я только учусь если что !!!!.К моему это как применит???
0
Почетный модератор
 Аватар для Puporev
64315 / 47611 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
06.12.2016, 09:40
Цитата Сообщение от antipenko_dasha Посмотреть сообщение
Я только учусь если что !!!!.
Да по моему ты не учишься, а сдираешь где попало коды или куски кодов, а потом паришь мозги нам. Я на твой вопрос ответил, а писать тебе программу не буду, до свидания.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
06.12.2016, 09:40
Помогаю со студенческими работами здесь

Переписать функцию sqrt, чтобы она работала с большими числами
желательно что бы корень извлекался из строки и возвращался результат в виде строки

Переделать готовую программу, чтобы она работала с файлом
здраствуйте форумчане! помогите переделать готовую программу, чтобы она работала с файлом. это готовая программа, без файлов. {№ 28 ...

Переписать программу, чтобы она работала не с текстом, а числами
Постараюсь быть максимально конкретным. Прога на языке Си. Здесь (проверено) работающая нормально прога с символами. В одном документе...

Переделать программу, чтобы она работала не с числами, а с символами
пожалуйста помогите переделать прогу на работу с символами!!!!!!! сейчас прога работает только с числами!!! unit Unit1; ...

Преобразовать код матрицы так чтобы она работала через процедуру или функцию
Добрый вечер, помогите преобразовать код матрицы так чтобы она работала через процедуру или функцию: Вот код var i, j, n, m, t:...


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

Или воспользуйтесь поиском по форуму:
16
Ответ Создать тему
Новые блоги и статьи
Программный контроль заполнения реквизита табличной части документа
Maks 02.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать контроль заполнения реквизита "ПричинаСписания". . .
wmic не является внутренней или внешней командой
Maks 02.04.2026
Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/
Программная установка даты и запрет ее изменения
Maks 02.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .
Вывод данных в справочнике через динамический список
Maks 01.04.2026
Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .
Программное заполнения текстового поля в реквизите формы документа
Maks 01.04.2026
Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .
К слову об оптимизации
kumehtar 01.04.2026
Вспоминаю начало 2000-х, университет, когда я писал на Delphi. Тогда среди программистов на форумах активно обсуждали аккуратную работу с памятью: нужно было следить за переменными, вовремя. . .
Идея фильтра интернета (сервер = слой+фильтр).
Hrethgir 31.03.2026
Суть идеи заключается в том, чтобы запустить свой сервер, о чём я если честно мечтал давно и давно приобрёл книгу как это сделать. Но не было причин его запускать. Очумелые учёные напечатали на. . .
Модель здравосоХранения 6. ESG-повестка и устойчивое развитие; углублённый анализ кадрового бренда
anaschu 31.03.2026
В прикрепленном документе раздумья о том, как можно поменять модель в будущем
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru