Untitled
raw download clone
TEXT
views 30
,
size 5642 b
Program project1;
{Програма створює прямокутну матрицю RxS дiйсних чисел, виводить її на екран}

{$mode objfpc}{$H+}

Uses crt, SysUtils,                {пiд’єднання модуля}
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes
  { you can add units after this };

Const
    gen=6;      {загальна кiлькiсть знакiв для виведення чисел}
    fr=1;          {кiлькiсть знакiв пiсля десяткової крапки}
    n0=1;        {мiнiмальна кiлькiсть рядкiв та стовпцiв матрицi}
    nfull=10;   {максимальна кiлькiсть рядкiв та стовпцiв матрицi}
    nm=3;    {нижня межа елементiв матрицi}
    vm=7;     {верхня межа елементiв матрицi}

Type marr=array [1..nfull,1..nfull] of real;  {тип-двовимiрний масив дiйсних чисел}

Var    {описання глобальних змiнних}
    v:string;   {повiдомлення для користувача}
    R:integer;         {реальна кiлькiсть рядкiв матрицi}
    S:integer;         {реальна кiлькiсть стовпцiв матрицi}
    m,n:marr;            {матрицi дiйсних чисел}

{функцiя введення реальної кiлькостi рядкiв/стовпцiв матрицi}
function in_n(vv:string; nn0,nnfull:integer):integer;
var
    nn:integer;    {замiсник функцiї}
begin
    repeat
        writeln(vv);
        readln(nn);
        if not((nn>=nn0) and (nn<=nnfull))
            then writeln('Недопустиме значення!');
    until (nn>=nn0) and (nn<=nnfull);
    in_n:=nn;     {передаємо значення функцiї вiд змiнної-замiсника}
end;

{процедура створення матрицi}
procedure inmarr(var mm:marr; rr,ss:integer);
var
    i:integer;    {лiчильник рядкiв}
    j:integer;    {лiчильник стовпцiв}
begin
{заповнення матрицi дiйсними числами в межах nm..vm}
    for i:=1 to rr do          {змiщення по рядкам}
        for j:=1 to ss do    {змiщення по стовпцям}
            mm[i,j]:=nm+(vm-nm)*random;
end;

{знаходження сумми та тезультючої матриці}
function resarr(a,b:marr;rr,ss:integer):marr;
var
    i:integer;    {лiчильник рядкiв}
    j:integer;    {лiчильник стовпцiв}
    sum:real; {сумма елементів матриці}
begin
    sum:=0;
   for i:=1 to rr do   {змiщення по рядкам}
        begin
            for j:=1 to ss do   {змiщення по стовпцям}
             sum+=b[i,j]; {додаємо елементи для знаходження сумми}
        end;
{ділимо кожен елемент матриці на сумму}
     for i:=1 to rr do   {змiщення по рядкам}
        begin
            for j:=1 to ss do   {змiщення по стовпцям}
             resarr[i,j]:=a[i,j]/sum; {додаємо елементи для знаходження сумми}
        end;
 end;

{процедура виведення матрицi}
procedure outmarr(mm:marr; rr,ss,zn,ip:integer);
var
    i:integer;    {лiчильник рядкiв}
    j:integer;    {лiчильник стовпцiв}
begin
    for i:=1 to rr do   {змiщення по рядкам}
        begin
            for j:=1 to ss do   {змiщення по стовпцям}
                write(mm[i,j]:zn:ip);
            writeln;   {перед тим, як виводити наступний рядок матрицi,
                                         курсор на екранi переводиться на наступний рядок}
        end;
end;

{Основний блок програми}
Begin
    clrscr;           {очистка екрану}
    randomize;   {запуск генератора випадкових чисел}

{введення реальної кiлькостi рядкiв матрицi}
    v:='Введiть кiлькiсть рядкiв матрицi в межах вiд '+IntToStr(n0)+' до '+ IntToStr(nfull);
    R:=in_n(v,n0,nfull);

{введення реальної кiлькостi стовпцiв матрицi}
    v:='Введiть кiлькiсть стовпцiв матрицi в межах вiд '+IntToStr(n0)+' до '+ IntToStr(nfull);
    S:=in_n(v,n0,nfull);

{створення матриць }
    inmarr(m,R,S);      {Виклик процедури створення матриць}
    inmarr(n,R,S);
{виведення матрицi }
    clrscr;          {очистка екрану}

    writeln('Матриця 1:');
    outmarr(m,R,S,gen,fr);         {Виклик процедури виведення матриць}
    writeln('Матриця 2:');
    outmarr(n,R,S,gen,fr);         {Виклик процедури виведення матриць}
    writeln;
{виведення оновленної матриці}
    writeln('Результуюча');
    outmarr(resarr(m,n,R,S),R,S,10,5);

    writeln('Програму завершено. Для виходу натиснiть Enter.');
    readln;                       {затримка екрану}
End.    {ну ось i все}
close fullscreen
Login or Register to edit or fork this paste. It's free.