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

Про кометнируйте

30.12.2010, 20:58. Просмотров 772. Ответов 3
Метки нет (Все метки)

Можете пожалуйста помочь прокоментировать програмы мне просто сдать нужно а сказали что нужно ищо написать коментарии может плиз помочь или хотябы написать что они делаю а то я сделал файлы и лабиринт по примеру а толком понять какая функцыя что делет закоментировать не могу помогите поалуйста.
1.ФАЙЛЫ Тектовые,типизированные и нетипизированные
2.Лабиринт Левой руки и движущийся окно
3.Аладин
4.ОКГ процедура и функцыи рисования через меню.

Помогите пожалуйста просто сдать нужно а времини написать коментарии нету плиз помогите!!!!

Вот сам програмы:

1.Файлы

Само задание было такое:Даны два файла чисел F и G . Переписать с сохранением порядка следования компоненты файла F в файл G, а компоненты файла G - в файл F. Использовать вспомогательный файл.

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
Текстовый
 
Program lab11TXT;
Var f1,f2,f3:text;
I,n: integer;
S: string;
Begin
Assign(f1, 'C:\F.txt');
Rewrite(f1);
Readln(n);
for i:=1 to n do
begin
readln(s);
writeln(f1,s);
end;
Assign(f2, 'C:\G.txt');
Rewrite(f2);
Readln(n);
for i:=1 to n do
begin
readln(s);
writeln(f2,s);
end;
Assign(f3, 'C:\H.txt');
Rewrite(f3);
Reset(f1);
reset(f2);
While not eof(f1) do
Begin
Readln(f1,s);
Writeln(f3,s);
End;
Rewrite(f1);
While not eof(f2) do
Begin
Readln(f2,s);
Writeln(f1,s);
End;
Reset(f3);
Rewrite(f2);
While not eof(f3) do
Begin
Readln(f3,s);
Writeln(f2,s);
End;
Writeln;
reset(f1);
Reset(f2);
While not eof(f2) do
Begin
Readln(f2,s);
Writeln(s);
end;
While not eof(f1) do
Begin Readln(f1,s); Writeln(s);
End;
readln;
End.
 
Типизированный
 
Program lab11TP;
Var f1,f2,f3:file of string;
I,n: integer;
S: string;
Begin
Assign(f1, 'C:\f1.dat');
Rewrite(f1);
Readln(n);
for i:=1 to n do
begin
read(s);
write(f1,s);
end;
Assign(f2, 'C:\f2.dat');
Rewrite(f2);
Readln(n);
for i:=1 to n do
begin
read(s);
write(f2,s);
end;
Assign(f3, 'C:\f3.dat');
Rewrite(f3);
Reset(f1);
reset(f2);
While not eof(f1) do
Begin
Read(f1,s);
Write(f3,s);
End;
Rewrite(f1);
While not eof(f2) do
Begin
Read(f2,s);
Write(f1,s);
End;
Reset(f3);
Rewrite(f2);
While not eof(f3) do
Begin
Read(f3,s);
Write(f2,s);
End;
Writeln;
reset(f1);
Reset(f2);
While not eof(f2) do
Begin
Read(f2,s);
Write(f2,s);
end;
While not eof(f1) do
Begin Read(f1,s); Write(s);End;readln;End.
 
Нетипизированый
 
Program lab11NP;
Var f1,f2,f3:file;
I,n: integer;
S: string;
Begin
Assign(f1, 'C:\F.dat');
Rewrite(f1,1);
Readln(n);
for i:=1 to n do
begin
read(s);
blockwrite(f1,s,sizeof(s));
end;
Assign(f2, 'C:\G.dat');
Rewrite(f2,1);
Readln(n);
for i:=1 to n do
begin
read(s);
blockwrite(f2,s,sizeof(s));
end;
Assign(f3, 'C:\H.dat');
Rewrite(f3,1);
Reset(f1,1);
reset(f2,1);
While not eof(f1) do
Begin
blockread(f1,s,sizeof(s));
blockwrite(f3,s,sizeof(s));
End;
Rewrite(f1,1);
While not eof(f2) do
Begin
blockRead(f2,s,sizeof(s));
blockWrite(f1,s,sizeof(s));
End;
Reset(f3,1);
Rewrite(f2,1);
While not eof(f3) do
Begin
blockread(f3,s,sizeof(s));
blockwrite(f2,s,sizeof(s));
End;
Writeln;
reset(f1,1);
Reset(f2,1);
While not eof(f2) do
Begin
blockread(f2,s,sizeof(s));
Write(s);
end;
While not eof(f1) do
Begin blockRead(f1,s,sizeof(s)); Write(s);End;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
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
Эвристика левой руки
 
