Group Abstract Group Abstract

Message Boards Message Boards

2
|
853 Views
|
3 Replies
|
6 Total Likes
View groups...
Share
Share this post:

Problems with iterative process

Posted 2 months ago

For some reasons I need to consider the following iterative process.
We have three positive numbers with constant total such that $x+y+z == t$
Consider the iterative algorithm:

  • if the sum of numbers is not equal to $t$ - stop (with message "Total error")
  • if one of the numbers is $t/2$ - stop (with message "Half")
  • if one of the numbers is greater than $t/2$ (let it be $z$) - returns new numbers $2z-t,2x,2y$
  • if all numbers are less than $t/2$ - return the new numbers $t-2z,t-2x,t-2y$

    ClearAll[genNumsReals]; genNumsReals[ tot_] :=
     Block[{a = RandomReal[{0., tot}], b},
      b = RandomReal[{0., tot - a}];
      {a, b, tot - a - b}];
    
    ClearAll[genNumsRationals]; genNumsRationals[e_, tot_] :=
     Block[{a = Rationalize[RandomReal[{e, tot - e}], e], b},
      b = Rationalize[RandomReal[{e, tot - a - e}], e];
      {a, b, tot - a - b}];
    
    Clear[nextNums]; nextNums[nums_, tot_] :=
     Which[
      Unequal[Total@nums, tot], {nums, "Error Total"},
      MemberQ[nums, tot/2], {nums, "Half Total"},
      AnyTrue[nums, GreaterThan[tot/2]], Mod[2 nums, tot],
      True, tot - 2 nums];
    
    numsNest[init_, tot_, iterMax_ : 100] :=
      NestWhileList[nextNums[#, tot] &, init,
       (UnsameQ[##] && Length@Last[{##}] == 3) &, All, iterMax];
    

Firstly, is it equal to Mod[-2 {x,y,z}, t]? Looks like not.
If the numbers are rational, the results are generally expected but interesting.
Either cycles of greater or lesser length are obtained,
either $t/2$ occurs.

But for reals I see some problems. For any initial data with machine precision we get "Half Total" sooner or later (here $t=1$):

{{0.84474, 0.117199, 0.0380613}, {0.68948, 0.234397, 
  0.0761226}, {0.37896, 0.468795, 0.152245}, {0.24208, 0.0624103, 
  0.69551}, {0.48416, 0.124821, 0.39102}, {0.0316802, 0.750359, 
  0.217961}, {0.0633604, 0.500718, 0.435922}, {0.126721, 0.00143543, 
  0.871844}, {0.253441, 0.00287087, 0.743688}, {0.506883, 0.00574174, 
  0.487375}, {0.0137658, 0.0114835, 0.974751}, {0.0275315, 0.0229669, 
  0.949502}, {0.0550631, 0.0459339, 0.899003}, {0.110126, 0.0918678, 
  0.798006}, {0.220252, 0.183736, 0.596012}, {0.440505, 0.367471, 
  0.192024}, {0.118991, 0.265058, 0.615952}, {0.237981, 0.530115, 
  0.231903}, {0.475963, 0.060231, 0.463806}, {0.0480747, 0.879538, 
  0.0723872}, {0.0961494, 0.759076, 0.144774}, {0.192299, 0.518152, 
  0.289549}, {0.384598, 0.0363047, 0.579098}, {0.769195, 0.0726095, 
  0.158195}, {0.538391, 0.145219, 0.31639}, {0.0767815, 0.290438, 
  0.632781}, {0.153563, 0.580876, 0.265561}, {0.307126, 0.161751, 
  0.531122}, {0.614252, 0.323503, 0.062245}, {0.228504, 0.647006, 
  0.12449}, {0.457009, 0.294012, 0.24898}, {0.0859828, 0.411977, 
  0.50204}, {0.171966, 0.823954, 0.00408077}, {0.343931, 0.647907, 
  0.00816154}, {0.687862, 0.295815, 0.0163231}, {0.375725, 0.591629, 
  0.0326462}, {0.75145, 0.183258, 0.0652924}, {0.502899, 0.366516, 
  0.130585}, {0.00579834, 0.733032, 0.261169}, {0.0115967, 0.466064, 
  0.522339}, {0.0231934, 0.932129, 0.0446777}, {0.0463867, 0.864258, 
  0.0893555}, {0.0927734, 0.728516, 0.178711}, {0.185547, 0.457031, 
  0.357422}, {0.628906, 0.0859375, 0.285156}, {0.257813, 0.171875, 
  0.570313}, {0.515625, 0.34375, 0.140625}, {0.03125, 0.6875, 
  0.28125}, {0.0625, 0.375, 0.5625}, {0.125, 0.75, 0.125}, {0.25, 0.5,
   0.25}, {{0.25, 0.5, 0.25}, "Half Total"}}

and for higher precision we get "Total error" (sooner or later too):

ClearAll[genNumsReals]; genNumsReals[tot_] :=
 Block[{a = RandomReal[{0., tot}, WorkingPrecision -> 30], b},
  b = RandomReal[{0., tot - a}, WorkingPrecision -> 30];
  {a, b, tot - a - b}];

Clear[nextNums]; nextNums[nums_, tot_] :=
 Which[
  Unequal[Total@nums, tot], {nums, "Error Total"},
  MemberQ[nums, tot/2], {nums, "Half Total"},
  AnyTrue[nums, GreaterThan[tot/2]],
  SetPrecision[Mod[2 nums, tot], 30],
  True, SetPrecision[tot - 2 nums, 30]];

{{0.659587099030496875713494880795, 0.185853135754329321586581016710,
  0.154559765215173802699924102495}, \
{0.319174198060993674630481109489, 0.371706271508658647739764546714,
  0.309119530430347622118603112540}, \
{0.361651603878012650739037781022, 0.256587456982682704520470906573,
  0.381760939139304755762793774920}, \
{0.276696792243974698521924437955, 0.486825086034634590959058186854,
  0.236478121721390488474412450159}, \
{0.446606415512050602956151124090, 0.0263498279307308180818836262915,
  0.527043756557219023051175099681}, \
{0.893212831024101205912302248180, 0.0526996558614616361637672525831,
  0.0540875131144380461023501993623}, \
{0.786425662048202411824604496360, 0.105399311722923272327534505166,
  0.108175026228876092204700398725}, \
{0.572851324096404823649208992720, 0.210798623445846544655069010332,
  0.216350052457752184409400797449}, \
{0.145702648192809647298417985439, 0.421597246891693089310138020664,
  0.432700104915504368818801594898}, \
{0.708594703614380705403164029121, 0.156805506216613821379723958671,
  0.134599790168991262362396810204}, \
{{0.708594703614380705403164029121, 0.156805506216613821379723958671,
   0.134599790168991262362396810204}, "Error Total"}}

I think the problems are in rounding, but how to understand it?

POSTED BY: Denis Ivanov
3 Replies
Posted 2 months ago

So SetPrecision[tot, Infinity] helps a lot

POSTED BY: Denis Ivanov
Posted 2 months ago

Thank you very much!
The problem is that by the results for rationals, there can be deterministic chaos.
And we need to understand that for reals can be natural behavior, and what - errors of rounding.
I see that the subject is not easy.

POSTED BY: Denis Ivanov
POSTED BY: Michael Rogers
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard