NaprogaemVse

1.pas

program Project1;
// Лаба 1
  uses math;
     var
     x : real = -4.5;
     y : real = 0.75;
     z : real = 0.84;
     a : real;
     b : real;
begin
   a:= exp(ln(8+Power(abs(x-y),2)+1)/3)/(x+Power(y,2)+2);
   b:= exp( abs(x-y) )* 1/exp( (Power(tan(z),2)+a )*ln( abs(x) ));
   writeln(b);
   readln;
end.

2.pas

program Project1;
(*
Работа 2. ПРОГРАММИРОВАНИЕ РАЗВЕТВЛЯЮЩЕГОСЯ ВЫЧИСЛИТЕЛЬНОГО ПРОЦЕССА
Вычислить значения y заданной кусочно-непрерывной функции для произвольных значений исходных данных.
Подготовить исходные данные для контрольного расчета значения функции по каждой формуле.
Выполнить контрольные расчеты и расчет для заданных исходных данных.
*)
  uses math;
     var
     v  : real = 1.2;   //  расчет для заданных исходных данных
     v1 : real; // для произвольных значений исходных данных
     u  : real;
     b  : real;
begin
   u:= exp(
           ln(
               ( 25 + sqrt(136) )/(0.00034)
             )*(1/5)
          );  // u ~=  10.14952
   // readln(v1); v:=v1; // раскоментить если нужно посчитать для произвольного с клавиатуры
   //v:= 50.1;  // раскоментить если нужно проверить первую формулу
   //v:= 2*abs(u); // раскоментить если нужно проверить вторую формулу
   //v:= 1.1;// раскоментить если нужно проверить третью формулу
   if  2*abs(u) < v then
    b:=  (exp(-u)+exp(-v))/
        (2*abs(u)+3*abs(v))
   else
    if 2*abs(u) = v then
       if(v >0) then
           b:= exp(ln(u)*(1/v))
       else
           b:= -exp(ln(u)*(1/abs(v)))
   else
    if 2*abs(u) > v then
       b:= u+v;
  writeln(b);
 readln;
end.

3.pas

program Project1;
(*
Работа 3. ПРОГРАММИРОВАНИЕ АРИФМЕТИЧЕСКОГО ЦИКЛА.
В каждом задании задан параметр и диапазон его значений,
из каждого значения параметра необходимо вычислить значение аргумента (используя заданную константу).
Из каждого значения аргумента необходимо вычислить значение функции.
*)
  uses math;
     var
      x : real = 2;
      a : real;
      y : real;
begin
 writeln('Параметр аргумент функция');
  while x <= 4 do begin
     a:= 3.34*abs( Power(tan(x),3) );
     y:= ( Power(x,3) - a* Power(x,2) + exp( ln(x)*(1/4) ) )/
          Power( Power(x,2)+a*x,0.3 );
      write(x:2:3);  write('     ');   // двоеточие означает количетво знаков при выводе. x:колви до точки: колво после точки
      write(a:2:3);  write('    ');  // К примеру, x = 123.456 при вывыоде x:3:1 выведется 123.1
      write(y:2:3);  write('  ');
      writeln('');
     x:= x+0.5;
 end;
 readln;
end.

4.pas

program Project1;
(*
Работа 4.ПРОГРАММИРОВАНИЕ ИТЕРАЦИОННОГО ЦИКЛА

Функция y(x) задана двумя способами: формулой y = f(x) и ее разложением в бесконечный ряд S.
Разработать программу вычисления точного yT и приближенного yP значений функций y(x) при изменении ее аргумента
 x от  a до b с шагом dx.
 Приближенное значение вычислять путем суммирования членов ряда до достижения требуемой точности
Предусмотреть завершение процесса суммирования членов ряда по заданному максимальному номеру члена ряда n
для предотвращения зацикливания итерационного цикла. Результаты расчетов вывести в виде таблицы следующей формы
*)
uses math;
function factorial(n : integer) : int64;
  var
    i : integer;
    f : int64;
  begin
      f := 1;
      for i := 2 to n do
        f := f * i;
      factorial := f
  end;

     var
     y : real;
     s : real;
     e : real;
     n : integer = 1;
     x : real = 0.2;
     sn : real;
     nmax : integer = 10;  // если n>10, то размер факториала выходит за размеры int64
begin
     while x <=0.8 do begin
        y:= sin(Pi*x);
        s:=0;
        e:=0.001;
        n:= 1;
        while (abs(y-s) >= e) and (n < nmax) do begin
          sn:= Power(-1,n)* (Power((Pi*x),2*n-1)/factorial(2*n -1));
          s:= s+sn*-1; // без домножения здесь на -1 программа откаывается считать правильно
          n:=n+1;
        end;
        writeln(x:1:1,' ',n,' ',s:1:3,' ',y:1:3);
        x:=x+0.1;
     end;
 readln;
end.

5.pas

