Описание и реализация алгоритмов:
Перевод из десятичной с.с в любую и наоборот.
function FromDec(n, radix:longint):string;
var
s: String;
const
digit: string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod radix)+1]+s;
n:=n div radix;
until n=0;
FromDec:=s;
end;
function ToDec(n:string; radix:longint):longint;
var
m, i: longint;
const
digit: string[16]='0123456789ABCDEF';
begin
m:=0;
while (n[1]='0') and (length(n) > 1) do delete(n,1,1);
for i:=1 to length(n) do m:=m*radix+pos(n[i],digit)-1;
ToDec:=m;
end;
function isCorrect(n: string; radix: byte): boolean;
const
symbols: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
bad: boolean;
i: integer;
begin
bad := False;
i := 0;
repeat
inc(i);
bad := (pos(n[i], copy(symbols, 1, radix)) = 0);
until bad or (i = length(n));
isCorrect := not bad;
end;
Возведение в степень.
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.
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;
Работа с двоичными числами
http://volvo71.narod.ru/faq_folder/math.htm#bin_sub двоичных чисел
http://volvo71.narod.ru/faq_folder/math.htm#bin_mult двоичных чисел с использованием строк
Внимание: Внешние ссылки !
Работа с римскими числами
Как проверить, является ли введенная с клавитуры строка римским числом, и перевести ее в арабское число?
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;
Как вычислить http://volvo71.narod.ru/faq_folder/math.htm#arc_sin / http://volvo71.narod.ru/faq_folder/math.htm#arc_cos аргумента?
Внимание: Внешние ссылки !
Разложение функции в ряд
Внимание: Внешние ссылки !
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.
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.