Завдання 1.
Умова: Знайти середнє арифметичне загальної сукупності елементів тих рядків заданої матриці, останній елемент яких дорівнює 1.
Програма:
program S2_Z1;
type m = array [1 .. 100,1 .. 100] of integer;
var A: m;
procedure vvod (m, n: integer; var x: m);
var i, j: integer;
begin writeln ('введіть елементи масиву');
for i: = 1 to m do
for j: = 1 to n do
read (x [i, j]);
end;
procedure arf (m, n: integer; var x: m);
var i, j, s: integer; sr: real;
begin
for i: = 1 to m do begin s: = 0; sr: = 0;
if x [i, n] = 1 then begin
for j: = 1 to n do
s: = s + x [i, j]; sr: = s / n;
writeln ('середнє арифметичне', i, 'рядка дорівнює', sr: 5:2); end; end;
end;
begin
vvod (3,3, A);
arf (3,3, A);
end.
Завдання 2.
Умова: Отримати масив Х (n) за правилом: Х i
= 1, якщо в i-му стовпці заданої матриці є хоча б один елемент перевищує задане значення С, інакше X i = 0. Знайти загальне число елементів, великих С.
Програма:
program S2_Z2;
type m = array [1 .. 100,1 .. 100] of integer; mas = array [1 .. 100] of integer;
var A: m;
procedure vvod (m, n: integer; var x: m);
var i, j: integer;
begin writeln ('введіть елементи масиву');
for i: = 1 to m do
for j: = 1 to n do
read (x [i, j]);
end;
procedure moped (m, n: integer; var y: m);
var i, j, c, k: integer; X: mas;
begin k: = 0; writeln ('введіть величину С ='); readln (c);
for j: = 1 to n do x [j]: = 0;
for j: = 1 to n do
for i: = 1 to m do
if y [i, j]> c then begin X [j]: = 1; k: = k +1; end;
writeln ('елементи масиву Х:');
for j: = 1 to n do write (X [j], '');
writeln;
writeln ('кількість елементів матриці перевищують число', c, 'одно', k)
end;
begin
vvod (2,5, A); moped (2,5, A); readln;
end.
Завдання 3.
Умова: Дано масив A (5,5). Змінити частина матриці, що знаходиться під головною діагоналлю наступним чином: якщо елемент A [i, j] цієї частини матриці більше елемента A [j, i], то задати елементу A [i, j] нове значення, рівне підлозі сумі двох цих елементів.
Програма:
program S2_Z3;
type m = array [1 .. 100,1 .. 100] of real;
var A: m;
procedure vvod (m, n: integer; var x: m);
var i, j: integer;
begin
writeln ('введіть елементи масиву');
for i: = 1 to m do
for j: = 1 to n do
read (x [i, j]);
end;
procedure mat (m, n: integer; var x: m);
var i, j: integer; t: real;
begin
writeln ('змінений матриця A [i, j] буде виглядати так');
for i: = 1 to m do
for j: = 1 to n do
if i> j then if x [i, j]> x [j, i] then x [i, j]: = (x [i, j] + x [j, i]) / 2;
for i: = 1 to m do
for j: = 1 to n do
write (A [i, j]: 2:1, '');
end;
begin
vvod (5,5, A);
mat (5,5, A);
end.
Завдання 4.
Умова: Визначити саму довгу послідовність поспіль нулів в заданому одновимірному масиві.
Програма:
program S2_Z4;
type m = array [1 .. 100] of integer;
var A: m;
procedure vvod (m: integer; var x: m);
var i: integer;
begin writeln ('введіть елементи масиву');
for i: = 1 to m do
read (x [i]);
end;
procedure moped (m: integer; var x: m);
var i, k, n: integer;
begin k: = 0; n: = 0;
for i: = 1 to m do
if x [i] = 0 then k: = k +1
else begin
if x [i-1] = 0 then
if k> n then n: = k;
k: = 0; end;
if k> n then
writeln ('найбільша послідовність нулів состовляет', k)
else
writeln ('найбільша послідовність нулів состовляет', n);
end;
begin
vvod (20, A); moped (20, A);
end.
Завдання 5.
Написати програму, що прочитує задану кількість одновимірних масивів, визначальну мінімальний елемент у кожному з них і підраховують кількість нулів серед елементів, розташованих за мінімальним.
Програма:
program S2_Z5;
type m = array [1 .. 100] of integer; mas = array [1 .. 10] of m;
var A: mas;
procedure vvod (kn: integer; x: mas);
var y: m; i, t, k, min, k0: integer;
begin
for k: = 1 to kn do begin
k0: = 0; min: = 1000;
writeln ('введіть кол-во ел-ів в', k, '-му масиві'); read (t);
writeln ('тепер введіть елементи цього масиву');
for i: = 1 to t do
read (y [i]);
for i: = 1 to t do
if y [i] writeln ('мінімальний елемент цього масиву дорівнює', min);
for i: = 1 to t do
if y [i] = min then for i: = i to t do
if y [i] = 0 then k0: = k0 +1;
writeln ('кількість нулів масиву після мінімального значення одно', k0);
write;
write;
end;
end;
begin
vvod (5, A);
end.
Завдання 6.
Умова: Написати програму підраховують в кожній із заданих рядків кількість слів `мама`.
Програма:
program S2_Z6;
type str = string [100]; ms = array [1 .. 100] of str;
var A: ms;
procedure vvod (m: integer; var x: ms);
var i: integer;
begin
for i: = 1 to m do begin writeln ('введіть', i, '-й рядок');
readln (A [i]); end; end;
procedure moped (m: integer; var x: ms);
var i, k: integer; st: str;
begin
for i: = 1 to m do begin k: = 0;
st: = A [i];
while pos ('мама', st) <> 0 do begin k: = k +1; delete (st, pos ('мама', st), 4); end;
writeln ('к-ть слів мама в', i, '-ої рядку', k); end; end;
begin
vvod (5, A);
moped (5, A);
end.
Завдання 7.
Умова: Дано масив з 7 рядків, в кожному з яких не більше 50 елементів. Видалити з кожного рядка всі прогалини і записати кількість віддалених прогалин в кінець цього рядка.
Програма:
program S2_Z7;
type s = string [50]; ms = array [1 .. 100] of s;
var A: ms;
procedure vvod (m: integer; var x: ms);
var i: integer;
begin
for i: = 1 to m do begin writeln ('введіть', i, '-й рядок');
readln (A [i]); end; end;
procedure prob (m: integer; var x: ms);
var i, k: integer; st, p: s;
begin
for i: = 1 to m do begin
st: = x [i]; k: = 0;
while pos ('', st) <> 0 do begin delete (st, pos ('', st), 1); k: = k +1; end;
str (k, p);
insert (p, st, length (st) +1); writeln (i, '-ий рядок:', st); end;
end;
begin
vvod (7, A); prob (7, A);
end.
Завдання 8.
Умова: У текстовому файлі відсортувати рядки за зростанням їх довжин.
Прграмма:
program S2_Z8;
type ft = text; mas = array [1 .. 100] of string;
var f1: ft; k, i, j: integer; s: string; A: mas;
procedure sozd (var f: ft; n: integer);
var i: integer; s: string;
begin assign (f, 'c: \ 1.txt'); rewrite (f);
for i: = 1 to n do
begin writeln ('введіть', i, '-й рядок'); readln (s);
writeln (f, s);
end; close (f);
end;
procedure w (var f: ft);
var s: string;
begin writeln ('змінений фаил буде виглядати так:');
reset (f);
while not eof (f) do begin readln (f, s); writeln (s)
end; close (f);
end;
begin writeln ('введіть кількість рядків у файлі'); readln (k);
sozd (f1, k);
reset (f1);
while not eof (f1) do
begin for i: = 1 to k do begin readln (f1, s); A [i]: = s; end; end;
for j: = 1 to k do
for i: = 1 to k do
if length (a [i]) s: = a [i]; a [i]: = a [i-1]; a [i-1]: = s; end;
close (f1);
rewrite (f1);
for i: = 1 to k do writeln (f1, a [i]);
close (f1);
w (f1);
end.
Завдання 9.
Умова: У файлі з дійсних чисел переставити елементи таким чином, щоб спочатку були записані всі позитивні, потім всі негативні, а потім усі нулі.
Програма:
program S2_Z9;
type fi = file of integer; m = array [1 .. 100] of integer;
var f1: fi; n: integer;
procedure vvod (n: integer; var f: fi);
var i, a: integer;
begin
assign (f, 'c: \ f.int');
rewrite (f);
writeln ('Введіть компоненти файлу');
for i: = 1 to n do begin
read (a); write (f, a); end;
close (f);
end;
procedure sort (n: integer; var f: fi);
var buf: fi; s, i, j, k: integer; a: m;
begin
reset (f);
assign (buf, 'c: \ buf.int');
rewrite (buf);
while not eof (f) do begin
for i: = 1 to n do begin read (f, s); A [i]: = s; end; end;
for j: = 1 to n do
for i: = 1 to n do
if a [i]> a [i-1] then begin
s: = a [i]; a [i]: = a [i-1]; a [i-1]: = s; end;
k: = 0;
for i: = 1 to n do
if a [i] = 0 then begin s: = a [i]; a [i]: = a [nk]; a [nk]: = s; k: = k +1; end;
for i: = 1 to n do write (buf, a [i]);
close (buf); close (f);
erase (f);
rename (buf, 'c: \ f.int');
end;
procedure w (var f: fi);
var a: integer;
begin
reset (f);
while not eof (f) do begin
read (f, a); write (a: 4); end;
end;
begin
writeln ('Задайте кількість компонентів файлу'); readln (n);
vvod (n, f1);
sort (n, f1);
w (f1);
write;
end.
Блок схема:
Завдання 10.
Умова: Записати в кінець кожного рядка текстового файлу кількість слів у цій рядка.
Програма:
program S2_Z10;
type ft = text; mas = array [1 .. 100] of string;
var f1: ft; k: integer;
procedure sozd (var f: ft; n: integer);
var i: integer; s: string;
begin assign (f, 'c: \ f.txt'); rewrite (f);
for i: = 1 to n do
begin writeln ('введіть', i, '-й рядок'); readln (s);
writeln (f, s);
end; close (f);
end;
procedure kslov (var f: ft);
var s, pk, p: string; k: integer; buf: ft;
begin
reset (f);
assign (buf, 'c: \ buf.txt');
rewrite (buf);
while not eof (f) do begin k: = 0; readln (f, s);
p: = s;
while pos ('', p)> 1 do begin k: = k +1; delete (p, 1, pos ('', p)); end;
str (k, pk); insert (pk, s, length (s) +1); writeln (buf, s); end;
close (f); close (buf);
erase (f);
rename (buf, 'c: \ f.txt');
end;
procedure w (var f: ft);
var s: string;
begin writeln ('змінений фаил буде виглядати так:');
reset (f);
while not eof (f) do begin readln (f, s); writeln (s)
end; close (f);
end;
begin
writeln ('введіть кількість рядків у файлі'); readln (k);
sozd (f1, k); kslov (f1); w (f1);
end.
Блок схема:
fi); </P><P> var buf: fi; s, i, j, k: integer; a: m; </P><P> begin </P><P> reset (f); </P><P> assign (buf, 'c: \ buf.int'); </P><P> rewrite (buf); </P><P> while not eof (f) do begin </P><P> for i: = 1 to n do begin read (f, s); A [i]: = s; end; end; </P><P> for j: = 1 to n do </P><P> for i: = 1 to n do </P><P> if a [i]> a [i-1] then begin </P><P> s: = a [i]; a [i]: = a [i-1]; a [i-1]: = s; end; </P><P> k: = 0; </P><P> for i: = 1 to n do </P><P> if a [i] = 0 then begin s: = a [i]; a [i]: = a [nk]; a [nk]: = s; k: = k +1; end; </P><P> for i: = 1 to n do write (buf, a [i]); </P><P> close (buf); close (f); </P><P> erase (f); </P><P> rename (buf, 'c: \ f.int'); </P><P> end; </P><br><P> procedure w (var f: fi); </P><P> var a: integer; </P><P> begin </P><P> reset (f); </P><P> while not eof (f) do begin </P><P> read (f, a); write (a: 4); end; </P><P> end; </P><br><P> begin </P><P> writeln ('Задайте кількість компонентів файлу'); readln (n); </P><P> vvod (n, f1); </P><P> sort (n, f1); </P><P> w (f1); </P><P> write; </P><P> end. </P><br><P> Блок схема: </P><br><P> Завдання 10. </P><P> Умова: Записати в кінець кожного рядка текстового файлу кількість слів у цій рядка. </P><br><P> Програма: </P><P> program S2_Z10; </P><P> type ft = text; mas = array [1 .. 100] of string; </P><P> var f1: ft; k: integer; </P><br><P> procedure sozd (var f: ft; n: integer); </P><P> var i: integer; s: string; </P><P> begin assign (f, 'c: \ f.txt'); rewrite (f); </P><P> for i: = 1 to n do </P><P> begin writeln ('введіть', i, '-й рядок'); readln (s); </P><P> writeln (f, s); </P><P> end; close (f); </P><P> end; </P><br><P> procedure kslov (var f: ft); </P><P> var s, pk, p: string; k: integer; buf: ft; </P><P> begin </P><P> reset (f); </P><P> assign (buf, 'c: \ buf.txt'); </P><P> rewrite (buf); </P><P> while not eof (f) do begin k: = 0; readln (f, s); </P><P> p: = s; </P><P> while pos ('', p)> 1 do begin k: = k +1; delete (p, 1, pos ('', p)); end; </P><P> str (k, pk); insert (pk, s, length (s) +1); writeln (buf, s); end; </P><P> close (f); close (buf); </P><P> erase (f); </P><P> rename (buf, 'c: \ f.txt'); </P><P> end; </P><br><P> procedure w (var f: ft); </P><P> var s: string; </P><P> begin writeln ('змінений фаил буде виглядати так:'); </P><P> reset (f); </P><P> while not eof (f) do begin readln (f, s); writeln (s) </P><P> end; close (f); </P><P> end; </P><br><P> begin </P><P> writeln ('введіть кількість рядків у файлі'); readln (k); </P><P> sozd (f1, k); kslov (f1); w (f1); </P><P> end. </P><h2> Блок схема: </h2></min>
</div>