program Project1;
(*
Работа 5. ПРОГРАММИРОВАНИЕ МАТРИЧНЫХ ОПЕРАЦИЙ
	1) Рассчитать элементы квадратной матрицы A = (aij ),   i,j = 1,2,...,n  по заданной формуле;
	2) Вычислить элементы вектора-столбца X = (xi), i = 1,2,...,n по заданному правилу;
	3) Вычислить произведение матрицы А на столбец Х;
	5) вычисления значения Y по заданной формуле.
	Размерность задачи: n=5.

*)
uses math;
  const N = 5;
     var
      matrix: array[1..N, 1..N] of real;
      xi : array[1..N] of real;
      product : array[1..N] of real; // A*X
      y : real = 0;
      temp : real;
      prodcount : real = 1;    // счётчик произведений
      i,j,k: integer; // итераторы
begin
      for i := 1 to N do
        for j := 1 to N do
             matrix[j,i]:=(ln(i*j)+2.3)/(ln(i)+ln(j)+1);  // заполняем матрицу


      writeln('Заполненная матрица: ');
      for i := 1 to N do begin
          for j := 1 to N do
          write(matrix[i,j]:1:2,' ');
          writeln('');
      end;


     for i := 1 to N do xi[i]:=0;  // инициализируем вектор xi
     for i := 1 to N do product[i]:=0;   // инициализируем вектор product

     for i := 1 to N do
       for j := 1 to N do
          xi[i]:=xi[i]+ (matrix[i,j]*matrix[j,i]); //заполняем его

     writeln(' ');
     writeln('Стоблец X: ');
     for i := 1 to N do write(xi[i]:1:2,' ');
     writeln('');



     for i := 1 to N do
       for j := 1 to N do
        product[i]:=product[i]+matrix[i,j]*xi[i]; // вычисляем A*Xi

     writeln(' ');
     writeln('Произведение матрицы на столбец Х:');
     for i := 1 to N do write(product[i]:1:2,' ');
     writeln('');


     for k := 1 to N do
       for i := 1 to N-1 do
         for j := 1 to N do  begin
         if j mod 2 <> 0 then  begin
           if matrix[j,i] < matrix[j+1,i] then
            begin

              temp:= matrix[j+1,i];
              matrix[j+1,i]:=matrix[j,i];
              matrix[j,i]:=temp;
           end;
         end;
         end;   // 	упорядочили элементы нечетных столб¬цов матрицы А по убыванию значений сортировкой пузырьком.
         (*  На самом деле это абсолютно бесполезное действие,
          поскольку формулой образования элементов задано,
          что в верхних строчках всегда значения будут больше, чем в нижних*)

         writeln(' ');
        writeln('Матрица с упорядоченными элементами нечетных столбцов матрицы А по убыванию значений:');
       for i := 1 to N do begin
          for j := 1 to N do
          write(matrix[i,j]:1:2,' ');
          writeln('');
      end;


       for i := 1 to N do
        begin
         prodcount:=1;  // счетчик произведения
         for k := 1 to i do
           prodcount:= prodcount*(xi[k]/k);
         y:=y+i*prodcount;
         end;

        writeln(' ');
        writeln('y = ',y:1:2);
        readln;
end.

6.pas

program Project1;
(*
Задание 6 (без разбиения по вариантам).
Подходящим назовем число, квадрат которого заканчивается на само число. Например, 25: 25*25=625 – заканчивается на 25.
Часть первая.
Найти все подходящие числа в диапазоне от 1.000.000 до 10.000.000.
Часть вторая. Найти все подходящие числа, содержащие не более 25 цифр..
*)
uses math,sysutils;
function digitsNum(n : int64) : integer;
  var count : integer;
  begin
  count:=0;
     while n>0 do
     begin
        count:=count+1;
        n:=n div 10;
     end;
     digitsNum:= count;
  end;
  const N = 5;
     var
      i,part : int64;
      temp : string;

begin // КОД КРАЙНЕ НЕ ОПТИМАЛЬНЫЙ!!! Но работает :)
temp:= IntToStr(i*i);
temp:= Copy(temp,Length(temp)-6,Length(temp));
        writeln('1 часть:');
        for i := 1000000 to 10000000 do begin
               temp:=IntToStr(i*i);
               temp:=Copy(temp,Length(temp)-digitsNum(i)+1,Length(temp));
               part:=StrToInt(temp);
             if  part = i then
              writeln(i,' ', Power(i,2));
        end;
        writeln('Поиск завершен!');
        writeln('2 часть:');
        part:=1;
        i:=1;
        while digitsNum(part)<25 do begin
            temp:=IntToStr(i*i);
               temp:=Copy(temp,Length(temp)-digitsNum(i)+1,Length(temp));
               part:=StrToInt(temp);
             if  part = i then
              writeln(i,' ', Power(i,2));
              i:=i+1;
        end;
        writeln('Поиск завершен!');
        readln;
end.