Примеры решенных задач
14.10.2011, 18:19. Показов 31374. Ответов 6
Вот решил выложить программы с лабораторных работ:
1) Сгенерировать одномерный массив и вывести на экран, далее представить его в виде двумерного массива в котором все нулевые элементы расположены на местах с нечетными индексами строк и столбцов. Вывести элемент массива (двумерного) который запрашивает пользователь по номеру.
| 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
| program one;
uses crt;
var
i,j,x,y,c,p: integer;
ch:boolean;
a: array [1..75] of integer;
function NewIndex (x1,y1:integer): integer;
var ind, res: integer;
begin
res := 0;
if (x1 mod 2 = 0) or (y1 mod 2 = 0) then
begin
for ind := 1 to x1 do begin
if (ind mod 2 <> 0) and (ind <> x1) then res:= res + y div 2;
if (ind mod 2 = 0) and (ind <> x1) then res := res + y;
if (ind mod 2 <> 0) and (ind = x1) then res:= res + y1 div 2;
if (ind mod 2 = 0) and (ind = x1) then res := res + y1;
end;
end;
NewIndex := res;
end;
function PutTab (x1,y1,p:integer): integer;
begin
PutTab := 0;
if NewIndex(x1,y1) <> 0 then begin
a[NewIndex(x1,y1)] := p;
PutTab := p;
end;
end;
function GetTab (x1,y1:integer): integer;
begin
GetTab:= 0;
if NewIndex(x1,y1) <> 0 then GetTab :=a[NewIndex(x1,y1)];
end;
begin
clrscr;
writeln ('Input size two-dimensional massiv: ');
randomize;
{$I-}
repeat
x:=0;
y:=0;
readln (x,y);
if IOResult = 0 then begin
if (x>0) and (y>0) and (x<=10) and (y<=10) then ch := true
else writeln ('Wrong input data');
end else writeln ('Wrong Input data');
until ch = true;
ch := false;
writeln ('Inner presentation:');
for i := 1 to x do
for j := 1 to y do begin
if NewIndex(i,j) <> 0 then begin
a[NewIndex(i,j)] := random(98)+1;
write (a[NewIndex(i,j)], ' ');
end;
end;
writeln;
writeln ('Logical presentation:');
for i := 1 to x do begin
for j := 1 to y do begin
if NewIndex (i,j) <> 0 then write (a[NewIndex(i,j)], ' ')
else write ('0', ' ');
end;
writeln;
end;
writeln;
repeat
writeln ('1) Get element');
writeln ('2) Exit');
readln (c);
if ioresult = 0 then begin
case c of 1: begin
repeat
i:=0; j:=0;
readln (i,j);
if IOResult = 0 then begin
if (i>0) and (j>0) and (i<=10) and (j<=10) then ch := true
else writeln ('Wrong input data');
end else writeln ('Wrong input data');
until ch = true;
ch := false;
writeln (GetTab(i,j));
readln;
end;
2: halt(1);
else begin writeln ('Wrong input data');
readln;
end;
end;
end else writeln ('Wrong input data');
until c = 4;
end. |
|
2) Функция Center(s1,s2,l). Центрирование - расположение строки s1 в середине строки s2 длины l.
| 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
| program MYstring;
var len1, len2:byte;
s1, s2: string;
function center (s1,s2:string; len1,len2:byte):string;
var res:string;
ind,i1,i2:integer;
begin
res := s1;
res[0] := chr(len1+len2);
ind := len1 div 2;
i1 := len1+len2;
i2 := len1;
repeat
res[i1] := res[i2];
dec(i2); dec(i1);
until i2=ind;
for i1 := 1 to len2 do res[ind+i1] := s2[i1];
center := res;
end;
begin
repeat
writeln('Input string:');
readln (s2);
readln (s1);
len1 := ord(s1[0]);
len2 := ord(s2[0]);
if len1+len2>255 then writeln ('Wrong input data');
until len1+len2 <= 255;
writeln (center(s1,s2,len1,len2));
writeln ('Enter from EXIT');
readln;
end. |
|
Может кому пригодится!
Добавлено через 20 часов 15 минут
3) Дано 100 целых чисел от 1 до 50. Определить сколько среди них чисел Фибоначчи и сколько чисел,
первая значищая цифра в дисятичной записи которых является 1 или 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
| Program Primer;
const f:set of byte=[0,1,2,3,5,8,13,21,34];
N=10;
var i,k,count_f,count_n:integer;
a:array [1..100] of integer;
begin
count_f:=0;
count_n:=0;
for i:=1 to N do
begin
read(a[i]);
end;
for i:=1 to N do
begin
if a[i] in f then
inc(count_f);
end;
for i:=1 to N do
begin
if a[i] in [1,2,10..29] then
inc(count_n);
end;
writeln;
writeln('Fibonachi - ',count_f);
readln;
writeln('Numbers 1,2 - ',count_n);
readln;
end. |
|
4) Даны целые числа а1,...,аn (могут быть повторяющиеся). Вывести на печать все числа,
которые входят в последовательность по одному разу.
| 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
| Program primer;
type set_int=set of byte;
var a:set_int;
i,N,k,min,max:integer;
begin
writeln('input number of integer(less than 256)');
read(N);
writeln('input min and max number in set');
read(min,max);
for i:=1 to N do
begin
read(k);
a:=a+[k];
end;
for i:= min to max do
begin
if i in a then
write(1, ' ');
end;
readln;
end. |
|
5) Дана непустая последовательность слов из строчных русских букв, между соседними
словами - запятая, за последним словом - точка. Напечатать в алфавитном порядке все
гласные буквы, которые входят в каждое слово.
| 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
| Program Primer;
const vowels:set of char=['*', 'Ґ', 'Ё', '®', 'г', 'л', 'н', 'о', 'п'];
var tmp_char:set of char;
s,tmp:string;
i,k:integer;
begin
repeat
writeln('input any string');
readln(s);
until s <> '';
delete(s,length(s),1);
s:=s+',';
while pos(',',s) > 0 do
begin
k:=pos(',',s);
tmp:=copy(s, 1, k-1);
s:=copy(s,k+1,length(s));
write(tmp, ' = ');
for i:=1 to length(tmp) do
begin
if (tmp[i] in vowels) and not(tmp[i] in tmp_char) then
begin
write(tmp[i]);
tmp_char:= tmp_char + [tmp[i]];
end;
end;
writeln;
tmp_char:=[];
end;
readln;
end. |
|
6) Простейшие алгоритмы сортировки: сортировка «прямого выбора», сортировка «двоичного включения», сортировка «обмена» (метод пузырька); оценка ефективности всех сортировок.
| 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 Metodi_Sort;
uses crt,dos;
const n=15;
type mas=array [1..n] of integer;
var A,B:mas;
h1,h2,m2,m1,s1,s2,ms1,ms2:word;
t1,t2,t:longint;
Procedure Input (var X:mas; m:integer);
var i:integer;
begin
randomize;
for i:=1 to m do
X[i]:=random(15);
end;
Procedure Output (X:mas; m:integer);
var i:integer;
begin
writeln;
for i:=1 to m do
write(x[i],' ');
writeln;
end;
Procedure Pyzirek (var X:mas; m:integer); {metod Pyzirka}
var i,j,y:integer;
begin
for i:=2 to m do
for j:=m downto i do
if x[j-1]>x[j] then begin
y:=x[j-1];
x[j-1]:=x[j];
x[j]:=y;
end;
end;
Procedure Insertion (var X:mas; m:integer); {metod Prymogo vklucheniy}
var
i,j,left,right,y: integer;
begin
for i:=2 to m do
begin
y:=X[i];
left:=1;
right:=i-1;
while (left<=right) do
begin
m:=(left+right) div 2;
if y<X[m] then right:=m-1
else left:=m+1;
end;
for j:=i-1 downto left do
X[j+1]:=X[j];
X[left]:=y;
end;
end;
Procedure Selection (var X:mas; m:integer); {metod prymogo vibora}
var
i, j, k, y:integer;
begin
for i:=1 to m-1 do
begin
k:=i; y:=X[i];
for j:=i+1 to m do
if X[j]<y then
begin
k:=j;
y:=X[j];
end;
X[k]:=X[i];
X[i]:=y;
end;
end;
begin
clrscr;
write('Massiv:');
Input(A,n);
Output(A,n);
B:=A;
writeln;
write('Metod Pyzirka');
gettime(h1,m1,s1,ms1);
Pyzirek(A,n);
gettime(h2,m2,s2,ms2);
t1:=h1*360000+m1*6000+s1*100+ms1;
t2:=h2*360000+m2*6000+s2*100+ms2;
t:=abs(t2-t1);
Output(A,n);
write('Time: ',t);
A:=B;
writeln;
writeln;
write('Metod Dvoichnogo Vklycheniy');
gettime(h1,m1,s1,ms1);
Insertion(A,n);
gettime(h2,m2,s2,ms2);
t1:=h1*360000+m1*6000+s1*100+ms1;
t2:=h2*360000+m2*6000+s2*100+ms2;
t:=abs(t2-t1);
Output(A,n);
write('Time: ',t);
writeln;
A:=B;
writeln;
write('Metod Prymogo Vibora');
gettime(h1,m1,s1,ms1);
Selection(A,n);
gettime(h2,m2,s2,ms2);
t1:=h1*360000+m1*6000+s1*100+ms1;
t2:=h2*360000+m2*6000+s2*100+ms2;
t:=abs(t2-t1);
Output(A,n);
write('Time: ',t);
readln;
end. |
|
7) Даны натуральные числа n,m найти наибольший общий делитель Nod(n,m). Для рекурсивной процедуры используйте соотношение Nod(n,m)=Nod(m,r), где r – остаток от деление n на m; Пример с итерацией и рекурсией.
| 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
| Program iNOD_rekursiy;
var k,l:integer;
rez:integer;
function iNOD_1 (k1,l1:integer):integer;
var m1:integer;
begin
m1:=k1 mod l1;
if m1=0 then iNOD_1:=l1
else iNOD_1:=iNOD_1(l1,m1);
end;
function iNOD_2 (k1,l1:integer):integer;
var m1:integer;
begin
while l1>0 do begin
m1:=k1 mod l1;
k1:=l1;
l1:=m1;
end;
iNOD_2:=k1;
end;
begin
writeln('vvedite 2 chisla ');
readln(k,l);
rez:=iNOD_1(k,l);
writeln('Iteratsia: NOD ',rez);
writeln('vvedite 2 chisla ');
readln(k,l);
rez:=iNOD_2(k,l);
writeln('Rekursiy: NOD ',rez);
readln;
end. |
|
8) Напишите программу, которая будет содержать функции вычисления: 1) Суммы элементов квадратной матрицы; 2) Произведения элементов квадратной матрицы; 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
88
89
90
91
92
93
94
| Program Primer;
const n=2;
k=100;
type Array1=array[1..n,1..n] of integer;
var A:Array1;
s,p:longint;
t:integer;
Procedure InputRandom (var X:array1; m:integer);
var i,j:integer;
begin
randomize;
for i:=1 to m do
for j:=1 to m do
X[i,j]:=random(k);
end;
Procedure OutPut (X:Array1; m:integer);
var i,j:integer;
begin
for i:=1 to m do
begin
for j:=1 to m do
write(X[i,j],' ');
writeln;
end;
end;
function iSum (X:Array1; m:integer):longint;
var i,j:integer;
summa:longint;
begin
summa:=0;
for i:=1 to m do
for j:=1 to m do
summa:=summa+X[i,j];
iSum:=summa;
end;
function iProd (X:Array1; m:integer):longint;
var i,j:integer;
prod:longint;
begin
prod:=1;
for i:=1 to m do
for j:=1 to m do
prod:=prod*X[i,j];
iProd:=prod;
end;
Procedure Poisk (X:Array1; m:integer; t:integer);
var
i,j:integer;
begin
for i:=1 to m do
for j:=1 to m do
if x[i,j]=t then writeln('Iteratsiy: stroka ',i,' stolbets ',j);
end;
function rSum (X:Array1; i:integer; j:integer):integer;
begin
if (i=1) and (j=1) then rSum:=x[i,j]
else
if (j=1) then rSum:=x[i,j]+rSum(x,i-1,n)
else rSum:=x[i,j]+rSum(x,i,j-1);
end;
function rProd (X:Array1; i:integer; j:integer):longint;
begin
if (i=1) and (j=1) then rProd:=x[i,j]
else
if (j=1) then rProd:=x[i,j]*rProd(x,i-1,n)
else rProd:=x[i,j]*rProd(x,i,j-1);
end;
Procedure rPoisk (X:Array1; m:integer; t:integer);
var
i,j:integer;
begin
for i:=1 to m do
for j:=1 to m do
if x[i,j]=t then writeln('Rekyrsiy: stroka ',i,' stolbets ',j);
end;
begin
InputRandom(A,n);
OutPut(A,n);
writeln('Vvedite element dly poiska ');
readln(t);
writeln('Poisk:');
Poisk(A,n,t);
rPoisk(A,n,t);
s:=iSum(A,n);
writeln('Iteracionnoe reshenie: summa ',s);
p:=iProd(A,n);
writeln('Iteracionnoe reshenie: proizvedenie ',p);
s:=rSum(A,n,n);
writeln('Rekyrsivnoe reshenie: summa ',s);
p:=rProd(A,n,n);
writeln('Rekyrsivnoe reshenie: proizvedenie ',p);
readln;
end. |
|
9) Даны символьные файлы f1 и f2. Переписать с сохранением порядка следования компоненты файла f1 в f2, а компоненты f2 в f1. Использовать вспомогательный файл h.
| 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
| Program Primer;
const
namef1='f1.txt';
namef2='f2.txt';
nameh='h.txt';
var
f1,f2,h:file of char;
s:string;
b:char;
i:integer;
begin
writeln('Vvedite text y file1:');
readln(s);
assign(f1,namef1);
rewrite(f1);
for i:=1 to lenght(s) do
begin
b:=s[i];
write(f1,b);
end;
close(f1);
writeln('Vvedite text y file2:');
readln(s);
assign(f2,namef2);
rewrite(f2);
for i:=1 to lenght(s) do
begin
b:=s[i];
write(f2,b);
end;
close(f2);
{ f1->h f2->f1 h->f2 }
assign(h,nameh);
rewrite(h);
reset(f1);
while not eof(f1) do
begin
read(f1,b);
write(h,b);
end;
close(f1);
close(h);
reset(f1);
while not eof(f1) do
begin
read(f1,b);
write(b);
end;
writeln;
assign(f1,nameh);
rewrite(f1);
reset(f2);
while not eof(f2) do
begin
read(f2,b);
write(f1,b);
end;
close(f2);
close(f1);
reset(f2);
while not eof(f2) do
begin
read(f2,b);
write(b);
end;
writeln;
assign(f2,nameh);
rewrite(f2);
reset(h);
while not eof(h) do
begin
read(h,b);
write(f2,b);
end;
close(h);
close(f2);
reset(h);
while not eof(h) do
begin
read(h,b);
write(b);
end;
writeln;
readln
end. |
|
10) Дан файл 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
| program Primer;
uses crt;
const ran=10;
var f:file of real;
i,ch,n,x,nech,kkv,kvv,kvvv:real;kv:real;
y:longint;
begin
randomize;
clrscr;
writeln('vvedite kolichestvo cifr');
readln(n);
assign(f,'zad2_a');
rewrite(f);
for i:=0 to n-1 do
begin
x:=random(ran);
write(f,x);
end;
close(f);
reset(f);
while not eof(f) do
begin
read(f,x);
write(x,' ');
end;
writeln;
close(f);
reset(f);
while not eof(f) do
begin
read(f,x);
if x mod 2 =0 then begin
inc(ch);
if x mod 4<>0 then
inc(nech); end;
kv:=sqrt(x);
kvv:=trunc(kv);
if kvv mod 2 <>0 then
inc(kvvv);
end;
close(f);
writeln('tchetnux chisel ',ch);
writeln('ydvoenux nechetnux ',nech);
writeln('kvadratov nechetnux chisel ',kvv);
readkey;
end. |
|
11) Выполнить задание использовав динамическую память. Текст задан массивом указателей на n строк равной длины. Если в тексте менее n строк, то последние элементы массива равны nil. Если в операции над текстом указан номер отсутствующей строки, то такая операция не возможна.
| 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
| program one;
uses crt;
const m=50;
type pstring = ^string;
mas = array [1..m] of pstring;
var a: mas;
i,n,j: integer;
str: string;
st:string;
ch:char;
flag:boolean;
procedure transposition(var z:mas;i,j:integer);
var s:pstring;
begin
if (z[i]<> nil) and (z[j]<> nil) then
begin
s:=z[i];
z[i]:=z[j];
z[j]:=s;
end;
end;
begin
clrscr;
repeat
repeat
writeln('vvedite kol-vo strok (m>=50)');
readln(n);
if (n>50) or (n<0) then
begin
writeln('nekkoreknniy vvod');
end;
until (n<=50) and (n>=0);
writeln('vvedite postrochno vash text ');
flag:=true;
for i:=1 to n do
begin
new(a[i]);
readln(str);
a[i]^:=str;
end;
writeln;
writeln('vvedite nomer stroki');
readln(i);
writeln('vvedite nomer stoki');
readln(j);
if (i<=n) and (j<=n) and (i>0) and (j>0) then
begin
transposition(a,i,j);
writeln('text posle perestanovki strok');
for i:=1 to n do
writeln(a[i]^)
end
else writeln('Takoy stroki ne syshestvyet');
for i:=1 to n do
begin
dispose(a[i]);
end;
writeln('dlya povtore najmi e');
writeln('dlya vixoda enter');
ch:=readkey;
until ord(ch)<>101;
readln;
end. |
|
12) Выполнить задание использовав внутреннее представление данных в виде однонаправленного списка и реализовав операции по созданию и удалению списка.
| 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
| program vvod;
uses crt;
type pt=^elem;
elem=record
data:integer;
next:pt;
end;
var ptr:pt;
i,n,k:integer;
procedure init (var z:pt;k:integer);
var
u:pt;
begin
new(u);
u^.data:=k;
u^.next:=z;
z:=u;
end;
procedure out(z:pt);
begin
while z <> nil do
begin
write(z^.data,' ');
z:=z^.next;
end;
end;
procedure del(var z:pt);
var u:pt;
begin
u:=z;
z:=z^.next;
dispose(u);
end;
function element(var z:pt):boolean;
var p1,p2:pt;
ch:boolean;
begin
p1:=z;
p2:=p1^.next;
ch:=false;
while p1<>nil do
begin
while p2 <> nil do
begin
if p1^.data=p2^.data then ch:=true;
p2:=p2^.next;
end;
p1:= p1^.next;
if p1<>nil then p2:=p1^.next;
if ch=true then
break;
end;
element:=ch;
end;
begin
clrscr;
writeln('vvedite kol-vo simvolov');
readln(n);
writeln('vvod');
ptr:=nil;
for i:=1 to n do
begin
readln(k);
init(ptr,k);
end;
{writeln('spisok ');
out(ptr);}
if (element(ptr)) then writeln('TRUE')
else writeln('FALSE');
while ptr<> nil do del(ptr);
readln;
end. |
|
3
|
(
Сообщение от odip