Program Lab13PYKA;
type mass=array [1..60,1..60] of integer;
var s,k, H,i,c,j,m,n:integer;
x,y:array[0..20] of integer;
L:mass; ch:char;
const DemoL:array[1..6,1..6] of integer = ( ( 0,1,0,0,0,0),(0,1,1,1,1,0),(0,0,1,0,0,0), (0,0,1,1,1,1),(1,1,1,0,0,0),(0,0,1,0,0,0) );
procedure Put;
Begin
if (s=1)or(s=m)or(k=n)or(k=1) then begin
inc (i); x[i]:=s; y[i]:=k;
end else
if (L[s,k+1]+L[s,k-1]+L[s-1,k]+L[s+1,k])=1 then
begin
L[s,k]:=0; dec (i);
End else
begin
inc (i); x[i]:=s; y[i]:=k;
end;
End;
procedure GoRight;
Begin
H:=4; inc(k); put;
End;
procedure GoLeft;
Begin
H:=2; dec(k); put;
End;
procedure GoUp;
Begin
H:=3; dec(s); put;
End;
procedure GoDown;
Begin
H:=1; inc (s); put;
End;
procedure vhodsverhu;
Begin
if L[s,k+1]=1 then begin GoRight; exit; end;
if L[s+1,k]=1 then begin GoDown; exit; end;
if L[s,k-1]=1 then begin Goleft; exit; end
else GoUp;
End;
procedure vhodsprava;
Begin
if L[s+1,k]=1 then begin GoDown; exit; end;
if L[s,k-1]=1 then begin GoLeft; exit; end;
if L[s-1,k]=1 then begin GoUp; exit; end
else GoRight;
End;
procedure vhodsnizu;
Begin
if L[s,k-1]=1 then begin GoLeft; exit; end;
if L[s-1,k]=1 then begin GoUp; exit; end;
if L[s,k+1]=1 then begin GoRight; exit; end
else GoDown;
End;
procedure vhodsleva;
Begin
if L[s-1,k]=1 then begin GoUp; exit; end;
if L[s,k+1]=1 then begin GoRight; exit; end;
if L[s+1,k]=1 then begin GoDown; exit; end
else GoLeft;
End;
procedure vibor;
Begin
repeat
case H of
1:vhodsverhu;
2: vhodsprava;
3: vhodsnizu;
4: vhodsleva;
end;
until (s=1) or (s=m) or (k=1) or (k=n);
End;
procedure reshenie;
var j:integer;
Begin
writeln ('reshenie');
writeln ('stroka-stolbez');
for j:=0 to i do
begin
writeln (x[j], '         ', y[j]);
end;
End;
BEGIN
writeln (' Demo (press 1) or User (press 2) ');  readln (c);
case C of
1: begin
for i:=1 to 6 do
for j:=1 to 6 do
L[i,j]:=DemoL[i,j];
for i:=1 to 6 do
begin
for j:=1 to 6 do
write (L[i,j], '  ');
writeln;
end;
end;
2: begin
writeln ('vvedite kolichestvo strok '); readln (m);
writeln ('vvedite kolichestvo stolbzov '); readln (n);
writeln ('vvedite svoi labirint');
for i:=1 to m do
for j:=1 to n do
read (L[i,j]);
end;end;
repeat
writeln ('vvedite koordinati tichki vhoda');
writeln ('stroka s= '); readln (s);
writeln ('stolbez k= '); readln (k);
if L[s,k]<>1 then
begin
writeln ('tut stena. poprobovat snova? (Y/N)');
read (ch); ch:=upcase (ch);
end;
until (L[s,k]=1) or (ch<>'Y');
i:=0; x[i]:=s; y[i]:=k;
writeln ('vvedite napravlenie. 1 - vverh, 2 - sprava, 3 - snizu, 4 - sleva'); read (H);
vibor;
reshenie;
end.
Метод скользящего окна.
Program Lab13OKHO;
var m,n,s,k,chus,ii,H,i,j :integer;
ch:char;
L: array[0..20,0..20] of integer;
x,y: array [1..50] of integer;
const DemoL:array [1..6,1..6] of integer = ( (0,1,0,0,0,0),(0,1,1,1,1,0),(0,0,1,0,0,0),
(0,0,1,1,1,1),(1,1,1,0,0,0),(0,0,1,0,0,0) );
 
