Talk:Fairshare between two and more: Difference between revisions

Trying to figure out "fairness"
(Trying to figure out "fairness")
Line 6:
 
:: Great :-) <br>--[[User:Paddy3118|Paddy3118]] ([[User talk:Paddy3118|talk]]) 18:26, 2 February 2020 (UTC)
::: I tried to clearify things to me, like [[User:Paddy3118|Paddy3118]] described in his links.Without different values, it makes no sense.<BR>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;
{$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>
{{out}}
<pre>
[ 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</pre>
:::This shows the fairness.But a cyclic value of people A to C is sufficient.<BR>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. [[User:Horst.h|Horst.h]]14:16, 25 June 2020 (UTC)
Anonymous user