Форум: "Потрепаться";
Текущий архив: 2002.06.06;
Скачать: [xml.tar.bz2];
Вниз
UBPFD: Надо бы ввести новое поле... Как это лучше организовать? Найти похожие ветки
← →
lipskiy (2002-04-30 14:07) [0]Вот конкретный пример - в базу добавлены две функции:
http://delphibase.endimus.com/?action=viewfunc&topic=mathcode&index=1
и
http://delphibase.endimus.com/?action=viewfunc&topic=mathcode&index=2
Одно функция криптует строку, другая декриптует.
Обе функции бесполезны друг без друга.
Об этом пользователю надо где-то сказать для каждой из них.
Поле "Зависимости" предназначено для списка модулей и функций, без которых приводимый код не будет даже компилироваться.
В данном случае - одна функция без другой прекрасно скомпилируется.
Поле "Источник данных", о котором говорилось раньше, но которое так и отсутствует, предполагало список функций, которые бы выдавали данные, непосредственно необходимые для вызова данной функции.
В данном случае это тоже не совсем так - в функцию раскодировки можно подать и незашифрованную строку - ошибки не будет, просто смысла нет так делать.
Есть предложение ввести поле "Связанные функции" или что-то в этом роде.
Ваши предложения?
← →
Alx2 (2002-04-30 14:15) [1]Как в хэлпе: линк "see also"
← →
vuk (2002-04-30 14:19) [2]Так ведь в базу же можно добавлять модули. Этим функциям как раз и место в одном модуле. ИМХО.
← →
Anatoly Podgoretsky (2002-04-30 14:24) [3]Это частный случай, в других такого не будет, но в тоже время они связанные, просто функция может использоваться в разных местах.
Зависимости как раз и выполняют эту роль, если указано в формате UBPFD.ххх
← →
VID (2002-04-30 14:42) [4]Необходимо добавить поле типа "Источник данных", либо "Связанные функции", либо тот же "См. также".
что-то из этого должно быть.
возможно наиболее всего подойдёт "См. также"
← →
lipskiy (2002-04-30 14:48) [5]Ок, голосуем :)
1. Оставить, как есть.
2. "Связанные функции"
3. "Источник данных"
4. "См. также"
5. Оформление модулем.
6. Что-то еще?
← →
Игорь Шевченко (2002-04-30 14:55) [6]День добрый,
"См. также"
С уважением,
← →
VictorT (2002-04-30 14:58) [7]"См. также"
← →
Mystic (2002-04-30 15:02) [8]"См. также"
← →
Johnmen (2002-04-30 15:14) [9]"Не см. также"
:-)
← →
Alx2 (2002-04-30 15:14) [10]Все-таки "See also" :)
← →
lipskiy (2002-04-30 15:28) [11]Аналогично :)
← →
VID (2002-04-30 15:37) [12]нифига себе :))) что ж .. принято ? или ещё подождать ? :)))
← →
Dimka Maslov (2002-04-30 16:07) [13]Пока поиск не закончен, сделать такое сложно, потом на много проще - система выведет ссылки на связанные функции через поиск, а уже как назвать это поле - всё равно.
>Alx2
База русскоязычная, по-этому see also там не будет
← →
Oleg_Gashev (2002-05-01 02:43) [14]Господа.
Вы, честно говоря, пытаетесь решить проблемы, которых в природе не существует. Кратко попытаюсь объяснить в чем проблема.
Начали Вы с того, что сделали постмодерирование. Хорошо или плохо это, говорить не буду. Мое мнение lipskiy уже знает. Ему принимать решение. После принятия вышеизложенного, появилась необходимость объединить некоторые ветки в единое целое посредством "смотри также". Откуда проблема- как организовать такую структуру. А если таких "смотри также" 5-10, что делать?
Мировой опыт, а это десятки сайтов, разрабатывающих идею базы функций, делает немного по другому, дабы избавить себя от многочисленных проблем. Приведу краткое изложение их по порядку. В этот список не входит только решение данной проблемы. Это многочисленные коментарии о работе библиотеки.
1) Каждый код, выложенный в базе имеет copyright, но не имеет права использования,то есть, права пользоваться данным кодом. Прежде чем о чем-то спорить, прочитайте http://planetsourcecode.com/vb/scripts/TermsAndConditions.asp?lngWId=-1
2) Фраза "Не тестировано" не говорит ни о чем. Это Вас не избавляет от ответственности, во время публикации кода. Надо четко оговаривать использование любого кода, публикуемого в библиотеке. Смотреть приведенный выше адрес.
3) Чтобы не использовать фразу "смотри также", публикуют полностью рабочий код. То есть, если в коде есть Encrypt, дожен быть Decrypt. Он публикуется как единый код, в одном модуле.
Не буду всего перечислять. Кому интерестно, могут связаться со мной по email oleg@gashev.com . Мне самому предстоит добавить некоторые функции в Code Library , что находится по адресу http://gashev.com .
С уважением, Олег Гашев.
← →
Malder (2002-05-01 10:51) [15]5. Оформление модулем.
← →
lipskiy (2002-05-01 14:35) [16]About Oleg_Gashev.
No comments.
← →
VID (2002-05-01 15:02) [17]TO Oleg_Gashev:
По пунктам:
1. и что теперь ?
2. Согласен с тем, что
> Надо четко оговаривать использование любого кода, публикуемого
> в библиотеке. Смотреть приведенный выше адрес.
Просто можно на странице с подробным описанием кода, указать, что если "Не проверено", то создатели базы не несут никакой ответственности за то-то и то-то... так всегда все отмазываются.
3. Ты говоришь, что в приводимом примере должены быть описаны и Encrypt и Decrypt. А кто же мешает ? Возможность оправки целых юнитов имеется. А поле "см. также" необходимо, в случае отправки функций, например, для одной из которых входными параметрами служат выходные параметры другой функции. Но ещё раз повторю: никто ведь не запрещает отправлять юниты. Наоборот, так будет красивее и понятнее - главное что бы каждый отправляемый юнит решал определённую задачу, а не являлся "копилкой функций на все случаи жизни".
← →
Anatoly Podgoretsky (2002-05-01 15:12) [18]VID © (01.05.02 15:02)
2. Очень интересно для случая отмечено
3. так было наложено ограничение, что каждая функция отдельно
← →
lipskiy (2002-05-01 15:27) [19]Лично я за то, чтобы в одной записи была одна функция и Anatoly Podgoretsky по-моему правильно разместил. Какой это, на хрен, юнит - из двух функций. А "см. также" - решит все проблемы. И вообще - я был против юнитов изначально, но согласился с мнением большинства. Юнит уже почти компонент, а это несколько иной тип информации. А я не приветствую свалку разнотипной инфы в одном месте. База по функциям - коротким законченным кускам кода. А компонентов полно и в других местах. Хотя вот сделать базу компонентов самим - это тоже интересно, но только ОТДЕЛЬНУЮ.
← →
Anatoly Podgoretsky (2002-05-01 15:43) [20]Я не про модуль, просто можно было обе функции поместить вместе без организации модуля, тем более что у них общая часть констант, но было сказано по одной функции.
Надо просто снять ограничение на это и все, кроме того необходимо и пост-модерирование, то есть нужен администратор архива, который сможет делать необходимые коррекции
← →
Oleg_Gashev (2002-05-01 19:08) [21]> Просто можно на странице с подробным описанием кода, указать, что если "Не проверено", то создатели базы не несут никакой ответственности за то-то и то-то... так всегда все отмазываются.
То есть, если проверено, то несут ответственность...
Интересно.
← →
VID (2002-05-01 19:46) [22]To lipskiy: Функция - кусок кода который выполняет конкретную задачу. Юнит - кусок кода, который выполняет конкретную задачу. Где разнотипность ? Иногда для выполнения конкретной задачи необходимо НЕСКОЛЬКО функций. Помещаем их в юнит. В интерфейсной части можно объявить только одну функцию, которая возвращает результат. Остальные функции вспомогательные для основной. Что не так ?
TO Anatoliy Podgoretskiy: А разве есть ограничение на размещение юнитов ?
Смотри:
Заголовок процедуры, функции или модуля предваряемый ключевыми словами procedure
function, или unit . Для простых незаконченных примеров, показывающих лишь принцип
работы воспользуйтесь словом intermediate.
To Oleg_gashev: Ну чего ты к словам придираешься ?
Метку проверено ставят не для того что бы на 100% обезопасить мир от глобальной катастрофы, а что бы пользователь знал, что какой-нибудь культурный человек проверил код, и ничего плохого не заметил. А если на то пошло, то можно прямо написать : "Функции в БАЗе ФРИВОРНые, ТАК ЧТО ЕСЛИ ОТ функции ExtractFileNameEX ваш компьютер вдруг станет не более полезен чем верстак, то не в обиду... фриворная ведь :))))"
PS: TO ALL: Извините, если показался вам несколько резким в своих высказываниях :)))
← →
Anatoly Podgoretsky (2002-05-01 19:57) [23]VID © (01.05.02 19:46)
Цитирую
Просто можно на странице с подробным описанием кода, указать, что если "Не проверено", то создатели базы не несут никакой ответственности за то-то и то-то... так всегда все отмазываются.
Соответственно если проверено то несут полную ответсвенность
← →
lipskiy (2002-05-01 21:31) [24]2 VID
> Что не так ?
Да я согласился с юнитами, ок.
Но почему то мне это не нравится.
Ну если юнит - законченный кусок кода, то почему его нельзя засунуть в одну процедуру?
Много параметров? Разные варианты использования? Тогда это уже компонент. Ладно, эту тему можно закрыть. Не так и важно.
2 Anatoly Podgoretsky
Действительно, ограниченя вроде нигде не ставилось такого.
Так что если бы можно было оформить обе функции в виде одной - это было бы лучше. Сделайте это, если хотите, а те две предыдущие мы удалим тогда.
Ну и действительно, не цепляйтесь вы к формулировкам!
VID правильную мысль немного неверно сформулировал, вот и все.
Метка "Протестировано" всего лишь метка для юзера, чтоб он знал, что код кем-то проверен и больше вероятности, что он работоспособен.
И ничего более, никаких гарантий и ответственности.
← →
Anatoly Podgoretsky (2002-05-01 21:38) [25]lipskiy © (01.05.02 21:31)
Ограничения были, по крайней мене на нечальных этапах.
"Сделайте это, если хотите, а те две предыдущие мы удалим тогда"
Это вот как раз относится к тому понятию, "как нужен администратор архива"
← →
VID (2002-05-01 21:48) [26]to anatoliy podgoretskiy:
> VID © (01.05.02 19:46)
> Цитирую
>
>
> Просто можно на странице с подробным описанием кода, указать,
> что если "Не проверено", то создатели базы не несут никакой
> ответственности за то-то и то-то... так всегда все отмазываются.
>
>
> Соответственно если проверено то несут полную ответсвенность
я действительно не правильно сформулировал свою мысль... но потом исправил ведь. (VID 01.05.02 19:46 . to oleg_gashev)
← →
lipskiy (2002-05-01 21:50) [27]А мы уже его админим.
Так что, но проблем.
И еще народ призываем в тестеры.
Пишите Dimke Maslovu.
← →
Oleg_Gashev (2002-05-01 21:53) [28]>lipskiy
> Ну если юнит - законченный кусок кода, то почему его нельзя засунуть в одну процедуру?
Нонсенс.
Напиши в виде одной функции.
Автор Sevastyanov Andrey
Description: Optimizing, method Nelder (deforming polyhedron)
unit Nelder;
interface
const
CONST_1_DIV_SQRT_2 = 0.70710678118654752440084436210485;
FIND_MIN_OK = 0;
FIND_MIN_INVALID_OPTION = 1;
FIND_MIN_INVALID_FUNC = 2;
FIND_MIN_INVALID_N = 3;
FIND_MIN_INVALID_X0 = 4;
FIND_MIN_INVALID_X = 5;
FIND_MIN_INVALID_EPS = 6;
FIND_MIN_INVALID_DELTA = 7;
FIND_MIN_INVALID_R = 8;
FIND_MIN_MODE_NOT_SUPPORT = 9;
FIND_MIN_OUT_OF_MEMORY = 10;
FIND_MIN_INVALID_ALPHA = 11;
FIND_MIN_INVALID_BETA = 12;
FIND_MIN_INVALID_GAMMA = 13;
FIND_MIN_MODE_STD = 0;
FIND_MIN_MODE_1 = 1;
FIND_MIN_MODE_2 = 2;
FIND_MIN_USE_EPS = $00000001;
FIND_MIN_USE_R = $00000002;
FIND_MIN_USE_MODE = $00000004;
FIND_MIN_USE_DELTA = $00000008;
FIND_MIN_USE_ALPHA = $00000010;
FIND_MIN_USE_BETA = $00000020;
FIND_MIN_USE_GAMMA = $00000040;
// Некоторые комбинации стандартных опций:
FIND_MIN_USE_EPS_R = FIND_MIN_USE_EPS or FIND_MIN_USE_R;
FIND_MIN_USE_EPS_R_MODE = FIND_MIN_USE_EPS_R or FIND_MIN_USE_MODE;
FIND_MIN_USE_EPS_R_DELTA = FIND_MIN_USE_EPS_R or FIND_MIN_USE_DELTA;
FIND_MIN_USE_EPS_R_MODE_DELTA = FIND_MIN_USE_EPS_R_MODE or FIND_MIN_USE_DELTA;
FIND_MIN_USE_ALL = FIND_MIN_USE_EPS or FIND_MIN_USE_R or FIND_MIN_USE_MODE or
FIND_MIN_USE_DELTA or FIND_MIN_USE_ALPHA or
FIND_MIN_USE_BETA or FIND_MIN_USE_GAMMA;
type
PMathFunction = ^TMathFunction;
TMathFunction = function(X: PExtended): Extended;
PNelderOption = ^TNelderOption;
TNelderOption = record
Size: Cardinal; // Размер структуры (обязательно)
Flags: Cardinal; // Флаги (обязательно)
Func: TMathFunction; // Функция (обязательно)
N: Integer; // Размерность (обязательно)
X0: PExtended; // Указатель на начальную точку (обязательно)
X: PExtended; // Указатель куда записывать результат (обязательно)
Eps: Extended; // Точность (опция FIND_MIN_USE_EPS)
Delta: Extended; // Способ проверки (опция FIND_MIN_USE_DELTA)
R: Extended; // Расстояние между вершинами симплекса (опция FIND_MIN_USE_R)
Mode: Integer; // Метод решения (опция FIND_MIN_USE_MODE)
Alpha: Extended; // Коэффициент отражения (опция FIND_MIN_USE_ALPHA)
Beta: Extended; // Коэффициент сжатия (опция FIND_MIN_USE_BETA)
Gamma: Extended; // Коэффициент растяжения (опция FIND_MIN_USE_GAMMA)
end;
function FindMin_Nelder(const Option: TNelderOption): Integer;
implementation
uses Windows, DebugReport;
{**********
Проверка указателя Option на то, что все его параметры доступны для чтения
**********}
function CheckNelderOptionPtr(Option: PNelderOption): Integer;
begin
// Проверка указателя #1 (допустимость указателя)
if IsBadReadPtr(@Option, 4) then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end;
// Проверка указателя #2 (слишком мало параметров)
if Option.Size < 24 then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end;
// Проверка указателя #3 (все данные можно читать?)
if IsBadReadPtr(@Option, Option.Size) then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end;
Result := FIND_MIN_OK;
end;
← →
Oleg_Gashev (2002-05-01 21:55) [29]
{************
Копирование данных из одной структуры в другую с попутной проверкой
на допустимость значений всех параметров.
************}
function CopyData(const InOption: TNelderOption; var OutOption: TNelderOption): Integer;
var
CopyCount: Cardinal;
begin
Result := FIND_MIN_OK;
// Копируем одну структуру в другую
CopyCount := SizeOf(TNelderOption);
if InOption.Size < CopyCount then CopyCount := InOption.Size;
Move(InOption, OutOption, CopyCount);
// Устанавливаем размер
OutOption.Size := SizeOf(TNelderOption);
// Проверка Option.Func
if IsBadCodePtr(@OutOption.Func) then
begin
Result := FIND_MIN_INVALID_FUNC;
Exit;
end;
// Проверка Option.N
if OutOption.N <= 0 then
begin
Result := FIND_MIN_INVALID_N;
Exit;
end;
// Проверка Option.X0
if IsBadReadPtr(OutOption.X0, OutOption.N * SizeOf(Extended)) then
begin
Result := FIND_MIN_INVALID_X0;
Exit;
end;
// Проверка Option.X
if IsBadWritePtr(OutOption.X, OutOption.N * SizeOf(Extended)) then
begin
Result := FIND_MIN_INVALID_X;
Exit;
end;
// Проверка Option.Eps
if (FIND_MIN_USE_EPS and OutOption.Flags) <> 0 then
begin
if OutOption.Size < 34 then // Eps не вписывается в размер
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end
else if OutOption.Eps <= 0 then
begin
Result := FIND_MIN_INVALID_EPS;
Exit;
end;
end
else begin
OutOption.Eps := 1E-06; // Default value;
end;
// Проверка OutOption.Delta
if (FIND_MIN_USE_DELTA and OutOption.Flags) <> 0 then
begin
if OutOption.Size < 44 then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end
else if (OutOption.Delta < 0.0) or (OutOption.Delta > 1.0) then
begin
Result := FIND_MIN_INVALID_DELTA;
Exit;
end;
end
else begin
OutOption.Delta := 0.5; // Default value
end;
// Проверка OutOption.R
if (FIND_MIN_USE_R and OutOption.Flags) <> 0 then
begin
if OutOption.Size < 54 then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end
else if (OutOption.R <= 0.0) then
begin
Result := FIND_MIN_INVALID_R;
Exit;
end;
end
else begin
OutOption.R := 100.0; // Default value
end;
// Проверка OutOption.Mode
if (FIND_MIN_USE_MODE and OutOption.Flags) <> 0 then
begin
if OutOption.Size < 58 then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end
else
if (OutOption.Mode <> FIND_MIN_MODE_STD) then
if (OutOption.Mode <> FIND_MIN_MODE_1) then
if (OutOption.Mode <> FIND_MIN_MODE_2) then
begin
Result := FIND_MIN_MODE_NOT_SUPPORT;
Exit;
end;
end
else begin
OutOption.Mode := FIND_MIN_MODE_STD; // Default value
end;
// Проверка OutOption.Alpha
if (FIND_MIN_USE_ALPHA and OutOption.Flags) <> 0 then
begin
if OutOption.Size < 68 then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end
else if OutOption.Alpha < 0.0 then
begin
Result := FIND_MIN_INVALID_ALPHA;
Exit;
end;
end
else begin
OutOption.Alpha := 1.0; // Default value
end;
// Проверка OutOption.Beta
if (FIND_MIN_USE_BETA and OutOption.Flags) <> 0 then
begin
if OutOption.Size < 78 then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end
else if (OutOption.Beta < 0.0) or (OutOption.Beta > 1.0) then
begin
Result := FIND_MIN_INVALID_BETA;
Exit;
end;
end
else begin
OutOption.Beta := 0.5; // Default value
end;
// Проверка OutOption.Gamma
if (FIND_MIN_USE_GAMMA and OutOption.Flags) <> 0 then
begin
if OutOption.Size < 88 then
begin
Result := FIND_MIN_INVALID_OPTION;
Exit;
end
else if OutOption.Gamma < 1.0 then
begin
Result := FIND_MIN_INVALID_GAMMA;
Exit;
end;
end
else begin
OutOption.Gamma := 1.5; // Default value
end;
end;
← →
Oleg_Gashev (2002-05-01 21:56) [30]
type
TNelderTempData = record
D1: Extended;
D2: Extended;
FC: Extended;
FU: Extended;
XN: PExtended;
D0: PExtended;
FX: PExtended;
C: PExtended;
U: PExtended;
V: PEXtended;
Indexes: PInteger;
end;
function InitializeTempData(var TempData: TNelderTempData; N: Integer): Integer;
var
SizeD0: Integer;
SizeFX: Integer;
SizeC: Integer;
SizeU: Integer;
SizeV: Integer;
SizeIndexes: Integer;
SizeAll: Integer;
Ptr: PChar;
begin
// Вычисляем размеры
SizeD0 := N*(N+1)*SizeOf(Extended);
SizeFX := (N+1)*SizeOf(Extended);
SizeC := N * SizeOf(Extended);
SizeU := N * SizeOf(Extended);
SizeV := N * SizeOf(Extended);
SizeIndexes := (N+1) * SizeOf(Integer);
SizeAll := SizeD0 + SizeFX + SizeC + SizeU + SizeV + SizeIndexes;
Ptr := SysGetMem(SizeAll);
if not Assigned(Ptr) then
begin
Result := FIND_MIN_OUT_OF_MEMORY;
Exit;
end;
TempData.D0 := PExtended(Ptr);
Ptr := Ptr + SizeD0;
TempData.FX := PExtended(Ptr);
Ptr := Ptr + SizeFX;
TempData.C := PExtended(Ptr);
Ptr := Ptr + SizeC;
TempData.U := PExtended(Ptr);
Ptr := Ptr + SizeU;
TempData.V := PExtended(Ptr);
Ptr := Ptr + SizeV;
TempData.Indexes := PInteger(Ptr);
// Ptr := Ptr + SizeIndexes
Result := FIND_MIN_OK;
end;
procedure FinalizeTempData(var TempData: TNelderTempData);
var
Ptr: Pointer;
begin
Ptr := TempData.D0;
TempData.D0 := nil;
TempData.FX := nil;
TempData.C := nil;
TempData.U := nil;
TempData.V := nil;
TempData.Indexes := nil;
SysFreeMem(Ptr);
end;
{*********
Строится симплекс:
В целях оптимизации поменяем местами строки и столбцы
**********}
procedure BuildSimplex(var Temp: TNelderTempData; const Option: TNelderOption);
var
I, J: Integer;
PtrD0: PExtended;
begin
with Temp, Option do
begin
D1 := CONST_1_DIV_SQRT_2 * R * (Sqrt(N+1) + N - 1) / N;
D2 := CONST_1_DIV_SQRT_2 * R * (Sqrt(N+1) - 1) / N;
FillChar(D0^, N*SizeOf(Extended), 0);
PtrD0 := D0;
PChar(PtrD0) := PChar(PtrD0) + N*SizeOf(Extended);
for I := 0 to N-1 do
for J := 0 to N-1 do
begin
if I = J
then PtrD0^ := D1
else PtrD0^ := D2;
PChar(PtrD0) := PChar(PtrD0) + SizeOf(Extended);
end;
end;
end;
{*********
Перемещение симплекса в точку A
*********}
procedure MoveSimplex(var Temp: TNelderTempData; const Option: TNelderOption; A: PExtended);
var
I, J: Integer;
PtrA, PtrD0: PExtended;
begin
with Temp, Option do
begin
PtrD0 := D0;
for I := 0 to N do
begin
PtrA := A;
for J := 0 to N-1 do
begin
PtrD0^ := PtrD0^ + PtrA^;
PChar(PtrD0) := PChar(PtrD0) + SizeOf(Extended);
PChar(PtrA) := PChar(PtrA) + SizeOf(Extended);
end;
end;
end;
end;
← →
Oleg_Gashev (2002-05-01 21:59) [31]
// Быстрая сортировка значений FX
procedure QuickSortFX(L, R: Integer; FX: PExtended; Indexes: PInteger);
var
I, J, K: Integer;
P, T: Extended;
begin
repeat
I := L;
J := R;
// P := FX[(L+R) shr 1] :
P := PExtended(PChar(FX) + SizeOf(Extended) * ((L+R) shr 1))^;
repeat
// while FX[I] < P do Inc(I):
while PExtended(PChar(FX) + SizeOf(Extended)*I)^ < P do
Inc(I);
// while FX[J] > P do Dec(J):
while PExtended(PChar(FX) + SizeOf(Extended)*J)^ > P do
Dec(J);
if I <= J then
begin
// Переставляем местами значения FX
T := PExtended(PChar(FX) + SizeOf(Extended)*I)^;
PExtended(PChar(FX) + SizeOf(Extended)*I)^ := PExtended(PChar(FX) + SizeOf(Extended)*J)^;
PExtended(PChar(FX) + SizeOf(Extended)*J)^ := T;
// Поддерживаем порядок и в индексах
K := PInteger(PChar(Indexes) + SizeOf(Integer)*I)^;
PInteger(PChar(Indexes) + SizeOf(Integer)*I)^ := PInteger(PChar(Indexes) + SizeOf(Integer)*J)^;
PInteger(PChar(Indexes) + SizeOf(Integer)*J)^ := K;
Inc(I);
Dec(J);
end;
until I>J;
if L < J then
QuickSortFX(L, J, FX, Indexes);
L := I;
until I >= R;
end;
procedure CalcFX(var Temp: TNelderTempData; Option: TNelderOption);
var
I: Integer;
PtrD0, PtrFX: PExtended;
begin
with Temp, Option do
begin
// Вычисление значений функции
PtrD0 := D0;
PtrFX := FX;
for I := 0 to N do
begin
PtrFX^ := Func(PtrD0);
PChar(PtrD0) := PChar(PtrD0) + N * SizeOf(Extended);
PChar(PtrFX) := PChar(PtrFX) + SizeOf(Extended);
end;
end;
end;
// Освежаем и сортируем FX + освежаем индексы
procedure RefreshFX(var Temp: TNelderTempData; Option: TNelderOption);
var
I: Integer;
PtrIndexes: PInteger;
begin
with Temp, Option do
begin
// Заполение индексов
PtrIndexes := Indexes;
for I := 0 to N do
begin
PtrIndexes^ := I;
PChar(PtrIndexes) := PChar(PtrIndexes) + SizeOf(Integer);
end;
// Сортировка
QuickSortFX(0, N, FX, Indexes);
// Возвращаемое значение: Result := D0 + SizeOf(Extended) * Indexes[N]
PChar(PtrIndexes) := PChar(PtrIndexes) - SizeOf(Integer);
XN := PExtended(PChar(D0) + N*SizeOf(Extended)*PtrIndexes^);
end;
end;
procedure CalcC(var Temp: TNelderTempData; const Option: TNelderOption);
var
PtrC, PtrD0: PExtended;
I, J: Integer;
begin
with Temp, Option do
begin
PtrD0 := D0;
// C := 0;
FillChar(C^, N*SizeOf(Extended), 0);
// C := Sum (Xn)
for I := 0 to N do
if PtrD0 <> XN then
begin
PtrC := C;
for J := 0 to N-1 do
begin
PtrC^ := PtrC^ + PtrD0^;
PChar(PtrC) := PChar(PtrC) + SizeOf(Extended);
PChar(PtrD0) := PChar(PtrD0) + SizeOf(Extended);
end;
end
else begin
// Пропускаем вектор из D0:
PChar(PtrD0) := PChar(PtrD0) + N * SizeOf(Extended);
end;
// C := C / N
PtrC := C;
for J := 0 to N-1 do
begin
PtrC^ := PtrC^ / N;
PChar(PtrC) := PChar(PtrC) + SizeOf(Extended);
end;
end;
end;
← →
Oleg_Gashev (2002-05-01 21:59) [32]
procedure ReflectPoint(var Temp: TNelderTempData; const Option: TNelderOption; P: PExtended; Factor: Extended);
var
PtrC, PtrXN: PExtended;
I: Integer;
begin
with Temp, Option do
begin
PtrXN := XN;
PtrC := C;
for I := 0 to N-1 do
begin
P^ := PtrC^ + Factor * (PtrC^ - PtrXN^);
PChar(P) := PChar(P) + SizeOf(Extended);
PChar(PtrC) := PChar(PtrC) + SizeOf(Extended);
PChar(PtrXN) := PChar(PtrXN) + SizeOf(Extended);
end;
end;
end;
const
SITUATION_EXPANSION = 0;
SITUATION_REFLECTION = 1;
SITUATION_COMPRESSION = 2;
SITUATION_REDUCTION = 3;
function DetectSituation(var Temp: TNelderTempData; const Option: TNelderOption): Integer;//FX, U: PExtended; Func: PMathFunction; N: Integer; FU: Extended): Integer;
var
PtrFX: PEXtended;
begin
with Temp, Option do
begin
FU := Func(Temp.U);
if FU < FX^ then
Result := SITUATION_EXPANSION
else begin
PtrFX := PExtended(PChar(FX)+(N-1)*SizeOf(Extended));
if FU < PtrFX^ then
Result := SITUATION_REFLECTION
else begin
PChar(PtrFX) := PChar(PtrFX) + SizeOf(Extended);
if FU < PtrFX^ then
Result := SITUATION_COMPRESSION
else
Result := SITUATION_REDUCTION;
end;
end;
end;
end;
procedure Expansion(var Temp: TNelderTempData;const Option: TNelderOption);
var
FV: EXtended;
LastIndex: Integer;
TempPtr: PChar;
begin
with Temp, Option do
begin
ReflectPoint(Temp, Option, V, Gamma);
FV := Func(Temp.V);
// Коррекция FX
Move(FX^, (PChar(FX)+SizeOf(Extended))^, N*SizeOf(Extended));
// Заносим на первое место
if FV < FU then
begin
FX^ := FV;
Move(V^, XN^, N*SizeOf(EXtended));
end
else begin
FX^ := FU;
Move(U^, XN^, N*SizeOf(Extended));
end;
// Коррекция Indexes
TempPtr := PChar(Indexes) + N*SizeOf(Integer);
LastIndex := PInteger(TempPtr)^;
Move(Indexes^, (PChar(Indexes)+SizeOf(Integer))^, N*SizeOf(Integer));
Indexes^ := LastIndex;
// Коррекция XN
PChar(XN) := PChar(D0) + PInteger(TempPtr)^ * N * SizeOf(EXtended);
end;
end;
// Рекурсивный бинарный поиск точки, где будет произведена вставка
// Интересно переделать в итерацию !!! (так оптимальней)
function RecurseFind(FX: PExtended; Value: Extended; L,R: Integer): Integer;
var
M: Integer;
Temp: Extended;
begin
if R<L then begin
Result := L; // Result := -1 если поиск точный
Exit;
end;
M := (L+R) div 2;
Temp := PExtended(PChar(FX) + M*SizeOf(Extended))^;
if Temp=Value then
begin
Result := M;
Exit;
end;
if Temp>Value
then Result := RecurseFind(FX, Value, L, M-1)
else Result := RecurseFind(FX, Value, M+1, R)
end;
← →
Oleg_Gashev (2002-05-01 22:01) [33]lipskiy:
Слабо?
Я тоже не могу и не хочу. А зачем? Проще unit.
С уважением, Олег Гашев.
← →
Oleg_Gashev (2002-05-01 23:11) [34]Можете воспользоваться. Писал для себя.
LICENSE AGREEMENT
Oleg Gashev, provides this web site and related services subject to the
following terms and conditions. USE OF THIS SITE IMPLIES AN AGREEMENT TO ABIDE BY AND BE BOUND BY THESE TERMS. Therefore, please read the following information carefully.
Code Submissions
Authors submitting code agree that individuals who obtain it from this site are free to use it in their own programs freely and without restriction, and may distribute compiled versions of the code freely and without restriction. By uploading code to this site, a developer asserts that he or she owns that code or otherwise has the right to redistribute it freely. Oleg Gashev assumes no liability for disputes regarding ownership, copyright, or trademarks of the code uploaded to this site.
YOU RETAIN OWNERSHIP OF ANY COPYRIGHTS OF ANY CODE YOU SUBMIT. However, by submitting code, you grant to Oleg Gashev a nonexclusive, worldwide license to link to, reproduce, distribute, adapt, perform, display and sublicense the submitted code or content. Oleg Gashev wishes to avoid any misunderstandings between it and site authors. Oleg Gashev will be exercising its right to distribute your code in any publications of Code Library only with your copyright.
Oleg Gashev reserves the right to refuse to post any submission, to alter submissions, and to remove a submission from the site that had previously been posted. Oleg Gashev may exercise this right without any advance notice to the individual submitting the code or content.
Copyright Information
All pages and graphics on this this Internet site are the property of Oleg Gashev. The pages may not be redistributed or reproduced in any way, shape, or form without the written permission of Oleg Gashev.
If you wish to redistribute the source code on this site (for example to a web site), you must receive express written permission from the original author(s). Failure to do so is a violation of copyright laws.
Warranties
All code provided by Oleg Gashev is provided "as is", without warranties as to performance, fitness, merchantability, and any other warranty (whether expressed or implied).
The Site
The site itself is also provided without warranty of any kind. There are no guarantees that it will be available at any given time, and no guarantes that use of the site will not be subject to interruptions. All direct or indirect risk related to use of the site is borne entirely by you, the user.
The possibility exists that the site and its contents may contain inaccuracies or errors. Oleg Gashev makes no guarantees regarding the accuracy of the site or its contents. If you discover that the site or its contents contains errors, please contact me so these can be corrected.
The site contains links to other sites operated by third parties. Oleg Gashev does not endorse and is not affiliated with these linked sites, and is not responsible for any content that appears on these linked sites.
Your Conduct
While using this site, you agree not to:
Restrict or inhibit anybody else from using the site.
Post any unlawful, fraudulent, threatening, abusive, defamatory, obscene or otherwise objectionable content.
Post or transmit any information or software that contains a virus or other harmful/disruptive component.
Post or transmit materials in violation of another party"s copyright or intellectual property rights.
Oleg Gashev reserves the right to refuse to block any user who does not adhere to these guidelines from using this site. Oleg Gashev may take this action without prior notice or explanation to the user.
Oleg Gashev reserves right to change this license agreement without notification of any kind.
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2002.06.06;
Скачать: [xml.tar.bz2];
Память: 0.58 MB
Время: 0.007 c
