nyuuzyou/soloby huggingface dataset:
Вопрос: Целью какой службы является работа по предупреждению преступности, наркомании, алкоголизма, бродяжничества:
(*ответ*) социальной профилактики
 социально-бытовой помощи
 социальной реабилитации
 по оказанию помощи семье
Эмпатичность - способность к состраданию:
(*ответ*) верно
 неверно
_ - блок неблагополучия и супернеблагополучия развития персонала, - изменение оплаты труда, системы защиты самих «защищающих» и психологической разгрузки, снятия напряжения после рабочего дня, рабочей недели
(*ответ*) Третий
 Первый
 Второй
 Четвертый
 Пятый
_ - блок среднего и ниже среднего уровня развития персонала, - развитие средств труда и мотивации персонала (исключая оплату труда), улучшение условий труда и отдыха
(*ответ*) Второй
 Первый
 Третий
 Четвертый
 Пятый
_ - отражает развитие и функционирование социальных процессов с учетом передовых показателей развития и функционирования аналогичных процессов
(*ответ*) Социальный ориентир
 Социальный критерий
 Социальный показатель
 Социальный индикатор
 Блок социальных параметров
_ - сложный феномен, она складывается из цели, результата, затрат, условий деятельности
(*ответ*) Эффективность
 Эффективность управления
 Эффективность социальной работы
 Эффективность социального управления
_ - это признак, на основе которого проводится оценка, определение или классификация чего-нибудь; это мерило оценки
(*ответ*) Критерий
 Социальный показатель
 Индикатор
 Определитель
_ - это совокупность нормативов, с помощью которых государство регулирует уровень заработной платы по отраслям в зависимости от квалификационных признаков, характера и условий труда работников
(*ответ*) Тарифная система ставок
 Тарифная сетка
 Тарификация
 Квалификационные требования
 Сертификат специалиста
_ - это шкала, определяющая положение тарифных ставок второго и последующего разрядов работающих к тарифной ставке первого разряда
(*ответ*) Тарифная сетка
 Тарификация
 Тарифная система ставок
 Квалификационные требования
_ в социальной работе должен быть не только теоретической основой, но и практическим содержанием деятельности
(*ответ*) Гуманизм
 Этикет
 Альтруизм
 Такт
_ в социальной работе не должны быть использованы в целях извлечения личной выгоды или переданы для применения в этих целях юридическим или физическим лицам
(*ответ*) Результаты исследования
 Данные исследований
 Выводы по исследованиям
 Рекомендации по исследованиям
Категория: гуманитарные
Ответы:
тест  прошел проверку
правильные ответы отмечены по тесту
пользуемся)
Вопрос: Натуральное число, в записи которого n цифр, называется числом Армстронга, если сумма его цифр, возведенная в степень n, равна самому числу. Найти все числа Армстронга от 1 до к.
Категория: школьный раздел
Ответы:
Program n1;
function st(a,b: integer): integer;
var i: integer;
begin
st:=1;
for i:=1 to b do st:=st*a;
end;
function ams(x: integer): boolean;
var k,t: integer;
sum: integer;
begin
ams:=false;
t:=x;
k:=0;
while x<>0 do
begin
x:=x div 10;
k:=k+1;
end;
x:=t;
sum:=0;
while t<>0 do
begin
sum:=sum+st(t mod 10,k);
t:=t div 10;
end;
if x=sum then ams:=true;
end;
var i,k: integer;
begin
readln(k);
for i:=1 to k do if ams(i) then write(i,' ');
end.
Вопрос: Найти все простые натуральные числа, не превосходящие n, двоичная запись которых представляет собой палиндром, т. е. читается одинаково слева направо и справа налево
Категория: школьный раздел
Ответы:
program ex;
var  i,k,n,count: word;
z,err:integer;
  
function dec2bin(x:integer):string;
var s:string;
begin
  s:='';
  while x>0 do
  begin
     s:=chr(ord('0')+x mod 2)+s;
     x:=x div 2;
  end;
dec2bin:=s;
end;
 
function palindrom(var a:integer):integer;
var b,c:integer;
begin
b:=a;
c:=0;
while b>0 do
 begin
  c:=c*10+(b mod 10);
  b:=b div 10;
 end;
if c=a then palindrom:=1
       else  palindrom:=0;
end;
 
begin
  readln(n);
  for k := 1 to n do begin
    count := 0;
    for i := 1 to k do begin
      if k mod i = 0 then inc(count)
    end;
    if count = 2 then (*write(k, ' ')*)
                  begin
                  val(dec2bin(k),z,err);
                  if (palindrom(z)=1) then
                  writeln(k);
                  end;
  end
end.
Вопрос: Составить программу для нахождения чисел из интервала [М, N], имеющих наибольшее количество делителей
Категория: школьный раздел
Ответы:
uses crt;
function KolDel(n:longint):integer;
var i,k:integer;
begin
k:=1;
for i:=1 to round(sqrt(n))do
if n mod i=0 then k:=k+1;
KolDel:=k;
end;
var m,n,i:longint;
    mx:integer;
begin
clrscr;
repeat
writeln('Ведите интервал вычислений n>m');
readln(m,n);
until n>m;
mx:=1;
for i:=m to n do
if KolDel(i)>mx then mx:=KolDel(i);
writeln('Максимальное количество делителе=',mx,' имеют:');
for i:=m to n do
if KolDel(i)=mx then write(i,' ');
readln
end.
Вопрос: Дано натуральное число n > 1. Определить длину периода десятичной записи дроби 1/n.
Категория: школьный раздел
Ответы:
var r, n, k: integer;
begin
  repeat
    write('n > 0;  n = ');
    readln(n)
  until n > 0;
  while n mod 2 = 0 do n := n div 2; //или while n and 1 = 0 do n := n shr 1;
  while n mod 5 = 0 do n := n div 5;
  k := 0;
  r := 1;
  repeat
    inc(k);
    r := r * 10 mod n
  until r <= 1;
  writeln(k);
  readln
end.
Вопрос: Дана последовательность действительных чисел а1, а2, ..., аn. Выяснить, будет ли она возрастающей
Категория: школьный раздел
Ответы:
var
  a:array[1..100] of real;
  i,n: byte;
  f: boolean;
begin
  readln(n);
  for i:=1 to n do
    readln(a[i]);
  f:=true;
  for i:=2 to n do
    if (a[i]>a[i-1]) and (f=true) then f:=true
      else f:=false;
  writeln('последовательность возрастающая: ',f);
  readln;
end.
Вопрос: Даны действительные числа а1, а2, ... ,аn. Поменять местами первый наибольший элемент с последним наименьшим элементом.
Категория: школьный раздел
Ответы:
var
  a: array[1..1000] of real;
  n, i, mi, ma: integer;
  max, min: real;
 
begin
  write('Введите N: ');
  readln(n);
  for i := 1 to n do 
  begin
    write('Введите ', i, ' элемент: ');
    readln(a[i]);
    if i = 1 then begin max := a[i]; min := a[i]; ma := i; mi := i; end;
    if min > a[i] then begin min := a[i]; mi := i; end; 
    if max < a[i] then begin max := a[i]; ma := i; end;
  end;
  writeln;
  writeln('Ваш массив: ');
  for i := 1 to n do writeln(i, ') ', a[i], ' ');
  writeln;
  writeln('Массив после замены Max на Min: ');
  a[mi] := a[ma] + a[mi];
  a[ma] := a[mi] - a[ma];
  a[mi] := a[mi] - a[ma];
  for i := 1 to n do writeln(i, ') ', a[i], ' ');
