Персональная страничка
Диканева Тараса
Викторовича
Главная \ Преподавательское \ Программирование для начинающих
Введение
Выбор среды программирования
1. Линейные программы: арифметические операторы, стандартные функции и ввод/вывод в текстовом режиме
2. Логические выражения и условный оператор
3. Цикл с параметром (for)
4. Вычисления с помощью рекуррентных соотношений
5. Вложенные циклы
6. Задачи на перебор вариантов
7. Переменные-флаги
8. Переменная - счетчик событий
9. Циклы while и repeat
10. Массивы
11. Процедуры и функции
12. Двумерные массивы
13. Графика в Паскале
14. Символы, строки, текстовые файлы
15. Записи
16. Указатели

12. Двумерные массивы

Предыдущий раздел:

12.1. Двумерные массивы: теория

Следующий раздел:

13.1. Графика в Паскале. Введение

Задание 12: Двумерные массивы

1. Опишите тип — двумерный массив, количество элементов по горизонтали и вертикали пусть задается константами. Создайте процедуры: заполняющую такой массив случайными числами, и печатающую массив на экране.

2. Создайте процедуры:

    (а) Обнуляющую двумерный массив.
    (б) Заносящую в квадратный двумерный массив единичную матрицу (с единицами на главной диагонали и нулями во всех прочих местах).

3. Создайте процедуру, присваивающую элементам двумерного массива их порядковые номера. Элементы нумеруются следующим образом:

    (а) Построчно, то есть

\begin{pmatrix} 1 & 2 & 3 & \cdots & n\\ n+1 & n+2 & \cdots & & 2n\\ 2n+1 & \cdots & & &\\ \vdots & & & & \vdots\\ \cdots & & & & n^2 \end{pmatrix}

    (б) По спирали. Например, для матрицы 5×5 должно получиться

\begin{pmatrix} 1&2&3&4&5\\ 16&17&18&19&6\\ 15&24&25&20&7\\ 14&23&22&21&8\\ 13&12&11&10&9 \end{pmatrix}

    (в) По диагонали. Например:

\begin{pmatrix} 1&3&6&10&15\\ 2&5&9&14&19\\ 4&8&13&18&22\\ 7&12&17&21&24\\ 11&16&20&23&25 \end{pmatrix}

4. Создайте процедуру, которая вычтет строку с заданным номером, помноженную на коэффициент, из всех последующих строк матрицы. Матрица, номер вычитаемой строки и коэффициент должны быть параметрами.

5. Создайте процедуру, осуществляющую транспонирование матрицы.

Следующий раздел:

13.1. Графика в Паскале. Введение

Предыдущий раздел:

12.1. Двумерные массивы: теория

Добавить комментарий