procedure reshenie;
var jj:integer;
Begin
writeln ('reshenie');
writeln ('stroka  stolbez');
for jj:=1 to ii do
begin
writeln (x[jj], '         ', y[jj]);
end;
for i:=1 to m do
begin
for j:=1 to n do
begin
write (L[i,j], ' ');
end; writeln; end;
halt; End;
procedure Scaner (i1,j1:integer);
Begin
if ((s=1) or (s=m) or (k=1) or (k=n)) and (chus<>2) then reshenie;
for i:=s-1 to s+1 do
for j:=k-1 to k+1 do
if ( (i=s-1 ) and ( (j=k-1) or (j=k+1) ) ) or ( (i=s+1 ) and ( (j=k-1) or (j=k+1) ) ) or ( (i=s) and (j=k) ) then Continue
else if L [i,j]= 1 then begin
L[s,k]:=chus;
s:=i; k:=j;
inc (ii);
x[ii]:=s; y[ii]:=k;
inc (chus);
Scaner (s,k);
end else if (L[i,j]=chus-1) and ((L[s-1,k]+L[s+1,k]+L[s,k-1]+L[s,k+1]=chus-1)) then
begin
L[s,k]:=0;
L[i,j]:=1;
dec (chus);
dec (ii);
s:=i; k:=j;
Scaner (s,k);
end; End;
BEGIN
writeln (' Demo (press 1) or User (press 2) ');  readln (H);
case H of
1:   begin
for i:=1 to 6 do
begin
for j:=1 to 6 do
begin
L[i,j]:=DemoL[i,j];
write (L[i,j], ' ');
end;
writeln;
end;
end;
2:   begin
writeln ('vvedite kolichestvo strok '); readln (m);
writeln ('vvedite kolichestvo stolbzov '); readln (n);
writeln ('vvedite vash labirint');
for i:=1 to m do
for j:=1 to n do
read (L[i,j]);
end; end; repeat
writeln ('vvedite tochku vhoda');
writeln ('stroka s= '); readln (s);
writeln ('stolbez k= '); readln (k);
if L[s,k]<>1 then  begin
writeln ('zdec stena. povtorite? (Y/N)'); 
read (ch); ch:=upcase (ch);
end; until (L[s,k]=1) or (ch<>'Y');
ii:=1; x[ii]:=s; y[ii]:=k; chus:=2;
Scaner (s,k);
reshenie;
readln;
END.
3.Аладин


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
program ALADIN;
type item=^itemrec;
itemrec=record
price,weight,numb:byte;
next:item;
end;
var items:item;
result:item;
i,cost:integer;
procedure create(var p:item;n:integer);
begin
if n>0 then
begin
new(p);
with p^ do
begin
numb:=i+1;
inc(i);
price:=random(20)+5;
weight:=random(10)+2;
create(next,n-1);
exit;
end;
end;
p:=nil;
end;
procedure output(p:item);
begin
while p<>nil do
begin
with p^ do
begin
writeln(numb:5,' ',price:5,' ',weight:5);
p:=next;
end;
end;
end;
procedure seekmax(p:item;w:integer;var r:item;var c:integer);
var t,h:item;
cm,ct:integer;
begin
if p=nil then
begin
r:=nil;
c:=0;
exit;
end;
t:=p;
cm:=-1;
new(r);
while t<>nil do
begin
with t^ do
begin
if w-weight>=0 then
begin
new(h);
seekmax(next,w-weight,h,ct);
if (price+ct)>cm then
begin
r^:=t^;
r^.next:=h;
cm:=price+ct;
end;
end;
t:=next;
end;
end;
if cm=-1 then
begin
c:=0;
r:=nil;
end
else
c:=cm;
end;
begin
randomize;
i:=0;
create(items,40);
output(items);
writeln('result');
seekmax(items,15,result,cost);
output(result);
writeln(cost);
readln;
end.