end.
Вопрос: В заданном одномерном массиве поменять местами соседние элементы, стоящие на четных местах, с элементами, стоящими на нечетных местах.
Категория: школьный раздел
Ответы:
Var A:array[1..100] of integer;
    i,n,t:integer;
Begin
    write('Введите размерность: ');readln(n);
    writeln('Исходный массив: ');
    For i:=1 to n do
     Begin
      A[i]:=random(30)-15;
      write(A[i]:4);
     End;
    writeln;
    writeln('Преобразованный: ');
    i:=0;
    While i<n-1 do
     Begin
      inc(i,1);
      t:=A[i];
      A[i]:=A[i+1];
      A[i+1]:=t;
      inc(i,1);
     End;
     For i:=1 to n do
      write(A[i]:4);
    readln;
End.
Вопрос: Задана последовательность {Хi} из N вещественных чисел. Вычислить последовательность {Si} по формуле: 
Si = корень (Xi-M)2/(N-1), 
где М — среднее арифметическое значение последовательности X.
Категория: школьный раздел
Ответы:
uses crt;
const max=100;
var x,s:array[1..max] of real;
    n,i:byte;
    m:real;
begin
clrscr;
randomize;
repeat
write('Размер последовательности n=');
readln(n);
until n in [1..max];
writeln('Последовательность:');
m:=0;
for i:=1 to n do
 begin
  x[i]:=10*random-4;
  write(x[i]:6:2);
  m:=m+x[i];
 end;
m:=m/n;
writeln;
writeln('Среднее=',m:0:2);
writeln;
writeln('Результат вычислений:');
for i:=1 to n do
 begin
  s[i]:=sqrt(sqr(x[i]-m)/(n-1));
  write(s[i]:6:2);
 end;
readln
end.
Вопрос: Задана последовательность из N целых чисел. Вычислить сумму тех элементов массива, порядковые номера которых совпадают со значением этого элемента.
Категория: школьный раздел
Ответы:
var n,i,a,s:integer;
begin
write('n=');
readln(n);
writeln('Vvedite ',n,' chisel');
s:=0;
for i:=1 to n do
 begin
  readln(a);
  if a=i then s:=s+a;
 end;
write('S=',s);
readln
end.
Вопрос: Определить, сколько процентов от всего количества элементов последовательности целых чисел составляют нечетные элементы.
Категория: школьный раздел
Ответы:
var
  a,b,n:integer;
begin
  writeln('введите последовательность целых чисел через пробел, enter-конец ввода');
  write('>');
  while not eoln do begin
    read(a);
    if a mod 2<>0 then b:=b+1;
    n:=n+1;
  end;
  writeln('нечетные числа составляют ',b/n*100:6:2,'%');
end.
Вопрос: Дан массив Х[N] целых чисел. Не используя других массивов, переставить его элементы в обратном порядке
Категория: школьный раздел
Ответы:
var
  i, n, c: integer;
  A: array[1..20] of integer;
  
begin
  n := 5 + random(16);
  for i := 1 to n do begin
    a[i] := random(100);
    write(' ', a[i])
  end;
  { Переписываем массив: }
  for i := 1 to n div 2 do begin
    c := a[n + 1 - i];
    a[n + 1 - i] := a[i];
    a[i] := c
  end;
  writeln;
  { Вывводим массив: }
  writeln('Массив задом наперед:');
  for i := 1 to n do
    write(' ', a[i]);
  writeln
end.
Вопрос: Задана последовательность из N вещественных чисел. Вычислить сумму чисел, порядковые номера которых являются простыми числами.
Категория: школьный раздел
Ответы:
uses crt;
const n=5;
var a:array[1..n] of real;
    i,j,k:integer;
    sum:real;
begin
clrscr;
randomize;
writeln('Posledovatelnost:');
for i:=1 to n do
   begin
     a[i]:=10*random;
     write(a[i]:4:1);
   end;
writeln;
sum:=0;
for i:=2 to n do  //начинаем с 2
  begin
    k:=0;
    for j:=2 to round(sqrt(i)) do //смотрим каждое число до его корня, дальше нет смысла, делителей нет
    if i mod j=0 then inc(k);//считаем делители
    if k=0 then sum:=sum+a[i];//если делителей нет, считаем сумму
  end;
write('Summa=',sum:0:1);
readln
end.
Вопрос: Последовательность а1, а2, ...,аn состоит из нулей и единиц. Поместить в начало этой последовательности все нули, а затем все единицы
Категория: школьный раздел
Ответы:
const
  nmax=100;
type
  mas=array[1..nmax] of integer;
var
  n,i,j,buf:integer;
  a:mas;
begin
  repeat
    write('Vvedite n->');
    readln(n);
  until n>0;
  for i:=1 to n do
    begin
      a[i]:=random(2);
      write(a[i]:4);
    end;
    writeln;
    for i:=n-1 downto 1 do
      for j:=1 to i do
        if a[j]>a[j+1] then
          begin
            buf:=a[j];
            a[j]:=a[j+1];
            a[j+1]:=buf;  
          end;
  writeln('Uporyadochenniy massiv:');
  for i:=1 to n do
    write(a[i]:4); 
readln;
end.
Вопрос: Даны действительные числа а1, а2, ..., а2n. Найти: 
mах(а1 +а2n, а2 +а2n-1, ..., аn +аn+1).
Категория: школьный раздел
Ответы:
Var 
a:array[1..100000] of integer; 
i,max,n:integer; 
begin 
Readln(n); 
for i:= 1 to n do 
  read(a[i]); 
max:=a[1]+a[n]; 
for i:= 2 to n div 2 do 
  if max < a[i] + a[n-i] then 
    max:= a[i] + a[n-i]; 
Writeln(max); 
end.
Вопрос: Дана последовательность действительных чисел a1 ≤ a2 ≤ ... ≤ аn. Вставить действительное число b в нее так, чтобы последовательность осталась неубывающей.
Категория: школьный раздел
Ответы:
program massiv3_11;
uses crt;
var
  a:array [1..100] of integer;
i,n,m,b:integer;
begin
clrscr;
repeat
write ('Vvedite kol-vo elementov massiva (ne bolee 100): ');
readln (n);
until (n>0) and (n<=100);
 for i:=1 to n do
  begin
   write ('Vvedite a[',i,']: ');
   readln (a[i]);
  end;
 write ('Vvedite chislo b: ');
 readln (b);
 i:=1;
 while b>=a[i] do
  begin
   m:=i;
   i:=i+1;
  end;
 for i:=n+1 downto 1 do
  begin
   a[i]:=a[i-1];
   a[m]:=b;
  end;
 for i:=1 to n+1 do writeln (a[i]);
 readln;
end.

var a: array [0..n] of real; 
i,k: integer; 
b: real; 
begin 
writeln ('введите число эл-ов массива'); 
readln (n); 
writeln ('введите массив формата a1<=a2<=...<=an'); 
for i:=0 to n-1 do readln a[i]; 
writeln ('введите число b'); 
readln (b); 
k:=0; 
while (k>n) and (a[k]>=b) do k:=k+1;
for i:=n downto k+1 do a[i]:=a[i-1]; 
a[k]:=b; 
for i:=0 to n do writeln (a[i]); 
readln; 
end.
Вопрос: Дана последовательность целых чисел а1, а2, ... ,аn. Указать пары чисел ai,аj, таких что ai + aj = m,    где m -    заданное целое число.
Категория: школьный раздел
Ответы:
var
 mas:array [1..100] of longint;
 m,n,i,j:longint;
begin
 write('Количество элементов ');readln(n);
 writeln('Заполняем массив');
 for i:=1 to n do{прочитали все числа и занесли их в массив}
  readln(mas[i]);
writeln;
 write('m=');readln(m);
 i:=1;
 j:=2;
 while(i<=n) do{будем искать нужные упорядоченные пары(i<j,i не равно j)}
 begin
  j:=i+1;
  while(j<=n) do
  begin
   if((mas[i]+mas[j])=m) then{нашли и вывели на экран}
    writeln(mas[i],' ',mas[j]);
   j:=j+1;
  end;
  i:=i+1;
 end;
end.
Вопрос: Даны координаты n (n < 30) точек на плоскости: (Х1, У1), ..., (Xn, Yn). Найти номера пары точек, расстояние между которыми наибольшее (считать, что такая пара единственная)
Категория: школьный раздел
Ответы:
var
 t:Array [1..30] of record
                    x,y: integer
                    end;
 r,d:            longint;
 i,j,n,t1,t2:    word;
begin
  write('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® в®зҐЄ: ');
  Readln(N);
  for i:=1 to N do
  begin
    write('Љ®®а¤Ё**вл ',i,' в®зЄЁ (• Y): ');
    Readln(t[i].x,t[i].y)
  end;
  r:=0;
  for i:=1 to n-1 do
    for j:=i+1 to n do
    begin
      d:=sqr(t[i].x-t[j].x)+sqr(t[i].y-t[j].y);
      if d>r then
      begin
        r :=d;
        t1:=i;
        t2:=j
      end
    end;
  writeln('Ќ*ЁЎ®«миҐҐ а*ббв®п*ЁҐ Ґ¦¤г в®зЄ*Ё ',t1,' Ё ',t2);
  readln;
end.
Вопрос: Дан массив, состоящий из n натуральных чисел. Образовать новый массив, элементами которого будут элементы исходного, оканчивающиеся на цифру к.
Категория: школьный раздел
Ответы:
VAR
   a,b: array[1..100] of integer;
   i,n,n1,k: byte;
BEGIN
   Randomize;
   Write('введите n: ');
   ReadLn(n);
   WriteLn('массив');
   For i:=1 to n do
      Begin
         a[i]:=Random(101)-50;
         Write(a[i],' ');
      End;
   WriteLn;
   Write('введите k: ');
   ReadLn(k);
   For i:=1 to n do
      If a[i] mod 10 = k then
         Begin
            inc(n1);
            b[n1]:=a[i];
         End;
   WriteLn('новый массив');
   For i:=1 to n1 do write(b[i],' ');
   ReadLn;
END.
Вопрос: Дан массив целых чисел. Найти в этом массиве минимальный элемент m и максимальный элемент М. Получить в порядке возрастания все целые числа из интервала (m; М), которые не входят в данный массив.
Категория: школьный раздел
Ответы:
uses crt;
var a:array[1..10] of integer;
max,min,i,j,s:integer;
begin
clrscr;
writeln('Г€Г±ГµГ®Г¤Г*Г»Г© ГГ*Г±Г±ГЁГў');
min:=40;
max:=0;
randomize;
for i:=1 to 10 do
 begin
  a[i]:=random(51)-10;
  write(a[i]:4);
  if (a[i]>=max) then max:=a[i];
  if (a[i]<=min) then min:=a[i];
 end;
writeln;
writeln('ГЊГ*ГЄГ±ГЁГГ*Г«ГјГ*Г»Г© ГЅГ«ГҐГГҐГ*ГІ ГГ*Г±Г±ГЁГўГ* ',max);
writeln('ГЊГЁГ*ГЁГГ*Г«ГјГ*Г»Г© ГЅГ«ГҐГГҐГ*ГІ ГГ*Г±Г±ГЁГўГ* ',min);
writeln('ГќГ«ГҐГГҐГ*ГІГ» ГГҐГ¦Г¤Гі ГГЁГ*ГЁГГ*Г«ГјГ*Г»Г ГЁ ГГ*ГЄГ±ГЁГГ*Г«ГјГ*Г»Г, Г*ГҐ ГўГµГ®Г¤ГїГ№ГЁГҐ Гў ГГ*Г±Г±ГЁГў');
for i:=min+1 to max-1 do
 begin
  for j:=1 to 10 do
   if (a[j]=i) then s:=i;
  for j:=1 to 10 do
   if (a[j]<>i) and (s<>i) then
    begin
     write(i:4);
     break;
    end;
  s:=0;
 end;
readln
end
Вопрос: Даны две последовательности а1, а2, ... ,аn и b1, b2, ... ,bm (m < n). В каждой из них значения элементов различны. Верно ли, что все элементы второй последовательности входят в первую последовательность?
Категория: школьный раздел
Ответы:
procedure fun(a,b:integer;var k:integer);
begin
if b=a then k:=k+1;
end;
var a,b:array[1..100] of integer;
i,n,k,m,j:integer;
begin
k:=0;
writeln('Кол-во элементов 1го массива');
readln(n);
writeln('Кол-во элементов 2го массива');
readln(m);
Writeln('Первый Массив: ');
for i:=1 to n do
readln(a[i]);
Writeln('Второй Массив: ');
for i:=1 to m do
readln(b[i]);
for i:=1 to m do
for j:=1 to n do
fun(a[j],b[i],k);
if k=m then write('Верно')
else write('НЕ верно');
end.
Вопрос: Сформировать массив простых чисел, не больших заданного натурального числа N.
Категория: школьный раздел
Ответы:
uses crt;
var i,n:integer;
begin
clrscr;
 
writeln('vvedite n');
readln(n);
 
for i:=1 to n do
 if (i = 2) or (i = 3) or (i = 5 )  or (i = 7) then write(i:3) else
 if (i mod 2 <> 0) and (i mod 3 <> 0 ) and (i mod 5 <> 0) and (i mod 7 <> 0) then write(i:3);
 
 
readkey;
end.
Вопрос: Сформировать массив простых множителей заданного числа
Категория: школьный раздел
Ответы:
type
  mas=array[1..100] of integer;
var
  a:mas;
  n,k,c,i:integer;
begin
  repeat
    write('n=');
    readln(n);
  until n>1;
  c:=0;
  k:=2;
  while n<>1 do
    if n mod k=0 then
      begin
        inc(c);
        a[c]:=k;
        n:=n div k;
      end
    else
      k:=k+1;
  for i:=1 to c do
    write(a[i]:4);
end.
Вопрос: В одномерном массиве все отрицательные элементы переместить в начало массива, а остальные — в конец с сохранением порядка следования. Дополнительный массив заводить не разрешается.
Категория: школьный раздел
Ответы:
var
a:array[1..100]of integer;
i,j,t,n:integer;
begin
randomize;
writeln('vvedite kol-vo elementov');
readln(n);
writeln('ishodnyj massiv');
for i:=1 to n do
begin
a[i]:=random(20)-10;
write(a[i],' ');
end;
writeln;
for i:=1 to n do
for j:=1 to n-1 do
if (a[j]>=0)and(a[j+1]<0)then 
begin
t:=a[j];
a[j]:=a[j+1];
a[j+1]:=t;
end;
writeln('novyj massiv');
for i:=1 to n do
write(a[i],' ');
readln;
end.
Вопрос: В одномерном массиве с четным количеством элементов (2N) находятся координаты N точек плоскости. Они располагаются в следующем порядке: х1, у1, х2, у2, х3, у3, и т. д. Определить: 
а) минимальный радиус окружности с центром в начале координат, которая содержит все точки; 
б) внутренний и внешний радиусы кольца с центром в начале координат, которое содержит все точки; 
в) номера точек, которые могут являться вершинами квадрата; 
г) номера точек, которые могут являться вершинами равнобедренного треугольника; 
д) номера самых удаленных и наименее удаленных друг от друга точек; 
е) три точки, которые являются вершинами треугольника, для которого разность точек вне его и внутри является минимальной
Категория: школьный раздел
Ответы:
uses crt;
     const n=100;
     type
     TVector = array [1..n] of integer;
      var
      B: TVector;
      procedure VvodMas;
      var
      i: integer;
      begin
      for i:=1 to n do B[i] := random(100);
      end;
      function LongVector(x1,y1,x2,y2: integer): real;
      begin
      LongVector := sqrt(sqr(x2-x1)+sqr(y2-y1));
      end;
      function UravPrjam(x,x1,y1,x2,y2: integer): real;
      begin
      if x2<>x1
      then UravPrjam := (((x-x1)*(y2-y1))/(x2-x1))+y1
      else UravPrjam := x;
      end;
      function RavnobedTreug(x1,y1,x2,y2,x3,y3: integer): boolean;
      var
     d1,d2,d3: real;
     begin
     RavnobedTreug := false;
     d1 := LongVector(x1,y1,x2,y2);
     d2 := LongVector(x1,y1,x3,y3);
     d3 := LongVector(x2,y2,x3,y3);
     if (d1=d2)or(d1=d3)or(d2=d3)
     then RavnobedTreug := true;
     end;
     function Treug(x1,y1,x2,y2,x3,y3: integer): boolean;
     var
     py1,py2: real;
     x: integer;
     begin
     Treug := true;
      x := random(100);
      py1 := UravPrjam(x,x1,y1,x2,y2);
      py2 := UravPrjam(x,x2,y2,x3,y3);
      if py1=py2 then Treug := False;
      end;
       procedure ProvAr;
      var
       i,j,m: integer;
       begin
       for i:= 1 to n do
       for j:= 3 to n do
       for m:= 5 to n do
       if odd(i)and odd(j)and odd(m) then
       if (i<j)and(j<m) then
       if Treug(a[i],a[i+1],a[j],a[j+1],a[m],a[m+1]) then
       if RavnobedTreug(a[i],a[i+1],a[j],a[j+1],a[m],a[m+1]) then
       writeln('(',a[i],'-',a[i+1],',',a[j],'-',a[j+1],',',a[m],'-',a[m+1],')');
       end;
       begin
       randomize;
      clrscr;
      VvodMas;
     ProvAr;
     readln;
    end.
Вопрос: Найдите площадь прямоугольного треугольника если радиус вписанной в него окружности 2 см а радиус описанной около него окружности 5 см
Категория: школьный раздел
Ответы:
Решение:
Так как треугольник прямоугольный и радиус описанной окружности равен 5, то гипотенуза равна 2R=10 см.
r=(a+b-c)/2
2=(a+b-10)/2
a+b=14
Тогда полупериметр треугольника равен:
p=(14+10)/2=12
S=r*p=2*12=24 см²
Вопрос: Дана последовательность целых чисел. Найти количество различных чисел в этой последовательности.
Категория: школьный раздел
Ответы:
uses crt;
const nmax=50;
var a:array[1..nmax] of integer;
    n,i,j,k,l,r:integer;
begin
clrscr;
repeat
write('Ввведите размер последовательности до ',nmax,' n=');
read(n);
until n in [1..nmax];
randomize;
writeln('Исходная последовательность:');
for i:=1 to n do
 begin
  a[i]:=random(10);
  write(a[i],' ');
 end;
writeln;
writeln('Разные числа в последовательности:');
i:=1;
while i<=n do
 begin
  write(a[i],' ');
  for j:=n downto i+1 do
  if a[j]=a[i] then
   begin
    for l:=j to n-1 do
    a[l]:=a[l+1];
    dec(n);
   end;
  inc(i);
 end;
writeln;
write('Всего разных чисел=',n);
end.
Вопрос: В данной действительной квадратной матрице порядка n найти наибольший по модулю элемент. Получить квадратную матрицу порядка n — 1 путем отбрасывания из исходной матрицы строки и столбца, на пересечении которых расположен элемент с найденным значением.
Категория: школьный раздел
Ответы:
program prog;
var i, j, n, m_i, m_j: byte;
    A: array[1..100,1..100] of Real;
    maxmod: Real;
begin
randomize;
writeln('Vvedite N:');
readln(n);
{заполнение случайными числами, можно вводить вручную}
for i:=1 to n do
    for j:=1 to n do
        A[i,j]:=-100+random(200);
 
{поиск максимального по модулю элемента}
maxmod:=abs(A[1,1]);
m_i:=1;
m_j:=1;
for i:=1 to n do
 for j:=1 to n do
  if abs(A[i,j])>maxmod then
  begin
  maxmod:=abs(A[i,j]);
  m_i:=i; m_j:=j;
  end;
 
{Печать матрицы и ответа}
writeln('Исходная матрица:');
for i:=1 to n do
begin
 for j:=1 to n do write(A[i,j]:6:1);
 writeln;
end;
writeln('Максимальный по модулю элемент A[',m_i,';',m_j,'] = ', A[m_i, m_j]:6:1);
{вывод на печать уменьшенной матрицы}
for i:=1 to n do
 if (i<>m_i) then
 begin
 for j:=1 to n do
   if (j<>m_j) then write(A[i,j]:6:1);
 writeln;
 end;
readln;
end.
Вопрос: Разделить массив на две части, поместив в первую элементы, большие среднего арифметического элементов массива, а во вторую — меньшие (части не сортировать).
Категория: школьный раздел
Ответы:
uses crt;
const nmax=100;
var a:array[1..nmax]of integer;
    n,i,k,j,x:integer;
    sr:real;
begin
clrscr;
randomize;
repeat
write('Размер массива до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Исходный массив:');
sr:=0;
for i:=1 to n do
   begin
     a[i]:=random(20);
     write(a[i]:3);
     sr:=sr+a[i];
   end;
writeln;
writeln;
sr:=sr/n;
writeln('Среднее=',sr:0:1);
writeln;
k:=0;
for i:=1 to n do
if a[i]>sr then
  begin
    k:=k+1;
    x:=a[i];
    for j:=i downto k+1 do
    a[j]:=a[j-1];
    a[k]:=x;
  end;
writeln('Перестановка:');
for i:=1 to n do
write(a[i],' ');
readln
end.

var
a:array[1..100]of integer;
i,j,t,n,sum:integer;
sred:real;
begin
randomize;
writeln('Введите количество элементов');
readln(n);
writeln('1-ый массив');
    for i:=1 to n do
      begin
        a[i]:=random(20);
        write(a[i],' ');
        sum:=sum+a[i];
      end;
      sred:=sum/n;
      writeln ('Среднее=',sred);
  writeln;
     for i:=1 to n do
       for j:=1 to n-1 do 
         if (a[j]<=sred)and(a[j+1]>sred)then 
          begin
            t:=a[j];
            a[j]:=a[j+1];
            a[j+1]:=t;
           end;
  writeln('2-ой массив');
      for i:=1 to n do
        write(a[i],' ');
end.
Вопрос: Даны две последовательности а1 < а2 ...< аn и b1 < b2 < ... < bm. Образовать из них новую последовательность чисел так, чтобы она тоже была неубывающей. 
Примечание. Дополнительный массив не использовать
Категория: школьный раздел
Ответы:
uses crt;
const nmax=50;
var a,b:array[1..2*nmax] of integer;
    n,m,i,j,k:integer;
