10 задач с решениями программированием на Паскале
Задача 1.
Условие: Найти среднее арифметическое общей совокупности элементов тех строк заданной матрицы, последний элемент которых равен 1.
program S2Z1;
type m=array[1.. 100,1.. 100] of integer;
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
if x[i,n]=1 then begin
for j:=1 to n do
s:=s+x[i,j]; sr:=s/n;
end;
begin
end.
Задача 2.
Условие: Получить массив Х(n) по правилу: Хi
=1, если в i-м столбце заданной матрицы есть хотя бы один элемент превышающий заданное значение С, иначе Xi
=0. Найти общее число элементов, больших С.
procedure vvod(m,n:integer;var x:m);
begin writeln('введите элементы массива');
for j:=1 to n do
read(x[i,j]);
end;
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
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
end.
Задача 3.
Условие: Дан массив A(5,5). Изменить часть матрицы, находящуюся под главной диагональю следующим образом: если элемент A[i,j] этой части матрицы больше элемента A[j,i], то задать элементу A[i,j] новое значение, равное полу сумме двух этих элементов.
Программа:
type m=array[1.. 100,1.. 100] of real;
procedure vvod(m,n:integer;var x:m);
var i,j: integer;
begin
writeln('введите элементы массива');
for j:=1 to n do
read(x[i,j]);
end;
var i,j: integer; t:real;
begin
writeln('изменённый матрица A[i,j] будет выглядеть так');
for i:=1 to m do
for j:=1 to n do
>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 S2Z4;
type m=array[1.. 100] of integer;
var A:m;
procedure vvod(m:integer;var x:m);
var i: integer;
begin writeln('введите элементы массива');
read(x[i]);
end;
procedure moped(m:integer;var x:m);
var i,k,n:integer;
begin k:=0;n:=0;
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
end.
Задача 5.
Написать программу, считывающую заданное количество одномерных массивов, определяющую минимальный элемент в каждом из них и подсчитывающую количество нулей среди элементов, расположенных за минимальным.
Программа:
program S2Z5;
type m=array[1.. 100] of integer; mas=array[1.. 10] of m;
var A:mas;
var y:m;i,t,k,min,k0:integer;
begin
k0:=0; min:=1000;
writeln('теперь введите элементы этого массива');
for i:=1 to t do
read(y[i]);
for i:=1 to t do
if y[i]<min then min:=y[i];
writeln('минимальный элемент этого массива равен ',min);
for i:=1 to t do
if y[i]=0 then k0:=k0+1;
writeln('количество нулей массива после минимального значения равно ',k0);
write;
end;
end;
begin
end.
Условие: Написать программу подсчитывающую в каждой из заданных строк количество слов `мама`.
program S2Z6;
type str=string[100]; ms=array[1.. 100] of str;
var A: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);
begin
for i:=1 to m do begin k:=0;
while pos('мама',st)<>0 do begin k:=k+1;delete(st,pos('мама',st),4); end;
writeln('кол-во слов мама в ',i,'-ой строке ',k);end;end;
begin
vvod(5,A);
end.
Задача 7.
Условие: Дан массив из 7 строк, в каждой из которых не более 50 элементов. Удалить из каждой строки все пробелы и записать количество удалённых пробелов в конец этой строки.
Программа:
type s=string[50]; ms=array[1.. 100] of s;
var A:ms;
procedure vvod(m:integer;var x:ms);
var i:integer;
begin
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;
<>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.
Условие: В текстовом файле отсортировать строки по возрастанию их длин.
Прграмма:
type ft=text; mas=array[1.. 100] of string;
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
writeln(f,s);
end; close(f);
end;
procedure w(var f:ft);
var s:string;
reset(f);
while not eof(f) do begin readln(f,s); writeln(s)
end; close(f);
end;
begin writeln('введите кол-во строк в файле'); readln(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])<length(a[i-1]) then begin
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]);
w(f1);
end.
Задача 9.
Условие: В файле из вещественных чисел переставить элементы таким образом, чтобы сначала были записаны все положительные, затем все отрицательные, а потом все нули.
program S2Z9;
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
close (f);
end;
var buf:fi;s,i,j,k:integer; a:m;
begin
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 i:=1 to n do
>a[i-1] then begin
k:=0;
for i:=1 to n do
if a[i]=0 then begin s:=a[i];a[i]:=a[n-k];a[n-k]:=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);
begin
while not eof(f) do begin
read(f,a);write(a:4);end;
end;
begin
vvod(n,f1);
sort(n,f1);
write;
end.
Блок схема:
Условие: Записать в конец каждой строки текстового файла количество слов в этой строки.
Программа:
program S2Z10;
type ft=text; mas=array[1.. 100] of string;
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
writeln(f,s);
end; close(f);
end;
procedure kslov(var f:ft);
var s,pk,p:string;k:integer; buf:ft;
begin
reset(f);
while not eof(f) do begin k:=0;readln(f,s);
p:=s;
>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);
rename(buf,'c:\f.txt');
end;
var s:string;
begin writeln('измененный фаил будет выглядеть так:');
reset(f);
while not eof(f) do begin readln(f,s); writeln(s)
end; close(f);
end;
begin
end.
Блок схема:
|