1 комментарий

  1. Таня 08.04.2011 в 19:43

    а в задании 3(в) матрица квадратная или любая?

  2. Taras 08.04.2011 в 23:13

    Любая

  3. Таня 08.04.2011 в 23:17

    эх, ну ладно)

  4. оксана 15.11.2013 в 00:50

    задание 1:
    …
    Был текст программы
    Час с лишним не могла понять почему не печатает всю матрицу, оказалось, что у меня после «do» стояли точка с запятой:
    for i:=1 to n do;
    for i:=1 to m do;
    )))))

  5. Taras 16.11.2013 в 11:09

    Программа правильная и даже замечаний никаких придумать не могу )

    Точка с запятой без ничего это так называемый пустой оператор — инструкция не делать ничего, но с формальной точки зрения полноценный оператор. А в цикле без begin/end должен выполнятся только один оператор, который идет сразу за do.

  6. оксана 16.11.2013 в 19:36

    задание 2 а и б:
    а) …
    Был текст программы

    б) …
    Был текст программы

  7. оксана 16.11.2013 в 20:57

    задание 3а:
    …
    Был текст программы

  8. оксана 16.11.2013 в 22:30

    А как по спирали делать? Дайте, пожалуйста, какую-нибудь зацепку)))

  9. Taras 18.11.2013 в 00:59

    2a — ok
    2б — недиагональные элементы надо явно делать нулями. Вдруг в матрице изначально не нули, а черт знает что.

    >> А как по спирали делать? Дайте, пожалуйста, какую-нибудь зацепку)))

    Универсальная рекомендация — если задача слишком сложная, надо разбить ее на более простые подзадачи. Подзадачи могут отличаться друг от друга параметрами.

    Конкретно для спирали, например, так:
    подзадача — заполнение одного шага спирали (одного круга).
    То, чем отличаются действия при заполнении каждого круга — параметры. А чем отличаются? Заполняя n-й круг мы работаем с внутренней подматрицей (без первых и последних n-1 строк и столбцов). Отличается также начальное значение.

    То есть делаешь процедуру, которая может заполнить n-й круг, начиная с числа m. Потом с ее помощью делаешь много кругов.

  10. оксана 19.11.2013 в 01:25

    задание 3б (но работает только для квадратной матрицы((, как исправить?))):
    const
    n=5;
    m=5;
    type
    TMatrix= array[1..n,1..m] of integer;
    var
    x: TMatrix;
    L1,t1,r1,s1,b1,i: integer;
    procedure IStroka(var a: TMatrix; var s: integer; L,t,r: integer);
    var
    i: integer;
    begin
    for i:=L to r do
    begin
    a[t,i]:=s;
    s:=s+1;
    end;
    end;
    procedure IStolb(var a: TMatrix; var s: integer; t,r,b: integer);
    var
    i: integer;
    begin
    for i:=t+1 to b do
    begin
    a[i,r]:=s;
    s:=s+1;
    end;
    end;
    procedure IIStroka(var a: TMatrix; var s: integer; t,r,b: integer);
    var
    i: integer;
    begin
    for i:=r-1 downto t do
    begin
    a[b,i]:=s;
    s:=s+1;
    end;
    end;
    procedure IIStolb(var a: TMatrix; var s: integer; t,L,b: integer);
    var
    i: integer;
    begin
    for i:=b-1 downto t+1 do
    begin
    a[i,l]:=s;
    s:=s+1;
    end;
    end;
    procedure Spiral(var a: TMatrix; var s: integer; t,r,b,L: integer);
    begin
    IStroka(x,s1,L1,t1,r1);
    IStolb(x,s1,t1,r1,b1);
    IIStroka(x,s1,t1,r1,b1);
    IIStolb(x,s1,t1,L1,b1);
    end;
    procedure Writee(var a: TMatrix);
    var
    i,k: integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    begin
    write(x[i,k],’ ‘);
    end;
    writeln;
    end;
    end;
    begin
    s1:=1;
    r1:=m;
    b1:=n;
    L1:=1;
    t1:=1;
    for i:=1 to (m div 2)+1 do
    begin
    Spiral(x,s1,t1,r1,b1,L1);
    r1:=r1-1;
    b1:=b1-1;
    L1:=L1+1;
    t1:=t1+1;
    end;
    Writee(x);
    end.

  11. оксана 20.11.2013 в 00:54

    опять не получилось, это из-за треугольных скобок, у вас где-то написано было как добавлять программы без ущерба для них, но я не нашла, попробую так:
    const
    n=10;
    m=4;
    type
    TMatrix= array[1..n,1..m] of integer;
    var
    x: TMatrix;
    s1,k1: integer;
    procedure IStolb(var a: TMatrix; s: integer);
    var
    i,k: integer;
    begin
    k:=1;
    for i:=1 to n do
    begin
    a[i,k]:=s;
    if i меньше=m then
    begin
    s:=s+i;
    end else
    begin
    s:=s+m;
    end;
    end;
    end;
    procedure NRjad(var a: TMatrix);
    var
    i,k: integer;
    begin
    k:=m;
    if n больше=m then
    begin
    for i:=2 to m do
    begin
    a[n,i]:=a[n,i-1]+k;
    k:=k-1;
    end;
    end else
    begin
    for i:=2 to m-2 do
    a[n,i]:=a[n,i-1]+n;
    if n mod 2=0 then
    begin
    a[n,m-1]:= a[n,m-2]+(n-1);
    a[n,m]:= a[n,m-1]+(n-2);
    end else
    begin
    a[n,m-1]:= a[n,m-2]+n;
    a[n,m]:= a[n,m-1]+(n-1);
    end;
    end;
    end;
    procedure NStolb(var a: TMatrix; k2: integer);
    var
    i: integer;
    begin
    for i:=1 to n-1 do
    a[i,k2]:=a[i+1,k2-1]+1;
    end;
    procedure Matrix(var a: TMatrix;var k2: integer);
    begin
    IStolb(x,s1);
    NRjad(x);
    for k2:=2 to m do
    NStolb(x,k1);
    end;
    procedure Writee(var a: TMatrix);
    var
    i,k: integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    begin
    if a[i,k]<10 then
    begin
    write(x[i,k],' ');
    end else
    begin
    write(x[i,k],' ');
    end;
    end;
    writeln;
    end;
    end;
    begin
    s1:=1;
    Matrix(x,k1);
    Writee(x);
    end.

  12. оксана 20.11.2013 в 23:53

    Я правильно поняла 4 задание? Нужно сумму элементов строки умноженную на коэффициент вычесть из общей суммы элементов всех последующих строк.

  13. Taras 21.11.2013 в 00:15

    Программу можно поместить между тегов

    <pre class="brush: delphi; toolbar: false; gutter: false">

</pre>

    Тогда сохраниться форматирование и будет подсветка синтаксиса.

    Проблема возникает из-за символа «<», который воспринимается как начало тега HTML. Его нужно заменять на комбинацию &lt;

    Надеюсь, у меня дойдут руки сделать все по-человечески.

     

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

    Общая идея и стиль реализации — хороши.

    3в я долго тестировал при всяких параметрах. Опыт работы программистом подсказывал мне, что программ без ошибок не бывает. Почти сотня строк — ошибка должна была быть! ))

    Короче, при n=1 и m=4 — не работает.

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

    x_{ij}\leftarrow x_{ij}-\alpha x_{1j}

    (Если ты, вдруг, когда-нибудь изучала линейную алгебру, то задача 4 — первый шаг метода Гаусса для решения систем линейных уравнений)

  14. оксана 21.11.2013 в 23:36

    тогда тело цикла 3б будет так:

    begin
    s1:=1;
    r1:=m;
    b1:=n;
    L1:=1;
    t1:=1;
    for i:=1 to (m div 2)+1 do
    begin
    IStroka(x,s1,L1,t1,r1);
    if s1>m*n then
    break;
    IStolb(x,s1,t1,r1,b1);
    if s1>m*n then
    break;
    IIStroka(x,s1,t1,r1,b1);
    if s1>m*n then
    break;
    IIStolb(x,s1,t1,L1,b1);
    if s1>m*n then
    break;
    r1:=r1-1;
    b1:=b1-1;
    L1:=L1+1;
    t1:=t1+1;

    end;

  15. Taras 22.11.2013 в 00:45

    Да, теперь все работает. Главное — вовремя остановиться.

    Поскольку счетчик i нигде не используется, можно заменить цикл на

      while s1 <= m*n do ...

    и, соответственно, убрать последний if.

    Изменения L1, r1, t1, b1 можно делать сразу после вызова соответствующей процедуры. Тогда внутри процедур не придется добавлять +1 или -1 к пределам изменения счетчиков циклов.

    Ну, и число шагов спирали логичнее было бы брать (m+1) div 2. Хотя, это тоже «с запасом». Точное значение (min(m,n)+1) div 2.

  16. оксана 22.11.2013 в 08:49

    все равно не так добавляется(((

  17. оксана 23.11.2013 в 00:07

    выпала вторая часть, даже теги не помогли(
    опять заменяю знаки на слова:

    const
    n=6;
    m=6;
    type
    TMatrix= array[1..n,1..m] of integer;
    var
    x: TMatrix;
    s1: integer;
    procedure IChast(var a: TMatrix; var s: integer);
    var
    i,t,k:integer;
    begin
    for t:=1 to n do
    begin
    i:=t;
    k:=1;
    while (i больше=1) and (k меньше=m) do
    begin
    a[i,k]:=s;
    s:=s+1;
    i:=i-1;
    k:=k+1;
    end;
    end;
    end;
    procedure IIChast(var a: TMatrix; var s: integer);
    var
    t,i,k: integer;
    begin
    for t:=2 to m do
    begin
    i:=n;
    k:=t;
    while (i больше=1) and (k меньше=m) do
    begin
    a[i,k]:=s;
    s:=s+1;
    i:=i-1;
    k:=k+1;
    end;
    end;
    end;
    procedure Writee(var a: TMatrix);
    var
    i,k: integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    begin
    if a[i,k]<10 then
    begin
    write(x[i,k],' ');
    end else
    begin
    if x[i,k]<100 then
    begin
    write(x[i,k],' ');
    end else
    begin
    write(x[i,k],' ');
    end;
    end;
    end;
    writeln;
    end;
    end;
    begin
    s1:=1;
    IChast(x,s1);
    IIChast(x,s1);
    Writee(x);
    end.

  18. оксана 23.11.2013 в 00:54

    задание 4:

    const
    n=5;
    m=6;
    type
    TMatrix= array[1..n,1..m] of integer;
    var
    x: TMatrix;
    k1,u1: integer;
    procedure Randomm(var a: TMatrix);
    var
    i,k: integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    begin
    a[i,k]:= random(50);
    end;
    end;
    end;
    procedure RRR(var a: TMatrix; k,u:integer);
    var
    i,t,p: integer;
    begin
    for i:=1 to m do
    a[u,i]:=a[u,i]*k;
    t:=1;
    for i:=u+t to n do
    begin
    for p:=1 to m do
    begin
    a[i,p]:=a[i,p]-a[u,p];
    end;
    t:=t+1;
    end;
    end;
    procedure Writee(var a: TMatrix);
    var
    i,k: integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    begin
    write(a[i,k],’ ‘);
    end;
    writeln;
    end;
    writeln;
    end;
    begin
    readln(u1,k1);
    Randomm(x);
    Writee(x);
    RRR(x,k1,u1);
    Writee(x);
    end.

  19. оксана 23.11.2013 в 13:27

    и задание 5:

    const
    n=5;
    m=6;
    type
    TMatrix= array[1..n,1..m] of integer;
    TMatrix2= array[1..m,1..n] of integer;
    var
    x: TMatrix;
    y: TMatrix2;
    t: integer;
    procedure Randomm(var a: TMatrix);
    var
    i,k: integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    begin
    a[i,k]:= random(50);
    end;
    end;
    end;
    procedure Writee(var a: TMatrix);
    var
    i,k: integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    begin
    write(a[i,k],’ ‘);
    end;
    writeln;
    end;
    writeln;
    end;
    procedure Trans(var a: TMatrix;var b: TMatrix2);
    var
    i,k: integer;
    begin
    for i:=1 to m do
    begin
    for k:=1 to n do
    begin
    b[i,k]:=a[k,i];
    end;
    end;
    end;
    procedure Writee2(var a: TMatrix2);
    var
    i,k: integer;
    begin
    for i:=1 to m do
    begin
    for k:=1 to n do
    begin
    write(a[i,k],’ ‘);
    end;
    writeln;
    end;
    writeln;
    end;
    begin
    Randomm(x);
    Writee(x);
    Trans(x,y);
    Writee2(y);
    end.

  20. Taras 25.11.2013 в 21:32

    3в — хорошо.

    Замечу только, что внутренность обоих циклов for в процедурах отличается только начальными значениями i и k. Логично было бы выделить ее в отдельную процедуру, сделав эти начальные значения параметрами. Но и так хорошо.

    4 — по заданию предполагалось, что первая строка останется неизменной (из остальных будут вычтены элементы первой строки умноженные на число). У тебя же первая строка изменится. Но это мелкая переделка.

    Хуже, что ты один из пределов изменения счетчика в цикла (u + t) изменяешь внутри этого самого цикла. Это очень нехорошо, ведет к запутыванию логики программы и труднообнаруживаемым ошибкам. Так делать никогда не надо. В данном конкретном случае «t := t + 1» это просто бессмысленный код, который никак не влияет на результат. Можно его стереть и заменить t на 1.

    5 — хорошо.

  21. оксана 25.11.2013 в 23:09

    ага, спасибочки за замечания)

  22. АленА 15.05.2015 в 14:26

    Что бы вы исправили в оформлении этой программы (12б)?

    Program Zadanie_12_3b;
    const
    n=5;
    m=5;
    type
    TMatrix=array[1..n, 1..m] of integer;
    var
    x: TMatrix;

    procedure P1;
    var
    i, k, r, n1, m1: integer;
    begin
    n1:=n;
    m1:=m;
    r:=1;

    for i:= 1 to (min(n,m)+1) div 2 do
    begin
    for k:= i to m1 do
    begin
    if r>n*m then break;
    x[i, k]:=r;
    r:=r+1;
    end;

    for k:= i+1 to n1 do
    begin
    if r>n*m then break;
    x[k, m1]:=r;
    r:=r+1;
    end;

    for k:= m1-1 downto i do
    begin
    if r>n*m then break;
    x[n1, k]:=r;
    r:=r+1;
    end;

    for k:= n1-1 downto i+1 do
    begin
    if r>n*m then break;
    x[k, i]:=r;
    r:=r+1;
    end;

    n1:=n1-1;
    m1:=m1-1;
    end;
    end;

    procedure P2vivod;
    var
    i, k: integer;
    begin
    writeln(‘Двумерный массив:’);
    for i:= 1 to n do
    begin
    for k:= 1 to m do
    begin
    write(x[i, k], ‘ ‘);
    end;
    writeln;
    end;
    end;

    begin
    P1;
    P2vivod;
    end.

  23. АленА 15.05.2015 в 17:00

    Попробовала написать решение 3-в так, подскажите, правильно ли я поняла задание и выполнила его?

    Program Zadanie_12_3v;
    const
    n=5;
    m=5;
    type
    TMatrix=array[1..n, 1..m] of integer;
    var
    x: TMatrix;

    procedure P1;
    var
    i, r, l, c, g, b: integer;
    begin
    r:=1;
    for i:= 1 to n+m-1 do
    begin
    if i<n then l:=i else l:=n;
    if i<=m then g:=1 else g:=1+(i-m);
    if i<=n then b:=1 else b:=(m-n+1)+(i-m);
    for c:=l downto g do
    begin
    x[c,b]:=r;
    r:=r+1;
    b:=b+1;
    end;
    end;
    end;

    procedure P2vivod;
    var
    i, k: integer;
    begin
    writeln('Двумерный массив:');
    for i:= 1 to n do
    begin
    for k:= 1 to m do
    begin
    write(x[i, k], ' ');
    end;
    writeln;
    end;
    end;

    begin
    P1;
    P2vivod
    end.

  24. АленА 15.05.2015 в 17:35

    Задача 4:

    Program Zadanie_12_4;
    const
    n=5;
    m=5;
    type
    TMatrix=array[1..n, 1..m] of integer;
    var
    x: TMatrix;
    s, k: integer;
    procedure P1(var z: TMatrix);
    var
    i, k: integer;
    begin
    for i:= 1 to n do
    for k:= 1 to m do
    z[i, k]:=random(10);
    end;
    procedure P2vivod(var z: TMatrix);
    var
    i, k: integer;
    begin
    writeln(‘Двумерный массив:’);
    for i:= 1 to n do
    begin
    for k:= 1 to m do
    begin
    write(z[i, k], ‘ ‘);
    end;
    writeln;
    end;
    end;
    procedure P3(var z: TMatrix; a, b:integer);
    var
    i, k: integer;
    begin
    p1(z);
    P2vivod(z);
    writeln;

    writeln(‘Вычитаемая строка:’);
    for k:= 1 to m do
    begin
    z[a, k]:=z[a, k]*b;
    write(z[a, k], ‘ ‘);
    end;
    writeln;
    writeln;

    for i:= a+1 to n do
    for k:= 1 to m do
    z[i, k]:=z[i, k]-z[a, k];

    for k:= 1 to m do
    z[a, k]:=z[a, k] div b;
    end;

    begin
    write (‘Введите номер строки и коэфициент: ‘);
    read(s, k);
    P3(x, s, k);
    P2vivod(x);
    end.

  25. АленА 15.05.2015 в 18:11

    Программа к 5-той задаче:

    Program Zadanie_12_5;
    const
    n=6;
    m=5;
    type
    TMatrix=array[1..n, 1..m] of integer;
    TMatrix2=array[1..m, 1..n] of integer;
    var
    y: TMatrix;
    x: TMatrix2;

    procedure P1(var z: TMatrix);
    var
    i, k: integer;
    begin
    for i:= 1 to n do
    for k:= 1 to m do
    z[i, k]:=random(9);
    end;

    procedure P2vivod(var z: TMatrix);
    var
    i, k: integer;
    begin
    writeln(‘Двумерный массив:’);
    for i:= 1 to n do
    begin
    for k:= 1 to m do
    begin
    write(z[i, k], ‘ ‘);
    end;
    writeln;
    end;
    end;

    procedure P3(var z: TMatrix2);
    var
    i, k: integer;
    begin
    p1(y);
    P2vivod(y);
    writeln;

    for i:= 1 to m do
    for k:= 1 to n do
    z[i, k]:=y[k, i];
    end;

    procedure P4vivod(var z: TMatrix2);
    var
    i, k: integer;
    begin
    writeln(‘Двумерный массив:’);
    for i:= 1 to m do
    begin
    for k:= 1 to n do
    begin
    write(z[i, k], ‘ ‘);
    end;
    writeln;
    end;
    end;

    begin
    P3(x);
    P4vivod(x);
    end.

  26. Darkhan 22.07.2015 в 19:27

    program N12_3b;{заполнение массива по спирали}
    const
    n = 9;
    m = 9;
    p = n*m;
    type
    TMatrix = array [1..n, 1..m] of real;
    var
    A:TMatrix;

    procedure InputMassive(var A:TMatrix);
    var
    i, k, n1, n2, m1, m2, t:integer;
    begin
    t:=1;
    n1:=1;
    n2:=n;
    m1:=1;
    m2:= m;
    while (t <= p) do
    begin
    i:=n1;
    k:=m1;
    while (k <= m2-1) and (t<= p) do {1-прямая строка}
    begin
    A[i, k]:= t;
    t:= t+1;
    k:= k+1;
    end;
    k:= m2;
    i:= n1;
    while (i <= n2-1) and (t= m1+1) and (t= n1+1) and (t<= p) do {4-обратный столбец}
    begin
    A[i, k]:= t;
    t:= t+1;
    i:= i-1;
    end;
    n1:= n1+1;
    m1:= m1+1;
    n2:= n2-1;
    m2:= m2-1;
    if p-t=0 then
    begin
    i:= ((n+1) div 2);
    A[i, i]:=t;
    t:=t+10;
    end;
    end;
    end;

    procedure OutputResult(var A:TMatrix);
    var
    i, k:integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    write(A[i, k], ' ');
    writeln;
    end;
    end;

    begin
    InputMassive(A);
    OutputResult(A);
    end.

  27. Darkhan 22.07.2015 в 19:49

    while (k <= m2-1) and (t<= p) do {1-прямая строка}
    begin
    A[i, k]:= t;
    t:= t+1;
    k:= k+1;
    end;
    k:= m2;
    i:= n1;
    while (i <= n2-1) and (t= m1+1) and (t= n1+1) and (t<= p) do {4-обратный столбец}
    begin
    A[i, k]:= t;
    t:= t+1;
    i:= i-1;
    end;

  28. Darkhan 23.07.2015 в 20:09

    В программе N12_3b от 22.07.2015 должно быть

    i:=n1;
    k:=m1;
    while (k<=m2-1) and (t<=p) do {1-прямая строка}
    begin
    A[i, k]:=t;
    t:=t+1;
    k:=k+1;
    end;
    k:=m2;
    i:=n1;
    while (i<=n2-1) and (t=m1+1) and (t=n1+1) and (t<=p) do {4-обратный столбец}
    begin
    A[i, k]:=t;
    t:=t+1;
    i:=i-1;
    end;

  29. Darkhan 23.07.2015 в 20:16

    program N12_3v;{заполнение массива по диагоналям}
    const
    n = 3;
    m = 9;
    type
    TMatrix = array [1..n, 1..m] of integer;
    var
    A:TMatrix;

    procedure InputMassive(var A:TMatrix);
    var
    i, k, n1, m1, p, t:integer;
    begin
    t:= 1;
    n1:= 1;
    m1:= 1;
    p:= 2;
    while (p <= n+m) do
    begin
    for i:= n1 downto 1 do
    begin
    for k:= 1 to m1 do
    begin
    if (i+k = p) then
    begin
    A[i, k]:= t;
    t:= t+1;
    end;
    end;
    end;
    if n1<n then
    n1:= n1+1;
    if m1<m then
    m1:= m1+1;
    p:= p+1;
    end;
    end;

    procedure OutputResult(var A:TMatrix);
    var
    i, k:integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to m do
    write(A[i, k], ' ');
    writeln;
    end;
    end;

    begin
    InputMassive(A);
    OutputResult(A);
    end.

  30. Darkhan 26.07.2015 в 06:34

    program N12_5; {транспонирование матрицы}
    const
    n = 3;
    m = 6;
    type
    TMatrix = array [1..n, 1..m] of integer;
    TMatrix2 = array [1..m, 1..n] of integer;
    var
    x:TMatrix;
    y:TMatrix2;

    procedure InputMatrix(var x:TMatrix;a, b:integer);
    var
    i, k:integer;
    begin
    for i:=1 to a do
    for k:=1 to b do
    x[i, k]:=k+(i-1)*b;
    end;

    procedure OutputMatrix(var x:TMatrix;a, b:integer);
    var
    i, k:integer;
    begin
    for i:=1 to a do
    begin
    for k:=1 to b do
    write(x[i, k], ‘ ‘);
    writeln;
    end;
    writeln;
    end;

    procedure OutputMatrix2(var y:TMatrix2;a, b:integer);
    var
    i, k:integer;
    begin
    for i:=1 to a do
    begin
    for k:=1 to b do
    write(y[i, k], ‘ ‘);
    writeln;
    end;
    writeln;
    end;

    procedure Transponirovanie(var x:TMatrix;var y:TMatrix2;a, b:integer);
    var
    i, k, a1, b1, p:integer;
    begin
    a1:=1;
    b1:=1;
    p:=2;
    while p=b then
    begin
    for i:=a1 downto 1 do
    for k:=1 to b1 do
    if (i+k=p) then
    y[k, i]:=x[i, k];
    end else
    begin
    for k:=b1 downto 1 do
    for i:=1 to a1 do
    if (i+k=p) then
    y[k, i]:=x[i, k];
    end;
    if (a>=b) and (a1=b) and (b1<b) then
    b1:=b1+1;
    if (a<b) and (a1<a) then
    a1:=a1+1;
    if (a<b) and (b1<b) then
    b1:=b1+1;
    p:=p+1;
    end;
    end;

    begin
    InputMatrix(x, n, m);
    OutputMatrix(x, n, m);
    Transponirovanie(x, y, n, m);
    OutputMatrix2(y,m, n);
    end.

  31. Darkhan 26.07.2015 в 06:47

    V programme N12_5 dolzhno byt’
    …
    while p=b then
    begin
    for i:=a1 downto 1 do
    for k:=1 to b1 do
    if (i+k=p) then
    y[k, i]:=x[i, k];
    …

  32. Darkhan 26.07.2015 в 06:51

    Да…Правильный текст не набирается.

  33. Darkhan 03.08.2015 в 18:13

    program N12_4;{прямой ход метода Гаусса для решения СЛАУ}
    const
    n = 5;
    type
    TMatrix = array [1..n, 1..(n+1)] of real;
    var
    a:TMatrix;
    n1:integer;
    q:real;

    procedure InputMatrix(var a:TMatrix);
    var
    i, k, a1:integer;
    begin
    for i:=1 to n do
    for k:=1 to n+1 do
    begin
    a1:=random(12)-6;
    if (a10) then
    a[i, k]:= a1
    else
    a[i, k]:=k;
    end;
    end;

    procedure OutputMatrix(var a:TMatrix);
    var
    i, k:integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to n+1 do
    write(a[i, k], ‘ ‘);
    writeln;
    end;
    writeln;
    end;

    procedure P1(var a:TMatrix; n1:integer; q:real);
    var
    i, k:integer;
    c:real;
    begin
    for i:=n1 to n-1 do
    begin
    c:=a[i+1, n1];
    for k:=n1 to n+1 do
    a[i+1, k]:=a[i+1, k]-c*(a[n1, k]/q);
    end;
    end;

    begin
    InputMatrix(a);
    OutputMatrix(a);
    for n1:=1 to n do
    begin
    q:=a[n1, n1];
    P1(a, n1, q);
    end;
    OutputMatrix(a);
    end.

  34. Darkhan 05.08.2015 в 20:12

    program N12_4;
    const
    n = 5;
    type
    TMatrix = array [1..n, 1..(n+1)] of real;
    TMassive = array [1..n] of real;
    var
    a:TMatrix;
    x:TMassive;

    procedure InputMatrix(var a:TMatrix);
    var
    i, k, a1:integer;
    begin
    for i:=1 to n do
    for k:=1 to n+1 do
    begin
    a1:=random(12)-5;
    if a1 не равно 0 then
    a[i, k]:= a1
    else
    a[i, k]:=k;
    end;
    end;

    procedure OutputMatrix(var a:TMatrix);
    var
    i, k:integer;
    begin
    for i:=1 to n do
    begin
    for k:=1 to n+1 do
    write(a[i, k], ‘ ‘);
    writeln;
    end;
    writeln;
    end;

    procedure OutputMassive(var x:TMassive);
    var
    k:integer;
    begin
    for k:=1 to n do
    writeln(‘x’, [k], ‘ = ‘, x[k]);
    end;

    procedure P1(var a:TMatrix); {прямой ход метода Гаусса}
    var
    i, k, n1:integer;
    c:real;
    begin
    for n1:=1 to n do
    for i:=n1 to n-1 do
    begin
    c:=a[i+1, n1];
    for k:=n1 to n+1 do
    a[i+1, k]:=a[i+1, k]-c*(a[n1, k]/a[n1, n1]);
    end;
    end;

    procedure P2(var a:TMatrix; var x:TMassive); {обратный ход метода Гаусса}
    var
    i, k:integer;
    begin
    for k:=n downto 1 do
    begin
    x[k]:=a[k, k+1]/a[k, k];
    for i:=k-1 downto 1 do
    a[i, k]:=a[i, k]*(-x[k])+a[i, k+1];
    end;
    end;

    begin
    InputMatrix(a);
    OutputMatrix(a);
    P1(a);
    OutputMatrix(a);
    P2(a, x);
    OutputMassive(x);
    end.

  35. Alex_Kot 02.10.2015 в 16:11

    Задачу 12_3b решал поэтапно 3 дня. Не без труда:

    Program Z12_3b;{Элемент 2-мерного массива — порядковый номер}
    const {заполнение по спирали; при этом: n>L, m>L}
    n = 6; {L (min(m,n)+1 div 2)[Т.В.Диканев]}
    m = 10;
    L = 4;
    type
    TMatrix = array[1..n, 1..m] of real;
    TProc = procedure(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    a: TMatrix;

    procedure Clean_TMatr(var x: TMatrix; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:=n1 to n2 do
    for k:=m1 to m2 do
    x[i, k]:= 0;
    end;

    procedure FillTMatr_1(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 to n2 do
    for k:= m1 to m2 do
    begin
    if (a[i, k] = 0) then
    a[i, k]:= z+1;
    z:=a[i, k];
    end;
    end;
    procedure FillTMatr_2(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 to n2 do
    for k:= m1 to m2 do
    begin
    if (a[i, k] = 0) then
    a[i, k]:= z+1;
    z:=a[i, k];
    end;
    end;

    procedure FillTMatr_3(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 downto n2 do
    for k:= m1 downto m2 do
    begin
    if (a[i, k] = 0) then
    a[i, k]:= z+1;
    z:=a[i, k];
    end;
    end;

    procedure FillTMatr_4(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 downto n2 do
    for k:= m1 downto m2 do
    begin
    if (a[i, k] = 0) then
    a[i, k]:= z+1;
    z:=a[i, k];
    end;
    end;

    procedure FillTMatr_Spiral(f_1, f_2, f_3, f_4: TProc; L: integer);
    var
    t: integer;
    z: real;
    begin
    z:=0;
    for t:=0 to L do
    if (z <= n*m) then
    begin
    f_1(a, z, 1+t, 1+t, 1+t, m-t);
    f_2(a, z, 2+t, n-t, m-t, m-t);
    f_3(a, z, n-t, n-t, m-1-t, 1+t);
    f_4(a, z, n-1-t, 2+t, 1+t, 1+t);
    end;
    end;

    procedure OutTMatr(var x: TMatrix; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 to n2 do
    begin
    for k:= m1 to m2 do
    write(x[i, k]:4);
    writeln;
    end;
    end;

    begin
    Clean_TMatr(a, 1, n, 1, m);
    FillTMatr_Spiral(FillTMatr_1, FillTMatr_2, FillTMatr_3, FillTMatr_4, L);
    OutTMatr(a, 1, n, 1, m);
    end.

  36. Alex_Kot 02.10.2015 в 16:23

    Еще короче решение 12_3b:

    Program Z12_3b;{Элемент 2-мерного массива — порядковый номер}
    const {заполнение по спирали; при этом: n>L, m>L}
    n = 6; {L (min(m,n)+1 div 2)[Т.В.Диканев]}
    m = 10;
    L = 4;
    type
    TMatrix = array[1..n, 1..m] of real;
    TProc = procedure(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    a: TMatrix;

    procedure Clean_TMatr(var x: TMatrix; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:=n1 to n2 do
    for k:=m1 to m2 do
    x[i, k]:= 0;
    end;

    procedure FillTMatr_1(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 to n2 do
    for k:= m1 to m2 do
    begin
    if (a[i, k] = 0) then
    a[i, k]:= z+1;
    z:=a[i, k];
    end;
    end;

    procedure FillTMatr_2(var x: TMatrix; var z: real; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 downto n2 do
    for k:= m1 downto m2 do
    begin
    if (a[i, k] = 0) then
    a[i, k]:= z+1;
    z:=a[i, k];
    end;
    end;

    procedure FillTMatr_Spiral(f_1, f_2, f_3, f_4: TProc; L: integer);
    var
    t: integer;
    z: real;
    begin
    z:=0;
    for t:=0 to L do
    if (z <= n*m) then
    begin
    f_1(a, z, 1+t, 1+t, 1+t, m-t);
    f_2(a, z, 2+t, n-t, m-t, m-t);
    f_3(a, z, n-t, n-t, m-1-t, 1+t);
    f_4(a, z, n-1-t, 2+t, 1+t, 1+t);
    end;
    end;

    procedure OutTMatr(var x: TMatrix; n1, n2, m1, m2: integer);
    var
    i, k: integer;
    begin
    for i:= n1 to n2 do
    begin
    for k:= m1 to m2 do
    write(x[i, k]:4);
    writeln;
    end;
    end;

    begin
    Clean_TMatr(a, 1, n, 1, m);
    FillTMatr_Spiral(FillTMatr_1, FillTMatr_1, FillTMatr_2, FillTMatr_2, L);
    OutTMatr(a, 1, n, 1, m);
    end.

  37. Alex_Kot 06.10.2015 в 18:23

    Program Z12_3v {заполнение квадратной матрицы по диагоналям; вывод};
    const
    n = 6;
    type
    TMatrix = array[1..n, 1..n] of integer;
    TProc = procedure(var x: TMatrix; var z: integer; t, n1: integer);
    var
    a: TMatrix;
    z: integer;

    procedure Diagonal(var x: TMatrix; f1, f2: TProc; n1: integer);
    var
    t: integer;
    begin
    for t:=1 to n1 do
    f1(x, z, t, n1);
    for t:=2 to n1 do
    f2(x, z, t, n1);
    end;

    procedure f1(var x: TMatrix; var z: integer; t, n1: integer);
    var
    i, k: integer;
    begin
    for i:=t downto 1 do
    begin
    k:=t+1-i;
    x[i, k]:=z+1;
    z:= x[i, k];
    end;
    end;

    procedure f2(var x: TMatrix; var z: integer; t, n1: integer);
    var
    i, k: integer;
    begin
    for k:=t to n1 do
    begin
    if z<=n1*n1 then
    begin
    i:=t-k+n1;
    x[i, k]:= z+1;
    z:= x[i, k];
    end;
    end;
    end;

    procedure OutTMatr(var x: TMatrix; n1: integer);
    var
    i, k: integer;
    begin
    for i:=1 to n1 do
    begin
    for k:=1 to n1 do
    write(x[i, k]:4);
    writeln;
    end;
    end;

    begin
    z:=0;
    Diagonal(a, f1, f2, n);
    OutTMatr(a, n);
    end.

  38. Аноним 08.10.2015 в 00:11

    Транспонирование квадратной матрицы:

    Program Z12_5; {Транспонирование квадратной матрицы}
    const
    n = 6;
    type
    TMatrix = array[1..n, 1..n] of real;
    TProc = procedure(var x: TMatrix; n1, i: integer);
    var
    a: TMatrix;
    p: Tproc;

    procedure FillTMatr(var x: TMatrix; n1: integer);
    var
    i, k: integer;
    begin
    for i:=1 to n1 do
    for k:=1 to n1 do
    x[i, k]:= i * 10;
    end;

    procedure Transp(var x: TMatrix; p: TProc; n1: integer);
    var
    i, k: integer;
    begin
    for i:=1 to n1 do
    p(x, n1, i);
    end;

    procedure PP(var x: TMatrix; n1, i: integer);
    var
    k: integer;
    z: real;
    begin
    for k:=i to n1 do
    begin
    z:= x[k, i];
    x[k, i]:= x[i, k];
    x[i, k]:= z;
    end;
    end;

    procedure OutTMatr(var x: TMatrix; n1: integer);
    var
    i, k: integer;
    begin
    for i:= 1 to n1 do
    begin
    for k:= 1 to n1 do
    write(x[i, k]:4);
    writeln;
    end;
    end;

    begin
    FillTMatr(a, n);
    p:= PP;
    Transp(a, p, n);
    OutTMatr(a, n);
    end.

  39. Alex_Kot 08.10.2015 в 00:16

    Транспонирование квадратной матрицы Z12_5: см. выше.

  40. Alex_Kot 08.10.2015 в 15:48

    Program Z12_5_2; { Транспонирование матрицы n*m в матрицу m*n}

    const
    n = 5;
    m = 8;
    type
    TMatrix_1 = array[1..n, 1..m] of real;
    TMatrix_2 = array[1..m, 1..n] of real;
    var
    a: TMatrix_1;
    at: TMatrix_2;

    procedure FillTMatr_a(var x: TMatrix_1; n1, m1: integer);
    var
    i, k: integer;
    begin
    for i:=1 to n1 do
    for k:=1 to m1 do
    x[i, k]:= i * 10;
    end;

    procedure Transp(var x: TMatrix_1; var y: TMatrix_2; n1, m1: integer);
    var
    i, k: integer;
    z: real;
    begin
    for i:=1 to n1 do
    for k:=1 to m1 do
    begin
    y[k, i]:= x[i, k];
    end;
    end;

    procedure OutTMatr_a(var x: TMatrix_1; w1, w2: integer);
    var
    i, k: integer;
    begin
    for i:= 1 to w1 do
    begin
    for k:= 1 to w2 do
    write(x[i, k]:4);
    writeln;
    end;
    end;

    procedure OutTMatr_at(var x: TMatrix_2; w1, w2: integer);
    var
    i, k: integer;
    begin
    for i:= 1 to w1 do
    begin
    for k:= 1 to w2 do
    write(x[i, k]:4);
    writeln;
    end;
    end;

    begin
    FillTMatr_a(a, n, m);
    OutTMatr_a(a, n, m);
    writeln;
    Transp(a, at, n, m);
    OutTMatr_at(at, m, n);
    end.

  41. Анна 11.04.2018 в 22:47

    Здравствуйте, 1.1 задача. Подскажите где ошибка, никак не могу сообразитью
    Const
    V=5;
    G=6;
    Var
    M:array[0..g-1,0..v-1] of integer;
    i,k:integer;
    begin
    for i:=0 to g-1 do begin
    for k:=0 to v-1 do begin
    m[k]:=random(100)-1;
    end;
    m[i]:=random(100)-1;
    end;
    writeln(m[i]);
    end.

Добавить комментарий