Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Войти
Регистрация
Восстановить пароль
Другие темы раздела
Pascal ABC Из исходных массивов сформировать массивы по заданному правилу https://www.cyberforum.ru/ pascalabc/ thread1614686.html
Даны два одномерных массива целых чисел (массив А, состоящий из n элементов, массив В – из m элементов), заполненных случайным образом числами из промежутка . Сформировать из элементов этих массивов...
Pascal ABC Запросить с клавиатуры целое 6-значное число
Составьте пожалуйста программку!) Вот задание: Запросить с клавиатуры целое 6-значное число,оканчивающееся семеркой и напечатать произведение его цифр.Если вводится не то число,то сообщить об этом...
функция не выполняется Pascal ABC
Не выполняется функция подсчета количества элементов очереди. Program Ochered; uses crt; {Для использования readkey и clrscr} type Tinf=integer; {тип данных, который будет храниться в...
Pascal ABC Как исправить ошибку "Несколько подпрограмм могут быть вызваны"? program LAB_7_1; uses crt; const nmax=19; type mtr=array of integer; function summa(a:mtr;n,k:byte):integer; var i,j,p,d:byte; s:integer; begin p:=n div 2+1; if k=p then s:=a https://www.cyberforum.ru/ pascalabc/ thread1614462.html
Pascal ABC Дано: квадратная матрица A[N,N] https://www.cyberforum.ru/ pascalabc/ thread1614433.html
Дано: квадратная матрица A. Назовём допустимым преобразованием перестановку двух строк или двух столбцов. С помощью допустимых преобразований добиться того, чтобы один из элементов матрицы,...
База данных. Магазин по продаже аудиоаппаратуры Pascal ABC
Можете написать программу, а то сам не бум бум. Задание: База данных магазин по продаже аудиоаппаратуры. Структура записи...
Сделать матрицу не используя массивы Pascal ABC
Ребят, нужна помощь в написании программы. Суть программы в том, что бы паскаль создавал текстовый документ с матрицей 2 на 4. После чего создавался еще один текстовый файл, где к числам начальной...
Pascal ABC Полиномы Помогите пожалуйста изменить программу что бы она сформулировала массив содержащий коэффициенты суммы полиномов.(коэффициенты полиномов вводятся с клавиатуры). Порядок полинома тоже должен быть uses... https://www.cyberforum.ru/ pascalabc/ thread1614285.html
Pascal ABC Вычислить значение функции https://www.cyberforum.ru/ pascalabc/ thread1614242.html
Pascal ABC нужно решение этих заданий, а сам в паскале не бум-бум. 12, 24 и вар12 https://www.cyberforum.ru/ pascalabc/ thread1614241.html
0 / 0 / 1
Регистрация: 15.12.2015
Сообщений: 2
17.12.2015, 16:26  [ТС] 0

Обработка списков

17.12.2015, 16:26. Просмотров 917. Ответов 1
Метки (Все метки)

Лучший ответ Сообщение было отмечено R0dan как решение

Решение

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
Program spiski;
uses crt;
Type
TElement=^element;
 Element=record
 a:integer;
 next:TElement;
End;
var Q,last,head:TElement; i,n,k,m,c,f,x:integer;
 
{====sozdanie spiska====}
procedure createhead(var head,last:TElement);
Begin
 new(head);
 head^.next:=nil;
 last:=head;
End;
 
{====zapolnenie spiska=====}
Procedure add(var last:TElement; Z:integer);
var Q:TElement;
Begin
  new(Q);
   Q^.a:=Z;
   Q^.next:=nil;
   last^.next:=Q;
   Last:=Q;
 End;
 
{====vivod na ekran spiska====}
procedure print(head:TElement);
var Q:TElement;  l:integer;
Begin
 
 Q:=head^.next;
 while Q<>nil do
  Begin
   write(Q^.a,'-->');
   Q:=Q^.next;
  End;
 writeln;
 
End;
procedure print1(head:TElement);
var Q:TElement;  l:integer;
Begin
 Q:=head^.next;
 n:=1;
 while (Q<>nil) or (n<>k) do
  Begin
  write(Q^.a,'-->');
  Q:=Q^.next;
  inc(n);
  End;
  Q:=Q^.next;
  while (Q<>nil) or (n<>m) do
  Begin
  write(Q^.a,'-->');
  Q:=Q^.next;
  inc(n);
  end;
  write(f,'-->');
    while Q<>nil do
  Begin
   write(Q^.a,'-->');
   Q:=Q^.next;
   inc(n);
   end;
 writeln;
 
End;
 
Begin
clrscr;
 
createhead(head,last);
 n:=1;
 write('k - ');
 readln(k);
 Write('m - ');
 readln(m);
 textcolor(6);
 write(n,'. ');
 textcolor(9);
 readln(f);
 
 if n=k then
 x:=f;
 inc(n);
 
 if f<>0 then
  Begin
   while f<>0 do
    Begin
     add(last,f);
     textcolor(6);
     write(n,'. ');
     textcolor(9);
     readln(f);
     if n=k then
     x:=f;
     inc(n);
    End;
 
   End
 else Begin textcolor(214);Writeln('spisok pust'); readln; Exit; End;
textcolor(13);
print(head);
print1(head);
write(x);
readln;
End.
Добавлено через 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
Program spiski;
uses crt;
Type
TElement=^element;
 Element=record
 a:integer;
 next:TElement;
End;
var Q,last,head:TElement; i,n,k,m,c,f,x:integer;
 
{====sozdanie spiska====}
procedure createhead(var head,last:TElement);
Begin
 new(head);
 head^.next:=nil;
 last:=head;
End;
 
{====zapolnenie spiska=====}
Procedure add(var last:TElement; Z:integer);
var Q:TElement;
Begin
  new(Q);
   Q^.a:=Z;
   Q^.next:=nil;
   last^.next:=Q;
   Last:=Q;
 End;
 
{====vivod na ekran spiska====}
procedure print(head:TElement);
var Q:TElement;  l:integer;
Begin
 
 Q:=head^.next;
 while Q<>nil do
  Begin
   write(Q^.a,'-->');
   Q:=Q^.next;
  End;
 writeln;
 
End;
procedure print1(head:TElement);
var Q:TElement;  l:integer;
Begin
 Q:=head^.next;
 n:=1;
 while (Q<>nil) or (n<>k) do
  Begin
  write(Q^.a,'-->');
  Q:=Q^.next;
  inc(n);
  End;
  Q:=Q^.next;
  while (Q<>nil) or (n<>m) do
  Begin
  write(Q^.a,'-->');
  Q:=Q^.next;
  inc(n);
  end;
  write(f,'-->');
    while Q<>nil do
  Begin
   write(Q^.a,'-->');
   Q:=Q^.next;
   inc(n);
   end;
 writeln;
 
End;
 
Begin
clrscr;
 
createhead(head,last);
 n:=1;
 write('k - ');
 readln(k);
 Write('m - ');
 readln(m);
 textcolor(6);
 write(n,'. ');
 textcolor(9);
 readln(f);
 
 if n=k then
 x:=f;
 inc(n);
 
 if f<>0 then
  Begin
   while f<>0 do
    Begin
     add(last,f);
     textcolor(6);
     write(n,'. ');
     textcolor(9);
     readln(f);
     if n=k then
     x:=f;
     inc(n);
    End;
 
   End
 else Begin textcolor(214);Writeln('spisok pust'); readln; Exit; End;
textcolor(13);
print(head);
print1(head);
write(x);
readln;
End.


Вернуться к обсуждению:
Обработка списков
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
17.12.2015, 16:26

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

Обработка списков
Список состоит из букв и цифр, буквы оставить без изменения, а цифры умножить на 2.

Обработка списков
Помогите защитить учебную практику. Заранее спасибо

Обработка списков
В коде, в строке head_list(list). появилась ошибка No clauses for this predicate. Но...

Обработка списков
1. Используя только CAR и CDR вытащить 'aaa' и следующего списка: (((( ddd (aaa)) eee) nnn) kkk) ...

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