Главная страница
Навигация по странице:

  • 21(1) Для массива С из N элементов составить процедуру, которая находит m наименьших значений С1,С2…С N и т.д.

    		•

    прога. 1 в прямоугольной матрице в каждом столбце поставить на первое место максимальный элемент столбца и, если среди полученных элементов первой строки не окажется элементов,


    Скачать 46.13 Kb.
    Название1 в прямоугольной матрице в каждом столбце поставить на первое место максимальный элемент столбца и, если среди полученных элементов первой строки не окажется элементов,
    Анкорпрога.docx
    Дата17.02.2018
    Размер46.13 Kb.
    Формат файлаdocx
    Имя файлапрога.docx
    ТипДокументы
    #15629

    1 В прямоугольной матрице в каждом столбце поставить на первое место максимальный элемент столбца и, если среди полученных элементов первой строки не окажется элементов, по модулю меньших заданной величины, разделить элементы последней строки на соотвутствующие элементы первой строки.

    Unit Z433_1;

    interface

    Const n=3;m=5;

    Type matr=array[1..n,1..m] of real;

    Var i,j:integer;

    t,p:boolean;

    a:matr;

    eps:real;

    procedure vvod(Var a:matr; eps:real);

    procedure proverka(Var t:boolean;eps:real;a:matr);

    procedure proverka1(Var p:boolean;a:matr);

    procedure delenie(Var a:matr);

    procedure sortirovka(Var a:matr;j:integer);

    implementation

    procedure vvod(Var a:matr; eps:real);

    Begin

    writeln('введите матрицу ');

    for i:=1 to n do

    for j:=1 to m do

    readln(a[i,j]);

    writeln('введите точность');

    readln(eps);

    end;

    procedure proverka(Var t:boolean;eps:real;a:matr);

    Var sh,j:integer;

    Begin

    sh:=0;

    for j:=1 to m do

    if abs(a[1,j])
    if sh=0 then t:=true

    else p:=false;

    end;

    procedure proverka1(Var p:boolean;a:matr);

    Var sh,j:integer;

    Begin

    sh:=0;

    for j:=1 to m do

    if a[1,j]=0 then sh:=sh+1;

    if sh=0 then p:=true

    else p:=false;

    end;

    procedure delenie(Var a:matr);

    Var j:integer;

    Begin

    for j:=1 to m do

    a[n,j]:=a[n,j]/a[1,j];

    end;

    procedure sortirovka(Var a:matr;j:integer);

    Var i,k,nom:integer;

    max,p:real;

    Begin

    for i:=1 to (n-1) do

    Begin

    max:=a[i,j];

    nom:=i;

    for k:=(i+1) to n do

    if a[k,j]>max then

    Begin

    max:=a[k,j];

    nom:=k;

    end;

    p:=a[i,j];a[i,j]:=a[nom,j];a[nom,j]:=p;

    end;

    end;

    begin

    end.

    program Z433_1;

    uses Z433_1;

    const n=3;m=5;

    Begin {основная программа}

    clrscr;

    vvod(a,eps);

    for j:=1 to m do

    sortirovka(a,j);

    proverka(t,eps,a);

    if t=true then

    Begin

    proverka1(p,a);

    if p=true then

    Begin

    delenie(a);

    for i:=1 to n do

    for j:=1 to m do

    write(a[i,j]:3:1,' ');

    end

    else writeln('в полученной 1 строке есть нулевые элементы');

    end else

    writeln('в полученной 1 строке есть элементы по мод.< eps');

    repeat until keypressed;

    end.

    2 Если первая строка прямоугольной матрицы имеет максимальное количество отрицательных элементов, проверить, как изменится среднее арифметическое всей матрицы, если заменить все отрицательные элементы их модулями.
    program z433_2;

    uses z433_2;

    Var A:matr;

    L:inmass;

    i,j:integer;

    s1,s2:real;

    BEGIN

    for i := 1 to n do

    for j := 1 to m do

    readln(A[i,j]);

    Negative(A,L);

    if Maximum(L) then

    Begin

    s1 := SrArifm(A);

    write('Среднее арифметическое исходной матрицы: ');

    writeln(s1:5:3);

    Replacement(A);

    s2 := SrArifm(A);

    write('Среднее арифметическое положительно определенной матрицы: ');

    writeln(s2:5:3);

    write('Разность: ');

    writeln((s2 - s1):5:3)

    end;

    readln;

    END.
    Unit Z433_2;

    interface

    Const n = 3; m = 4;

    Type matr = array[1..n,1..m] of real;

    inmass = array[1..n] of integer;

    procedure Negative(A:matr; Var L:inmass); {записывает в целочисленный массив L количество отрицательных элементов по строкам}

    function Maximum(L:inmass):boolean; {возвращает true, если L[1] - максимален}

    function SrArifm(A:matr):real; {возвращает среднее арифметическое матрицы}

    procedure Replacement(Var A:matr); {меняет все отрицательные элементы матрицы их модулями}

    implementation

    procedure Negative(A:matr; Var L:inmass);

    Var i,j,k:integer;

    Begin

    for i := 1 to n do

    Begin

    k := 0;

    for j := 1 to m do

    if A[i,j] < 0 then k := k + 1;

    L[i] := k;

    end;

    end; {Negative}

    function Maximum(L:inmass):boolean;

    Var i:integer;

    b:boolean;

    Begin

    b := true;

    i := 1;

    repeat i := i + 1;

    if L[i] > L[1] then b := false

    until (i >= n) or (not b);

    Maximum := b;

    end; {Maximum}

    function SrArifm(A:matr):real;

    Var s:real;

    i,j:integer;

    Begin

    s := 0;

    for i := 1 to n do

    for j := 1 to m do

    s := s + A[i,j];

    SrArifm := s / (m * n);

    end; {SrArifm}

    procedure Replacement(Var A:matr);

    Var i,j:integer;

    Begin

    for i := 1 to n do

    for j := 1 to m do

    if A[i,j] < 0 then A[i,j] := abs(A[i,j]);

    end; {Replacement}

    begin

    END.

    3 Если в прямоугольной матрице все суммы элементов строк

    попадают на заданный отрезок, определить номер строки

    с максимальной суммой элементов, иначе определить номера строк,

    сумма элементов которых не попала на заданный отрезок.
    Program z433_3;

    uses z433_3;

    Var A:matr;

    S:mass;

    L:inmass;

    b:boolean;

    xn,xk:real;

    i,j,k:integer;

    BEGIN

    for i := 1 to n do

    for j := 1 to m do

    readln(A[i,j]);

    writeln('Введите границы отрезка: ');

    readln(xn,xk);

    Sum(A,S);

    InArea(S,xn,xk,L,k,b);

    if b then writeln('Строка с максимальной суммой элементов: ',Maximum(S):5)

    else Begin

    writeln('Номера строк, сумма элементов которых выходит за пределы отрезка: ');

    for i := 1 to k do

    write(L[i],' ');

    end;

    readln;

    END.

    Unit Z433_3;

    interface

    Const n = 3;

    m = 4;

    Type matr = array[1..n,1..m] of real;

    mass = array[1..n] of real;

    inmass = array[1..n] of integer;

    procedure Sum(A:matr; Var S:mass);

    {Записывает в массив S суммы элементов строк матрицы A}

    procedure InArea(S:mass; xn,xk:real; Var L:inmass; Var k:integer; Var b:boolean);

    {b = true, если все элементы массива S попадают в отрезок [xn,xk], иначе

    b = false и целочисленный массив L содержит k номеров элементов S,

    не попавших в отрезок}

    function Maximum(S:mass):integer;

    {Возвращает номер максимального элемента массива S}

    implementation

    procedure Sum(A:matr; Var S:mass);

    Var i,j:integer;

    ss:real;

    Begin

    for i := 1 to n do

    Begin

    ss := 0;

    for j := 1 to m do

    ss := ss + A[i,j];

    S[i] := ss;

    end;

    end; {Sum}

    procedure InArea(S:mass; xn,xk:real; Var L:inmass; Var k:integer; Var b:boolean);

    Var i:integer;

    Begin

    k := 0;

    for i := 1 to n do

    L[i] := 0;

    for i := 1 to n do

    if (S[i] < xn) or (S[i] > xk) then

    Begin

    k := k + 1;

    L[k] := i;

    end;

    if k = 0 then b := true

    else b := false;

    end; {InArea}

    function Maximum(S:mass):integer;

    Var max:real;

    i,k:integer;

    Begin

    k := 1;

    max := S[1];

    for i := 2 to n do

    if S[i] > max then

    Begin

    max := S[i];

    k := i;

    end;

    Maximum := k;

    end; {Maximum}

    begin

    END.

    4 Для заданного массива В составить процедуру формирования массива из индексов элементов, для которых f1(Bi)>f2(Bi). Дана матрица А, у которой 6 строк и 6 столбцов. Для каждой строки матрицы А определить сумму тех элементов, для которых Aik3>eAik.
    Unit Z432_20;

    interface

    Const N=6;

    type fun=function(x:real):real;

    matr=array[1..N,1..N] of real;

    mas=array[1..N] of real;

    inmas=array[1..N] of integer;

    var A:matr;B:mas;l:inmas;s:real;i,j,k,t,tt:integer;

    function f1(x:real):real;

    function f2(x:real):real;

    procedure p(B:mas; f1,f2:fun; var l:inmas; var k:integer);

    implementation

    {$F+}

    function f1(x:real):real;

    begin f1:=sqr(x)*x end;

    function f2(x:real):real;

    begin f2:=exp(x) end;

    {$F-}

    procedure p(B:mas; f1,f2:fun; var l:inmas; var k:integer);

    var i,t,tt:integer;

    begin

    k:=0;

    for i:=1 to n do

    if f1(B[i])>f2(B[i]) then begin

    k:=k+1;

    l[k]:=i;

    end;

    end; {procedure_p}

    end.
    program z432_20;

    uses Z432_20;

    type fun=function(x:real):real;

    matr=array[1..N,1..N] of real;

    mas=array[1..N] of real;

    inmas=array[1..N] of integer;

    var A:matr;B:mas;l:inmas;s:real;i,j,k,t,tt:integer;

    begin{основной программы}

    for i:=1 to n do

    for j:=1 to n do

    readln(A[i,j]); {ввод матрицы}

    for i:=1 to n do begin

    {перепись j-ой строки матрицы в дополнительный массив B}

    for j:=1 to n do B[j]:=A[i,j];

    p(B,f1,f2,l,k)

    if k<>0 then begin s:=0;

    for t:=1 to k do begin tt:=l[t];

    s:=s+B[tt]

    end;

    writeln(s);

    end; end;

    end.

    5 Определить столбец прямоугольной матрицы с максимальной

    суммой элементов и, если его номер больше заданного,

    сформировать матрицу из стобцов исходной до найденного

    столбца, иначе сформировать массив из элементов

    заданного столбца.
    program Z433_5;

    uses Z433_5;

    Var A,B:matr;

    C:mass1;

    S:mass2;

    i,j,k,G:integer;

    BEGIN

    for i := 1 to n do

    for j := 1 to m do

    readln(A[i,j]);

    readln(G);

    Sum(A,s);

    Maximum(S,k);
    if k > G then

    Begin

    CreateMatr(A,k,B);

    for i := 1 to n do

    Begin

    for j := 1 to k do

    write(B[i,j]:5:3,' ');

    writeln;

    end;

    end

    else Begin

    CreateMass(A,k,C);

    for i := 1 to n do

    writeln(C[i]:5:3);

    end;

    readln;

    END.

    Unit Z433_5;

    interface

    Const n = 3;

    m = 4;

    Type matr = array[1..n,1..m] of real;

    mass1 = array[1..n] of real;

    mass2 = array[1..m] of real;

    procedure Sum(A:matr; Var S:mass2); {записывает в массив S суммы элементов столбцов матрицы A}

    procedure Maximum(S:mass2; Var k:integer); {k - максимальный элемент массива S}

    procedure CreateMatr(A:matr; k:integer; Var B:matr); {формирует матрицу из столбцов исходной до k-го}

    procedure CreateMass(A:matr; k:integer; Var C:mass1); {формирует массив из элементов k-го столбца исходной матрицы}

    implementation

    procedure Sum(A:matr; Var S:mass2);

    Var i,j:integer;

    Begin

    for j := 1 to m do

    Begin

    S[j] := 0;

    for i := 1 to n do

    S[j] := S[j] + A[i,j];

    end;

    end; {Sum}

    procedure Maximum(S:mass2; Var k:integer);

    Var i:integer;

    max:real;

    Begin

    max := S[1];

    k := 1;

    for i := 2 to m do

    if S[i] > max then

    Begin

    max := S[i];

    k := i;

    end;

    end; {Maximum}

    procedure CreateMatr(A:matr; k:integer; Var B:matr);

    Var i,j:integer;

    Begin

    for i := 1 to n do

    for j := 1 to k do

    B[i,j] := A[i,j];

    end; {CreateMatr}

    procedure CreateMass(A:matr; k:integer; Var C:mass1);

    Var i:integer;

    Begin

    for i := 1 to n do

    C[i] := A[i,k];

    end; {CreateMass}

    END.


    6 Если заданная квадратная целочисленная матрица является треугольной(элементы выше главной диагонали равны нулю),вычислить её среднее арифметическое, иначе определить, сколько элементов, лежащих выше главной диагонали, отличны от нуля.

    program z433_6;

    uses Z433_6;

    Var A:matr;

    i,j,k:integer;

    s:real;

    b:boolean;

    BEGIN

    for i := 1 to n do

    for j := 1 to n do

    readln(a[i,j]);

    Triangle(A,k,b);

    if b then

    Begin

    SrArifm(A,s);

    writeln(s);

    end

    else writeln(k);

    readln;

    END.

    Unit Z433_6;

    interface

    Const n = 3;

    Type matr = array[1..n,1..n] of integer;

    procedure SrArifm(A:matr; Var s:real); {s - среднее арифметическое матрицы A}

    procedure Triangle(A:matr; Var k:integer; Var b:boolean);

    {Если b = true, то матрица треугольная; k - число элементов выше главной диагонали, отличных от нуля}

    implementation

    procedure Triangle(A:matr; Var k:integer; Var b:boolean);

    Var i,j:integer;

    Begin

    b := true;

    k := 0;

    for i := 1 to n do

    for j := 1 to n do

    if (j > i) and (A[i,j] <> 0) then

    Begin

    b := false;

    k := k + 1;

    end;

    end; {Rect}

    procedure SrArifm(A:matr; Var s:real);

    Var i,j:integer;

    Begin

    s := 0;

    for i := 1 to n do

    for j := 1 to n do

    s := s + A[i,j];

    s := s / (n * n);

    end; {SrArifm}

    begin

    END.

    7 Если к-й столбец прямоугольной матрицы имеет минимальную сумму элементов, определить сумму элементов столбцов до к-ого, иначе - сумму элементов столбцов после к-ого.
    Unit Z433_7;

    interface

    Const n = 3, m = 4;

    Type matr = array[1..n,1..m] of real;

    mas = array[1..m] of real;

    procedure p1(A:matr; Var S:mas); {записывает в массив S суммы элементов столбцов}

    procedure p2(S:mas; Var nom:integer); {l - минимальный элемент массива S}

    procedure p3(A:matr; l1,l2:integer; Var sum:real);

    implementation

    procedure p1;

    Var i,j:integer;

    Begin for j := 1 to m do

    Begin S[j] := 0;

    for i := 1 to n do

    S[j] := S[j] + A[i,j];

    end;

    end; {p1}

    procedure p2;

    Var j:integer;

    Smin:real;

    Begin Smin := S[1];

    nom := 1;

    for j := 1 to m do

    if S[j] < Smin then

    Begin Smin := S[j];

    nom := j;

    end;

    end; {p2}

    procedure p3;

    Var i,j:integer;

    Begin sum := 0;

    for i := 1 to n do

    for j := l[1] to 1[2] do

    sum := sum + A[i,j];

    end; {p3}

    end.
    program z433_7;

    uses 433_7;

    const n = 3, m = 4;

    Type matr = array[1..n,1..m] of real;

    mas = array[1..m] of real;

    Var A:matr; S:mas; i,j,k,nom:integer; sum1,sum2:real;

    Begin for i := 1 to n do

    for j := 1 to m do readln(A[i,j]);

    readln(k);

    p1(A,S); p2(S,nom);

    if (nom = k) then

    Begin p3(A,1,k,sum1);

    Writeln (sum1)

    end else

    Begin p3(A,k+1,m,sum2);

    writeln(sum2);

    end;

    end.

    8 Если целочисленная квадратная матрица симметрична относително

    главной диагонали, обнулить все элементы, лежащие выше главной

    диагонали, и определить сумму элементов, лежащих ниже

    главной диагонали.
    program z433_8;

    uses Z433_8;

    Var A:matr;

    i,j,s:integer;

    BEGIN

    for i := 1 to n do

    for j := 1 to n do

    readln(A[i,j]);

    if Sim(A) then

    Begin

    NulSum(A,s);

    write('Сумма элементов, лежащих ниже главной диагонали: ');

    writeln(s);

    end

    else writeln('Матрица не симметрична относительно главной диагонали.');

    for i := 1 to n do

    Begin

    for j := 1 to n do

    write(A[i,j],' ');

    writeln;

    end;

    END.
    Unit Z433_8;

    interface

    Const n = 3;

    Type matr = array[1..n,1..n] of integer;

    function Sim(A:matr):boolean;

    {Возвращает true, если матрица симметрична относительно главной диагонали}

    procedure NulSum(Var A:matr; Var s:integer);

    {Обнуляет элементы, лежащие выше главной диагонали, и подсчитывает их сумму}

    implementation

    function Sim(A:matr):boolean;

    Var i,j,k:integer;

    b:boolean;

    Begin

    k := 0;

    b := true;

    for i := 1 to n do

    for j := 1 to n do

    if (j < i) and (A[i,j] <> A[j,i]) then k := k + 1;

    if k <> 0 then b := false;

    Sim := b;

    end; {Sim}

    procedure NulSum(Var A:matr; Var s:integer);

    Var i,j:integer;

    Begin

    s := 0;

    for i := 1 to n do

    for j := 1 to n do

    if j > i then

    Begin

    s := s + A[i,j];

    A[i,j] := 0;

    end;

    end; {NulSum}

    END.

    9. Переставить в каждом столбце прямоугольной матрицы

    все отрицательные элементы в конце столбца. Распечатать

    часть полученной матрицы, состоящую из n первых строк,

    не имеющих отрицательных элементов.

    program z433_9;

    uses Z433_9;

    Var A:matr;

    i,j,l:integer;

    BEGIN

    for i := 1 to n do

    for j := 1 to m do

    readln(A[i,j]);

    Transpos(A,l);

    if l > 0 then PrintL(A,L)

    else writeln('Ненулевых строк нет.');

    END.

    Unit Z433_9;

    interface

    Const n = 3;

    m = 4;

    Type matr = array[1..n,1..m] of real;

    procedure Transpos(Var A:matr; Var l:integer);

    {Переставляет в каждом столбце матрицы A все отрицательные элементы в конец столбца, l - число строк с ненулевыми элементами}

    procedure PrintL(A:matr; l:integer);

    {печатает l первых строк матрицы A}

    implementation

    procedure Transpos(Var A:matr; Var l:integer);

    Var i,j,k:integer;

    r:real;

    Begin

    l := 0;

    for j := 1 to m do

    Begin

    k := 0;

    for i := 1 to n do

    Begin

    while A[n-k,j] < 0 do k := k + 1;

    if (A[i,j] < 0) and (i <= (n - k)) then

    Begin

    r := A[i,j];

    A[i,j] := A[n-k,j];

    A[n-k,j] := r;

    k := k + 1;

    end;

    end;

    if k > l then l := k;

    end;

    l := n - l;

    end; {Transpos}

    procedure PrintL(A:matr; l:integer);

    Var i,j:integer;

    Begin

    for i := 1 to l do

    Begin

    for j := 1 to m do

    write(A[i,j]:5:3,' ');

    writeln;

    end;

    end; {PrintL}

    END.

    10 Если все точки плоскости, заданные своими координатами, попадают в круг с радиусом R и центром в начале координат, определить их среднюю абсциссу и ординату, иначе распечатать номера точек, не попавших в заданый круг.
    Unit Z433_10;

    interface

    Const n = 5;

    Type mass = array[1..n] of real;

    function InArea(X,Y:mass; R:real):boolean;

    {возвращает true, если все точки попали в круг радиусом R}

    procedure SrZnach(A:mass; Var s:real);

    {Вычисляет среднее значение массива A}

    procedure PrintNum(X,Y:mass; R:real);

    {Печатает номера точек, не попавших в круг радиусом R}

    implementation

    function InArea(X,Y:mass; R:real):boolean;

    Var i:integer;

    b:boolean;

    Begin

    b := true;

    i := 0;

    repeat i := i + 1;

    if sqrt((sqr(X[i]) + sqr(Y[i]))) > R then b := false

    until (not b) or (i >= n);

    InArea := b;

    end; {InArea}

    procedure SrZnach(A:mass; Var s:real);

    Var i:integer;

    Begin

    s := 0;

    for i := 1 to n do

    s := s + A[i];

    s := s / n;

    end; {SrZnach}

    procedure PrintNum(X,Y:mass; R:real);

    Var i:integer;

    Begin

    for i := 1 to n do

    if sqrt((sqr(X[i]) + sqr(Y[i]))) > R then write(i,' ');

    end; {PrintNum}

    END.
    program z433_10;

    uses Z433_10;

    Var X,Y:mass;

    i:integer;

    R,sx,sy:real;

    BEGIN

    for i := 1 to n do

    Begin

    write('X: ');

    readln(X[i]);

    write('Y: ');

    readln(Y[i]);

    end;

    write('R: ');

    readln(R);

    if InArea(X,Y,R) then

    Begin

    SrZnach(X,sx);

    SrZnach(Y,sy);

    writeln('A: ',sx,' O: ',sy)

    end

    else Begin

    write('N: ');

    PrintNum(X,Y,R);

    end;

    END.

    11 Если столбцы заданной прямоугольной целочисленной матрицы расположены в порядке возрастания числа нулевых элементов в них, то подсчитать число нулевых элементов во всей матрице, иначе определить столбец с максимальным количеством нулей.

    program z433_11;

    uses Z12433_11;

    Var A:matr;

    S:mass;

    i,j,ch,nmax:integer;

    BEGIN

    for i := 1 to n do

    for j := 1 to m do

    readln(A[i,j]);

    NulS(A,S);

    if Vozr(S) then

    Begin

    NulCh(S,ch);

    write('ch: ');

    writeln(ch);

    end

    else Begin

    Maximum(S,nmax);

    write('nmax: ');

    writeln(nmax);

    end;

    END.

    Unit Z433_11;

    interface

    Const n = 3;

    m = 4;

    Type matr = array[1..n,1..m] of integer;

    mass = array[1..m] of integer;

    procedure NulS(A:matr; Var S:mass);

    {Записывает в массив S число нулей в каждом столбце}

    function Vozr(S:mass):boolean;

    {возвращает true, если в массиве S элементы расположены в порядке возрастания}

    procedure NulCh(S:mass; Var ch:integer);

    {ch - количество нулей в матрице}

    procedure Maximum(S:mass; Var nmax:integer);

    {nmax - номер столбца с максимальным количеством нулей}

    implementation

    procedure NulS(A:matr; Var S:mass);

    Var i,j,k:integer;

    Begin

    for j := 1 to m do

    Begin

    k := 0;

    for i := 1 to n do

    if A[i,j] = 0 then k := k + 1;

    S[j] := k;

    end;

    end; {NulS}
    function Vozr(S:mass):boolean;

    Var i,k:integer;

    b:boolean;

    Begin

    k := 0;

    for i := 2 to m do

    if S[i] > S[i-1] then k := k + 1;

    if k = m - 1 then b := true

    else b := false;

    Vozr := b;

    end; {Vozr}
    procedure NulCh(S:mass; Var ch:integer);

    Var i:integer;

    Begin

    ch := 0;

    for i := 1 to m do

    ch := ch + S[i];

    end; {NulCh}
    procedure Maximum(S:mass; Var nmax:integer);

    Var i,max:integer;

    Begin

    max := S[1];

    nmax := 1;

    for i := 2 to m do

    if S[i] > max then

    Begin

    max := S[i];

    nmax := i;

    end;

    end; {Maximum}
    END.

    12,Если максимальный элемент квадратной матрицы находится выше главной диагонали, транспонировать матрицу,иначе определить сумму элементов строки и столбца с номерами, равными индексам максимального элемента.

    program z433_12;

    uses Z433_12;

    Var A:matr;

    i,j,k,l:integer;

    b:boolean;

    s:real;

    BEGIN

    for i := 1 to n do

    for j := 1 to n do

    readln(A[i,j]);

    Maximum(A,k,l,b);

    if b then

    Begin

    Transpos(A);

    for i := 1 to n do

    Begin

    for j := 1 to n do

    write(A[i,j]:5:3,' ');

    writeln;

    end; end

    else Begin

    Sum(A,k,l,s);

    write('Сумма элементов строки и столбца, содержащих максимальный элемент: ');

    writeln(s:5:3); end;END.

    Unit Z433_12;

    interface

    Const n = 3;

    Type matr = array[1..n,1..n] of real;

    procedure Maximum(A:matr; Var k,l:integer; Var b:boolean);

    {b = true, если максимальный элемент матрицы находится выше главной диагонали, k,l - индексы максимального элемента}

    procedure Transpos(Var A:matr);{Транспонирует матрицу}

    procedure Sum(A:matr; k,l:integer; Var s:real);

    {s - сумма элементов k-й строки и l-го столбца}

    implementation

    procedure Maximum(A:matr; Var k,l:integer; Var b:boolean);

    Var i,j:integer;

    max:real;

    Begin

    k := 1;l := 1;

    max := A[1,1];

    for i := 1 to n do

    for j := 1 to n do

    if A[i,j] > max then

    Begin

    max := A[i,j];

    k := i;

    l := j;

    end;

    if l > k then b := true

    else b := false;

    end; {Maximum}

    procedure Transpos(Var A:matr);

    Var i,j:integer;

    r:real;

    Begin

    for i := 1 to n do

    for j := 1 to n do

    if i > j then

    Begin

    r := A[i,j];

    A[i,j] := A[j,i];

    A[j,i] := r;

    end;end; {Transpos}

    procedure Sum(A:matr; k,l:integer; Var s:real);

    Var i:integer;

    Begin

    s := 0;

    for i := 1 to n do

    s := s + A[i,l] + A[k,i];

    s := s - A[k,l];

    end; {Sum}END.

    13 Дана квадратная матрица. Увеличить все элементы строки с минимальной суммой элементов на среднее арифметическое элементов матрицы, лежащих выше главной диагонали.
    Unit Z433_13;

    interface

    Const n = 3;

    Type matr = array[1..n,1..n] of real;

    mass = array[1..n] of real;

    procedure Sum(A:matr; Var S:mass);

    {Записывает в массив S суммы элементов матрицы A по строкам}

    procedure Minimum(S:mass; Var k:integer);

    {k - номер минимального элемента массива S}

    procedure SrArifm(A:matr; Var sr:real);

    {sr - среднее арифметическое элементов матрицы, лежащих выше главной диагонали}

    procedure Increase(k:integer; sr:real; Var A:matr);

    {Увеличивает элементы k-й строки матрицы на величину sr}

    implementation

    procedure Sum(A:matr; Var S:mass);

    Var i,j:integer;

    Begin

    for i := 1 to n do

    Begin

    S[i] := 0;

    for j := 1 to n do

    S[i] := S[i] + A[i,j];

    end;

    end; { procedure Sum }

    procedure Minimum(S:mass; Var k:integer);

    Var i:integer;

    min:real;

    Begin

    min := S[1];

    k := 1;

    for i := 2 to n do

    if S[i] < min then

    Begin

    min := S[i];

    k := i;

    end;

    end; { procedure Minimum }

    procedure SrArifm(A:matr; Var sr:real);

    Var i,j,k:integer;

    Begin

    k := (n * n - n) div 2;

    sr := 0;

    for i := 1 to n do

    for j := 1 to n do

    if j > i then sr := sr + A[i,j];

    sr := sr / k;

    end; { procedure SrArifm }

    procedure Increase(k:integer; sr:real; Var A:matr);

    Var j:integer;

    Begin

    for j := 1 to n do

    A[k,j] := A[k,j] + sr;

    end; { procedure Increase }

    END.
    program z433_13;

    uses Z433_13;

    Var A:matr;

    S:mass;

    i,j,k:integer;

    sr:real;

    BEGIN

    for i := 1 to n do

    for j := 1 to n do

    readln(A[i,j]);

    Sum(A,S);

    Minimum(S,k);

    SrArifm(A,sr);

    Increase(k,sr,A);

    for i := 1 to n do

    Begin

    for j := 1 to n do

    write(A[i,j]:5:3,' ');

    writeln;

    end;

    END.

    14 Изменить заданную прямоугольную матрицу так, чтобы

    на первом месте стояла строка с максимальной, а на

    последнем месте строка с минимальной суммой элементов,

    сохранив все элементы исходной матрицы.

    program z433_14;

    uses Z433_14;

    const n=3; m=4;

    BEGIN

    writeln('Введите матрицу');

    for i:=1 to n do

    for j:=1 to m do

    readln( a[i,j]);

    max(a,k);

    min(a,b);

    zamena(k,a);

    for i:=1 to n do

    begin

    for j:=1 to m do

    write(A[i,j]:0:1,' ' );

    writeln;

    end;

    END.
    Unit Z433_14;

    const n=3; m=4;

    type matr=array[1..n,1..m] of real;

    var a:matr;b,k,i,j:integer;

    Procedure max(var a:matr;var k:integer);

    procedure min(var a:matr; var k:integer);

    procedure zamena(k:integer;var a:matr);

    implementation

    Procedure max(var a:matr;var k:integer);

    var t,sum:real;

    begin

    sum:=0; t:=0;

    for i:=1 to n do

    begin

    for j:=1 to m do

    sum:=sum+a[i,j];

    if sum>t then begin t:=sum;k:=i;end;

    sum:=0;

    end;

    end;

    procedure min(var a:matr; var k:integer);

    var b,sum:real;

    begin

    sum:= 0; b:= 0;

    for i:= 1 to n do

    begin

    for j:= 1 to m do sum:=sum+a[i,j];

    if sum
    sum:=0; end; end;

    procedure zamena(k:integer;var a:matr);

    var t:real;

    begin

    for j:=1 to m do begin

    t:=a[1,j];

    a[1,j]:=a[k,j];

    a[k,j]:=t;

    end; end; end.

    15.Задачка с длинным условием и разными бяками=)
    program Z433_15;

    uses Z433_15;

    Var a:matr;

    c:mas;

    i,j,k:integer;

    sr:real;

    Begin

    vvodm(a);

    k:=0;

    sr:=0;

    for i:=1 to n-1 do

    Begin

    for j:=1 to n do c[j]:=a[i,j];

    k:=k+chktri(c,i);

    end;

    vyvodm(a);

    if k=0 then

    Begin

    for i:=1 to n do

    Begin

    for j:=1 to n do c[j]:=a[i,j];

    sr:=sr+sredmas(c);

    end;

    writeln('Srednee arifmeticheskoe=',sr/n:2:3);

    end else writeln('Chislo ne nulevyx=',k);

    readln;

    end.

    Unit Z433_15;

    interface

    uses crt;

    Const n=4;

    Type mas= array [1..n] of real;

    procedure vvodm(Var a:mas);

    procedure vyvodm(a:mas);

    function iter(x,e:real):real;

    implementation

    procedure vvodm;

    Var i:integer;

    Begin

    clrscr;

    writeln('Vvod elementov massiva:');

    for i:=1 to n do

    Begin

    write('[',i,']=');

    readln(a[i]);

    end;

    end;

    procedure vyvodm;

    Var i:integer;

    Begin

    writeln;

    writeln('Soderganie massiva:');

    for i:=1 to n do write(a[i]:3:2,' ');

    writeln;

    end;

    function iter;

    Var i:integer;

    y,y1,y2:real;

    Begin

    y:=1/x;

    repeat

    y1:=(3*y/2)-(x*y*y*y/2);

    y2:=(3*y1/2)-(x*y1*y1*y1/2);

    y:=y1;

    until(abs(y1-y2)<=e);

    iter:=y2;

    end;

    end.

    end.

    16 Если все заданные точки плоскости принадлежат первой четверти, определить координаты точки, наиболее удаленной от начала коодинат, иначе определить координаты точке, не попавших в первую четверть.
    unit Z433_16;

    interface

    uses crt;

    Const n=5;

    Type mas=array[1..n] of real;

    inmas=array[1..n] of real;

    Var x,y:mas;

    l:inmas;

    k,i,t,c:integer;

    procedure check(x,y:mas; k:integer);

    procedure coord(x,y:mas;c:integer);

    implementation

    procedure check(x,y:mas; k:integer);

    Begin

    k:=0;

    for i:=1 to n do

    Begin

    if (x[i]>0) and (y[i]>0) then k:=k+1

    end;

    if k=n then t:=1

    else

    t:=0;

    end;

    procedure coord(x,y:mas;c:integer);

    Begin

    if(not(x[i]>0) and (y[i]>0)) then

    Begin k:=k+1;

    l[k]:=i

    end;

    end;

    end.

    program Z433_16;

    uses Z433_16;

    Var x,y:mas;

    l:inmas;

    k,i,t,c:integer;

    Begin

    for i:=1 to n do

    Begin

    writeln('vvedite kordinati x');

    readln(x[i]);

    writeln('vvedite koordinati y');

    readln(y[i]);

    check(x,y,k);

    coord(x,y,c);

    writeln(t, k, l[k]);

    readln;

    end;

    end.

    17 Найти максимальный среди отрицательных и минимальный среди положительных элементов прямоугольной матрицы. если они отличаются по модолю меньше чем на заданную величину, заменить все отриц элементы их модулями.
    program Z433_17;

    uses Z433_17;

    Var a:matr;

    max,min,eps:real;

    i,j:integer;

    Begin

    for i:=1 to n do

    for j:=1 to t do

    readln(a[i,j]);

    readln(eps);

    max(a,max);

    min(a,min);

    if abs(max-min)
    for i:=1 to n do

    for j:=1 to t do

    if a[i,j]<0

    then a[i,j]:=abs(a[i,j]); end;

    for i:=1 to n do

    for j:=1 to t do

    writeln(a[i,j]);

    end.

    unit Z433_17;

    interface

    Const n=5;

    Const m=6;

    Type matr=array[1..n,1..m]of real;

    procedure max(a:matr;Var max:real);

    procedure min(a:matr;Var min:real);

    implementation

    procedure max(a:matr;Var max:real);

    Var i,j:integer;

    Begin

    for i:=1 to n do

    for j:=1 to m do

    if a[i,j]<0 then max:=abs(a[i,j]);

    for i:=1 to n do

    for j:=1 to m do

    if a[i,j]<0 and abs(a[i,j])
    then max:=abs(a[i,j]);

    end;

    procedure min(a:matr;Var min:real);

    Var i,j:integer;

    Begin

    for i:=1 to n do

    for j:=1 to m do

    if a[i,j]>0 then min:=a[i,j];

    for i:=1 to n do

    for j:=1 to t do

    if a[i,j]>0 and abs(a[i,j])
    then min:=abs(a[i,j]);

    end;

    end.

    18 Определить по экзаменациооной ведомости попадает ли группа на конкурс лучших групп. Условие конкурса: средний балл группы выше четырех, отсутствие неуспевающих, число студентов не имеющих тройки больше половины всех студентов группы
    program Z433_18;

    uses Z433_18;

    Var A: matr;

    sum, sr_bal: real;

    T: vector;

    k, i, j, kol: integer;

    Begin {осн. программы}

    For i:=1 to n do

    For j:=1 to m do

    readln(A[i,j]);

    Bal(A,sum, sr_bal);

    USPEVAEMOST(A, k);

    TROIKI(A, T, kol);

    If (sr_bal>4) and (k=0) and

    (kol>(m/2)) then writeln('Gruppa_popadaet')

    else writeln('ne_popadaet');

    end.
    Unit Z433_18;

    interface

    Const n=3; m=4;

    Type matr=array[1..n,1..m] of real;

    vector=array [1..m] of integer;

    Var A: matr;

    sum, sr_bal: real;

    T: vector;

    k, i, j, kol: integer;

    Procedure BAL(A: matr; Var sum, sr_bal: real);

    Procedure USPEVAEMOST(A: matr; Var k: integer);

    Procedure TROIKI(A:matr; Var T:vector; Var kol: integer);

    implementation

    Procedure BAL(A: matr; Var sum, sr_bal: real);

    Var i, j: integer;

    Begin

    sum:=0;

    sr_bal:=0;

    For i:=1 to n do

    For j:=1 to m do

    sum:=sum+A[i,j];

    sr_bal:=sum/(n*m);

    end;

    Procedure USPEVAEMOST(A: matr; Var k: integer);

    Var i, j: integer;

    Begin

    k:=0;

    For i:=1 to n do

    For j:=1 to m do

    If A[i, j]<3 then k:=k+1

    end;

    Procedure TROIKI(A:matr; Var T:vector; Var kol: integer);

    Var i, j: integer;

    Begin

    kol:=0;

    For i:=1 to n do

    For j:=1 to m do

    If A[i,j]>3 then T[j]:=1 else T[j]:=0;

    For j:=1 to m do

    If T[j]=1 then kol:=kol+1

    end;

    end.

    19 Подсчитать как изменится среднее арифметическое элементов матрицы, если во всех столбац с номерами, большими, чем номер столбца с максимальным количеством отрицательных элементов, заменить все отрицательные элементы по их модулям.
    Unit Z433_19;

    interface

    Const n=5;

    Type

    Matr = array [1..n,1..n] of real;

    Var p,i,j: integer; V,A:matr; w: string; r,sr1,sr2:real;

    Procedure SrAr (A:matr; Var sr:real);

    Procedure nomer (A:matr; Var P:integer);

    Procedure Zamena(P:integer; A:matr; Var V:matr);

    Procedure Pods4et (sr1,sr2:real;Var w:string; Var r:real);

    implementation

    Procedure SrAr (A:matr; Var sr:real);

    Var i,j : integer;

    Begin

    For i:=1 to n do

    For j:=1 to n do

    Sr:=sr+A[i,j];

    Sr:=sr/sqr(n);

    End; { Procedure SrAr }

    Procedure nomer (A:matr; Var P:integer);

    Var Z,B, i,j : integer;

    Begin

    For i:=1 to n do

    If A[i,1]<0 then

    Begin

    Z:=z+1;

    P:=1;

    End;

    For j :=2 to n do

    Begin

    For i:=1 to n do

    If A[i,j]<0 then

    B:=b+1;

    If b>z then

    Begin

    Z:=b;

    P:=j;

    End;

    End;

    End; { Procedure nomer }

    Procedure Zamena(P:integer; A:matr; Var V:matr);

    Var I,j:integer;

    Begin

    For j:=1 to n do

    If i>n then

    For i:=1 to n do

    If A[i,j]<0 then

    V[i,j]:=abs (A[i,j]);

    End; { Procedure Zamena }

    Procedure Pods4et (sr1,sr2:real;Var w:string; Var r:real);

    Begin

    If sr1>sr2 then

    Begin

    R:=sr1-sr2;

    W:='уменьшилось';

    End

    Else

    If sr1
    Begin

    R:=sr1-sr2;

    W:='увелчилось';

    End;

    End; { Procedure Pods4et }

    end.
    Program Z433_19;

    Uses Z433_19;

    Var

    p,i,j: integer;

    V,A:matr;

    w: string;

    r,sr1,sr2:real;

    BEGIN

    for i:=1 to n do

    for j:=1 to n do

    readln(a[i,j]);

    SrAr(A,sr1);

    Nomer(A,N);

    Zamena(N,A,V);

    SrAr (A,sr2);

    Pods4et(sr1,sr2,w,r);

    Writeln (w, 'на', r);

    End.

    20 В заданной прямоугольной матрице поставить на первое место

    столбец с наименьшим количеством нулевых элементов,

    перестаиви все нули в конец этого столбца. (Измененная

    матрица должна сожержать все элементы исходной матрицы).
    program Z433_20;

    uses Z433_20;

    Var a:matr; i,j:integer;

    Begin

    for i:=1 to n do

    for j:=1 to m do

    read(a[i,j]);

    obmen_nul(a);

    for j:=1 to m do

    for i:=1 to n do

    writeln(a[i,j]);

    end.
    unit Z433_20;

    interface

    Const n=4; Const m=5;

    Type matr=array[1..n,1..m] of real;

    Var a:matr; i,j:integer;

    procedure nul_schet(a:matr; Var k:mas);

    procedure nom_stol(k:mas; Var w:integer);

    procedure obmen_nul(Var a:matr);

    implementation

    procedure nul_schet;

    Var i,j:integer;

    Begin

    for j:=1 to m do

    for i:=1 to n do

    if a[i,j]=0 then k[j]:=k[j]+1;

    end;

    end;{proc1}

    procedure nom_stol;

    Var i,j:integer;

    Begin w:=0;

    for j:=1 to m do

    if k[j]>k[j+1] then w:=i+1;

    end;

    end;{proc2}

    procedure obmen_nul;

    Var j, k,l:integer;

    Begin k:=1; l:=m;

    for i:=1 to n do

    for j:=1 to m do

    while k<>l do Begin

    if a[i,k]=0 then Begin

    if a[i,l]=0 then l:=l-1

    else Begin a[i,l]:=a[i,k]; a[i,k]:=0; k:=k+1; l:=l+1; end; end

    else k:=k+1;

    end;

    end;{proc}

    21(1) Для массива С из N элементов составить процедуру, которая находит m наименьших значений С1,С2…СN и т.д.
    program 432_1;

    const n=6;

    type fun=function(x:real):real;

    matr=array[1..n,1..n] of real;

    mas=array[1..n] of real;

    var A:matr; c:mas; i,j,m:integer; S:real;

    procedure UPOR_P(c:mas;f:fun;m:integer;s:real);

    var i,j,k,l:integer; w,min:real;z:array[1..m] of real;

    begin for j:=1 to n-1 do begin

    min:=c[j]; k:=j;

    for i:=j to n do if c[i]
    then begin min:=c[i]; k:=1; end;

    w:=c[j];

    c[j]:=c[k];

    c[k]:=w;

    end;

    for l:=1 to n do

    z[l]:=c[l];

    s:=0;

    for l:=1 to m do s:=s+f(z[l]);

    end;

    {$F+} function G(x:real):real;

    begin

    G:=SQR(x);

    end;

    {$F-};

    begin

    for i:=1 to n do

    for j:=1 to n do

    readln A[i,j];

    read(m);

    for i:=1 to n do begin

    for j:=1 to n do

    c[j]:=A[i,j];

    p(c,G,m,S);

    writeln(S);

    end;

    end.

    22 Дана квадратная матрица. Если номер столбца с максимальной суммой элементов совпадает с номером строки с максимальной суммой элементов, определить сумму найденных элементов строки и столбца, иначе - распечатать номера найденных строки и столбца с максимальными суммами.
    unit Z433_22;

    interface

    Const n=5;

    Type matriza=array[1..n,1..n]of real;

    massiv=array[1..n]of real;

    procedure colmax(a:matriza;Var ncol:integer;Var sumcol:massiv;Var maxcol:real);

    procedure rowmax(a:matriza;Var nrow:integer;Var sumrow:massiv;Var maxrow:real);

    procedure summa(a:matriza;ncol:integer;nrow:integer;Var sumelem:real);

    implementation

    procedure colmax(a:matriza;Var ncol:integer;Var sumcol:massiv;Var maxcol:real);

    Var i,j:integer;

    Begin

    for j:=1 to n do Begin

    sumcol[j]:=0;

    for i:=1 to n do

    sumcol[j]:=sumcol[j]+a[i,j]; end;

    maxcol:=sumcol[1];

    for j:=2 to n do

    if sumcol[j]>maxcol then Begin

    maxcol:=sumcol[j];

    ncol:=j; end;

    end; { procedure colmax }

    procedure rowmax(a:matriza;Var nrow:integer;Var sumrow:massiv;Var maxrow:real);

    Var i,j:integer;

    Begin

    for i:=1 to n do Begin

    sumrow[i]:=0;

    for j:=1 to n do

    sumrow[i]:=sumrow[i]+a[i,j]; end;

    maxrow:=sumrow[1];

    for i:=2 to n do

    if sumrow[i]>maxrow then Begin

    maxrow:=sumrow[i];

    nrow:=i; end;

    end;{ procedure rowmax }

    procedure summa(a:matriza;ncol:integer;nrow:integer;Var sumelem:real);

    Var i,j:integer;

    Begin

    sumelem:=0;

    for i:=1 to n do

    for j:=1 to n do

    if (i=nrow) or (j=ncol)

    then sumelem:=sumelem+a[i,j];

    end; { procedure summa }

    end.
    program Z433_22;

    uses Z433_22;

    Var a:matriza;

    sumcol,sumrow:massiv;

    sumelem,maxcol,maxrow:real;

    ncol,nrow,i,j:integer;

    Begin

    for i:=1 to n do

    for j:=1 to n do

    readln(a[i,j]);

    colmax(a,ncol,sumcol,maxcol);

    rowmax(a,nrow,sumrow,maxrow);

    if ncol=nrow then Begin

    summa(a,ncol,nrow,sumelem);

    writeln(sumelem); end

    else writeln(nrow,ncol);

    end.


    23 program Z433_23;

    uses Z433_23;

    Var x,y:mass; t:boolean; z:mass1;

    i:integer;

    Begin{osnovnaya programma}

    writeln('x[i]=');

    for i:=1 to n do

    readln(x[i]);

    writeln('y[i]=');

    for i:=1 to n do

    readln(y[i]);

    ysl(x,y,t);

    if t then Begin

    form_massiv(x,y,z);

    for i:=1 to n do

    writeln (z[i]);

    end

    else writeln('yslovie ne vupolneno');

    end.

    unit Z433_23;

    interface;

    Const n=2;

    Type mass=array[1..n] of integer;

    mass1=array[1..n] of real;

    function fact(n:integer):integer;

    procedure ysl(x,y:mass; Var t:boolean);

    procedure form_massiv(x,y:mass; Var z:mass1);

    implementation

    function fact(n:integer):integer;

    Var y,i:integer;

    Begin y:=1;

    for i:=1 to n do

    y:=y*i;

    fact:=y;

    end;

    procedure ysl(x,y:mass; Var t:boolean);

    Var i:integer;

    Begin

    for i:=1 to n do

    if (y[i]>x[i]) then t:=true

    else t:=false;

    end;

    procedure form_massiv(x,y:mass; Var z:mass1);

    Var i:integer;

    Begin

    for i:=1 to n do

    z[i]:=fact(y[i])/(fact(x[i])*(fact(y[i])-fact(x[i])));

    end;

    end.

    написать администратору сайта