Будь умным!


У вас вопросы?
У нас ответы:) SamZan.ru

10] of integer; iminind- integer; Begin rndomize; For i-1 to 10 do Begin ms[i]-Rndom4020 ; writems[i] ; End; writeln; writeln; min-ms[1]; For i

Работа добавлена на сайт samzan.ru: 2015-07-05


Минимальный элемент массива и его порядковый номер

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.




1. а Индекс уникален для любого экземпляра книги среди всех книг в библиотеках города Автор строка Назв
2. цы нац валюты выраженная в едцах иностр
3. типично американскую
4. Воздействие государства на механизм ценообразования
5. ответ вы можете написать нужна ли вам эта услугааксессуар забронирована ли на данный момент та или иная п
6. Теория общественного договора1
7. На тему- Теория длинных волн Н
8. 122013 г фамилия сумма 1
9. Введение Проблемы изменения климата
10. законы красоты складывались исторически постепенно
11. Крадіжка і ст 186 КК Грабіж
12. это скалярная величина численно равная длине траектории пройденной телом за данный промежуток времени
13. 1 Операторы цикла Цикл ~ это многократно повторяющиеся фрагменты програ
14. Народная художественная культура
15. ТЕМА 2- rdquo;АРТИЛЛЕРИЙСКИЕ ОПТИЧЕСКИЕ ПРИБОРЫrdquo;
16. .П.Говорухина Е.И
17. Вейделевской средней общеобразовательной школы Вейделевского района Белгородской области Качество обр
18. по теме Прибыль рентабельность Задача 1 Годовой объем производства продукции на предприятии ~ 260 т
19. задание Постарайтесь описать ваши первые детские впечатления сказала она
20.  Облік оприбуткування основних засобів Одиницею обліку основних засобів відповідно до ПСБО 7 є об~єкт о