Описание и реализация алгоритмов:

• Системы счисления:
  Перевод из десятичной системы счисления в любую и наоборот
  Как проверить, является ли строка корректным представлением числа в определенной системе счисления ?
  
  
• Возведение в степень
  
  
• Работа с двоичными числами:
  Вычитание двоичных чисел
  Перемножение двоичных чисел с использованием строк
  
  
• Работа с римскими числами:
  Как проверить, является ли введенная с клавитуры строка римским числом, и перевести ее в арабское число?
  Программа перевода арабских чисел в римские и наоборот (итеративный и рекурсивный вариант)
  
  
• Как вычислить арксинус/арккосинус аргумента?
  
  
• Разложение функции в ряд (рассмотрены функции Ln, Exp, Sin и Cos)

Перевод из десятичной с.с в любую и наоборот.






Как проверить, является ли строка корректным представлением числа в определенной системе счисления ?
Допустимые значения radix: 2 .. 36

Возведение в степень.

1. Самый простой способ. Только для положительных чисел и степеней.
   

   Procedure S(Var p,n,r : Integer);
   Begin
    IF r=0 Then r:=1;
    IF n=0 Then Exit;
    r:=r*p;
    Dec(n);
    S(p,n,r)
   End;
   
   Var
    a,b,c:Integer;
   Begin
    ReadLn( a, b );
    S( a, b, c );
    WriteLn( c );
   End.

   
   
2. стандартный способ.
   x^a = Exp(a*Ln(x))
   
   
3. Как возвести (-1) в степень N?
   информация от volvo
   
   Способ x^a = Exp(a*Ln(x)) не подходит, т.к. для вычисления по этой формуле основание степени x должно быть положительным. Используем функцию:
   

   
   Function minusOnePower(n: Integer): Integer;
     Begin
       minusOnePower := (1 - 2*Byte(Odd(n)));
     End;
   

Является ли число степенью двойки?

Function is_power_2(x: Word): Boolean;
Begin
  is_power_2 := (x > 0) and ((x and Pred(x)) = 0)
End;

Работа с двоичными числами

Вычитание двоичных чисел

Перемножение двоичных чисел с использованием строк

Внимание: Внешние ссылки !

Работа с римскими числами

Как проверить, является ли введенная с клавитуры строка римским числом, и перевести ее в арабское число?

Const
legals = 'IVXLCDM';
values:
  Array[1 .. 7] Of Word =
    (1, 5, 10, 50, 100, 500, 1000);
Var
s: String;
i: Byte;
value, v, c: Integer;
Begin
 WriteLn('Примеры чисел:');
 writeln('XXVIII=28  XXXIX=39  CCCXCVII=397  MDCCCXVIII=1818');
 Write('Введите римское число: ');
 ReadLn(s);
 For i := 1 To Length(s) Do
   If Pos(UpCase(s[i]), legals) = 0 Then
     Begin
       WriteLn('Ошибка - неверный символ "',s[i],'"'); Halt
     End
   Else s[i] := Upcase(s[i]);
 v := values[Pos(s[1], legals)];
 value := 0;
 c := 1;
 For i := 2 To Length(s) Do
   If Pos(s[Pred(i)],legals) <> Pos(s[i],legals) Then
     Begin
       c := c * (Byte(pos(s[Pred(i)],legals) > Pos(s[i],legals))*2 - 1);
       If c < (-1) Then
         Begin
           value := -v * c -10001; Break
         End
       Else Inc(value, v * c);
       v := values[Pos(s[i], legals)];
       c := 1;
     End
   Else
     If c > 2 Then
       Begin
         value := -v * c - 10000; Break;
       End
     Else Inc©;

 Inc(value, v * c);
 Case value Of
   -10000: WriteLn('Ошибка: больше 3 одинаковых элементов');
   -10001: WriteLn('Ошибка: присутствует более одного меньшего элемента');
   -9999..-1: WriteLn('Ошибка: отрицательный результат');
   0: WriteLn('Ошибка: сгенерирован 0');
   else WriteLn('Арабское число: ',value);
 End;
End.

Программа переводит арабские числа в римские и наоборот:

const
  n = 13;			{ Всего рассматривается 13 комбинаций }
  pair: array[1 .. n] of record	{ Каждая подобная Пара однозначно определяет соответствие }
    r: string[2];		{ заданого в виде строки римского числа (поле R)	}
    a: integer;			{ арабскому числу, хранящемуся в поле A			}
  end =
  (
    (r: 'I' ; a:    1),
    (r:'IV' ; a:    4),
    (r: 'V' ; a:    5),
    (r:'IX' ; a:    9),
    (r: 'X' ; a:   10),
    (r:'XL' ; a:   40),
    (r: 'L' ; a:   50),
    (r:'XC' ; a:   90),
    (r: 'C' ; a:  100),
    (r:'CD' ; a:  400),
    (r: 'D' ; a:  500),
    (r:'CM' ; a:  900),
    (r: 'M' ; a: 1000)
  );

{ Функция перевода целого числа (value) в строку, представляющую его в римской системе }
function ToRoman(value: integer): string;
var
  theResult: string;
  i: integer;