begin
clrscr;
repeat
write('Размер массива А до ',nmax,' n=');
readln(n);
until n in [1..nmax];
for i:=1 to n do
 begin
  a[i]:=3*i;{по возрастанию, можно по другому}
  write(a[i],' ');
 end;
writeln;
writeln;
repeat
write('Размер массива B до ',nmax,' n=');
readln(m);
until m in [1..nmax];
for i:=1 to m do
 begin
  b[i]:=2*i;
  write(b[i],' ');
 end;
writeln;
writeln;
{вставляем массив b в массив а}
for i:=1 to m do
if b[i]>=a[n] then{если больше последнего}
 begin
  n:=n+1;
  a[n]:=b[i];{добавляем в конец}
 end
else{иначе}
 begin
  for j:=1 to n doищем место для вставки}
   if a[j]>=b[i] then
    begin
     n:=n+1;{увеличим размер}
     for k:=n downto j+1 do{сдвинем конец массива вправо на 1}
     a[k]:=a[k-1];
     a[j]:=b[i];{на освободившееся место вставляем}
     break;{выходим из цикла поиска}
    end;
 end;
writeln('Результат:');
for i:=1 to n do
write(a[i],' ');
readln
end.
Вопрос: «Центр социальной помощи семье и детям» имеет право приобретать или арендовать основные средства за счет
(*ответ*) имеющихся у него финансовых ресурсов
 спонсоров
 имеющихся у него благотворительных ресурсов
 заработанных им финансовых ресурсов
«Центр социальной помощи семье и детям» может осуществлять международное сотрудничество и внешнеэкономическую деятельность в соответствии с
(*ответ*) действующим законодательством
 уставом Центра
 статусом Центра
 договорными обязательствами
«Центр социальной помощи семье и детям» осуществляет бухгалтерский учет и статистическую отчетность в порядке
(*ответ*) установленном действующим законодательством
 установленном уставом Центра
 вытекающем из статуса Центра
 договорных обязательств
«Центр социальной помощи семье и детям» строит свои отношения с третьими лицами в сфере хозяйственной деятельности на основе
(*ответ*) договоров
 контрактов
 соглашений
 протоколов намерений
«Центр социальной помощи семье и детям» считается созданным как юридическое лицо с момента государственной регистрации его
(*ответ*) устава
 статуса
 положения
 структуры
 штатного расписания
«Центр социальной помощи семье и детям», его филиалы не могут быть приватизированы или перепрофилированы, а закрепленное за Центром на праве оперативного управления имущество
(*ответ*) не может сдаваться в аренду или отдаваться в залог
 может сдаваться в аренду
 может отдаваться в залог
 может подлежать замене
Аттестационная комиссия в системе ПФР утверждается в составе:
(*ответ*) председателя
(*ответ*) заместителя председателя
(*ответ*) секретаря
(*ответ*) членов комиссии
 сопредседателя
 кураторов аттестуемых
Аттестационная комиссия открытым голосованием дает одну из следующих оценок деятельности работника:
(*ответ*) соответствует занимаемой должности
(*ответ*) заслуживает повышения заработной платы в пределах вилки должностного оклада
(*ответ*) заслуживает персональной надбавки к заработной плате
(*ответ*) целесообразно персональную надбавку к заработной плате снизить
(*ответ*) целесообразно лишить на срок _ персональной надбавки к заработной плате
(*ответ*) заслуживает быть включенным в резерв на выдвижение
(*ответ*) соответствует занимаемой должности при условии улучшения работы и выполнения рекомендаций комиссии с повторной аттестацией через год
 заслуживает быть включенным в резерв руководящего состава
Аттестация работников ПФР проводится один раз в _ лет (года)
(*ответ*) 5
 2
 3
 4
 7
Категория: гуманитарные
Ответы:
тест  прошел проверку
правильные ответы отмечены по тесту
пользуемся)
Вопрос: Сортировка вставками. Дана последовательность чисел а1, а2, ..., аn. Требуется переставить числа в порядке возрастания. Делается это следующим образом. Пусть а1, а2, ..., аi, — упорядоченная по неубыванию последовательность, т. е. а1<=а2<= ... <= ai. Берется следующее число ai+1 и вставляется в последовательность так, чтобы новая последовательность была также возрастающей. Процесс производится до тех пор, пока все элементы от i+1 до n не будут перебраны. 
Примечание. Место помещения очередного элемента в отсортированную часть найти с помощью двоичного поиска. Двоичный поиск оформить в виде отдельной функции.
Категория: школьный раздел
Ответы:
Program pro;
var
a:Array[1..88] of real;
p,s:Real;
n,i,j:integer;
begin
cls;
writeln('Введите количество чисел');
readln(n);
writeln('Введите массив чисел'); 
For j:=1 To n Do
read(a[j]);
{Сортировка}
s:=0;
For i:=1 To n Do
 For j:=1 To n-i Do
  If a[j]>a[j+1] then
  Begin
  s:=s+i; // ВОТ ОНА ОШИБОЧКА, нужно i поставить, а не 1 
   p:=a[j];
   a[j]:=a[j+1];
   a[j+1]:=p;
   end;
write('Отсортированный массив чисел: ');
for j:=1 to n do
write(a[j],' ');
writeln;
write('Количество перестановок в массиве: ', s);
end.
Вопрос: Шейкер-сортировка. Алгоритм «пузырьковой» сортировки легко улучшить. Разумно запомнить, производился ли на данном проходе какой-либо обмен. Если нет, то алгоритм можно закончить. Еще одно улучшение заключается в том, что периодически меняется направление сортировки, которое борется с некоторой асимметрией «пузырькового» метода. Написать программу, реализующую данный улучшенный алгоритм.
Категория: школьный раздел
Ответы:
const
  nmax=100;
var
  a: array[1..nmax] of integer;
  n,i,l,r: Integer;
  tmp : integer;
  f,g: text;
begin
  assign(f,'C:\Files\input.txt');
  reset(f);
  n:=0;
  writeln('Исходный массив:');
  while not eof(f) do
  begin
    inc(n);
    read(f,tmp);
    a[n]:=tmp;
    write(a[n],' ');
  end;
  close(f);
  writeln;
  l:=2;
  r:=n;
  while l<=r do
  begin
    for i:=l to r do
    if a[i]<a[i-1] then
    begin
      tmp:=a[i];
      a[i]:=a[i-1];
      a[i-1]:=tmp;
    end;
    r:=r-1;
    for i:=r downto l do
    if a[i]<a[i-1] then
    begin
      tmp:=a[i];
      a[i]:=a[i-1];
      a[i-1]:=tmp;
    end;
    l:=l+1;
  end;
  assign(g,'C:\Files\output.txt');
  rewrite(g);
  writeln('Упорядоченный массив:');
  for i:=1 to n do 
  begin
    write(a[i],' ');
    write(g,a[i],' ');
  end;
  close(g);
end.

алгоритм сортировки пузырьком

P:=True; {Перестановка есть}
K:=1; {Номер просмотра}
While P Do
Begin
    P:=false;
    For i:=1 To n-k Do
        If X[i] > X[i+1] Then
        Begin
            A:=X[i];
            X[i]:=X[i+1];
            X[i+1]:=A;
            P:=true;
        End;
    k:=k+1;
End;
Вопрос: Вычислить сумму и число положительных элементов матрицы A[N, N], находящихся над главной диагональю.
Категория: школьный раздел
Ответы:
program ff;
var A:array[1..100,1..100] of integer; {переменная массива}
    i,j,n:integer; {переменные для циклов}
    sum,kol:integer; {переменные суммы и кол-ва}
 
begin
write ('Vvedite razmer massiva A');
readln (n); {считываем размер массива}
 
for i:=1 to n do
for j:=1 to n do begin
write ('A[',i,',',j,']='); readln (A[i,j]); end; {считываем сам массив}
 
write ('Vot vvedennyy vami massiv A- ');
for i:=1 to n do begin writeln;
for j:=1 to n do write (A[i,j]:3,' '); end; {выводим массив на экран}
 
sum:=0; kol:=0; {сумме и кол-ву присваиваем изначально нули}
 
for i:=1 to n do
for j:=1 to n do {циклами проходим по матрице}
if (A[i,j]>0) and (i<j) then {прописываем условия положительные и выше диагонали}
begin inc(kol); sum:=sum+A[i,j]; end; {сумму и кол-во соответственно увеличиваем}
writeln;
writeln('Summa= ',sum); {выводим на экран сумму}
writeln('Kol-vo= ',kol);{выводим на экран кол-во}
 
readln;
end.

Var A:array[1..20,1..20] of integer;
    i,j,n,k,s:integer;
Begin
    write('Введите размерность: ');readln(n);
    For i:=1 to n do
    Begin
      For j:=1 to n do
      Begin
        A[i,j]:=random(31)-15;
        write(A[i,j]:4);
      End;
      writeln;
    End;
    k:=0;s:=0;
    For i:=1 to n do
     For j:=1 to n do
      if (i<j)and(A[i,j]>0) then
      Begin
        inc(k);
        s:=s+A[i,j];
      End;
    writeln('Сумма положительных над главной диагональю: ',s);
    writeln('Кол-во положительных над главной диагональю: ',k);
    readln;
End.
Вопрос: Дана целая квадратная матрица n-го порядка. Определить, является ли она магическим квадратом, т. е. такой матрицей, в которой суммы элементов во всех строках и столбцах одинаковы
Категория: школьный раздел
Ответы:
const
  MAX=5;
 var a:array[1..MAX,1..MAX] of integer;
     n:integer;
     ok:boolean;
     i,j:integer;
     sum:integer;
     temp:integer;
 begin
  Write('Введите рамер матрицы (3..4)');
  Readln(n);
  Writeln('Введите строки матрицы!');
  Writeln('После ввода ',n,' целых чисел нажимайте Enter!');
   for i:=1 to n do
    begin
     Write('->');
      for j:=1 to n-1 do
       read(a[i,j]);
       readln(a[i,n]);
      end;
 
    Ok:=True;
    sum:=0;
     for i:=1 to n do
      sum:=sum+a[i,i];
    {Вычисляем сумму по строкам}
   i:=1;
    repeat
     temp:=0;
      for j:=1 to n do
       temp:=temp+a[i,j];
      i:=i+1;
       if temp <> sum then
        ok:=False;
    until (not ok) or (i>n);
 
   if ok then
    begin
     j:=1;
      repeat
       temp:=0;
       for i:=1 to n do
        temp:=temp+a[i,j];
        j:=j+1;
         if temp <> sum then
          ok:=False;
      until (not ok) or (j>n);
     if ok then
      begin
       temp:=0;
       j:=n;
        for i:=1 to n do
         begin
          temp:=temp+a[i,j];
          j:=j-1;
          end;
         if temp<> sum then
          ok:=False;
         end;
        end;
       Write('Введенная матрица');
        if not ok then
         write('не');
        Writeln('является магическим квадратом!');
       readln;
      end
Вопрос: Определить, является ли заданная целая квадратная матрица n-го порядка симметричной (относительно главной диагонали).
Категория: школьный раздел
Ответы:
program prim1;
uses crt;
type mas=array[1..100,1..100] of integer;
var i,j,n,s: integer;
var a,b: mas;
 begin
 clrscr;
 write('n=');
 readln(n);
 for i:=1 to n do begin
 for j:=1 to n do begin
  readln(a[i,j]);
  end;
  end;
  for j:=1 to n do begin
  for i:=1 to n do begin
  b[j,i]:=a[i,j];
  write(b[j,i]);
  end;
END;
s:=0;
i:=j;
for i:=1 to n do begin
for j:=1 to n do begin
if a[i,j]<>b[i,j] then s:=s+1;
 end;
 end;
 if s>0 then write('НЕТ') else write('ДА, является симметричной');
end.
Вопрос: Дана целочисленная квадратная матрица. Найти в каждой строке наибольший элемент и поменять его местами с элементом главной диагонали в этой же строке.
Категория: школьный раздел
Ответы:
const n=4;
var
a:array[1..n,1..n] of integer;
max:array[1..n] of integer;
i,j,t, index,index1:integer;
begin
randomize;for i:=1 to n do 
for j:=1 to n do 
a[i,j]:=random(100);
max[1]:=a[1,1];
for i:=1 to n do begin   
for j:=1 to n do   
if a[i,j]> max[i] then    
begin     
max[i]:=a[i,j];      
index:=i; index1:=j;    
end;   
t:=a[i,i]; 
a[i,i]:=max[i]; 
a[index,index1]:=t;
end;
for i:=1 to n do 
writeln(max[i]);
for i:=1 to n do 
begin  for j:=1 to n do 
write(a[i,j]:4);  
writeln; 
end;
readln;
end.
Вопрос: Упорядочить по возрастанию элементы каждой строки матрицы размером n х m.
Категория: школьный раздел
Ответы:
program Dekio;
const
n=5;
m=8;
var
arr :array[1..n,1..m] of integer;
i,j,l,t :integer;
begin
randomize;
writeln('Г€Г±ГµГ®Г¤Г*Г»Г© ГГ*Г±Г±ГЁГў');
for i:=1 to n do
begin
for j:=1 to m do
begin
arr[i,j]:=random(16);
write(arr[i,j]:4);
end;
writeln;
end;
for l:=1 to n do
for i:=1 to m-1 do
for j:=i+1 to m do
if arr[l,i] > arr[l,j] then
begin
t:=arr[l,i];
arr[l,i]:=arr[l,j];
arr[l,j]:=t;
end;
writeln('ГђГҐГ§ГіГ«ГјГІГ*ГІ');
for i:=1 to n do
begin
for j:=1 to m do
write(arr[i,j]:4);
writeln;
end;
end.
Вопрос: Задана квадратная матрица. Получить транспонированную матрицу (перевернутую относительно главной диагонали).
Категория: школьный раздел
Ответы:
uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of integer;
    n,i,j,x:integer;
begin
randomize;
repeat
write('Размер матрицы до ',nmax,' n=');
read(n);
until n in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=random(50);
    write(a[i,j]:3);
   end;
  writeln;
 end;
writeln;
for i:=2 to n do
for j:=1 to i-1 do
 begin
  x:=a[i,j];
  a[i,j]:=a[j,i];
  a[j,i]:=x;
 end;
writeln('Транспонированная матрица:');
for i:=1 to n do
 begin
  for j:=1 to n do
  write(a[i,j]:3);
  writeln;
 end;
end.
Вопрос: Квадратная матрица, симметричная относительно главной диагонали, задана верхним треугольником в виде одномерного массива. Восстановить исходную матрицу и напечатать по строкам.
Категория: школьный раздел
Ответы:
uses crt;
const nmax=20;
var b:array[1..(nmax*(nmax+1)) div 2] of integer;
    a:array[1..nmax,1..nmax] of integer;
    n,i,j,k:integer;
begin
clrscr;
randomize;
repeat
write('Размер матрицы до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Элементы верхней треугольной матрицы:');
for i:=1 to (n*(n+1))div 2 do
 begin
  b[i]:=random(50);
  write(b[i]:4);
 end;
writeln;
writeln;
writeln('Исходная матрица:');
k:=0;
for i:=1 to n do
for j:=i to n do
 begin
  k:=k+1;
  a[i,j]:=b[k];
  a[j,i]:=b[k];
 end;
for i:=1 to n do
 begin
  for j:=1 to n do
  write(a[i,j]:4);
  writeln;
 end;
readln
end.
Вопрос: Задана матрица порядка n и число к. Разделить элементы k-й строки на диагональный элемент, расположенный в этой строке.
Категория: школьный раздел
Ответы:
uses crt;
var
 a : array[1..100,1..100] of real;
 k,i,j,n : integer;
begin
     clrscr;
     randomize;
     write('vvedite razmer n');
     readln(n);
     for i:=1 to n do
     for j:=1 to n do
     a[i,j]:=random(10);
     for i:=1 to n do
     begin
          for j:=1 to n do
          write(a[i,j]:3:0);
          writeln;
     end;
     repeat
     write('vvedite k от 1 до ',n);
     readln (k);
     until k in [1..n];
     for j:=1 to n do
     a[k,j]:=a[k,j]/a[k,k];
      for i:=1 to n do
     begin
          for j:=1 to n do
          write(a[i,j]:3:0);
          writeln;
     end;
       readkey;
end.
Вопрос: Для целочисленной квадратной матрицы найти число элементов, кратных k, и наибольший из этих элементов.
Категория: школьный раздел
Ответы:
uses crt;
const n=5;
var a:array[1..n,1..n]of integer;
i,j,max,k,t:integer;
 
begin
 clrscr;
 randomize;
 writeln('Исходный массив');
 for i:=1 to n do
 begin 
  for j:=1 to n do
  begin
    a[i,j]:=random(100);
    write(a[i,j]:3);
  end;
  writeln;
 end;
 write('K -> ');
 readln(k); 
 
 max:=-1;
 t:=0;
 for i:=1 to n do for j:=1 to n do if a[i,j] mod k=0 then
 begin
  inc(t);
  if a[i,j]>max then max:=a[i,j];
 end;
 write(k);
 writeln('MAX=',max);
 readln;
end.
Вопрос: Найти наибольший и наименьший элементы прямоугольной матрицы и поменять их местами.
Категория: школьный раздел
Ответы:
const max = 7; // так, для примера
  var
    A : array [1..max,1..Max] of Integer;
    i,j,imax,imin,jmax,jmin : Byte;
    b : Integer;
  Begin
    Randomize; imax:=1; jmax:=1; imin:=1; jmin:=1;
    Writeln('Matrix A=');
    for i:=1 to max do begin
      for j:=1 to Max do begin
        A[i,j]:=Random(300);
        write(A[i,j]:8);
        if A[i,j]>A[imax,jmax] then begin
          imax:=i; jmax:=j;
        end;
        if A[i,j]<A[imin,jmin] then begin
          imin:=i; jmin:=j;
        end;
      end;
      Writeln;
    end;
 
    writeln('Min[',imin,',',jmin,']=',A[imin,jmin],
    '  Max[',imax,',',jmax,']=',A[iMax,jmax]);
    b:=A[imax,jmax]; A[imax,jmax]:=A[imin,jmin]; A[imin,jmin]:=b;
 
    writeln('Matrix A posle:');
    for i:=1 to max do begin
      for j:=1 to Max do write(A[i,j]:8);
      Writeln;
    end;
    readln;
  End.
Вопрос: В данной действительной квадратной матрице порядка п найти сумму элементов строки, в которой расположен элемент с наименьшим значением. Предполагается, что такой элемент единственный.
Категория: школьный раздел
Ответы:
uses crt;
const n=3;
var
c:array [1..n,1..n] of integer;
min,i,j,s,e:integer;
Begin
clrscr;
min:=10000;
s:=0;
for i:=1 to n do
 for j:=1 to n do
  begin
  write('C[',i,',',j,']: ');
  readln(c[i,j]);
  end;
clrscr;
for i:=1 to n do begin
 for j:=1 to n do
  write(c[i,j]:7);
  writeln;
  end;
for i:=1 to n do
 for j:=1 to n do
 if c[i,j]<min then
  begin
 min:=c[i,j];
 s:=i;
 end;
for j:=1 to n do
 e:=e+c[s,j];
writeln('Min:',min) ;
writeln('Summa:',e);
readkey;
end
Вопрос: Дана действительная матрица размером n х m. Требуется преобразовать матрицу: поэлементно вычесть последнюю строку из всех строк, кроме последней.
Категория: школьный раздел
Ответы:
program tmp;
uses crt;
const count=100;
var
   i,j,n,m:integer;
   mas:array[1..count,1..count] of integer;
begin
clrscr;
readln(n,m);
write('ishod mas: ');writeln;
for i:=1 to n do begin
    for j:=1 to m do begin
                     mas[i,j]:=random(50);
                     write(mas[i,j]:4);
                     end;
                 writeln;
                 end;
writeln;
for i:=1 to n-1 do
    for j:=1 to m do mas[i,j]:=mas[i,j]-mas[n,j];
write('poluch mas:'); writeln;
for i:=1 to n do begin
    for j:=1 to m do write(mas[i,j]:4);
                 writeln;
                 end;
readkey;
end.
Вопрос: Определить наименьший элемент каждой четной строки матрицы А[М, N].
Категория: школьный раздел
Ответы:
uses
  crt;
const
  m=4;
  n=4;
var
  a: array [1..m,1..n] of integer;
  i,j,min: integer;
begin
  clrscr;
  randomize;
  for i:= 1 to m do
  begin
    for j:= 1 to n do
    begin
      a[i,j]:=random(10);
      write(a[i,j],' ');
    end;
    writeln;
  end;
  for i:= 1 to m do
  begin
    min:=a[i,1];
    for j:= 1 to n do
      if i mod 2 = 0 then
        if a[i,j]<min then
          min:=a[i,j];
    if i mod 2 = 0 then
      writeln('Min element ',i,'-oi stroki = ',min);
  end;
  readkey;
end.
Вопрос: Задана квадратная матрица. Переставить строку с максимальным элементом на главной диагонали со строкой с заданным номером m.
Категория: школьный раздел
Ответы:
program lab5_dvum_mass_var8;
const n=5; m=5;
type ar=array[1..n,1..m] of integer;
type br=array[1..n] of integer;
var i,z,t,j,nm,imax,jmax,max:integer; a:ar;
 
procedure vvod(var a:ar);
var i,j:integer;
begin
  for i:=1 to n do
    for j:=1 to m do
    a[i,j]:=random(51);
end;
 
procedure vivod(a:ar);
var i,j:integer;
begin
  for i:=1 to n do
   begin
    for j:=1 to m do
    write(a[i,j]:5);
    writeln;
    end;
end;
 
begin
vvod(a);
vivod(a);
 begin
 max:=0;
 for i:=1 to n do
  for j:=1 to m do
  if i=j then
   begin
    if a[i,j]>max then
    begin
     max:=a[i,j]; imax:=i; jmax:=j;
     end;
     end;
     end;
    writeln('element,' ',max:2,' ','ryadok',imax:2,' ',stolbec',jmax:2);
    Repeat
 write('vvedite nomer ryadka: ');readln(nm);
Until nm in [1..n];
For j:=1 to m do
Begin
   t:=A[nm,j];
   A[nm,j]:=A[imax,j];
   A[imax,j]:=t;
