Пятничная задача от Розыча

← →
Rouse_ © (2015-09-04 19:44) [0]

Ну вот такое простое:

program Project1; {$APPTYPE CONSOLE} uses SysUtils; const Demo = 10; var A: Extended = 0.123; B, Sum: Extended; I: Integer; begin Sum := 0.0; B := A / Demo; for I := 1 to Demo - 1 do Sum := Sum + B; Writeln(A); Writeln(Sum); Writeln(A - Sum); Readln; end.

объяснить результаты вывода

1.23000000000000E-0001
1.10700000000000E-0001 << этот
1.23000000000000E-0002 << и этот

← →
Rouse_ © (2015-09-04 20:29) [1]

ЗЗЫ: когда ответите на первые вопросы измените следующую константу:
const Demo = 10000000;

← →
Pavia © (2015-09-04 20:38) [2]

При выводе в научном формате в переди едёт значащая цифра, т.е отлична от 0. Поэтому при выводе А=0.123 порядок смещается на -1 получаем 1.23E-1

for I := 1 to Demo - 1 do
1..9 и того 9 раз, а не 10.
Поэтому разность отлична на B.

А то что в конце(середине) этих строк идут нули.
1.10700000000000E-0001 << этот
1.23000000000000E-0002 << и этот
Так это обясняется везением. Хотя не стоит уменьшать и заслугу IEEE которая постаралось уменьшить ошибку.

← →
Pavia © (2015-09-04 21:18) [3]

1.23000000000000E-0001
1.22999998769927E-0001
^^ это из за того что опять таки 1 не досчитали
1.22999998769927E-0001
^^ ошибка округления. При приведение чисел к одному порядку у воторго слогаемого откусили лишнее.
1.23007295865231E-0009
^^^^^^^ из-за бесконечности реальных чисел небольшая ошибка в рассчётах приводит к длинной серии чисел при смене СС от двоичной к десятичной

← →
Rouse_ © (2015-09-04 21:31) [4]

> Pavia © (04.09.15 20:38) [2]
> При выводе в научном формате в переди едёт значащая цифра,
> т.е отлична от 0. Поэтому при выводе А=0.123 порядок смещается
> на -1 получаем 1.23E-1
>
> for I := 1 to Demo - 1 do
> 1..9 и того 9 раз, а не 10.

Этот ответ верный, просто тест на внимательность.
Второй и третий ответы не совсем верные.

Впрочем расширю тогда вопрос - рассчитайте погрешность.

← →
Rouse_ © (2015-09-04 21:41) [5]

Поясню: необходимло написать функцию, которая после данного суммирования

for I := 1 to Demo do Sum := Sum + B;

выведет изначальную A

(в фунцкии уже учитывается порядок переменной Demo, без ее декремента)

← →
Rouse_ © (2015-09-04 21:45) [6]

ЗЗЗЫ: также жду ответа на данный вопрос: Writeln(A - Sum);
Почему получили именно 1.23000000000000E-0002

← →
SergP © (2015-09-05 10:41) [7]

>
> объяснить результаты вывода
>
> 1.23000000000000E-0001
> 1.10700000000000E-0001 << этот
> 1.23000000000000E-0002 << и этот

С математикой тут все в порядке, согласно коду получается что:
второе число = первое * 0.9
А третье = первое * 0.1

С точки зрения внутреннего представления этих чисел, то похоже что у Extended погрешность находится за пределами той части, что выводится writeln, а отображаемое число у нас красиво округляется.

если поменять тип переменных на double то уже можно наблюдать небольшое отличие:

1.23000000000000E-0001
1.10700000000000E-0001
1.22999999999999E-0002

а если поменять тип на single то погрешность становится очень заметной.

1.23000003397464E-0001
1.10700003802776E-0001
1.22999995946884E-0002

т.е. если бы в мантисе числа 1.23000000000000E-0002 выводилось больше десятичных знаков (не могу точно сказать на сколько) то тоже была бы видна погрешность

ИМХО