begin
  theResult := '';
  i := n;

  while value > 0 do begin

    while pair[i].a > value do dec(i);
    theResult := theResult + pair[i].r;
    dec(value, pair[i].a);

  end;

  ToRoman := theResult;
end;

{
  Попытка перевода строки в арабское число.
  Если в строке содержатся неподходящие символы, или полученное арабское число,
  переведенное в римскую систему, выдает результат, отличающийся от входной строки S,
  считается, что произошла ошибка конвертации, и функция возвращает -1
}
function ToArabic(s: string): integer;
var
  theResult: integer;
  i, pos: integer;
begin
  ToArabic := -1;
  theResult := 0;

  i := n;
  pos := 1;

  while pos <= length(s) do begin

    while copy(s, pos, length(pair[i].r)) <> pair[i].r do begin

      dec(i);
      { I будет равняться 0 только если во входной строке встречается некорректный символ }
      if i = 0 then exit;

    end;
    theResult := theResult + pair[i].a;
    inc(pos, length(pair[i].r));

  end;
  {
      Проверяем результат переводом его назад в римскую систему
  }
  if ToRoman(theResult) = s then ToArabic := theResult
end;

var
  value, Err: integer;
  s: string;

begin

  {
    Программа будет работать, пока пользователь не введет пустую строку 
  }
  repeat
    write('--> '); readLn(s);

    if s <> '' then begin

    { Пытаемся перевести строку в число }
      val(s, value, Err);
    
    { Если это удалось (Err = 0), то было введено арабское число, иначе - _возможно_ введено римское число }
      if Err = 0 then
        writeln(ToRoman(value))
      else writeln(ToArabic(s));

    end;

  until s = '';

end.

Ну, и если кому-то понадобится рекурсивная функция перевода арабских чисел в римские - вот она:

const
  n = 13;
  pair: array[1 .. n] of record
    r: string[2];
    a: integer;
  end =
  (
    (r: 'I' ; a:    1),
    (r:'IV' ; a:    4),
    (r: 'V' ; a:    5),
    (r:'IX' ; a:    9),
    (r: 'X' ; a:   10),
    (r:'XL' ; a:   40),
    (r: 'L' ; a:   50),
    (r:'XC' ; a:   90),
    (r: 'C' ; a:  100),
    (r:'CD' ; a:  400),
    (r: 'D' ; a:  500),
    (r:'CM' ; a:  900),
    (r: 'M' ; a: 1000)
  );


function get_roman(value: integer): string;
var i: integer;
begin

  if value <= 0 then get_roman := ''
  else begin

    i := n;
    while pair[i].a > value do dec(i);
    get_roman := pair[i].r + get_roman(value - pair[i].a);

  end

end;

Как вычислить арксинус / арккосинус аргумента?

Внимание: Внешние ссылки !

Разложение функции в ряд

Внимание: Внешние ссылки !

1. Как самому написать функцию Ln(x), если бы ее не было в Паскале?
2. Как разложить функцию Exp(x) в ряд?

Как разложить функцию sin(x) в ряд?
Нажмите для просмотра прикрепленного файла
(количество суммируемых членов ряда определяется точностью – e).

В процессе вычисления очередной член (pi) определяется по формуле:
pi = - pi * x2 /(I * (I - 1))
При этом учитывается, что члены ряда индексируются с шагом 2, т.е. i=1,3,5, … и в качестве начальных установок используются i :=3, s :=x, p :=x, x2 :=x*x.
Переменная s является "накопителем" текущей суммы членов ряда, а условием окончания процесса является проверка вида "очередной член по абсолютной величине меньше заданной точности", т. е. P<E.

var
 I : Integer;
 E,X,P,S,x2 : Real;
begin
 Write ('Введите аргумент  функции Sin(x), x= ');
 ReadLn (X);
 Write ('Введите точность  e=');
 ReadLn (E);
 S :=X;
 P :=X;
 X2 :=X*X;
 I :=3;
 repeat
  P :=-P*X2/(I*(I-1));
  S :=S+P;
  I:=I+2
 until Abs(P)<E;
 WriteLn ('Sin (', X, ') =  ', S)  ;
 readln;
end.

Как разложить функцию cos(z) в ряд?

Program ZnachCos;
Var
 n,k:Integer;
 z,a,b,e,s,p,Eps:real;
Begin {ZnachCos}
 Write('Введите значение Z ');
 Read(z);
 Write('Введите значене Eps ');
 Read(Eps);
 Writeln('Z= ',z);
 writeln('Eps= ',Eps);
 n:=1;
 a:=1;
 s:=1;
 While Abs(a)>Eps do
  Begin
  a:=-a*z*z/(2*n*(2*n-1));
  s:=s+a;
  Inc(n)
  End;
 Writeln('COS(z) равен ',s,' при разложении в степенной ряд.');
 Writeln('Число итераций равно ',n);
 p:=1;
 k:=0;
 b:=1-2*z/(pi*(2*k+1))*2*z/(pi*(2*k+1));
 while abs(e-p)>eps do
  begin
   e:=p;
   b:=1-2*z/(pi*(2*k+1))*2*z/(pi*(2*k+1));
   p:=p*b;
   inc(k)
  end;
 Writeln('COS(z) равен ',p,' при разложении в бесконечное произведение.');
 Writeln('Число итераций равно ',k)
End.