End;
writeln('preobrazovannaya matrica');
vivod(a);
writeln;
end.
Вопрос: Дана матрица B[N, М]. Найти в каждой строке матрицы максимальный и минимальный элементы и поменять их с первым и последним элементами строки соответственно.
Категория: школьный раздел
Ответы:
const n=5;
      m=5;
var b:array[1..n,1..m]of integer;
    i,j,jmx,jmn,t:integer;
begin
randomize;
for i:=1 to n do
begin
    for j:=1 to n do
    begin
     b[i,j]:=random(11)-5;
     write(b[i,j]:3);
    end;
    writeln;
end;
for i:=1 to n do
begin
   jmx:=1; jmn:=1;
   for j:=1 to m do
   begin
      if b[i,j]>b[i,jmx] then jmx:=j;
      if b[i,j]<b[i,jmn] then jmn:=j;
   end;
   t:=b[i,jmx]; b[i,jmx]:=b[i,1]; b[i,1]:=t;
   t:=b[i,jmn]; b[i,jmn]:=b[i,m]; b[i,m]:=t;
end;
writeln('Результат:');
for i:=1 to n do
begin
   for j:=1 to m do
   write(b[i,j]:3);
   writeln;
end;
readln;
end.
Вопрос: Элемент матрицы назовем седловой точкой, если он является наименьшим в своей строке и одновременно наибольшим в своем столбце или, наоборот, является наибольшим в своей строке и наименьшим в своем столбце. Для заданной целой матрицы размером n х m напечатать индексы всех ее седловых точек.
Категория: школьный раздел
Ответы:
repeat
write('Vvedite kolichestvo strok ');
readln(x);
until x in [1..nmax];
repeat
write('Kolichestvo stolbcov ');
readln(y);
writeln('    Polyshilas takaia matritsa ');
until y in [1..nmax];
for i:=1 to x do
 begin
  for j:=1 to y do
   begin
    mt[i,j]:=random(50);
    write(mt[i,j]:6);
   end;
  writeln;
 end;
end;
procedure search(mt:Tmatr;x,y:byte;var mx:integer);
var lit: array[1..nmax] of integer;
    i,j:byte;
    k:integer;
begin
writeln('Naimenshie hisla matritsi:');
for i:=1 to x do
 begin
  k:=mt[i,1];
  for j:=1 to y do
  if k > mt[i,j] then k:=mt[i,j];
  writeln('naimenshee iz stroki ',i,'=',k);
  lit[i]:=k;
 end;
writeln;
mx:=lit[1];
for i:=1 to x do
if mx < lit[i] then mx:=lit[i];
writeln('naibolshee iz naimenshih=',mx);
end;
var
  n,m:byte;
  max:integer;
  mas:Tmatr;
begin
clrscr;
Randomize;
Vvod(mas,n,m);
search(mas,n,m,max);
readln;
end.
Вопрос: Дана вещественная матрица размером n х m. Переставляя ее строки и столбцы, добиться того, чтобы наибольший элемент (или один из них) оказался в верхнем левом углу.
Категория: школьный раздел
Ответы:
Uses crt;
Type MyType = real;
Var 
  n,m,i,j,xi,xj: byte;
  a: array[1..100,1..100] of MyType;
 
Procedure Stroka(i,i1: byte);
  var 
    j: byte;
    buf: MyType;
  begin
    For j:=1 to m do
      begin
        buf:=a[i,j];
    a[i,j]:=a[i1,j];
    a[i1,j]:=buf
      end
  end;
 
Procedure Stolb(j,j1: byte);
  var
    i: byte;
    buf: MyType;
  begin
    For i:=1 to n do
      begin
        buf:=a[i,j];
    a[i,j]:=a[i,j1];
    a[i,j1]:=buf
      end
  end;
 
Begin
  Clrscr;
  Write('n=');
  Readln(n);
  Write('m=');
  Readln(m);
  Randomize;
  For i:=1 to n do
    begin
      For j:=1 to m do
         begin
           a[i,j]:=random*20-5;
           Write(a[i,j]:5:1);
         end;
      Writeln;
    end;
  Writeln;
 
  xi:=1; xj:=1;
  For i:=1 to n do
  For j:=1 to m do
    If a[i,j] > a[xi,xj] then
      begin
     xi:=i;
     xj:=j
      end;
            
  While xi < n do
    begin
      Stroka(xi,xi+1);
      Inc(xi)
    end;
  While xj > 1 do
    begin
      Stolb(xj,xj-1);
      Dec(xj)
    end;
        
  For i:=1 to n do
    begin
      For j:=1 to m do write(a[i,j]:5:1);
      Writeln
    end;
End
Вопрос: Дана целочисленная матрица размером n×m. Переставляя её строки и столбцы, добиться того, чтобы наименьший элемент (или один из них) оказался в верхнем правом углу.
Категория: школьный раздел
Ответы:
Uses crt;
Type MyType = integer;
Var 
  n,m,i,j,xi,xj: byte;
  a: array[1..100,1..100] of MyType;
 
Procedure Stroka(i,i1: byte);
  var 
    j: byte;
    buf: MyType;
  begin
    For j:=1 to m do
      begin
        buf:=a[i,j];
    a[i,j]:=a[i1,j];
    a[i1,j]:=buf
      end
  end;
 
Procedure Stolb(j,j1: byte);
  var
    i: byte;
    buf: MyType;
  begin
    For i:=1 to n do
      begin
        buf:=a[i,j];
    a[i,j]:=a[i,j1];
    a[i,j1]:=buf
      end
  end;
 
Begin
  Clrscr;
  Write('n=');
  Readln(n);
  Write('m=');
  Readln(m);
  Randomize;
  For i:=1 to n do
    begin
      For j:=1 to m do
         begin
           a[i,j]:=random(21)-5;
           Write(a[i,j]:4);
         end;
      Writeln;
    end;
  Writeln;
 
  xi:=1; xj:=1;
  For i:=1 to n do
  For j:=1 to m do
    If a[i,j] < a[xi,xj] then
      begin
     xi:=i;
     xj:=j
      end;
            
  While xi > 1 do
    begin
      Stroka(xi,xi-1);
      Dec(xi)
    end;
  While xj < n do
    begin
      Stolb(xj,xj+1);
      Inc(xj)
    end;
        
  For i:=1 to n do
    begin
      For j:=1 to m do write(a[i,j]:4);
      Writeln
    end;
End.
Вопрос: Дана квадратная матрица A[N, N], Записать на место отрицательных элементов матрицы нули, а на место положительных — единицы. Вывести на печать нижнюю треугольную матрицу в общепринятом виде
Категория: школьный раздел
Ответы:
uses crt;
var
   a:array[1..100,1..100] of integer;
   i,j,n:integer;
function b(x:integer):integer;
begin
     if x>0 then
        b:=1
     else
         b:=0;
end;
 
begin
     clrscr;
     readln(n);
     for i:=1 to n do
         for j:=1 to n do
             begin
                  clrscr;
                  writeln('BBeDuTe ',i,' ',j,'eJleMeHT');
                  readln(a[i,j]);
             end;
     for i:=1 to n do
         begin
              for j:=1 to n do
                  write(a[i,j],' ');
              writeln;
         end;
     writeln;
     for i:=1 to n do
         for j:=1 to n do
             a[i,j]:=b(a[i,j]);
     writeln;
 
     for i:=1 to n do
         begin
              for j:=1 to n do
                  write(a[i,j],' ');
              writeln;
         end;
     writeln;
 
     readln;
end.