IPB
ЛогинПароль:

> Внимание! Действует предмодерация

Подраздел FAQ (ЧАВО, ЧАстые ВОпросы) предназначен для размещения готовых рабочих программ, реализаций алгоритмов. Это нечто вроде справочника, он наполнялся в течение 2000х годов. Ваши вопросы, особенно просьбы решить задачу, не пройдут предмодерацию. Те, кто наполнял раздел, уже не заходят на форум, а с теми, кто на форуме сейчас, лучше начинать общение в других разделах. В частности, решение задач — здесь.

 
 Ответить  Открыть новую тему 
> Общие вопросы по математике.
сообщение
Сообщение #1


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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

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;


Как проверить, является ли строка корректным представлением числа в определенной системе счисления ?
Допустимые значения radix: 2 .. 36
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;


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


Возведение в степень.
  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;


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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

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

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

Внимание: Внешние ссылки !
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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©;

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;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






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

Внимание: Внешние ссылки !
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






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

Внимание: Внешние ссылки !
  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.


Эскизы прикрепленных изображений
Прикрепленное изображение Прикрепленное изображение
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 19.01.2017 9:15
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"