← →
SergP © (2015-09-05 10:48) [8]

> 1.23000000000000E-0001
> 1.10700000000000E-0001 << этот
> 1.23000000000000E-0002 << и этот

т.е. на самом деле там числа другие, просто при выводе они округляются до 15 десятичных разрядов

← →
Rouse_ © (2015-09-05 11:34) [9]

Такс, вижу мы немного не в ту степь уплыли, это я виноват, не совсем корректно поставил условие и разьяснил.

Хорошо, тогда вот так:

program Project2; {$APPTYPE CONSOLE} uses SysUtils; function Test(Value: Extended; Count: UInt64): Extended; var I: Integer; begin Result := 0; for I := 0 to Count - 1 do Result := Result + Value; end; const Demo = 10000000000; var A: Extended = 1.23456; Sum: Extended; begin Sum := Test(A / Demo, Demo); Writeln(A); Writeln(Sum); Readln; end.

Данный код выведет такие числа:
1.23456000000000E+0000
1.74081035008117E-0001

1. Разьяснить, как это получается
2. Изменить алгоритм функции Test на правильный.

← →
SergP © (2015-09-05 12:46) [10]

Ну так в процессе работы цикла складываются числа у которых мантисы в двоичном представлении имеют все или почти все значащие цифры, а порядки сильно отличаются. Естественно, при этом будут происходить округления.

это типа как если бы: к 1.0E0 прибавить 1Е-50 то все равно получим 1.0E0

← →
SergP © (2015-09-05 12:48) [11]

и чем больше demo, тем большая часть цифр меньшего числа отсекается (округляется) при сложении.

← →
Rouse_ © (2015-09-05 13:12) [12]

> SergP © (05.09.15 12:48) [11]
> и чем больше demo, тем большая часть цифр меньшего числа
> отсекается (округляется) при сложении.

Ответ на первый вопрос, скажем, правильный, хоть и не полный.

← →
SergP © (2015-09-05 13:14) [13]

> 2. Изменить алгоритм функции Test на правильный.

ну не знаю как написать, но думаю что складывать нужно числа соизмеримых порядков.

если нужно сложить 10000000000 раз, то похоже что нужно так делать:

s:=value;
result:=0;
for i:=1 to 10 do
begin
result:=s+s;
result:=result+s+result;
result:=result+result;
s:=result;
end;

← →
SergP © (2015-09-05 13:17) [14]

> Rouse_ © (05.09.15 13:12) [12]
>
>
> > SergP © (05.09.15 12:48) [11]
> > и чем больше demo, тем большая часть цифр меньшего числа
> > отсекается (округляется) при сложении.
>
> Ответ на первый вопрос, скажем, правильный, хоть и не полный.
>

ну там в теле цикла сначала все складывается более-менее, но чем дальше, тем погрешность сложения возрастает...

← →
Rouse_ © (2015-09-05 13:27) [15]

> SergP © (05.09.15 13:14) [13]

Вот это не понял.

> SergP © (05.09.15 13:17) [14]
> ну там в теле цикла сначала все складывается более-менее,
> но чем дальше, тем погрешность сложения возрастает...

Ну так в этом и задача - как нивелировать данную погрешность.

← →
Rouse_ © (2015-09-05 13:37) [16]

ЗЫ: в [13] у тебя ошибка.

function Test3(Value: Extended; Count: UInt64): Extended; var s: extended; i: Integer; begin s:=value; result:=0; for i := 1 to Count do begin result:=s+s; result:=result+s+result; result:=result+result; s:=result; end; end;

Это не будет работать даже на вот таком вызове:

Sum2 := Test3(A / 10000, 10000);

← →
SergP © (2015-09-05 13:57) [17]

function Test(Value: Extended; Count: UInt64): Extended; begin if count=1 then Result := value else Result:=test(value, count div 2)+test(value, count div 2 + count mod 2); end;

← →
SergP © (2015-09-05 14:03) [18]

может я не совсем понимаю что нужно сделать, ибо трудно внести изменения в функцию, которая выполняет бессмысленные действия.

