![]() |
![]() ![]() |
![]() |
Altair |
![]()
Сообщение
#1
|
![]() Ищущий истину ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 824 Пол: Мужской Реальное имя: Олег Репутация: ![]() ![]() ![]() |
Описание и реализация алгоритмов:
-------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Altair |
![]()
Сообщение
#2
|
![]() Ищущий истину ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 824 Пол: Мужской Реальное имя: Олег Репутация: ![]() ![]() ![]() |
Перевод из десятичной с.с в любую и наоборот.
function FromDec(n, radix:longint):string; function ToDec(n:string; radix:longint):longint; Как проверить, является ли строка корректным представлением числа в определенной системе счисления ? Допустимые значения radix: 2 .. 36 function isCorrect(n: string; radix: byte): boolean; -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Altair |
![]()
Сообщение
#3
|
![]() Ищущий истину ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 824 Пол: Мужской Реальное имя: Олег Репутация: ![]() ![]() ![]() |
Возведение в степень.
Function is_power_2(x: Word): Boolean;
Begin
is_power_2 := (x > 0) and ((x and Pred(x)) = 0)
End;
-------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
volvo |
![]()
Сообщение
#4
|
Гость ![]() |
Работа с двоичными числами
Вычитание двоичных чисел Перемножение двоичных чисел с использованием строк Внимание: Внешние ссылки ! |
volvo |
![]()
Сообщение
#5
|
Гость ![]() |
Работа с римскими числами
Как проверить, является ли введенная с клавитуры строка римским числом, и перевести ее в арабское число? 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(c);
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;
|
volvo |
![]()
Сообщение
#6
|
Гость ![]() |
|
volvo |
![]()
Сообщение
#7
|
Гость ![]() |
Разложение функции в ряд
Внимание: Внешние ссылки !Как разложить функцию 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.
Эскизы прикрепленных изображений ![]() ![]() |
![]() ![]() |
![]() |
Текстовая версия | 19.07.2025 4:55 |