1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
| unit BynaryFind;
{Будьте внимательны при использовании границ поиска по умолчанию, поскольку
использованы максимальное и минимальное возможные значения переменной типа
Extended, и если для некоторых х выполняется: f(x)>x, то программа может
вылететь с печальной ошибкой "Floating point overflow".
Так же стоит учесть, что проверки на монотонность функция не производит.}
interface
uses
Math;
type
/// <summary>
/// Монотонная функция
/// </summary>
TMonoFunc=function(x:extended):extended;
/// <summary>
/// Результат поиска
/// </summary>
TResult=record
/// <summary>
/// Значение аргумента
/// </summary>
argument:extended;
/// <summary>
/// Точность поиска
/// </summary>
epsilon:extended;
/// <summary>
/// Найден ли аргумет (если <c>false</c>, то возвращается ближайшее значение из
/// интервала поиска)
/// </summary>
isFinded:boolean;
end;
/// <summary>
/// Функция бинарного поиска аргумента по известному значению. Работает
/// только для монотонных и непрерывных на [a,b] функций.
/// </summary>
function FindArgument(func:TMonoFunc; y:extended; a:extended=-MaxExtended;
b:extended=MaxExtended; eps:extended=1e-18):TResult;
/// <summary>
/// Функция бинарного поиска индекса элемента в массиве. Работает только
/// в отсортированных массивов.
/// </summary>
function FindIndex(arr:TArray<extended>; v:extended):integer;
implementation
var
tmp,staticA,staticB,tY,tA,tB,tEps:extended;
tFunc:TMonoFunc;
tflg:boolean;
compareMod:ShortInt;
function FindArgumentRec:extended;
begin
tmp:=(tA+tB)/2; //середина отрезка
if IsZero(tFunc(ta)-tFunc(tb),teps) then //если длина отрезка меньше эпсилон
begin //то возвращаем середину хитрым путем
tflg:=tmp>((staticA+staticB)/2);
if tflg then
Exit(-staticA+tmp)
else
Exit(-staticB+tmp)
end;
//проверяем середину отрезка на соответствие
//домножение на compareMod позволяет работать с функцией как с возрастающей
case compareMod*CompareValue(tfunc(tmp),ty,teps) of
0:Result:=tmp;//если f(tmp)=y, то его и возвращаем
-1: //если f(tmp)<y, ищем правее
begin
tA:=tmp;
Result:=FindArgumentRec
end;
1: //если f(tmp)>y, ищем левее
begin
tB:=tmp;
Result:=FindArgumentRec
end
end
end;
function FindArgument(func:TMonoFunc; y,a,b,eps:extended):TResult;
begin
staticA:=a; //запись исходных границ поиска
staticB:=b;
tFunc:=func; //и прочих нужных вещей в глобальные
tA:=a; //переменные, дабы не засорять стек
tB:=b;
tY:=y;
tEps:=eps;
Result.epsilon:=eps;
//определение вида функции: возрастает(1) она или убывает(-1)
//если compareMod=0, то функция либо постоянна, либо не монотонна
compareMod:=CompareValue(func(b),func(a),eps);
if compareMod=0 then
with Result do
begin
argument:=(b+a)/2;
isFinded:=func(argument)=y;
Exit;
end;
with Result do
begin
argument:=FindArgumentRec;//собственно поиск
//проверка, найдено ли значение, и нахождение ближайшей границы области
isFinded:=((-argument>a) and tflg) or ((-argument<b) and not tflg);
if not isFinded then
begin
if tflg then
argument:=argument+a
else
argument:=argument+b
end
end
end;
var
tarr:TArray<extended>;
tv:extended;
a,b,t:integer;
function FindIndexRec:integer;
begin
t:=(a+b) div 2;
if (a=b) then
Exit(-1);
case compareMod*CompareValue(tarr[t],tv) of
0:Result:=t;
-1:
begin
a:=t;
Result:=FindIndexRec
end;
1:
begin
b:=t;
Result:=FindIndexRec
end
end
end;
function FindIndex(arr:TArray<extended>; v:extended):integer;
begin
tv:=v;
a:=0;
b:=length(arr)-1;
if b<0 then//в пустом массиве искомого элемента точно нет
Exit(-1);
tarr:=arr;
compareMod:=CompareValue(arr[b],arr[a]);
if compareMod=0 then//если массив постоянен
Exit(IfThen(arr[a]=v,a,-1));
Result:=FindIndexRec;
end;
end. |
