Все задачи паскаль с решением

10 задач с решениями программированием на Паскале.
Условие: Найти среднее арифметическое общей совокупности элементов тех строк заданной матрицы, последний элемент которых равен 1. type m=array[1..100,1..100] of integer; procedure vvod(m,n:integer;var x:m); begin writeln('введите элементы массива'); procedure arf(m,n:integer;var x:m); for i:=1 to m do begin s:=0; sr:=0; if x[i,n]=1 then begin. writeln ('среднее арифметическое ',i,' строки равно ',sr:5:2); end; end; Условие: Получить массив Х(n) по правилу: Х i =1, если в i-м столбце заданной матрицы есть хотя бы один элемент превышающий заданное значение С, иначе X i =0. Найти общее число элементов, больших С. type m=array[1..100,1..100] of integer; mas=array[1..100] of integer; procedure vvod(m,n:integer;var x:m); begin writeln('введите элементы массива'); 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; 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('число элементов матрици превышающих число ',c,' равно ',k) Условие: Дан массив 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); writeln('введите элементы массива'); procedure mat(m,n:integer;var x:m); var i,j: integer; t:real; writeln('изменённый матрица A[i,j] будет выглядеть так'); if i>j then if x[i,j] > x[j,i] then x[i,j]:=(x[i,j]+x[j,i])/2; Условие: Определить самую длинную последовательность подряд идущих нулей в заданном одномерном массиве. type m=array[1..100] of integer; procedure vvod(m:integer;var x:m); begin writeln('введите элементы массива'); procedure moped(m:integer;var x:m); if x[i]=0 then k:=k+1. writeln('самая большая последовательность нулей состовляет ',k) writeln('самая большая последовательность нулей состовляет ',n); Написать программу, считывающую заданное количество одномерных массивов, определяющую минимальный элемент в каждом из них и подсчитывающую количество нулей среди элементов, расположенных за минимальным.

type m=array[1..100] of integer; mas=array[1..10] of m; for k:=1 to kn do begin. writeln('введите кол-во эл-ов в ',k,'-ом массиве');read (t); writeln('теперь введите элементы этого массива'); if y[i] 0 do begin k:=k+1;delete(st,pos('мама',st),4); end; writeln('кол-во слов мама в ',i,'-ой строке ',k);end;end; Условие: Дан массив из 7 строк, в каждой из которых не более 50 элементов. Удалить из каждой строки все пробелы и записать количество удалённых пробелов в конец этой строки. type s=string[50]; ms=array[1..100] of s; procedure vvod(m:integer;var x:ms); for i:=1 to m do begin writeln('введите ',i,'-ю строку'); procedure prob(m:integer;var x:ms); for i:=1 to m do begin. while pos(' ',st)<>0 do begin delete(st,pos(' ',st),1);k:=k+1;end; insert(p,st,length(st)+1); writeln(i,'-ая строка:', st);end; Условие: В текстовом файле отсортировать строки по возрастанию их длин.

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); begin writeln('введите ',i,'-ю строку');readln(s); procedure w(var f:ft); begin writeln('измененный фаил будет выглядеть так:'); while not eof(f) do begin readln(f,s); writeln(s) begin writeln('введите кол-во строк в файле'); readln(k); while not eof(f1) do. begin for i:=1 to k do begin readln(f1,s); A[i]:=s;end;end; if length(a[i]) a[i-1] then begin. 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]); procedure w(var f:fi); while not eof(f) do begin. writeln('Задайте кол-во компонентов файла');readln(n);

Условие: Записать в конец каждой строки текстового файла количество слов в этой строки. 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); begin writeln('введите ',i,'-ю строку');readln(s); procedure kslov(var f:ft); var s,pk,p:string;k:integer; buf:ft; while not eof(f) do begin k:=0;readln(f,s); while pos(' ',p)>1 do begin k:=k+1; delete(p,1,pos(' ',p));end; procedure w(var f:ft); begin writeln('измененный фаил будет выглядеть так:'); while not eof(f) do begin readln(f,s); writeln(s) writeln('введите кол-во строк в файле'); readln(k);


Новинки: