Talk:Fairshare between two and more
Perl 6 count of how many turns each person gets
Whilst important to some degree, the sequence minimises any advantage that going first/going earlier might give. I've blogged twice, here, and here about it and the sequence appears many times in science and maths. (Try this paper (PDF), for example. --Paddy3118 (talk) 23:54, 1 February 2020 (UTC)
- I have to say, I kind of missed the point of the task initially so was not really sure what it was demonstrating. The actual algorithm was simple, the reason for it escaped me. After reading your links, the lightbulb lit. I removed the "number of times each person goes" which was kind-of pointless, and added a "fairness correlation" calculation showing the relative fairness to the Perl 6 entry. --Thundergnat (talk) 13:43, 2 February 2020 (UTC)
- Great :-)
--Paddy3118 (talk) 18:26, 2 February 2020 (UTC)- I tried to clearify things to me, like Paddy3118 described in his links.Without different values, it makes no sense.
The first will get the highest value of a bucket, the second the maximum of left over and so on.I use a bucket of size Peoplecnt and the values are PeopleCnt downto 1.The choosen people grabs one value from Top.After all people are finished the game starts again ( MOD peoplecnt). <lang pascal>program Fair;
- I tried to clearify things to me, like Paddy3118 described in his links.Without different values, it makes no sense.
- Great :-)
{$IFDEF FPC}
{$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$CodeAlign proc=8}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
const
cntbasedigits = 21;
type
tSumDigit = record sdSumDig : NativeUint; sdBase : NativeUint; sdNumber : NativeUint; sdDigits : array[0..cntbasedigits-1] of NativeUint; end;
var
SumWealth : array of NativeUint; Values : array of NativeUint;
function InitSumDigit(n,base : NativeUint):tSumDigit; var
sd : tSumDigit; qt : NativeUint; i : integer;
begin
with sd do begin sdNumber:= n; sdBase := base; fillchar(sdDigits,SizeOf(sdDigits),#0); sdSumDig :=0; i := 0; // calculate Digits und sum them up while n > 0 do begin qt := n div sdbase; {n mod base} sdDigits[i] := n-qt*sdbase; inc(sdSumDig,sdDigits[i]); n:= qt; inc(i); end; end; InitSumDigit:=sd;
end;
procedure IncSumDigit(var sd:tSumDigit); var
i,d: integer;
begin
i := 0; with sd do begin inc(sdNumber); repeat d := sdDigits[i]; inc(d); inc(sdSumDig); //base-1 times the repeat is left here if d < sdbase then begin sdDigits[i] := d; BREAK; end else begin sdDigits[i] := 0; dec(sdSumDig,sdbase); inc(i); end; until i > high( sdDigits); end;
end;
procedure First25(base:NativeUint); var
MySumDig : tSumDigit; cnt: NativeUint;
begin
write(' [',base:5,'] -> '); MySumDig:=InitSumDigit(0,base); cnt := 0; repeat with MySumDig do write(sdSumDig MOD sdbase,'-'); inc(cnt); IncSumDigit(MySumDig); until cnt >= 25; writeln('....');
end;
procedure CheckRoundsOfPeople(turns,peopleCnt:NativeUint); var
MySumDig : tSumDigit; i, wholeWealth, minWealth, maxWealth : NativeUint;
Begin
setlength(SumWealth,peopleCnt); setlength(Values,peopleCnt); //Values[0] = peopleCnt ...Values[peopleCnt-1] = 1 For i := 0 to peopleCnt-1 do Values[i] := peopleCnt-i;
MySumDig:=InitSumDigit(0,peopleCnt); i := 0; while i<turns do begin inc(SumWealth[MySumDig.sdSumDig MOD peopleCnt],Values[i MOD peopleCnt]); IncSumDigit(MySumDig); inc(i); end; setlength(Values,0); MinWealth := High(MinWealth); MaxWealth := Low(MaxWealth); For i := 0 to peopleCnt-1 do Begin wholeWealth := SumWealth[i]; IF MaxWealth<wholeWealth then MaxWealth:=wholeWealth; IF MinWealth>wholeWealth then MinWealth := wholeWealth; end; writeln(peopleCnt:6,turns:11,MinWealth:10,MaxWealth:10, MinWealth/MaxWealth:10:7); setlength(SumWealth,0);
end;
procedure CheckRoundsOfPeopleOneByOne(turns,peopleCnt:NativeUint); var
i, wholeWealth, minWealth, maxWealth : NativeUint;
Begin
setlength(SumWealth,peopleCnt); setlength(Values,peopleCnt); //Values[0] = peopleCnt ...Values[peopleCnt-1] = 1 For i := 0 to peopleCnt-1 do Values[i] := peopleCnt-i;
i := 0; while i<turns do begin //first gets always the max value 0,1,2,3,4..,n inc(SumWealth[i MOD peopleCnt],Values[i MOD peopleCnt]); inc(i); end; setlength(Values,0); MinWealth := High(MinWealth); MaxWealth := Low(MaxWealth); For i := 0 to peopleCnt-1 do Begin wholeWealth := SumWealth[i]; IF MaxWealth<wholeWealth then MaxWealth:=wholeWealth; IF MinWealth>wholeWealth then MinWealth := wholeWealth; end; writeln(peopleCnt:6,turns:11,MinWealth:10,MaxWealth:10, MinWealth/MaxWealth:10:7); setlength(SumWealth,0);
end;
const
cTURNS = 500;
begin
First25(2);First25(3);First25(5); First25(11); writeln; writeln('Fair share'); writeln(' people turns MinWealth MaxWealth ratio MinWealth/MaxWealth'); CheckRoundsOfPeople(11*11,11); CheckRoundsOfPeople(1377 *1377,1377); CheckRoundsOfPeople(cTURNS*11,11); CheckRoundsOfPeople(cTURNS*1377,1377);
writeln; writeln('First gets max value , last gets 1'); writeln(' people turns MinWealth MaxWealth ratio MinWealth/MaxWealth'); CheckRoundsOfPeopleOneByOne(11*11,11); CheckRoundsOfPeopleOneByOne(1377 *1377,1377); CheckRoundsOfPeopleOneByOne(cTURNS*11,11); CheckRoundsOfPeopleOneByOne(cTURNS*1377,1377);
end.</lang>
- Output:
[ 2] -> 0-1-1-0-1-0-0-1-1-0-0-1-0-1-1-0-1-0-0-1-0-1-1-0-0-.... [ 3] -> 0-1-2-1-2-0-2-0-1-1-2-0-2-0-1-0-1-2-2-0-1-0-1-2-1-.... [ 5] -> 0-1-2-3-4-1-2-3-4-0-2-3-4-0-1-3-4-0-1-2-4-0-1-2-3-.... [ 11] -> 0-1-2-3-4-5-6-7-8-9-10-1-2-3-4-5-6-7-8-9-10-0-2-3-4-.... Fair share people turns MinWealth MaxWealth ratio MinWealth/MaxWealth 11 121 66 66 1.0000000 1377 1896129 948753 948753 1.0000000 11 5500 2985 3015 0.9900498 1377 688500 125250 563750 0.2221729 First gets max value , last gets 1 //[ 11] -> 0-1-2-3-4-5-6-7-8-9-10-0-1-2-3-4-5-6-7-8-9-10-0-1-2-3-.... people turns MinWealth MaxWealth ratio MinWealth/MaxWealth 11 121 11 121 0.0909091 1377 1896129 1377 1896129 0.0007262 11 5500 500 5500 0.0909091 1377 688500 500 688500 0.0007262
- This shows the fairness.But a cyclic value of people A to C is sufficient.
The easier sequence ABC_BCA_CAB will get the same results. A,B,C are in every possible position, so square( peopleCnt) is fair too. Horst.h14:16, 25 June 2020 (UTC)
- This shows the fairness.But a cyclic value of people A to C is sufficient.
Fairness example and cycles
I saw Horsts' Perl program above, and recognized that the idea of fairness is hard to bring across so I thought I might do an example by hand.
The set of numbers in this case are not a linear progression, so we (maybe), see the emergence of Thue-Morse as being the most "fair" calculated as the spread in final amounts per person.
For all cases we will have have three people A B and C to choose the best at their turn, from the same, ever decreasing pots of money.
18 then 27 Fibonacci numbers
Numbers: [2584, 1597, 987, 610, 377, 233, 144, 89, 55, 34, 21, 13, 8, 5, 3, 2, 1, 1] Order: ABC_ABC_ABC_ABC_ABC_ABC : Simple Repetition A gets: 2584 + 610 + 144 + 34 + 8 + 2 = 3382 B gets: 1597 + 377 + 89 + 21 + 5 + 1 = 2090 C gets: 987 + 233 + 55 + 13 + 3 + 1 = 1292 Maximum difference in amounts = 2090 Order: ABC-BCA-CAB_ABC-BCA-CAB : Simple Rotation A gets: 2584 + 233 + 89 + 34 + 3 + 1 = 2944 B gets: 1597 + 610 + 55 + 21 + 8 + 1 = 2292 C gets: 987 + 377 + 144 + 13 + 5 + 2 = 1528 Maximum difference in amounts = 1416 Order: ABC-BCA-CAB-BCA-CAB-ABC : Thue-Morse Fairshare A gets: 2584 + 233 + 89 + 13 + 5 + 2 = 2926 B gets: 1597 + 610 + 55 + 34 + 3 + 1 = 2300 C gets: 987 + 377 + 144 + 21 + 8 + 1 = 1538 Maximum difference in amounts = 1388 Numbers: [196418, 121393, 75025, 46368, 28657, 17711, 10946, 6765, 4181, 2584, 1597, 987, 610, 377, 233, 144, 89, 55, 34, 21, 13, 8, 5, 3, 2, 1, 1] Order: ABC_ABC_ABC_ABC_ABC_ABC_ABC_ABC_ABC : Simple Repetition A gets: 196418 + 46368 + 10946 + 2584 + 610 + 144 + 34 + 8 + 2 = 257114 B gets: 121393 + 28657 + 6765 + 1597 + 377 + 89 + 21 + 5 + 1 = 158905 C gets: 75025 + 17711 + 4181 + 987 + 233 + 55 + 13 + 3 + 1 = 98209 Maximum difference in amounts = 158905 Order: ABC-BCA-CAB_ABC-BCA-CAB_ABC-BCA-CAB : Simple Rotation A gets: 196418 + 17711 + 6765 + 2584 + 233 + 89 + 34 + 3 + 1 = 223838 B gets: 121393 + 46368 + 4181 + 1597 + 610 + 55 + 21 + 8 + 1 = 174234 C gets: 75025 + 28657 + 10946 + 987 + 377 + 144 + 13 + 5 + 2 = 116156 Maximum difference in amounts = 107682 Order: ABC-BCA-CAB-BCA-CAB-ABC-CAB-ABC-BCA : Thue-Morse Fairshare A gets: 196418 + 17711 + 6765 + 987 + 377 + 144 + 21 + 8 + 1 = 222432 B gets: 121393 + 46368 + 4181 + 2584 + 233 + 89 + 13 + 5 + 2 = 174868 C gets: 75025 + 28657 + 10946 + 1597 + 610 + 55 + 34 + 3 + 1 = 116928 Maximum difference in amounts = 105504
Thue-Morse is best in this case.
Hmmm, I feel a blog coming on...