Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Предоплата всего
Подписываем
Минимальный элемент массива и его порядковый номер
program pr;
uses crt;
var
mas: array[1..10] of integer;
i,min,ind: integer;
Begin
randomize;
For i:=1 to 10 do
Begin
mas[i]:=Random(40)+20 ;
write(mas[i], ' ');
End;
writeln();
writeln();
min:=mas[1];
For i:=1 to 10 do
Begin
If (min>mas[i]) then
Begin
min:=mas[i];
ind:=i;
End;
End;
write('Минимальный элемент массива: ',min, ' ,находится на ', ind, ' месте');
End.
среднее арифметическое элементов массива
uses crt;
var n,k,sa,sum:real;
x:array[1..20]of real;
begin
clrscr; {очищаем экран}
sum:=0;
write('Vvedite razmer massiva n = '); readln(n); {ввод кол-ва членов массива}
writeln('Vvedite massiv');
for k:=1 to n do
begin
readln(x[k]); {ввод массива}
sum:=sum+x[k] {подсчет суммы всех его членов}
end;
sa:=sum/n;
writeln('Srednee arifmeticheskoe massiva: ',sa); {вывод на экран переменной SA}
readkey;
end.
Определить минимальный положитеьный элемент массива
program mas;
uses crt;
label 1;
var a: array [1..10] of integer;
i,min,k: integer;
begin
clrscr;
k:=0;
for i:=1 to 10 do
begin
write('a[',i,']= ');
readln(a[i]);
end;
min:=32767;
for i:=1 to 10 do
if (a[i]<min) and (a[i]>0) then min:= a[i]
else k:=k+1;
if k=10 then
begin
writeln('нету положительных элементов');
goto 1;
end;
writeln('min= ',min);
1:readln;
end.
Сумма положительных и отрицательных элементов массива
Program Summa;
uses crt;
type
mas= array [1..30,1..30] of integer;
var i,j,n,m,s:integer;
a:mas;
Procedure Sum;
begin
S:=0;
for i:=1 to m do
begin
if a[i]>0 then s:=s+a[i];
write(a[i],' ');
end;
begin
writeln('введите размеры массива');
readln(n,m);
writeln('введите ',n*m,' элементов массива');
For i:=1 to n do
For j:=1 to m do
read(a[i,j]);
writeln('Массив:');
For i:=1 to n do
begin
For j:=1 to m do
write(a[i,j]:4);
writeln;
end;
end.
Удаление отрицательных элементовмассива
uses crt;
var a:array[1..50]of integer;
n,i,j:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
writeln('Massiv:');
for i:=1 to n do
begin
a[i]:=random(10)-4;
write(a[i],' ');
end;
writeln;
i:=1;
while i<=n do
begin
if a[i]<0then //если <0
begin
for j:=i to n-1 do//то сдвигаем массив на 1 влево
a[j]:=a[j+1];
n:=n-1;//уменьшаем длину массива на 1
end
else i:=i+1;//если нет, переходим к следующему
end;
writeln('Rezultat:');
for i:=1 to n do
write(a[i],' ');
readln
end.
Удалить положительные элементы массива, стоящие на нечетных местах
uses crt;
var a:array[1..50]of integer;
n,i,j,k:integer;
begin
clrscr;
randomize;
write('n=');readln(n);
writeln('Massiv:');
for i:=1 to n do
begin
a[i]:=random(50)-10;
write(a[i],' ');
end;
writeln;
i:=n;{начнем с конца, чтобы не менялись индексы еще не просмотренных элементов}
while i>=1 do
begin
if (a[i]>0)and odd(i) then{если положительное и номер нечетный (odd) }
begin
for j:=i to n-1 do{к этому элементу сдвинем конец массива}
a[j]:=a[j+1];{на 1, элемент исчезнет}
n:=n-1;{уменьшим размер массива}
end;
i:=i-1;{перейдем к следующему слева}
end;
writeln('Rezultat:');
for i:=1 to n do
write(a[i],' ');
readln
end.
Количество элементов массива кратных 7
uses
crt;
var
a:array[1..1000] of integer;
i,k,n:integer;
begin
writeln('wvedite razmernost matrici');
readln(n);
writeln('wvedite massiv razmerom ',n,' x ',n);
for i:= 1 to n do
read(a[i]);
k:=0;
for i:= 1 to n do
begin
if a[i] mod 7 = 0 then
k:=k+1;
end;
writeln('kol-vo takih shisel ravno ',k);
readkey
end.
Среднее арифмтическое положиельных элементов массива
var
a:array[1..20] of integer;
s, i:integer;
begin
clrscr;
for i:=1 to 20 do
readln(a[i]);
s:=0;
for i:=1 to 20 do
if a[i]>0 then s:=s+a[i];
writeln(s/20);
readln;
end.
Вставить элемент в массив
var i,n,k,m:longint;
a:array [1..101] of longint;
begin
readln(n); {читаем длинну массива}
for i:=1 to n do {и сам массив}
read(a[i]);
readln(k); {читаем место, куда нужно вставить элемент}
readln(m); {читаем элемент}
for i:=n+1 downto k+1 do {сдвигаем элементы с N до K вправо}
a[i]:=a[i-1]; {на одну позицию}
a[k]:=m; {записываем новое число в A[k]}
for i:=1 to n+1 do
write(a[i],' ');
readln;
end.
Определить количество слов в строке
var s:string;
n,i,j,k,k1:byte;
begin
clrscr;
writeln('Введите последовательность слов, разделенных пробелами');
readln(s);
n:=pos(' ',s);
k1:=1;{если считать и первое слово, если нет, то k1:=0;}
i:=n+1;
while i<=length(s) do
if (s[i]<>' ')and ((s[i-1]=' ')or(i=1)) then{если буква, а перед ней пробел, или она первая}
begin
k:=i;j:=1;
while (s[k]<>' ')and(k<=length(s))do {пока не пробел и не конец строки}
begin
k:=k+1;{идем вперед}
j:=j+1;{длина слова}
end;
if j=n then k1:=k1+1;
i:=i+j;{перепрыгиваем}
end
else i:=i+1;
write('K=',k1);
readln
end.
Удаление пробелов в строке
uses
crt;
var
i: integer;
st: string;
begin
clrscr;
write('Vvedite stroku: ');
readln(st);
i:=1;
while st[1]=' ' do {удаляем пробелы в начале}
delete(st,1,1);
while i<=length(st) do
begin
if st[i]=' ' then
while (st[i+1]=' ') and (length(st)>=i) do {удаляем лишние пробелы между словами и в конце}
delete(st,i,1);
inc(i);
end;
write(st);
readkey;
end.
В строке перевернуть четные слова и удалить нечетные
uses crt;
var s,s1,s2:string;
c:char;
i,n:byte;
begin
clrscr;
writeln('Введите строку, слова отделены одним пробелом:');
readln(s);
s:=s+' ';
s2:='';
n:=0;
while pos(' ',s)>0 do
begin
s1:=copy(s,1,pos(' ',s)-1);
n:=n+1;
if n mod 2=0 then
begin
for i:=1 to length(s1) div 2 do
begin
c:=s1[i];
s1[i]:=s1[length(s1)-i+1];
s1[length(s1)-i+1]:=c;
end;
s2:=s2+s1+' ';
end;
delete(s,1,pos(' ',s));
end;
delete(s2,length(s2),1);
write(s2);
readln
end.
Слово максимальной длины
uses
crt;
const
dividers=[' ',',','.',';',':','-','=','+'];{дописать нужные}
var
s,max,temp:string;
i:integer;
begin
clrscr;
writeln('Введите строку...');
readln(s);
temp:='';
max:='';
{пробегаем всю строку посимвольно}
for i:=1 to length(s) do
begin
if not (s[i] in dividers) then
temp:=temp+s[i];
if (s[i] in dividers) or (i=length(s)) then
if temp<>'' then
begin
if length(temp)>length(max) then
max:=temp;
temp:='';
end;
end;
writeln('Самое длинное слово: ',max,'. В нем букв: ',length(max))
end.
Слово минимальной длины
s:= s + ' ';
m:= ord( s[0] );
min:= 100;
j:= 1;
for i:=1 to n do
begin
s1[j] := s1[j] + s[i];
if s[i] in zn
then
begin
numb[j] := i - length(s1[j]) + 1;
inc(j);
end;
for i:= 1 to j-1 do
begin
if length( s1[i] ) < min
then
begin
s_min := s1[i]; { минимальное длинной слово }
min := length( s1[i] ); { длинна }
k_min := numb[i] - min + 1; { позиция }
end;
сумма кодов всех элементов строки
uses crt;
var sum: integer;
i: byte;
s: string;
begin
write('s='); readln(s); //запрашиваем и считываем строку
for i:=1 to length(s) do //в цикле с параметром перебираем все элементы строки (length- функция определения длины строки)
inc(sum,ord(s[i])); //увеличиваем сумму на значение кода символа в таблице ASCII (inc - процедура увеличения, ord - возвращает номер символа)
writeln('Cумма=',sum); //вывод результата
readln;
end.
Сумма кодов чётных и нечетных слов
uses crt;
var s: string;
i,ns: byte;
suc,sun: integer;
begin
write('s='); readln(s);
for i:=length(s)-1 downto 1 do
if (s[i]=' ') and (s[i+1]=' ') then delete(s,i,1);
writeln('s=',s);
ns:=1;
for i:=1 to length(s) do
if s[i]<>' ' then
begin
if odd(ns) then inc(sun,ord(s[i])) else inc(suc,ord(s[i]));
end else inc(ns);
writeln('Сумма кодов четных слов=',suc);
writeln('Сумма кодов нечетных слов=',sun);
readln;
end.
Опрелить максимальное число в строке
uses crt;
const cf=['0'..'9'];
var s,s1,max:string;
i,j,k:byte;
c:char;
begin
clrscr;
writeln('Введите строку, содержащую числа:');
readln(s);
writeln('Числа в строке:');
i:=1;max:='0';k:=0;
while i<=length(s) do
if (s[i] in cf)and (not(s[i-1]in cf)or(i=1)) then{если цифра, а перед ней не цифра, или она первая}
begin
k:=i;s1:='';
while (s[k] in cf)and(k<=length(s))do {пока цифры и не конец строки}
begin
s1:=s1+s[k];
k:=k+1;{идем вперед}
end;
write(s1,' ');
if s1>max then max:=s1;{максимальное число}
i:=i+length(s1);{перепрыгиваем}
end
else i:=i+1;{иначе идем вперед}
writeln;
if k=0 then write('В строке нет чисел')
else write('Максимальное число=',max);
readln
end.
Минимальное число в строке
var S:string;
m,i,n,min:integer;
begin
writeln('vvedite posledovatelnost simvolov');
readln(s);
n:=1;
min:=1000;
For i:=1 to length(s) do
if (Ord(s[i])>=4) and (Ord(s[i])<=57) then
begin
m:=Ord(s[i])-48;
n:=n*10+m;
if n<min then
min:=n;
end
else
begin
n:=Ord(s[i]);
if n<min then
min:=n;
end;
writeln(min);
readln;
end.
Сумма цифр в строке
var
i,sum: integer;
s: string;
begin
{ чтение строки }
readln(s);
sum := 0;
for i:=1 to length(s) do
if s[i] in ['0'..'9'] then { если цифра }
sum := sum+(ord(s[i])-ord('0')); { Код цифры - код нуля -> число, которое
нужно прибавить к сумме }
writeln(sum);
end.
Произведние чисел в строке
var
s:string;
l,i:integer;
g:longint;
begin
writeln('Vvedite stroku:');
readln(s);
g:=1;
l:=length(s);
for i:=1 to l do
if s[i] in ['0'..'9'] then (ord(s[i])-48);
s:=s[i]*g;
writeln(s);
readln;
end.
Сколько раз встречается символ в строке
uses crt;
var
s:string;
countp,countz,i:word;
begin
clrscr;
countp:=0;countz:=0;
write('Введите строку: ');
readln(s);
for i:=1 to length(s) do begin
if s[i]='*' then inc(countz);
if s[i]='+' then inc(countp);
end;
writeln('В строке символов "+" : ',countp);
writeln('В строке символов "*" : ',countz);
readln;
end.
Удалить повторяющмеся символы
uses crt;
var s:string;
i,j:byte;
begin
clrscr;
writeln('Введите слово с повторябщимися символами');
readln(s);
i:=1;
while i<length(s) do
begin
for j:=length(s) downto i+1 do
if s[j]=s[i] then delete(s,j,1);
i:=i+1;
end;
write(s);
readln
end.
Слова в алфавитном порядке
uses crt;
var s,sl:string;
i,j,k,m,l:integer;
a:array [1..255] of string;
begin
write('Stroka: ');readln(s);
s:=s+' '; sl:='';
for i:=1 to length(s) do
if s[i]<>' ' then sl:=sl+s[i] else
if length(sl)>0 then
begin
inc(j);
a[j]:=sl;
sl:='';
end;
k:=0;
while k<=j do
begin
for i:=1 to j-1 do
begin
l:=1; m:=0;
repeat
if a[i][l]<>a[i+1][l] then inc(m);
if a[i][l]>a[i+1][l] then
begin
s:=a[i];
a[i]:=a[i+1];
a[i+1]:=s;
end;
inc(l);
until (m=1) or (l>length(a[i]));
end;
inc(k);
end;
for i:=1 to j do
writeln(a[i],' ');
readln;
end.
Дан текст, состоящий из букв и пробелов, слова разделяются пробелом. Найти количество слов, начинающихся с буквы "х".
var
s: string;
i: integer;
k: integer;
begin
writeln('Введите строку:');
readln(s);
s := ' ' + s;
for i := 1 to length(s) do
if (s[i] = ' ') and (s[i + 1] = 'x') then inc(k);
writeln('Количество слов, начинающихся с буквы х равно:', ' ', k);
end.
Минимальный элемент матрицы
сonst
csize=10;
type
tmatrix=array [1..csize,1..csize] of integer;
procedure creatematrix(var arg:tmatrix);
var
i,j:byte;
begin
for i:=1 to csize do begin
for j:=1 to csize do begin
arg[i,j]:=random(100)+1;
write(arg[i,j]:3);
end;
writeln;
end;
end;
procedure findmin(var arg:tmatrix);
var
min,i,j,indi,indj:byte;
begin
min:=arg[1,1];
for i:=1 to csize do begin
for j:=1 to csize do
if arg[i,j]<min then begin
min:=arg[i,j];
indi:=i;
indj:=j;
end;
end;
writeln('минимальный элемент в массиве ar[',indi,',',indj,'] = ',min);
end;
var
ar:tmatrix;
begin
randomize;
creatematrix(ar);
writeln;
findmin(ar);
end.
Среднее арифметическое элементов матрицы
program z;
var i,j,s,k:integer; sa:real;
a:array [1..5,1..7] of integer;
begin
writeln('Ввод элементов матрицы');
for i:=1 to 5 do
for j:=1 to 7 do
begin
write('a[',i,',',j,']=');
readln(a[i,j]);
end;
s:=0; k:=0;
for i:=1 to 5 do
for j:=1 to 7 do
begin
s:=s+a[i,j];
k:=k+1;
end;
sa:=s/k;
writeln('Матрица');
for i:=1 to 5 do
begin
for j:=1 to 7 do
write(a[i,j],' ');
writeln;
end;
writeln('Среднее арифметическое элементов матрицы = ',sa:2:2);
end.
среднее арифметическое наименьших отрицательных элементов каждой строки матрицы procedure Poisk(var a:Tmatr,s:integer);
var i,j,sum,min,k:integer;
SA:real;
begin
min:=a[1,1]; sum:=0;
for i:=1 to m do
for j:=1 to m do
//проверка элементов на отрицание, нахождение выше главной диагонали, и поиск минимальных эл-тов
if (i>j) and (a[i,j]<0) and (a[i,j]>min) then
begin
min:=a[i,j];
sum:=sum+a[i,j];
inc(k);// счётчик наименьших отрицательных чисел
end;
SA:=sum/n;
end;
Сформировать одномерный массив из элементов, стоящих под главной диагональю матрицы
uses crt;
const
mmax = 10;
var
K : array [1..mmax, 1..mmax] of integer;
A : array [1..mmax] of integer;
i, j, m, n : integer;
Sum : integer;
begin
ClrScr;
Repeat
Write('Размер матрицы (не более ', mmax, '): ');
Readln(m);
until m in [1..mmax];
Writeln('Введите элементы матрицы: ');
for i := 1 to m do
for j := 1 to m do
Readln(K[i, j]);
ClrScr;
Writeln('Исходная матрица:');
for i := 1 to m do
begin
for j := 1 to m do
Write(K[i, j]:4, ' ');
Writeln;
end;
Writeln('Новый массив: ');
n := 0;
Sum := 0;
for i := 1 to m do
for j := 1 to m do
if i > j then
begin
inc(n);
A[n] := K[i, j];
Write(A[n], ' ');
sum := sum + A[n];
end;
Writeln;
Writeln('Сумма: ', sum);
Readln;
end.
Сформировать одномерный массив, состоящий из положительных элементов, располагающихся в нечетных столбцах матрицы X (n x m)
program dz;
uses crt;
var x:array[1..100,1..100] of integer;
a:array[1..100] of Integer;
i,j,n,m,k:Integer;
begin
repeat
ClrScr;
Write('Введите размеры матрицы X:');
Readln(n,m);
until (n in [1..100]) and (m in [1..100]);
Writeln('Массив,заполненный случайными числами:');
Randomize;
for i:=1 to n do
for j:=1 to m do
x[i,j]:=Random(81)-40;
for i:=1 to n do
begin
for j:=1 to m do Write(x[i,j]:4);
Writeln;
end;
for j:=1 to m do
if odd(j) then
for i:=1 to n do
if x[i,j]>0 then
begin
inc(k);
a[k]:=x[i,j];
end;
Writeln('Массив,состоящий из положительных элементов,расположенных в нечетных столбцах:');
for j:=1 to k do Write(a[j],' ');
Writeln;
Readln;
end.
Сформировать одномерный массив из максимальных элементов столбцов матрицы.
Program Massive;
Uses Crt;
Const
row=10;
col=10;
Var
i,j,max:integer;
mas2: array[1..row,1..col] of integer;
mas1: array[1..col] of integer;
Begin
{Создание дыумерного массива}
For i:=1 to row do
For j:=1 to col do
mas2[i,j]:=random(9)+1;
{Поиск максимума в столбце J}
For i:=1 to row do
begin
max:=mas2[i,1];
For j:=1 to col do
if mas2[i,j]>max then max:=mas2[i,j];
mas1[col]:=max;
end;
{Вывод результата}
For i:=1 to col do
write(mas1[i]:3);
End.
сформировать одномерный массив из сумм элементов строк матрицы
сonst
nmax=100;
var
a: array[1..nmax,1..nmax] of integer;
b: array[1..nmax] of integer;
i,j,s,n: integer;
begin
write('vvedite razmer matrici: ');
readln(n);
writeln('MATRICA:');
for i:=1 to n do
begin
s:=0;
for j:=1 to n do
begin
a[i,j]:=random(99)+1;
write(a[i,j]:4);
s:=s+a[i,j];
end;
b[i]:=s;
writeln;
end;
writeln;
writeln('MASSIV SUMM:');
for i:=1 to n do write(b[i],' ');
readln;
end.
Сформировать массив из сумм нечетных положительных элементов строк матрицы
uses crt;
const
nmax = 500;
mmax = 500;
type
Matrix = array [1..nmax, 1..mmax] of integer;
Arr = array [1..nmax] of integer;
var
Mat: Matrix;
A : Arr;
i, j, n, m : integer;
Summa : integer;
BEGIN
ClrScr;
Write('Введите размерность массива (не более: ', nmax, ' ', mmax, '): ');
Readln(n, m);
Writeln('Введите элементы массива построчно: ');
for i := 1 to n do
for j := 1 to m do
Read(Mat[i, j]);
Writeln('Результат: ');
for i := 1 to n do
begin
Summa := 0;
for j := 1 to m do
if (odd(j)) and (Mat[i, j] > 0) then Summa := Summa + Mat[i, j];
A[i] := Summa;
Write(A[i], ' ');
end;
Readln;
END.