4.ОКГ


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
program OKG6;
uses
graph;
var
num,x,y,x1,y1: integer;
r,ug: real;
gd,gm: integer;
 
procedure koord;
begin
setcolor(14);
line(320,0,320,479);
line(0,240,639,240);
end;
 
function okrugl(n: real): integer;
begin
if n-round(n)>=0.5 then
okrugl:=round(n)+1
else
okrugl:=round(n);
end;
 
function f1(x: integer):integer;
begin
f1:=-okrugl(200*sin(0.02*(x-320)))+240;
end;
 
function f2(x: integer):integer;
begin
f2:=-okrugl(200*cos(0.02*(x-320)))+240;
end;
 
function f3(x: integer):integer;
var
a: real;
begin
a:=0.02*(x-320);
if cos(a)=0 then
a:=a+0.0001;
f3:=-okrugl(50*sin(a)/cos(a))+240;
end;
 
function f4(x: integer):integer;
var
a: real;
begin
a:=0.02*(x-320);
if sin(a)=0 then
a:=a+0.0001;
f4:=-okrugl(50*cos(a)/sin(a))+240;
end;
 
procedure Num1;
begin
koord;
x:=0;
y:=f1(x);
moveto(x,y);
for x:=1 to 639 do
begin
y:=f1(x);
setcolor(15);
lineto(x,y);
end;
end;
 
procedure Num2;
begin
koord;
x:=0;
y:=f2(x);
moveto(x,y);
for x:=1 to 639 do
begin
y:=f2(x);
setcolor(15);
lineto(x,y);
end;
end;
 
procedure Num3;
begin
koord;
x:=0;
y:=f3(x);
moveto(x,y);
y1:=y;
for x:=1 to 639 do
begin
y:=f3(x);
setcolor(15);
if abs(y-y1)<100 then
lineto(x,y)
else
moveto(x,y);
y1:=y;
end;
end;
 
procedure Num4;
begin
koord;
x:=0;
y:=f4(x);
moveto(x,y);
y1:=y;
for x:=1 to 639 do
begin
y:=f4(x);
setcolor(15);
if abs(y-y1)<100 then
lineto(x,y)
else
moveto(x,y);
y1:=y;
end;
end;
 
procedure Num5;
begin
x1:=320;
y1:=240;
ug:=0;
r:=0;
moveto(x1,y1);
while ug<=5*2*pi do
begin
x:=okrugl(r*sin(ug))+x1;
y:=-okrugl(r*cos(ug))+y1;
ug:=ug+0.001;
r:=r+0.005;
setcolor(15);
lineto(x,y);
end;
end;
 
begin
writeln('Vvedite nomer funktsii.');
writeln('1: sinX');
writeln('2: cosX');
writeln('3: tgX');
writeln('4: ctgX');
writeln('5: spiral');
readln(num);
gd:=detect;
Initgraph(gd,gm,'');
case Num of
1: num1;
2: num2;
3: num3;
4: num4;
5: num5;
end;
readln;
end.
Или просто обясните как щитет аладина и лабиринт пожалуйста.
И если ктот занет какиеэто формулы для графика подскажыте пожалуйста!!!!

Добавлено через 1 час 42 минуты
Извените что може не так тему назвал "Просто если написать обяснить как сделал не по правилам писать ..."
1
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
30.12.2010, 20:58
Ответы с готовыми решениями:

про лягушку
На Pascal: лягушка съедает на 20% больше комаров чем в предыдущий день и еще на два комара больше...

Про лыжника
Начав тренировки, лыжник в первый день пробегал 10 км. Каждый следующий день он увеличивал длину...

про видеотеку
делаю базу данных про видеотеку, помогите с процедурой вывода из файла program videoteka; uses...

про улиточку
каждый солнечный день улитка,сидящая на дереве,поднимается наверх на 2 см,а каждый день пасмурный...

Про лыжника
Люди помогите решить задачьку по паскалю :Лыжник в первый день прошел 10КМ.КАждый следующий день...

3
N@tali
778 / 459 / 85
Регистрация: 20.02.2010
Сообщений: 974
30.12.2010, 21:36 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
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
Program Lab13PYKA;                // название программы
type mass=array [1..60,1..60] of integer;  // задание типа
var s,k, H,i,c,j,m,n:integer;                     // задание переменных   
x,y:array[0..20] of integer;                    // задание массива
L:mass; ch:char;
const DemoL:array[1..6,1..6] of integer = ( ( 0,1,0,0,0,0),(0,1,1,1,1,0),(0,0,1,0,0,0), (0,0,1,1,1,1),(1,1,1,0,0,0),(0,0,1,0,0,0) );                 // задание константы
procedure Put;                                    // Процедура название
Begin                                                     // начало
if (s=1)or(s=m)or(k=n)or(k=1) then begin    // задается условие если..
inc (i); x[i]:=s; y[i]:=k;
end else                                               // иначе
if (L[s,k+1]+L[s,k-1]+L[s-1,k]+L[s+1,k])=1 then    // опять задается условие если..
begin                                                            //начало работы тела
L[s,k]:=0; dec (i);
End else                                                   //иначе
begin                                                       // начало работы тела
inc (i); x[i]:=s; y[i]:=k;
end;                                                    // конец работы тела подпрограммы
End;                                                   // конец работы тела подпрограммы
procedure GoRight;                              // другая процедура
Begin                                                 // начало работы
H:=4; inc(k); put;
End;                                                // конец работы тела
procedure GoLeft;                            // Следующая процедура
Begin
H:=2; dec(k); put;
End;
procedure GoUp;
Begin
H:=3; dec(s); put;
End;
procedure GoDown;
Begin
H:=1; inc (s); put;
End;
procedure vhodsverhu;                 // процедура
Begin
if L[s,k+1]=1 then begin GoRight; exit; end;
if L[s+1,k]=1 then begin GoDown; exit; end;
if L[s,k-1]=1 then begin Goleft; exit; end
else GoUp;                                               // иначе переходим вверх
End;
procedure vhodsprava;
Begin
if L[s+1,k]=1 then begin GoDown; exit; end;
if L[s,k-1]=1 then begin GoLeft; exit; end;
if L[s-1,k]=1 then begin GoUp; exit; end
else GoRight;
End;
procedure vhodsnizu;
Begin
if L[s,k-1]=1 then begin GoLeft; exit; end;
if L[s-1,k]=1 then begin GoUp; exit; end;
if L[s,k+1]=1 then begin GoRight; exit; end
else GoDown;
End;
procedure vhodsleva;
Begin
if L[s-1,k]=1 then begin GoUp; exit; end;
if L[s,k+1]=1 then begin GoRight; exit; end;
if L[s+1,k]=1 then begin GoDown; exit; end
else GoLeft;
End;
procedure vibor;
Begin
repeat
case H of
1:vhodsverhu;
2: vhodsprava;
3: vhodsnizu;
4: vhodsleva;
end;
until (s=1) or (s=m) or (k=1) or (k=n);
End;
procedure reshenie;
var j:integer;
Begin
writeln ('reshenie');
writeln ('stroka-stolbez');
for j:=0 to i do
begin
writeln (x[j], '         ', y[j]);
end;
End;
BEGIN
writeln (' Demo (press 1) or User (press 2) ');  readln (c);
case C of
1: begin
for i:=1 to 6 do
for j:=1 to 6 do
L[i,j]:=DemoL[i,j];
for i:=1 to 6 do
begin
for j:=1 to 6 do
write (L[i,j], '  ');
writeln;
end;
end;
2: begin
writeln ('vvedite kolichestvo strok '); readln (m);
writeln ('vvedite kolichestvo stolbzov '); readln (n);
writeln ('vvedite svoi labirint');
for i:=1 to m do
for j:=1 to n do
read (L[i,j]);
end;end;
repeat
writeln ('vvedite koordinati tichki vhoda');
writeln ('stroka s= '); readln (s);
writeln ('stolbez k= '); readln (k);
if L[s,k]<>1 then
begin
writeln ('tut stena. poprobovat snova? (Y/N)');
read (ch); ch:=upcase (ch);
end;
until (L[s,k]=1) or (ch<>'Y');
i:=0; x[i]:=s; y[i]:=k;
writeln ('vvedite napravlenie. 1 - vverh, 2 - sprava, 3 - snizu, 4 - sleva'); read (H);  //вывод  строки "введите поправление"
vibor;
reshenie;
end.
 
 
Метод скользящего окна.
Program Lab13OKHO;
var m,n,s,k,chus,ii,H,i,j :integer;
ch:char;
L: array[0..20,0..20] of integer;
x,y: array [1..50] of integer;
const DemoL:array [1..6,1..6] of integer = ( (0,1,0,0,0,0),(0,1,1,1,1,0),(0,0,1,0,0,0),
(0,0,1,1,1,1),(1,1,1,0,0,0),(0,0,1,0,0,0) );
 
procedure reshenie;
var jj:integer;
Begin
writeln ('reshenie');
writeln ('stroka  stolbez');
for jj:=1 to ii do
begin
writeln (x[jj], '         ', y[jj]);
end;
for i:=1 to m do
begin
for j:=1 to n do
begin
write (L[i,j], ' ');
end; writeln; end;
halt; End;
procedure Scaner (i1,j1:integer);
Begin
if ((s=1) or (s=m) or (k=1) or (k=n)) and (chus<>2) then reshenie;
for i:=s-1 to s+1 do
for j:=k-1 to k+1 do
if ( (i=s-1 ) and ( (j=k-1) or (j=k+1) ) ) or ( (i=s+1 ) and ( (j=k-1) or (j=k+1) ) ) or ( (i=s) and (j=k) ) then Continue
else if L [i,j]= 1 then begin
L[s,k]:=chus;
s:=i; k:=j;
inc (ii);
x[ii]:=s; y[ii]:=k;
inc (chus);
Scaner (s,k);
end else if (L[i,j]=chus-1) and ((L[s-1,k]+L[s+1,k]+L[s,k-1]+L[s,k+1]=chus-1)) then
begin
L[s,k]:=0;
L[i,j]:=1;
dec (chus);
dec (ii);
s:=i; k:=j;
Scaner (s,k);
end; End;
BEGIN
writeln (' Demo (press 1) or User (press 2) ');  readln (H);
case H of
1:   begin
for i:=1 to 6 do
begin
for j:=1 to 6 do
begin
L[i,j]:=DemoL[i,j];
write (L[i,j], ' ');
end;
writeln;                                                                  //вывод
end;
end;
2:   begin
writeln ('vvedite kolichestvo strok '); readln (m);           //  выводим строку "введите количество строк"
writeln ('vvedite kolichestvo stolbzov '); readln (n);      // выводим строку "введите количество столбцов"
writeln ('vvedite vash labirint');                               // выводим строку "введите ваш лабиринт"
for i:=1 to m do
for j:=1 to n do                                              //для
read (L[i,j]);
end; end; repeat                                       // повтор
writeln ('vvedite tochku vhoda');                   //   вывод строки "Введите точки входа"
writeln ('stroka s= '); readln (s);                  //    вывод строки "Введите строку"
writeln ('stolbez k= '); readln (k);                //    вывод строки "Введите столбец"
if L[s,k]<>1 then  begin                            // условие задаем если это то тогда начало
writeln ('zdec stena. povtorite? (Y/N)');     //   выводим строку
read (ch); ch:=upcase (ch);                 //    чтение    
end; until (L[s,k]=1) or (ch<>'Y');
ii:=1; x[ii]:=s; y[ii]:=k; chus:=2;
Scaner (s,k);
reshenie;
readln;
END.
4
Crazyroma
3 / 3 / 5
Регистрация: 21.10.2010
Сообщений: 124
30.12.2010, 23:14  [ТС] 3
Цитата Сообщение от N@tali Посмотреть сообщение
Давай попробуем на одной из задач остальные сделаешь по образцу... окей? правда сама подзабыла уже. Давно паскаль изучала. но основу помню... Строчки повторяются. Если будут вопросы по строчкам скопируй и спроси.

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
Program Lab13PYKA;                // название программы
type mass=array [1..60,1..60] of integer;  // задание типа
var s,k, H,i,c,j,m,n:integer;                     // задание переменных   
x,y:array[0..20] of integer;                    // задание массива
L:mass; ch:char;
const DemoL:array[1..6,1..6] of integer = ( ( 0,1,0,0,0,0),(0,1,1,1,1,0),(0,0,1,0,0,0), (0,0,1,1,1,1),(1,1,1,0,0,0),(0,0,1,0,0,0) );                 // задание константы
procedure Put;                                    // Процедура название
Begin                                                     // начало
if (s=1)or(s=m)or(k=n)or(k=1) then begin    // задается условие если..
inc (i); x[i]:=s; y[i]:=k;
end else                                               // иначе
if (L[s,k+1]+L[s,k-1]+L[s-1,k]+L[s+1,k])=1 then    // опять задается условие если..
begin                                                            //начало работы тела
L[s,k]:=0; dec (i);
End else                                                   //иначе
begin                                                       // начало работы тела
inc (i); x[i]:=s; y[i]:=k;
end;                                                    // конец работы тела подпрограммы
End;                                                   // конец работы тела подпрограммы
procedure GoRight;                              // другая процедура
Begin                                                 // начало работы
H:=4; inc(k); put;
End;                                                // конец работы тела
procedure GoLeft;                            // Следующая процедура
Begin
H:=2; dec(k); put;
End;
procedure GoUp;
Begin
H:=3; dec(s); put;
End;
procedure GoDown;
Begin
H:=1; inc (s); put;
End;
procedure vhodsverhu;                 // процедура
Begin
if L[s,k+1]=1 then begin GoRight; exit; end;
if L[s+1,k]=1 then begin GoDown; exit; end;
if L[s,k-1]=1 then begin Goleft; exit; end
else GoUp;                                               // иначе переходим вверх
End;
procedure vhodsprava;
Begin
if L[s+1,k]=1 then begin GoDown; exit; end;
if L[s,k-1]=1 then begin GoLeft; exit; end;
if L[s-1,k]=1 then begin GoUp; exit; end
else GoRight;
End;
procedure vhodsnizu;
Begin
if L[s,k-1]=1 then begin GoLeft; exit; end;
if L[s-1,k]=1 then begin GoUp; exit; end;
if L[s,k+1]=1 then begin GoRight; exit; end
else GoDown;
End;
procedure vhodsleva;
Begin
if L[s-1,k]=1 then begin GoUp; exit; end;
if L[s,k+1]=1 then begin GoRight; exit; end;
if L[s+1,k]=1 then begin GoDown; exit; end
else GoLeft;
End;
procedure vibor;
Begin
repeat
case H of
1:vhodsverhu;
2: vhodsprava;
3: vhodsnizu;
4: vhodsleva;
end;
until (s=1) or (s=m) or (k=1) or (k=n);
End;
procedure reshenie;
var j:integer;
Begin
writeln ('reshenie');
writeln ('stroka-stolbez');
for j:=0 to i do
begin
writeln (x[j], '         ', y[j]);
end;
End;
BEGIN
writeln (' Demo (press 1) or User (press 2) ');  readln (c);
case C of
1: begin
for i:=1 to 6 do
for j:=1 to 6 do
L[i,j]:=DemoL[i,j];
for i:=1 to 6 do
begin
for j:=1 to 6 do
write (L[i,j], '  ');
writeln;
end;
end;
2: begin
writeln ('vvedite kolichestvo strok '); readln (m);
writeln ('vvedite kolichestvo stolbzov '); readln (n);
writeln ('vvedite svoi labirint');
for i:=1 to m do
for j:=1 to n do
read (L[i,j]);
end;end;
repeat
writeln ('vvedite koordinati tichki vhoda');
writeln ('stroka s= '); readln (s);
writeln ('stolbez k= '); readln (k);
if L[s,k]<>1 then
begin
writeln ('tut stena. poprobovat snova? (Y/N)');
read (ch); ch:=upcase (ch);
end;
until (L[s,k]=1) or (ch<>'Y');
i:=0; x[i]:=s; y[i]:=k;
writeln ('vvedite napravlenie. 1 - vverh, 2 - sprava, 3 - snizu, 4 - sleva'); read (H);  //вывод  строки "введите поправление"
vibor;
reshenie;
end.
 
 
Метод скользящего окна.
Program Lab13OKHO;
var m,n,s,k,chus,ii,H,i,j :integer;
ch:char;
L: array[0..20,0..20] of integer;
x,y: array [1..50] of integer;
const DemoL:array [1..6,1..6] of integer = ( (0,1,0,0,0,0),(0,1,1,1,1,0),(0,0,1,0,0,0),
(0,0,1,1,1,1),(1,1,1,0,0,0),(0,0,1,0,0,0) );
 