по сути то она вычисляет вот это:

> function Test(Value: Extended; Count: UInt64): Extended;
>
> begin
> Result := value*count;
> end;

поэтому я так понял что нужно сделать так чтобы не используя умножения достичь результатов с минимальной погрешностью.
Правильно я понял или нет?

← →
Rouse_ © (2015-09-05 14:07) [19]

Уже красивее, Кэхена чтоли читал?

← →
Rouse_ © (2015-09-05 14:08) [20]

Да правильно, задача избавиться от погрешности.
Впрочем перемножение тоже не панацея, там тоже целый ворох нюансов.

← →
SergP © (2015-09-05 14:10) [21]

> Уже красивее, Кэхена чтоли читал?

Это что такое или кто такой?

← →
Rouse_ © (2015-09-05 14:11) [22]

Ух долго она у тебя работает, как закончит скажу - правильно или нет. Но идея в принципе верная.

← →
Rouse_ © (2015-09-05 14:12) [23]

Да есть такой дядька :)
https://ru.wikipedia.org/wiki/%D0%9A%D1%8D%D1%85%D1%8D%D0%BD,_%D0%A3%D0%B8%D0%BB%D1%8C%D1%8F%D0%BC_%D0%9C%D0%BE%D1%80%D1%82%D0%BE%D0%BD

← →
Rouse_ © (2015-09-05 14:15) [24]

Отработала.
Почти 10 минут пыхтела, но результат верный.
Молоток.

Будем считать что с этой задачей справился - а теперь сделай чтобы она работала быстро :)

← →
SergP © (2015-09-05 14:19) [25]

> Rouse_ © (05.09.15 14:11) [22]
>
> Ух долго она у тебя работает

Ну еще бы... конечно долго...
с Demo = 100000000 она секунд 8 считает, а с большими значениями я даже и не пытался запускать.

← →
SergP © (2015-09-05 14:26) [26]

>
> Будем считать что с этой задачей справился - а теперь сделай
> чтобы она работала быстро :)

если в [16]
вместо
for i:=1 to count
написать

for i:=1 to trunc(log10(count))

то должно работать, правда не с произвольными Demo а только с круглыми вида 10 в целой степени

← →
Rouse_ © (2015-09-05 14:36) [27]

Нет - задача именно такая как есть :)
У меня тоже есть свой вариант решения, но я его пока не выкладываю, бо нашел более быстрый, но пока не успел причесать :)

ну если чуть подправить вариант [17], то он становится во много раз быстрее

function Test(Value: Extended; Count: UInt64): Extended; begin if count=1 then Result := value else if (count and 1) = 1 then Result:=test(value, count div 2)+test(value, count div 2 + 1) else begin Result:=test(value, count div 2); Result:=Result+Result; end; end;

Завтра проверю, бо уже убегаю.

Я решал немного по другому, но тут концовка не доделана:

asm fld tbyte ptr [ebp + $14] fld tbyte ptr [ebp + $8] fadd fld st(0) fld tbyte ptr [ebp + $14] fsub st(1), st fld st(2) fsub st, st(2) fld tbyte ptr [ebp + $8] fsub st, st(3) fld st(2) fsub st, st(2) fadd st, st(1) and dl, 1 je @exit fadd st, st @exit: mov edx, [ebp - $10] mov [eax], edx mov edx, [ebp - $C] mov [eax + 4], edx mov dx, [ebp - 8] mov [eax + 8], dx ... (5)

ЗЫ: ну и конечно в моем варианте все не красиво, начиная с двойной загрузки внешних данных, до нерационального использования FPU регистров.

PPS^ на всякий дам подсказку, это классический алгоритм TwoSum, применяемый при сложении и пытающийся нивелировать ошибку округления.

> SergP © (05.09.15 15:16) [28]

function Test(Value: Extended; Count: UInt64): Extended; begin if count=1 then Result := value else begin Result:=test(value, count shr 1); if (count and 1) = 1 then Result:=Result+test(value, count shr 1 + 1) else Result:=Result+Result; end; end;

при Demo = 100000000000000000; (10^17) время около 2 секунд

> Rouse_ © (05.09.15 15:49) [29]

К сожалению мой уровень знаний ассемблера ограничен в основном тем, что я успел найти в инете решая предыдущие пятничные задачки. А команды сопроцессора вообще не знаю, посему твой вариант пока мне не совсем понятен.

> SergP © (05.09.15 19:39) [32]

Можно точнее и быстрее, хотя, конечно проще умножить
function SumTest2(Value: extended; Count: int64): extended; begin; Result:=0; if Count>0 then while true do begin; if Count and 1<>0 then Result:=Result+Value; Count:=Count shr 1; if Count=0 then break; Value:=Value+Value; end; end;

> Sha © (05.09.15 20:14) [33]

по сути это и есть умножение.
тоже так думал сделать, но потом из-за этого:

> Rouse_ © (05.09.15 14:08) [20]
>
> Да правильно, задача избавиться от погрешности.
> Впрочем перемножение тоже не панацея, там тоже целый ворох
> нюансов.

подумал что так погрешность будет больше... хотя на самом деле при проверке оказалось наоборот.

> Rouse_ © (05.09.15 15:49) [29]
> ...
> fsub st, st(2)
> fadd st, st(1)

- если я правильно перевёл - то получилось довольно замысловатое вычисление нуля:
x0 = [ebp + $14]^;
x1 = [ebp + $8]^;
st0 = x1
st0 = x0; st1 = x1;
st0 = x0+x1
st0 = x0+x1; st1 = x0+x1; st2 = x1
st0 = x1; st1 = x0+x1; st2 = x0+x1; st3 = x1
st1 = (x0+x1)-x1
st0 = x0+x1; st1 = x1; st2 = (x0+x1)-x1; st3 = x0+x1; st4 = x1
st0 = (x0+x1)-((x0+x1)-x1)
st0 = x0; st1 = (x0+x1)-((x0+x1)-x1); st2 = x1; st3 = (x0+x1)-x1; st4 = x0+x1; st5 = x1
st0 = x0 - ((x0+x1)-x1)
st0 = x1; st1 = x0 - ((x0+x1)-x1); st2 = (x0+x1)-((x0+x1)-x1)
st0 = x1 - ((x0+x1)-((x0+x1)-x1))
st0 = (x1 - ((x0+x1)-((x0+x1)-x1))) + (x0 - ((x0+x1)-x1))

наоборот
x0 = [ebp + $8]^;
x1 = [ebp + $14]^;
- но это, в принципе, не принципиально...

Немного не так, код дельфевый дома валяется.
На асме это уже в субботу делать нечего было дома, сидел оптимизировал.

function SumTest3(pValue: pExtended; pCount: pInt64): Extended; asm fldz //Result fld tbyte ptr [eax] //Value mov ecx, [edx] //Count mov edx, [edx+4] @loop: mov eax, ecx //Count = 0 ? or eax, edx jz @return shrd ecx, edx, 1 //Count and 1 = 0 ? jnc @zerobit fadd st(1), st(0) //Result := Result + Value @zerobit: shr edx, 1 //Count := Count shr 1 fadd st(0), st(0) //Value := Value + Value jmp @loop @return: fstp st(0) //drop Value end;

> Немного не так, код дельфевый дома валяется.

- ну это я вручную приведённый код "транслировал", как уж есть...

только "не тем вы путём идёте - товарищи"...

Довно бы уже арифметику на натуральных дробях реализовали, с нужной точностью и правилами округления, вместо шаманства с непригодным инструментом...
Там всей теории - https://ru.wikipedia.org/wiki/Китайская_теорема_об_остатках да https://ru.wikipedia.org/wiki/Непрерывная_дробь
Учитывая количество и скорость ALU на современных процессорах - оно и работать быстрее будет...

Пятничная задача от Розыча Найти похожие ветки