procedure reshenie;
var jj:integer;
Begin
writeln ('reshenie');
writeln ('stroka  stolbez');
for jj:=1 to ii do
begin
writeln (x[jj], '         ', y[jj]);
end;
for i:=1 to m do
begin
for j:=1 to n do
begin
write (L[i,j], ' ');
end; writeln; end;
halt; End;
procedure Scaner (i1,j1:integer);
Begin
if ((s=1) or (s=m) or (k=1) or (k=n)) and (chus<>2) then reshenie;
for i:=s-1 to s+1 do
for j:=k-1 to k+1 do
if ( (i=s-1 ) and ( (j=k-1) or (j=k+1) ) ) or ( (i=s+1 ) and ( (j=k-1) or (j=k+1) ) ) or ( (i=s) and (j=k) ) then Continue
else if L [i,j]= 1 then begin
L[s,k]:=chus;
s:=i; k:=j;
inc (ii);
x[ii]:=s; y[ii]:=k;
inc (chus);
Scaner (s,k);
end else if (L[i,j]=chus-1) and ((L[s-1,k]+L[s+1,k]+L[s,k-1]+L[s,k+1]=chus-1)) then
begin
L[s,k]:=0;
L[i,j]:=1;
dec (chus);
dec (ii);
s:=i; k:=j;
Scaner (s,k);
end; End;
BEGIN
writeln (' Demo (press 1) or User (press 2) ');  readln (H);
case H of
1:   begin
for i:=1 to 6 do
begin
for j:=1 to 6 do
begin
L[i,j]:=DemoL[i,j];
write (L[i,j], ' ');
end;
writeln;                                                                  //вывод
end;
end;
2:   begin
writeln ('vvedite kolichestvo strok '); readln (m);           //  выводим строку "введите количество строк"
writeln ('vvedite kolichestvo stolbzov '); readln (n);      // выводим строку "введите количество столбцов"
writeln ('vvedite vash labirint');                               // выводим строку "введите ваш лабиринт"
for i:=1 to m do
for j:=1 to n do                                              //для
read (L[i,j]);
end; end; repeat                                       // повтор
writeln ('vvedite tochku vhoda');                   //   вывод строки "Введите точки входа"
writeln ('stroka s= '); readln (s);                  //    вывод строки "Введите строку"
writeln ('stolbez k= '); readln (k);                //    вывод строки "Введите столбец"
if L[s,k]<>1 then  begin                            // условие задаем если это то тогда начало
writeln ('zdec stena. povtorite? (Y/N)');     //   выводим строку
read (ch); ch:=upcase (ch);                 //    чтение    
end; until (L[s,k]=1) or (ch<>'Y');
ii:=1; x[ii]:=s; y[ii]:=k; chus:=2;
Scaner (s,k);
reshenie;
readln;
END.

Спасибо!!!
0
use
179 / 179 / 81
Регистрация: 18.12.2010
Сообщений: 346
31.12.2010, 05:13 4
Лучший ответ Сообщение было отмечено как решение

Решение

Цитата Сообщение от N@tali Посмотреть сообщение
остальные сделаешь по образцу... окей?
N@tali, я оценил твою шутку!
СУПЕР!!

Цитата Сообщение от N@tali Посмотреть сообщение
// название программы
// задание типа
// задание переменных
// задание массива
// Процедура название
// другая процедура
Особенно понравилось вот это:
Begin // начало
// начало работы тела
так их, неучей и лоботрясов..
+1

про комментировано!
3
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
31.12.2010, 05:13

Про массивы
Есть файл с содержанием: 6 1 2 3 4 5 6 как из файла вытащить 6 в отдельную переменную, а 1 2 3 4...

про интгегралы
Вычислить приближенно интеграл функции f(x)=5x2-x+2 на интервале от а до b, суммируя площади...

про палиндром
Составить программу, которая определяет, является ли заданное натуральное число палиндромом. Числа...


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

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

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