Rosetta Code

Fairshare between two and more: Difference between revisions

Page Discussion

Fairshare between two and more (view source)

Revision as of 00:13, 10 February 2024

59,655 bytes added ,  3 months ago
Add C# implementation
(Add C# implementation)
 
(60 intermediate revisions by 28 users not shown)
Line 1:
{{draft task}}
 
The [[Thue-Morse]] sequence is a sequence of ones and zeros that if two people
Line 10:
The Thue-Morse sequence of ones-and-zeroes can be generated by:
:''"When counting in binary, the digit sum modulo 2 is the Thue-Morse sequence"''
 
 
;Sharing fairly between two or more:
Use this method:
:''When counting base '''b''', the digit sum modulo '''b''' is the Thue-Morse sequence of fairer sharing between '''b''' people.''
 
 
;Task
Counting from zero;   using a function/method/routine to express an integer count in base '''b''',
Counting from zero;
<br>sum the digits modulo '''b''' to produce the next member of the Thue-Morse fairshare series for '''b''' people.
using a function/method/routine to express an integer count in base b,
Sum the digits modulo b to produce the next member of the Thue-Morse fairshare
series for b people.
 
Show the first 25 terms of the fairshare sequence
* For two people
* For three people
* For five people
* For eleven people
 
Show the first 25 terms of the fairshare sequence:
;References:
:* &nbsp; For two people:
* [[Non-decimal radices/Convert]]
:* &nbsp; For three people
* [[Thue-Morse]]
:* &nbsp; For five people
* [https://oeis.org/A010060 A010060], [https://oeis.org/A053838 A053838], [https://oeis.org/A053840 A053840]: The On-Line Encyclopedia of Integer Sequences® (OEIS®)
:* &nbsp; For eleven people
 
 
;Related tasks:
:* &nbsp; [[Non-decimal radices/Convert]]
:* &nbsp; [[Thue-Morse]]
 
 
;See also:
:* &nbsp; [https://oeis.org/A010060 A010060], [https://oeis.org/A053838 A053838], [https://oeis.org/A053840 A053840]: The On-Line Encyclopedia of Integer Sequences® (OEIS®)
<br><br>
 
=={{header|11l}}==
{{trans|Python}}
 
<syntaxhighlight lang="11l">F _basechange_int(=num, b)
‘
Return list of ints representing positive num in base b
’
I num == 0
R [0]
[Int] result
L num != 0
(num, V d) = divmod(num, b)
result.append(d)
R reversed(result)
 
F fairshare(b, n)
[Int] r
L(i) 0..
r [+]= sum(_basechange_int(i, b)) % b
I r.len == n
L.break
R r
 
L(b) (2, 3, 5, 11)
print(‘#2’.format(b)‘: ’String(fairshare(b, 25))[1 .< (len)-1])</syntaxhighlight>
 
{{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
</pre>
 
=={{header|ALGOL 68}}==
<syntaxhighlight lang="algol68">
BEGIN # Use the generalised Thue-Morse sequence to generate Fairshare #
# sequences for various numbers of people #
# returns the digit sum of n in the specified base #
PROC digit sum = ( INT n, base )INT:
IF n = 0 THEN 0
ELSE
INT result := 0;
INT v := ABS n;
WHILE v > 0 DO
result +:= v MOD base;
v OVERAB base
OD;
result
FI # digit sum # ;
# show the first n terms of the fairshare sequence in the specified base #
PROC show fairshare = ( INT n, base )VOID:
BEGIN
print( ( whole( base, -2 ), ":" ) );
FOR i FROM 0 TO n - 1 DO
print( ( " ", whole( digit sum( i, base ) MOD base, -2 ) ) )
OD;
print( ( newline ) )
END # show fairshare # ;
show fairshare( 25, 2 );
show fairshare( 25, 3 );
show fairshare( 25, 5 );
show fairshare( 25, 11 )
END
</syntaxhighlight>
{{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
</pre>
 
=={{header|APL}}==
{{works with|Dyalog APL}}
<syntaxhighlight lang="apl">fairshare ← ⊣|(+/⊥⍣¯1)
2 3 5 11 ∘.fairshare 0,⍳24</syntaxhighlight>
{{out}}
<pre>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
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
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
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</pre>
 
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">-- thueMorse :: Int -> [Int]
on thueMorse(base)
-- Non-finite sequence of Thue-Morse terms for a given base.
fmapGen(baseDigitsSumModBase(base), enumFrom(0))
end thueMorse
 
 
-- baseDigitsSumModBase :: Int -> Int -> Int
on baseDigitsSumModBase(b)
script
on |λ|(n)
script go
on |λ|(x)
if 0 < x then
Just(Tuple(x mod b, x div b))
else
Nothing()
end if
end |λ|
end script
sum(unfoldl(go, n)) mod b
end |λ|
end script
end baseDigitsSumModBase
 
 
-------------------------- TEST ---------------------------
on run
script rjust
on |λ|(x)
justifyRight(2, space, str(x))
end |λ|
end script
script test
on |λ|(n)
|λ|(n) of rjust & " -> " & ¬
showList(map(rjust, take(25, thueMorse(n))))
end |λ|
end script
unlines({"First 25 fairshare terms for N players:"} & ¬
map(test, {2, 3, 5, 11}))
end run
 
 
-------------------- GENERIC FUNCTIONS --------------------
 
-- Just :: a -> Maybe a
on Just(x)
-- Constructor for an inhabited Maybe (option type) value.
-- Wrapper containing the result of a computation.
{type:"Maybe", Nothing:false, Just:x}
end Just
 
 
-- Nothing :: Maybe a
on Nothing()
-- Constructor for an empty Maybe (option type) value.
-- Empty wrapper returned where a computation is not possible.
{type:"Maybe", Nothing:true}
end Nothing
 
 
-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
-- Constructor for a pair of values, possibly of two different types.
{type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple
 
 
-- enumFrom :: Enum a => a -> [a]
on enumFrom(x)
script
property v : missing value
property blnNum : class of x is not text
on |λ|()
if missing value is not v then
if blnNum then
set v to 1 + v
else
set v to succ(v)
end if
else
set v to x
end if
return v
end |λ|
end script
end enumFrom
 
 
-- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
on fmapGen(f, gen)
script
property g : mReturn(f)
on |λ|()
set v to gen's |λ|()
if v is missing value then
v
else
g's |λ|(v)
end if
end |λ|
end script
end fmapGen
 
 
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
 
 
-- intercalateS :: String -> [String] -> String
on intercalate(delim, xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, delim}
set s to xs as text
set my text item delimiters to dlm
s
end intercalate
 
 
-- justifyRight :: Int -> Char -> String -> String
on justifyRight(n, cFiller, s)
if n > length of s then
text -n thru -1 of ((replicate(n, cFiller) as text) & s)
else
s
end if
end justifyRight
 
 
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of xs.
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
 
 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
else
script
property |λ| : f
end script
end if
end mReturn
 
 
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {}
if 1 > n then return out
set dbl to {a}
repeat while (1 < n)
if 0 < (n mod 2) then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
 
 
-- showList :: [a] -> String
on showList(xs)
"[" & intercalate(",", map(my str, xs)) & "]"
end showList
 
 
-- str :: a -> String
on str(x)
x as string
end str
 
 
-- sum :: [Num] -> Num
on sum(xs)
script add
on |λ|(a, b)
a + b
end |λ|
end script
foldl(add, 0, xs)
end sum
 
 
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
set c to class of xs
if list is c then
if 0 < n then
items 1 thru min(n, length of xs) of xs
else
{}
end if
else if string is c then
if 0 < n then
text 1 thru min(n, length of xs) of xs
else
""
end if
else if script is c then
set ys to {}
repeat with i from 1 to n
set v to |λ|() of xs
if missing value is v then
return ys
else
set end of ys to v
end if
end repeat
return ys
else
missing value
end if
end take
 
 
-- > unfoldl (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- > [1,2,3,4,5,6,7,8,9,10]
-- unfoldl :: (b -> Maybe (b, a)) -> b -> [a]
on unfoldl(f, v)
set xr to Tuple(v, v) -- (value, remainder)
set xs to {}
tell mReturn(f)
repeat -- Function applied to remainder.
set mb to |λ|(|2| of xr)
if Nothing of mb then
exit repeat
else -- New (value, remainder) tuple,
set xr to Just of mb
-- and value appended to output list.
set xs to ({|1| of xr} & xs)
end if
end repeat
end tell
return xs
end unfoldl
 
 
-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation
-- of a list of strings with the newline character.
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set s to xs as text
set my text item delimiters to dlm
s
end unlines</syntaxhighlight>
{{Out}}
<pre>First 25 fairshare terms for N players:
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]</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">thueMorse: function [base, howmany][
i: 0
result: new []
while [howmany > size result][
'result ++ (sum digits.base:base i) % base
i: i + 1
]
 
return result
]
 
loop [2 3 5 11] 'b ->
print [
(pad.right "Base "++(to :string b) 7)++" =>"
join.with:" " map to [:string] thueMorse b 25 'x -> pad x 2
]</syntaxhighlight>
 
{{out}}
 
<pre>Base 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
Base 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
Base 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
Base 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</pre>
 
=={{header|BASIC}}==
<syntaxhighlight lang="gwbasic">10 DEFINT A-Z
20 DIM B(4): B(1)=2: B(2)=3: B(3)=5: B(4)=11
30 FOR I=1 TO 4
40 B=B(I)
50 PRINT USING "###:";I;
60 FOR N=0 TO 24: GOSUB 100: PRINT USING "###";S;: NEXT N
70 PRINT
80 NEXT I
90 END
100 REM
101 REM S = N'th item of fairshare sequence for B people
102 REM
110 S=0: Z=N
120 S=S+Z MOD B: Z=Z\B: IF Z>0 THEN 120
130 S=S MOD B
140 RETURN</syntaxhighlight>
{{out}}
<pre> 1: 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
2: 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
3: 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
4: 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</pre>
 
=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
 
let digitsum(n,b) =
n < b -> n,
n rem b + digitsum(n/b, b)
 
let fairshare(n,b) =
digitsum(n,b) rem b
 
let start() be
$( let bs = table 2, 3, 5, 11
for bi = 0 to 3
$( writef("%I2:", bs!bi)
for n = 0 to 24 do writef("%I2 ", fairshare(n, bs!bi))
wrch('*N')
$)
$)</syntaxhighlight>
{{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</pre>
 
=={{header|C}}==
<syntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
 
int turn(int base, int n) {
int sum = 0;
while (n != 0) {
int rem = n % base;
n = n / base;
sum += rem;
}
return sum % base;
}
 
void fairshare(int base, int count) {
int i;
 
printf("Base %2d:", base);
for (i = 0; i < count; i++) {
int t = turn(base, i);
printf(" %2d", t);
}
printf("\n");
}
 
void turnCount(int base, int count) {
int *cnt = calloc(base, sizeof(int));
int i, minTurn, maxTurn, portion;
 
if (NULL == cnt) {
printf("Failed to allocate space to determine the spread of turns.\n");
return;
}
 
for (i = 0; i < count; i++) {
int t = turn(base, i);
cnt[t]++;
}
 
minTurn = INT_MAX;
maxTurn = INT_MIN;
portion = 0;
for (i = 0; i < base; i++) {
if (cnt[i] > 0) {
portion++;
}
if (cnt[i] < minTurn) {
minTurn = cnt[i];
}
if (cnt[i] > maxTurn) {
maxTurn = cnt[i];
}
}
 
printf(" With %d people: ", base);
if (0 == minTurn) {
printf("Only %d have a turn\n", portion);
} else if (minTurn == maxTurn) {
printf("%d\n", minTurn);
} else {
printf("%d or %d\n", minTurn, maxTurn);
}
 
free(cnt);
}
 
int main() {
fairshare(2, 25);
fairshare(3, 25);
fairshare(5, 25);
fairshare(11, 25);
 
printf("How many times does each get a turn in 50000 iterations?\n");
turnCount(191, 50000);
turnCount(1377, 50000);
turnCount(49999, 50000);
turnCount(50000, 50000);
turnCount(50001, 50000);
 
return 0;
}</syntaxhighlight>
{{out}}
<pre>Base 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
Base 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
Base 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
Base 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
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: Only 50000 have a turn</pre>
 
=={{header|C#}}==
{{trans|Java}}
<syntaxhighlight lang="C#">
using System;
using System.Collections.Generic;
 
class FairshareBetweenTwoAndMore
{
static void Main(string[] args)
{
foreach (int baseValue in new List<int> { 2, 3, 5, 11 })
{
Console.WriteLine($"Base {baseValue} = {string.Join(", ", ThueMorseSequence(25, baseValue))}");
}
}
 
private static List<int> ThueMorseSequence(int terms, int baseValue)
{
List<int> sequence = new List<int>();
for (int i = 0; i < terms; i++)
{
int sum = 0;
int n = i;
while (n > 0)
{
// Compute the digit sum
sum += n % baseValue;
n /= baseValue;
}
// Compute the digit sum modulo baseValue.
sequence.Add(sum % baseValue);
}
return sequence;
}
}
</syntaxhighlight>
{{out}}
<pre>
Base 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
Base 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
Base 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
Base 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
 
</pre>
 
=={{header|C++}}==
{{trans|C}}
<syntaxhighlight lang="cpp">#include <iostream>
#include <vector>
 
int turn(int base, int n) {
int sum = 0;
while (n != 0) {
int rem = n % base;
n = n / base;
sum += rem;
}
return sum % base;
}
 
void fairshare(int base, int count) {
printf("Base %2d:", base);
for (int i = 0; i < count; i++) {
int t = turn(base, i);
printf(" %2d", t);
}
printf("\n");
}
 
void turnCount(int base, int count) {
std::vector<int> cnt(base, 0);
 
for (int i = 0; i < count; i++) {
int t = turn(base, i);
cnt[t]++;
}
 
int minTurn = INT_MAX;
int maxTurn = INT_MIN;
int portion = 0;
for (int i = 0; i < base; i++) {
if (cnt[i] > 0) {
portion++;
}
if (cnt[i] < minTurn) {
minTurn = cnt[i];
}
if (cnt[i] > maxTurn) {
maxTurn = cnt[i];
}
}
 
printf(" With %d people: ", base);
if (0 == minTurn) {
printf("Only %d have a turn\n", portion);
} else if (minTurn == maxTurn) {
printf("%d\n", minTurn);
} else {
printf("%d or %d\n", minTurn, maxTurn);
}
}
 
int main() {
fairshare(2, 25);
fairshare(3, 25);
fairshare(5, 25);
fairshare(11, 25);
 
printf("How many times does each get a turn in 50000 iterations?\n");
turnCount(191, 50000);
turnCount(1377, 50000);
turnCount(49999, 50000);
turnCount(50000, 50000);
turnCount(50001, 50000);
 
return 0;
}</syntaxhighlight>
{{out}}
<pre>Base 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
Base 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
Base 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
Base 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
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: Only 50000 have a turn</pre>
 
=={{header|Cowgol}}==
<syntaxhighlight lang="cowgol">include "cowgol.coh";
 
sub fairshare(index: uint16, base: uint16): (result: uint16) is
result := 0;
while index > 0 loop
result := result + index % base;
index := index / base;
end loop;
result := result % base;
end sub;
 
sub printSequence(amount: uint16, base: uint16) is
print_i16(base);
print(": ");
var index: uint16 := 0;
while index < amount loop
print_i16(fairshare(index, base));
print(" ");
index := index + 1;
end loop;
print_nl();
end sub;
 
printSequence(25, 2);
printSequence(25, 3);
printSequence(25, 5);
printSequence(25, 11);</syntaxhighlight>
{{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</pre>
 
=={{header|EasyLang}}==
{{trans|Cowgol}}
<syntaxhighlight lang="easylang">
func fairshare ind base .
while ind > 0
r += ind mod base
ind = ind div base
.
r = r mod base
return r
.
proc sequence n base . .
write base & ": "
for ind range0 n
write (fairshare ind base) & " "
.
print ""
.
sequence 25 2
sequence 25 3
sequence 25 5
sequence 25 11
</syntaxhighlight>
 
=={{header|D}}==
{{trans|Kotlin}}
<syntaxhighlight lang="d">import std.array;
import std.stdio;
 
int turn(int base, int n) {
int sum = 0;
while (n != 0) {
int re = n % base;
n /= base;
sum += re;
}
return sum % base;
}
 
void fairShare(int base, int count) {
writef("Base %2d:", base);
foreach (i; 0..count) {
auto t = turn(base, i);
writef(" %2d", t);
}
writeln;
}
 
void turnCount(int base, int count) {
auto cnt = uninitializedArray!(int[])(base);
cnt[] = 0;
 
foreach (i; 0..count) {
auto t = turn(base, i);
cnt[t]++;
}
 
auto minTurn = int.max;
auto maxTurn = int.min;
int portion = 0;
foreach (num; cnt) {
if (num > 0) {
portion++;
}
if (num < minTurn) {
minTurn = num;
}
if (maxTurn < num) {
maxTurn = num;
}
}
 
writef(" With %d people: ", base);
if (minTurn == 0) {
writefln("Only %d have a turn", portion);
} else if (minTurn == maxTurn) {
writeln(minTurn);
} else {
writeln(minTurn," or ", maxTurn);
}
}
 
void main() {
fairShare(2, 25);
fairShare(3, 25);
fairShare(5, 25);
fairShare(11, 25);
 
writeln("How many times does each get a turn in 50000 iterations?");
turnCount(191, 50000);
turnCount(1377, 50000);
turnCount(49999, 50000);
turnCount(50000, 50000);
turnCount(50001, 50000);
}</syntaxhighlight>
{{out}}
<pre>Base 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
Base 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
Base 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
Base 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
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: Only 50000 have a turn</pre>
 
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
 
 
<syntaxhighlight lang="Delphi">
 
 
procedure DoFairshare(Memo: TMemo; Base: integer);
{Display 25 fairshare sequence items}
var I, N, Sum: integer;
var S: string;
begin
S:=Format('Base - %2d: ',[Base]);
for I:= 0 to 25-1 do
begin
N:= I; Sum:= 0;
while N>0 do
begin
Sum:= Sum + (N mod Base);
N:= N div Base;
end;
S:=S+' '+IntToStr(Sum mod Base);
end;
Memo.Lines.Add(S);
end;
 
 
procedure ShowFairshare(Memo: TMemo);
begin
DoFairshare(Memo,2);
DoFairshare(Memo,3);
DoFairshare(Memo,5);
DoFairshare(Memo,11);
end;
 
 
</syntaxhighlight>
{{out}}
<pre>
Base - 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
Base - 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
Base - 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
Base - 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
 
Elapsed Time: 4.753 ms.
 
</pre>
 
 
=={{header|Draco}}==
<syntaxhighlight lang="draco">proc fairshare(word n, base) word:
word result;
result := 0;
while n>0 do
result := result + n % base;
n := n / base
od;
result % base
corp
 
proc main() void:
[4]word bases = (2,3,5,11);
word b, n;
for b from 0 upto 3 do
write(bases[b]:2, ':');
for n from 0 upto 24 do
write(fairshare(n, bases[b]):3)
od;
writeln()
od
corp</syntaxhighlight>
{{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</pre>
 
=={{header|Factor}}==
{{works with|Factor|0.99 2020-01-23}}
<langsyntaxhighlight lang="factor">USING: formatting kernel math math.parser sequences ;
 
: nth-fairshare ( n base -- m )
Line 44 ⟶ 931:
 
{ 2 3 5 11 }
[ 25 over <fairshare> "%2d -> %u\n" printf ] each</langsyntaxhighlight>
{{out}}
<pre>
Line 52 ⟶ 939:
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 }
</pre>
 
=={{header|FreeBASIC}}==
{{trans|Visual Basic .NET}}
<syntaxhighlight lang="freebasic">
Function Turn(mibase As Integer, n As Integer) As Integer
Dim As Integer sum = 0
While n <> 0
Dim As Integer re = n Mod mibase
n \= mibase
sum += re
Wend
Return sum Mod mibase
End Function
 
Sub Fairshare(mibase As Integer, count As Integer)
Print Using "mibase ##:"; mibase;
For i As Integer = 1 To count
Dim As Integer t = Turn(mibase, i - 1)
Print Using " ##"; t;
Next i
Print
End Sub
 
Sub TurnCount(mibase As Integer, count As Integer)
Dim As Integer cnt(mibase), i
For i = 1 To mibase
cnt(i - 1) = 0
Next i
For i = 1 To count
Dim As Integer t = Turn(mibase, i - 1)
cnt(t) += 1
Next i
Dim As Integer minTurn = 4294967295 'MaxValue of uLong
Dim As Integer maxTurn = 0 'MinValue of uLong
Dim As Integer portion = 0
For i As Integer = 1 To mibase
Dim As Integer num = cnt(i - 1)
If num > 0 Then portion += 1
If num < minTurn Then minTurn = num
If num > maxTurn Then maxTurn = num
Next i
Print Using " With ##### people: "; mibase;
If 0 = minTurn Then
Print Using "Only & have a turn"; portion
Elseif minTurn = maxTurn Then
Print minTurn
Else
Print Using "& or &"; minTurn; maxTurn
End If
End Sub
 
Fairshare(2, 25)
Fairshare(3, 25)
Fairshare(5, 25)
Fairshare(11, 25)
 
Print "How many times does each get a turn in 50000 iterations?"
TurnCount(191, 50000)
TurnCount(1377, 50000)
TurnCount(49999, 50000)
TurnCount(50000, 50000)
TurnCount(50001, 50000)
Sleep
</syntaxhighlight>
{{out}}
<pre>
Igual que la entrada de Visual Basic .NET.
</pre>
 
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import (
Line 112 ⟶ 1,071:
fmt.Printf(" With %d people: %s\n", base, t)
}
}</langsyntaxhighlight>
 
{{out}}
Line 130 ⟶ 1,089:
 
=={{header|Haskell}}==
<syntaxhighlight lang ="haskell">import Data.ListBool (intercalate, unfoldrbool)
import Data.List (intercalate, unfoldr)
import Data.Tuple (swap)
 
import Data.Bool (bool)
------------- FAIR SHARE BETWEEN TWO AND MORE ------------
 
thueMorse :: Int -> [Int]
Line 140 ⟶ 1,101:
baseDigitsSumModBase base n =
mod
( sum $
unfoldr
(unfoldr ((bool Nothing . Just . swap . flip quotRem base) <*> (0 <)) n))
( bool Nothing
. Just
. swap
. flip quotRem base
<*> (0 <)
)
n
)
base
 
--------------------------- TEST--- -------------------------
main :: IO ()
main =
putStrLn $
fTable
( "First 25 fairshare terms for a given number of players:\n"
<> "for a given number of players:\n"
show
)
(('[' :) . (++ " ]") . intercalate "," . fmap (justifyRight 2 ' ' . show))
(take 25 . thueMorse)show
( ('[' :) . (<> "]") . intercalate ","
[2, 3, 5, 11]
. fmap show
)
(take 25 . thueMorse)
[2, 3, 5, 11]
 
-------------------------- DISPLAY-- ------------------------
fTable ::
fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
String ->
(a -> String) ->
(b -> String) ->
(a -> b) ->
[a] ->
String
fTable s xShow fxShow f xs =
unlines $
s :
fmap
fmap (((++) . justifyRight w ' ' . xShow) <*> ((" -> " ++) . fxShow . f)) xs
( ((<>) . justifyRight w ' ' . xShow)
<*> ((" -> " <>) . fxShow . f)
)
xs
where
w = maximum (length . xShow <$> xs)
 
justifyRight :: Int -> aChar -> [a]String -> [a]String
justifyRight n c = (drop . length) <*> (replicate n c ++<>)</langsyntaxhighlight>
{{Out}}
<pre>First 25 fairshare terms for a given number of players:
 
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 ]</pre>
 
=={{header|J}}==
<pre>
fairshare=: [ | [: +/"1 #.inv
 
2 3 5 11 fairshare"0 1/i.25
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
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
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
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
 
 
NB. In the 1st 50000 how many turns does each get? answered:
<@({.,#)/.~"1 ] 2 3 5 11 fairshare"0 1/i.50000
+-------+-------+-------+-------+-------+------+------+------+------+------+-------+
|0 25000|1 25000| | | | | | | | | |
+-------+-------+-------+-------+-------+------+------+------+------+------+-------+
|0 16667|1 16667|2 16666| | | | | | | | |
+-------+-------+-------+-------+-------+------+------+------+------+------+-------+
|0 10000|1 10000|2 10000|3 10000|4 10000| | | | | | |
+-------+-------+-------+-------+-------+------+------+------+------+------+-------+
|0 4545 |1 4545 |2 4545 |3 4545 |4 4546 |5 4546|6 4546|7 4546|8 4546|9 4545|10 4545|
+-------+-------+-------+-------+-------+------+------+------+------+------+-------+
</pre>
 
=={{header|Java}}==
<syntaxhighlight lang="java">
import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;
 
public class FairshareBetweenTwoAndMore {
 
public static void main(String[] args) {
for ( int base : Arrays.asList(2, 3, 5, 11) ) {
System.out.printf("Base %d = %s%n", base, thueMorseSequence(25, base));
}
}
private static List<Integer> thueMorseSequence(int terms, int base) {
List<Integer> sequence = new ArrayList<Integer>();
for ( int i = 0 ; i < terms ; i++ ) {
int sum = 0;
int n = i;
while ( n > 0 ) {
// Compute the digit sum
sum += n % base;
n /= base;
}
// Compute the digit sum module base.
sequence.add(sum % base);
}
return sequence;
}
 
}
</syntaxhighlight>
{{out}}
<pre>
Base 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]
Base 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]
Base 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]
Base 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]
</pre>
 
=={{header|JavaScript}}==
<langsyntaxhighlight lang="javascript">(() => {
'use strict';
 
Line 365 ⟶ 1,412:
// MAIN ---
return main();
})();</langsyntaxhighlight>
{{Out}}
<pre>First 25 fairshare terms for a given number of players:
Line 373 ⟶ 1,420:
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 ]</pre>
 
=={{header|jq}}==
jq has a built-in for limiting a generator, but does not have a built-in for generating the integers in an arbitrary base, so we begin by defining `integers($base)` for generating integers as arrays beginning with the least-significant digit.
<syntaxhighlight lang="jq"># Using a "reverse array" representations of the integers base b (b>=2),
# generate an unbounded stream of the integers from [0] onwards.
# E.g. for binary: [0], [1], [0,1], [1,1] ...
 
def integers($base):
def add1:
[foreach (.[], null) as $d ({carry: 1};
if $d then ($d + .carry ) as $r
| if $r >= $base
then {carry: 1, emit: ($r - $base)}
else {carry: 0, emit: $r }
end
elif (.carry == 0) then .emit = null
else .emit = .carry
end;
select(.emit).emit)];
[0] | recurse(add1);
 
def fairshare($base; $numberOfTerms):
limit($numberOfTerms;
integers($base) | add | . % $base);
 
# The task:
(2,3,5,11)
| "Fairshare \((select(.>2)|"among") // "between") \(.) people: \([fairshare(.; 25)])"
</syntaxhighlight>
{{out}}
As for Julia.
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">fairshare(nplayers,len) = [sum(digits(n, base=nplayers)) % nplayers for n in 0:len-1]
 
for n in [2, 3, 5, 11]
println("Fairshare ", n > 2 ? "among" : "between", " $n people: ", fairshare(n, 25))
end
</langsyntaxhighlight>{{out}}
<pre>
Fairshare between 2 people: [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]
Line 389 ⟶ 1,466:
</pre>
 
=={{header|PerlKotlin}}==
{{trans|PerlVisual 6Basic .NET}}
<syntaxhighlight lang="scala">fun turn(base: Int, n: Int): Int {
<lang perl>use strict;
var sum = 0
use warnings;
var n2 = n
use Math::AnyNum qw(sum polymod);
while (n2 != 0) {
val re = n2 % base
n2 /= base
sum += re
}
return sum % base
}
 
fun fairShare(base: Int, count: Int) {
sub fairshare {
print(String.format("Base %2d:", base))
my($b, $n) = @_;
for (i in 0 until count) {
sprintf '%3d'x$n, map { sum ( polymod($_, $b, $b )) % $b } 0 .. $n-1;
val t = turn(base, i)
print(String.format(" %2d", t))
}
println()
}
 
forfun turnCount(<2base: 3Int, 5count: 11>Int) {
val cnt = IntArray(base) { 0 }
printf "%3s:%s\n", $_, fairshare($_, 25);
for (i in 0 until count) {
}</lang>
val t = turn(base, i)
cnt[t]++
}
 
var minTurn = Int.MAX_VALUE
var maxTurn = Int.MIN_VALUE
var portion = 0
for (i in 0 until base) {
val num = cnt[i]
if (num > 0) {
portion++
}
if (num < minTurn) {
minTurn = num
}
if (num > maxTurn) {
maxTurn = num
}
}
 
print(" With $base people: ")
when (minTurn) {
0 -> {
println("Only $portion have a turn")
}
maxTurn -> {
println(minTurn)
}
else -> {
println("$minTurn or $maxTurn")
}
}
}
 
fun main() {
fairShare(2, 25)
fairShare(3, 25)
fairShare(5, 25)
fairShare(11, 25)
 
println("How many times does each get a turn in 50000 iterations?")
turnCount(191, 50000)
turnCount(1377, 50000)
turnCount(49999, 50000)
turnCount(50000, 50000)
turnCount(50001, 50000)
}
</syntaxhighlight>
{{out}}
<pre>Base 2: 0 1 1 0 1 0 0 1 0 1 10 0 1 0 01 1 0 1 10 0 1 0 01 1 0 0
Base 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
Base 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
Base 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</pre>
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: Only 50000 have a turn</pre>
 
=={{header|Perl 6Lua}}==
{{trans|D}}
{{works with|Rakudo|2020.01}}
<syntaxhighlight lang="lua">function turn(base, n)
Add an extension showing the relative fairness correlation of this selection algorithm. An absolutely fair algorithm would have a correlation of 1 for each person (no person has an advantage or disadvantage due to an algorithmic artefact.) This algorithm is fair, and gets better the more iterations are done.
local sum = 0
while n ~= 0 do
local re = n % base
n = math.floor(n / base)
sum = sum + re
end
return sum % base
end
 
function fairShare(base, count)
A lower correlation factor corresponds to an advantage, higher to a disadvantage, the closer to 1 it is, the fairer the algorithm. Absolute best possible advantage correlation is 0. Absolute worst is 2.
io.write(string.format("Base %2d:", base))
for i=1,count do
local t = turn(base, i - 1)
io.write(string.format(" %2d", t))
end
print()
end
 
function turnCount(base, count)
<lang perl6>sub fairshare (\b) { ^∞ .hyper.map: { .polymod( b xx * ).sum % b } }
local cnt = {}
 
for i=1,base do
.say for <2 3 5 11>.map: { .fmt('%2d:') ~ .&fairshare[^25]».fmt('%2d').join: ', ' }
cnt[i - 1] = 0
end
 
for i=1,count do
say "\nRelative fairness of this method. Scaled fairness correlation. The closer to 1.0 each person
local t = turn(base, i - 1)
is, the more fair the selection algorithm is. Gets better with more iterations.";
if cnt[t] ~= nil then
cnt[t] = cnt[t] + 1
else
cnt[t] = 1
end
end
 
local minTurn = count
for <2 3 5 11 39> -> $people {
local maxTurn = -count
print "\n$people people: \n";
local portion = 0
for $people * 1, $people * 10, $people * 1000 -> $iterations {
for _,num in pairs(cnt) do
my @fairness;
if num > 0 then
fairshare($people)[^$iterations].kv.map: { @fairness[$^v % $people] += $^k }
my $scale portion = @fairness.sumportion /+ @fairness;1
end
my @range = @fairness.map( { $_ / $scale } );
if num < minTurn then
printf "After round %4d: Best advantage: %-10.8g - Worst disadvantage: %-10.8g - Spread between best and worst: %-10.8g\n",
minTurn = num
$iterations/$people, @range.min, @range.max, @range.max - @range.min;
} end
if maxTurn < num then
}</lang>
maxTurn = num
<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
end
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
end
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
 
io.write(string.format(" With %d people: ", base))
Relative fairness of this method. Scaled fairness correlation. The closer to 1.0 each person
if minTurn == 0 then
is, the more fair the selection algorithm is. Gets better with more iterations.
print(string.format("Only %d have a turn", portion))
elseif minTurn == maxTurn then
print(minTurn)
else
print(minTurn .. " or " .. maxTurn)
end
end
 
function main()
2 people:
fairShare(2, 25)
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
fairShare(3, 25)
After round 10: Best advantage: 1 - Worst disadvantage: 1 - Spread between best and worst: 0
fairShare(5, 25)
After round 1000: Best advantage: 1 - Worst disadvantage: 1 - Spread between best and worst: 0
fairShare(11, 25)
 
print("How many times does each get a turn in 50000 iterations?")
3 people:
turnCount(191, 50000)
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
turnCount(1377, 50000)
After round 10: Best advantage: 0.99310345 - Worst disadvantage: 1.0068966 - Spread between best and worst: 0.013793103
turnCount(49999, 50000)
After round 1000: Best advantage: 0.99999933 - Worst disadvantage: 1.0000007 - Spread between best and worst: 1.3337779e-06
turnCount(50000, 50000)
turnCount(50001, 50000)
end
 
main()</syntaxhighlight>
5 people:
{{out}}
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
After<pre>Base round 102: Best advantage:0 1 1 0 1 0 -0 Worst disadvantage:1 1 0 0 1 0 -1 Spread between1 best and0 1 worst: 0 0 1 0 1 1 0 0
AfterBase round 10003: Best advantage:0 1 2 1 2 0 -2 Worst disadvantage:0 1 1 2 0 2 -0 Spread between1 best and0 1 2 2 worst: 0 1 0 1 2 1
Base 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
Base 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
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: Only 50000 have a turn</pre>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
11 people:
<syntaxhighlight lang="mathematica">ClearAll[Fairshare]
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
Fairshare[n_List, b_Integer : 2] := Fairshare[#, b] & /@ n
After round 10: Best advantage: 0.99082569 - Worst disadvantage: 1.0091743 - Spread between best and worst: 0.018348624
Fairshare[n_Integer, b_Integer : 2] := Mod[Total[IntegerDigits[n, b]], b]
After round 1000: Best advantage: 0.99999909 - Worst disadvantage: 1.0000009 - Spread between best and worst: 1.8183471e-06
Fairshare[Range[0, 24], 2]
Fairshare[Range[0, 24], 3]
Fairshare[Range[0, 24], 5]
Fairshare[Range[0, 24], 11]</syntaxhighlight>
{{out}}
<pre>{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}
{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}
{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}
{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}</pre>
 
=={{header|Nim}}==
39 people:
<syntaxhighlight lang="nim">import math, strutils
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
 
After round 10: Best advantage: 0.92544987 - Worst disadvantage: 1.0745501 - Spread between best and worst: 0.14910026
#---------------------------------------------------------------------------------------------------
After round 1000: Best advantage: 0.99999103 - Worst disadvantage: 1.000009 - Spread between best and worst: 1.7949178e-05</pre>
 
iterator countInBase(b: Positive): seq[Natural] =
## Yield the successive integers in base "b" as a sequence of digits.
var value = @[Natural 0]
yield value
 
while true:
 
# Add one to current value.
var c = 1
for i in countdown(value.high, 0):
let val = value[i] + c
if val < b:
value[i] = val
c = 0
else:
value[i] = val - b
c = 1
 
if c == 1:
# Add a new digit at the beginning.
# In this case, for better performances, we could have add it at the end.
value.insert(c, 0)
 
yield value
 
#---------------------------------------------------------------------------------------------------
 
func thueMorse(b: Positive; count: Natural): seq[Natural] =
## Return the "count" first elements of Thue-Morse sequence for base "b".
var count = count
for n in countInBase(b):
result.add(sum(n) mod b)
dec count
if count == 0: break
 
#———————————————————————————————————————————————————————————————————————————————————————————————————
 
for base in [2, 3, 5, 11]:
echo "Base ", ($base & ": ").alignLeft(4), thueMorse(base, 25).join(" ")</syntaxhighlight>
 
{{out}}
<pre>Base 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
Base 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
Base 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
Base 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</pre>
 
=={{header|Pascal}}==
==={{header|Free Pascal}}===
<syntaxhighlight lang="pascal">program Fairshare;
{$IFDEF FPC}{$MODE Delphi}{$Optimization ON,ALL}{$ENDIF}
{$IFDEF WINDOWS}{$APPTYPE CONSOLE}{$ENDIF}
uses
sysutils;
const
maxDigitCnt = 32;
type
tdigit = Uint32;
tDgtSum = record
dgts : array[0..maxDigitCnt-1] of tdigit;
dgtNum : Uint64;
dgtsum : Uint64;//maxValue maxDigitCnt*(dgtBase-1)
dgtBase,
dgtThue : tDigit;
end;
procedure OutDgtSum(const ds:tDgtSum);
var
i : NativeInt;
Begin
with ds do
Begin
writeln(' base ',dgtBase,' sum of digits : ',dgtSum,' dec number ',dgtNum);
i := Low(dgts);
repeat
write(dgts[i],'|');
inc(i);
until i > High(dgts);
writeln;
end;
end;
 
function IncDgtSum(var ds:tDgtSum):boolean;
//add 1 to dgts and corrects sum of Digits
//return false if overflow happens
var
i,base_1 : NativeInt;
Begin
with ds do
begin
i := High(dgts);
base_1 := dgtBase-1;
inc(dgtNum);
repeat
IF dgts[i] < base_1 then
//add one and done
Begin
inc(dgts[i]);
inc(dgtSum);
BREAK;
end
else
Begin
dgts[i] := 0;
dec(dgtSum,base_1);
end;
dec(i);
until i < Low(dgts);
dgtThue := dgtSum MOD (base_1+1);
result := i < Low(dgts)
end;
end;
 
procedure CheckBase_N_Turns( base:tDigit;turns:NativeUInt);
var
actualNo :tDgtSum;
slots : array of Uint32;
pSlots : pUint32;
i : NativeUInt;
Begin
fillchar(actualNo,SizeOf(actualNo),#0);
setlength(slots,base);
pSlots := @slots[0];
actualNo.dgtBase := Base;
Write(base:3,' [');
while turns>0 do
Begin
inc(pSlots[actualNo.dgtThue],turns);
IncDgtSum(actualNo);
dec(turns);
end;
For i := 0 to Base-1 do
write(pSlots[i],' ');
writeln(']');
end;
 
procedure SumBase_N_Turns( base:tDigit;turns:NativeUInt);
var
actualNo :tDgtSum;
Begin
fillchar(actualNo,SizeOf(actualNo),#0);
actualNo.dgtBase := Base;
Write(base:3,' [');
while turns>1 do
Begin
write(actualNo.dgtThue,',');
IncDgtSum(actualNo);
dec(turns);
end;
writeln(actualNo.dgtThue,']');
end;
 
var
turns : NativeInt;
Begin
turns := 25;
SumBase_N_Turns(2,turns); SumBase_N_Turns(3,turns);
SumBase_N_Turns(5,turns); SumBase_N_Turns(11,turns);
Writeln;
writeln('Summing up descending numbers from turns downto 0');;
turns := 2*3*5*11;
Writeln(turns,' turns = 2*3*5*11');
CheckBase_N_Turns(2,turns); CheckBase_N_Turns(3,turns);
CheckBase_N_Turns(5,turns); CheckBase_N_Turns(11,turns);
 
turns := sqr(2)*sqr(3)*sqr(5)*sqr(11);
Writeln(turns,' turns = sqr(2)*sqr(3)*sqr(5)*sqr(11)');
CheckBase_N_Turns(2,turns); CheckBase_N_Turns(3,turns);
CheckBase_N_Turns(5,turns); CheckBase_N_Turns(11,turns);
end.
</syntaxhighlight>
{{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]
 
Summing up descending numbers from turns downto 0
330 turns = 2*3*5*11
2 [27307 27308 ]
3 [18206 18204 18205 ]
5 [10925 10924 10923 10922 10921 ]
11 [4961 4953 4956 4959 4962 4965 4968 4971 4974 4977 4969 ]
108900 turns = sqr(2)*sqr(3)*sqr(5)*sqr(11)
2 [2964829725 2964829725]
3 [1976553150 1976553150 1976553150]
5 [1185931890 1185931890 1185931890 1185931890 1185931890]
11 [539059950 539059950 539059950 539059950 539059950 539059950 539059950 539059950 539059950 539059950 539059950]
 
</pre>
 
=={{header|Perl}}==
{{trans|Raku}}
<syntaxhighlight lang="perl">use strict;
use warnings;
use Math::AnyNum qw(sum polymod);
 
sub fairshare {
my($b, $n) = @_;
sprintf '%3d'x$n, map { sum ( polymod($_, $b, $b )) % $b } 0 .. $n-1;
}
 
for (<2 3 5 11>) {
printf "%3s:%s\n", $_, fairshare($_, 25);
}</syntaxhighlight>
{{out}}
<pre> 2: 0 1 1 0 1 0 0 1 0 1 1 0 1 0 0 1 0 1 1 0 1 0 0 1 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</pre>
 
=={{header|Phix}}==
{{trans|Go}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function fairshare(integer n, base)
<span style="color: #008080;">function</span> <span style="color: #000000;">fairshare</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">base</span><span style="color: #0000FF;">)</span>
sequence res = repeat(0,n)
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
for i=1 to n do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
integer j = i-1,
<span style="color: #004080;">integer</span> <span style="color: #000000;">j</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span>
t = 0
<span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
while j>0 do
<span style="color: #008080;">while</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">></span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
t += remainder(j,base)
<span style="color: #000000;">t</span> <span style="color: #0000FF;">+=</span> <span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">j</span><span style="color: #0000FF;">,</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)</span>
j = floor(j/base)
<span style="color: #000000;">j</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">j</span><span style="color: #0000FF;">/</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)</span>
end while
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
res[i] = remainder(t,base)
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">,</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
return {base,res}
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">base</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">}</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
constant tests = {2,3,5,11}
<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">11</span><span style="color: #0000FF;">}</span>
for i=1 to length(tests) do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
printf(1,"%2d : %v\n", fairshare(25, tests[i]))
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%2d : %v\n"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">fairshare</span><span style="color: #0000FF;">(</span><span style="color: #000000;">25</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]))</span>
end for</lang>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 493 ⟶ 1,901:
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}
</pre>
 
=={{header|PL/M}}==
<syntaxhighlight lang="plm">100H:
 
BDOS: PROCEDURE (F,A); DECLARE F BYTE, A ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; GO TO 0; END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
 
PRINT$NUMBER: PROCEDURE (N);
DECLARE S (7) BYTE INITIAL ('..... $');
DECLARE (N, P) ADDRESS, C BASED P BYTE;
P = .S(5);
DIGIT:
P = P - 1;
C = N MOD 10 + '0';
N = N / 10;
IF N > 0 THEN GO TO DIGIT;
CALL PRINT(P);
END PRINT$NUMBER;
 
FAIR$SHARE: PROCEDURE (N, BASE) ADDRESS;
DECLARE (N, BASE, SUM) ADDRESS;
SUM = 0;
DO WHILE N>0;
SUM = SUM + N MOD BASE;
N = N / BASE;
END;
RETURN SUM MOD BASE;
END FAIR$SHARE;
 
DECLARE BASES (4) BYTE INITIAL (2, 3, 5, 11);
DECLARE (I, N) BYTE;
 
DO I=0 TO LAST(BASES);
CALL PRINT$NUMBER(BASES(I));
CALL PRINT(.': $');
DO N=0 TO 24;
CALL PRINT$NUMBER(FAIR$SHARE(N, BASES(I)));
END;
CALL PRINT(.(13,10,'$'));
END;
CALL EXIT;
EOF</syntaxhighlight>
{{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</pre>
 
=={{header|Python}}==
===Procedural===
<langsyntaxhighlight lang="python">from itertools import count, islice
 
def _basechange_int(num, b):
Line 521 ⟶ 1,977:
if __name__ == '__main__':
for b in (2, 3, 5, 11):
print(f"{b:>2}: {str(list(islice(fairshare(b), 25)))[1:-1]}")</langsyntaxhighlight>
 
{{out}}
Line 530 ⟶ 1,986:
 
===Functional===
<langsyntaxhighlight lang="python">'''Fairshare between two and more'''
 
from itertools import count, islice
Line 536 ⟶ 1,992:
 
 
# thueMorse :: Int -> [Int] -> [Int]
def thueMorse(base):
'''Thue-Morse sequence for a given base.'''
return mapfmapNext(baseDigitsSumModBase(base), count)(0))
count(0)
)
 
 
Line 549 ⟶ 2,007:
def go(n):
return sum(unfoldl(
lambda x: NothingJust(divmod(x, base)) if 0 ==< x else Just(divmodNothing(x, base))
)(n)) % base
 
return lambda n: go(n)
return go
 
 
# TEST -------------------------- TEST --------------------------
# main :: IO ()
def main():
Line 572 ⟶ 2,031:
 
 
# GENERIC ------------------------ GENERIC -------------------------
 
# Just :: a -> Maybe a
Line 595 ⟶ 2,054:
of a series of functions.
'''
returndef lambdago(f, xg): reduce(
lambdadef a, f: ffg(ax),:
fs[::-1], return f(g(x))
) return fg
return reduce(go, fs, identity)
 
 
# fmapNext <$> :: (a -> b) -> Iter [a] -> Iter [b]
def fmapNext(f):
'''A function f mapped over a
possibly non-finite iterator.
'''
def go(g):
v = next(g, None)
while None is not v:
yield f(v)
v = next(g, None)
return go
 
 
Line 617 ⟶ 2,090:
xShow, fxShow, f, xs
)
 
# identity :: a -> a
def identity(x):
'''The identity function.'''
return x
 
 
Line 649 ⟶ 2,127:
while True:
mb = f(x)
if mb.get(['Nothing')]:
return xs
else:
x, r = mb.get(['Just')]
xs.insert(0, r)
return xs
return lambda x: go(x)
 
 
# MAIN ---
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>First 25 fairshare terms for a given number of players:
Line 668 ⟶ 2,146:
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 ]</pre>
 
=={{header|Quackery}}==
<code>digitsum</code> is defined at [http://rosettacode.org/wiki/Sum_digits_of_an_integer#Quackery Sum digits of an integer].
 
<syntaxhighlight lang="quackery"> [ dup dip digitsum mod ] is fairshare ( n n --> n )
 
' [ 2 3 5 11 ]
witheach
[ dup echo say ": "
25 times
[ i^ over fairshare echo sp ]
drop cr ]</syntaxhighlight>
 
{{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 </pre>
 
=={{header|Racket}}==
 
<syntaxhighlight lang="racket">#lang racket
 
(define (Thue-Morse base)
(letrec ((q/r (curryr quotient/remainder base))
(inner (λ (n (s 0))
(match n
[0 (modulo s base)]
[(app q/r q r) (inner q (+ s r))]))))
inner))
 
(define (report-turns B n)
(printf "Base:\t~a\t~a~%" B (map (Thue-Morse B) (range n))))
 
(define (report-stats B n)
(define TM (Thue-Morse B))
(define h0 (for/hash ((b B)) (values b 0)))
(define d (for/fold ((h h0)) ((i n)) (hash-update h (TM i) add1 0)))
(define d′ (for/fold ((h (hash))) (([k v] (in-hash d))) (hash-update h v add1 0)))
(define d′′ (hash-map d′ (λ (k v) (format "~a people have ~a turn(s)" v k))))
(printf "Over ~a turns for ~a people:~a~%" n B (string-join d′′ ", ")))
 
(define (Fairshare-between-two-and-more)
(report-turns 2 25)
(report-turns 3 25)
(report-turns 5 25)
(report-turns 11 25)
(newline)
(report-stats 191 50000)
(report-stats 1377 50000)
(report-stats 49999 50000)
(report-stats 50000 50000)
(report-stats 50001 50000))
 
(module+ main
(Fairshare-between-two-and-more))</syntaxhighlight>
 
{{out}}
<pre>Base: 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)
Base: 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)
Base: 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)
Base: 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)
 
Over 50000 turns for 191 people:42 people have 261 turn(s), 149 people have 262 turn(s)
Over 50000 turns for 1377 people:428 people have 37 turn(s), 949 people have 36 turn(s)
Over 50000 turns for 49999 people:49998 people have 1 turn(s), 1 people have 2 turn(s)
Over 50000 turns for 50000 people:50000 people have 1 turn(s)
Over 50000 turns for 50001 people:50000 people have 1 turn(s), 1 people have 0 turn(s)</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2020.01}}
Add an extension showing the relative fairness correlation of this selection algorithm. An absolutely fair algorithm would have a correlation of 1 for each person (no person has an advantage or disadvantage due to an algorithmic artefact.) This algorithm is fair, and gets better the more iterations are done.
 
A lower correlation factor corresponds to an advantage, higher to a disadvantage, the closer to 1 it is, the fairer the algorithm. Absolute best possible advantage correlation is 0. Absolute worst is 2.
 
<syntaxhighlight lang="raku" line>sub fairshare (\b) { ^∞ .hyper.map: { .polymod( b xx * ).sum % b } }
 
.say for <2 3 5 11>.map: { .fmt('%2d:') ~ .&fairshare[^25]».fmt('%2d').join: ', ' }
 
say "\nRelative fairness of this method. Scaled fairness correlation. The closer to 1.0 each person
is, the more fair the selection algorithm is. Gets better with more iterations.";
 
for <2 3 5 11 39> -> $people {
print "\n$people people: \n";
for $people * 1, $people * 10, $people * 1000 -> $iterations {
my @fairness;
fairshare($people)[^$iterations].kv.map: { @fairness[$^v % $people] += $^k }
my $scale = @fairness.sum / @fairness;
my @range = @fairness.map( { $_ / $scale } );
printf "After round %4d: Best advantage: %-10.8g - Worst disadvantage: %-10.8g - Spread between best and worst: %-10.8g\n",
$iterations/$people, @range.min, @range.max, @range.max - @range.min;
}
}</syntaxhighlight>
<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
 
Relative fairness of this method. Scaled fairness correlation. The closer to 1.0 each person
is, the more fair the selection algorithm is. Gets better with more iterations.
 
2 people:
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
After round 10: Best advantage: 1 - Worst disadvantage: 1 - Spread between best and worst: 0
After round 1000: Best advantage: 1 - Worst disadvantage: 1 - Spread between best and worst: 0
 
3 people:
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
After round 10: Best advantage: 0.99310345 - Worst disadvantage: 1.0068966 - Spread between best and worst: 0.013793103
After round 1000: Best advantage: 0.99999933 - Worst disadvantage: 1.0000007 - Spread between best and worst: 1.3337779e-06
 
5 people:
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
After round 10: Best advantage: 1 - Worst disadvantage: 1 - Spread between best and worst: 0
After round 1000: Best advantage: 1 - Worst disadvantage: 1 - Spread between best and worst: 0
 
11 people:
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
After round 10: Best advantage: 0.99082569 - Worst disadvantage: 1.0091743 - Spread between best and worst: 0.018348624
After round 1000: Best advantage: 0.99999909 - Worst disadvantage: 1.0000009 - Spread between best and worst: 1.8183471e-06
 
39 people:
After round 1: Best advantage: 0 - Worst disadvantage: 2 - Spread between best and worst: 2
After round 10: Best advantage: 0.92544987 - Worst disadvantage: 1.0745501 - Spread between best and worst: 0.14910026
After round 1000: Best advantage: 0.99999103 - Worst disadvantage: 1.000009 - Spread between best and worst: 1.7949178e-05</pre>
 
=={{header|REXX}}==
Programming note: &nbsp; the &nbsp; '''base''' &nbsp; function (as coded herein) handles bases from base ten up to &nbsp; '''36'''.
<lang rexx>/*REXX program calculates N terms of the fairshare sequence for some group of peoples.*/
<syntaxhighlight lang="rexx">/*REXX program calculates N terms of the fairshare sequence for some group of peoples.*/
parse arg n g /*obtain optional arguments from the CL*/
if n=='' | n=="," then n= 25 /*Not specified? Then use the default.*/
Line 686 ⟶ 2,292:
do while #>=b; y= substr(@, #//b + 1, 1)y; #= #%b; end; return substr(@, #+1, 1)y
/*──────────────────────────────────────────────────────────────────────────────────────*/
sumDigs: parse arg x; !=0; do i=1 for length(x); != !+pos(substr(x,i,1),@@); end; return !</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 693 ⟶ 2,299:
base 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
base 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
</pre>
 
=={{header|Ring}}==
<syntaxhighlight lang="ring">
str = []
people = [2,3,5,11]
 
result = people
for i in people
str = []
see "" + i + ": "
fair(25, i)
for n in result
add(str,n)
next
showarray(str)
next
func fair n,base
 
result = list(n)
for i=1 to n
j = i-1
t = 0
while j>0
t = t + j % base
j = floor(j/base)
end
result[i] = t % base
next
func showarray vect
svect = ""
for n in vect
svect += " " + n + ","
next
svect = left(svect, len(svect) - 1)
? "[" + svect + "]"
</syntaxhighlight>
{{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]
</pre>
 
=={{header|RPL}}==
<code>DIGITS</code> is defined at [[Sum digits of an integer#RPL|Sum digits of an integer]].
 
<code>D→B</code> is a slightly modified version of the program defined at [[Non-decimal radices/Convert#RPL|Non-decimal radices/Convert]], using uppercase characters to be compatible with <code>DIGITS</code>
≪ → b
≪ "" SWAP
'''WHILE''' DUP '''REPEAT'''
b MOD LAST / IP
SWAP DUP 9 > 55 48 IFTE + CHR
ROT + SWAP
'''END''' DROP
≫ ≫ '<span style="color:blue">D→B</span>' STO
≪ → b
≪ { 0 } 1 24 '''FOR''' j
j b <span style="color:blue">D→B</span> <span style="color:blue">DIGITS</span> b MOD + '''NEXT'''
≫ ≫ '<span style="color:blue">TASK</span>' STO
 
2 <span style="color:blue">TASK</span> 3 <span style="color:blue">TASK</span> 5 <span style="color:blue">TASK</span> 11 <span style="color:blue">TASK</span>
{{out}}
<pre>
4: { 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 }
2: { 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 }
1: { 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 }
</pre>
 
=={{header|Ruby}}==
{{trans|C}}
<syntaxhighlight lang="ruby">def turn(base, n)
sum = 0
while n != 0 do
rem = n % base
n = n / base
sum = sum + rem
end
return sum % base
end
 
def fairshare(base, count)
print "Base %2d: " % [base]
for i in 0 .. count - 1 do
t = turn(base, i)
print " %2d" % [t]
end
print "\n"
end
 
def turnCount(base, count)
cnt = Array.new(base, 0)
 
for i in 0 .. count - 1 do
t = turn(base, i)
cnt[t] = cnt[t] + 1
end
 
minTurn = base * count
maxTurn = -1
portion = 0
for i in 0 .. base - 1 do
if cnt[i] > 0 then
portion = portion + 1
end
if cnt[i] < minTurn then
minTurn = cnt[i]
end
if cnt[i] > maxTurn then
maxTurn = cnt[i]
end
end
 
print " With %d people: " % [base]
if 0 == minTurn then
print "Only %d have a turn\n" % portion
elsif minTurn == maxTurn then
print "%d\n" % [minTurn]
else
print "%d or %d\n" % [minTurn, maxTurn]
end
end
 
def main
fairshare(2, 25)
fairshare(3, 25)
fairshare(5, 25)
fairshare(11, 25)
 
puts "How many times does each get a turn in 50000 iterations?"
turnCount(191, 50000)
turnCount(1377, 50000)
turnCount(49999, 50000)
turnCount(50000, 50000)
turnCount(50001, 50000)
end
 
main()</syntaxhighlight>
{{out}}
<pre>Base 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
Base 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
Base 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
Base 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
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: Only 50000 have a turn</pre>
{{trans|Sidef}}
<syntaxhighlight lang="ruby">
def fairshare(base, upto) = (0...upto).map{|n| n.digits(base).sum % base}
 
upto = 25
[2, 3, 5, 11].each{|b| puts"#{'%2d' % b}: " + " %2d"*upto % fairshare(b, upto)}
</syntaxhighlight>
{{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
</pre>
 
=={{header|Rust}}==
{{trans|Python}}
<langsyntaxhighlight lang="rust">struct Digits {
rest: usize,
base: usize,
Line 742 ⟶ 2,515:
println!("{}: {:?}", i, fair_sharing(i).take(25).collect::<Vec<usize>>());
}
}</langsyntaxhighlight>
{{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]
Line 750 ⟶ 2,523:
 
=={{header|Sidef}}==
<langsyntaxhighlight lang="ruby">for b in (2,3,5,11) {
say ("#{'%2d' % b}: ", 25.of { .sumdigits(b) % b })
}</langsyntaxhighlight>
{{out}}
<pre>
Line 759 ⟶ 2,532:
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]
</pre>
 
=={{header|Visual Basic .NET}}==
{{trans|C}}
<syntaxhighlight lang="vbnet">Module Module1
 
Function Turn(base As Integer, n As Integer) As Integer
Dim sum = 0
While n <> 0
Dim re = n Mod base
n \= base
sum += re
End While
Return sum Mod base
End Function
 
Sub Fairshare(base As Integer, count As Integer)
Console.Write("Base {0,2}:", base)
For i = 1 To count
Dim t = Turn(base, i - 1)
Console.Write(" {0,2}", t)
Next
Console.WriteLine()
End Sub
 
Sub TurnCount(base As Integer, count As Integer)
Dim cnt(base) As Integer
For i = 1 To base
cnt(i - 1) = 0
Next
 
For i = 1 To count
Dim t = Turn(base, i - 1)
cnt(t) += 1
Next
 
Dim minTurn = Integer.MaxValue
Dim maxTurn = Integer.MinValue
Dim portion = 0
For i = 1 To base
Dim num = cnt(i - 1)
If num > 0 Then
portion += 1
End If
If num < minTurn Then
minTurn = num
End If
If num > maxTurn Then
maxTurn = num
End If
Next
 
Console.Write(" With {0} people: ", base)
If 0 = minTurn Then
Console.WriteLine("Only {0} have a turn", portion)
ElseIf minTurn = maxTurn Then
Console.WriteLine(minTurn)
Else
Console.WriteLine("{0} or {1}", minTurn, maxTurn)
End If
End Sub
 
Sub Main()
Fairshare(2, 25)
Fairshare(3, 25)
Fairshare(5, 25)
Fairshare(11, 25)
 
Console.WriteLine("How many times does each get a turn in 50000 iterations?")
TurnCount(191, 50000)
TurnCount(1377, 50000)
TurnCount(49999, 50000)
TurnCount(50000, 50000)
TurnCount(50001, 50000)
End Sub
 
End Module</syntaxhighlight>
{{out}}
<pre>Base 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
Base 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
Base 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
Base 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
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: Only 50000 have a turn</pre>
 
=={{header|V (Vlang)}}==
{{trans|Go}}
<syntaxhighlight lang="v (vlang)">fn fairshare(n int, base int) []int {
mut res := []int{len: n}
for i in 0..n {
mut j := i
mut sum := 0
for j > 0 {
sum += j % base
j /= base
}
res[i] = sum % base
}
return res
}
fn turns(n int, fss []int) string {
mut m := map[int]int{}
for fs in fss {
m[fs]++
}
mut m2 := map[int]int{}
for _,v in m {
m2[v]++
}
mut res := []int{}
mut sum := 0
for k, v in m2 {
sum += v
res << k
}
if sum != n {
return "only $sum have a turn"
}
res.sort()
mut res2 := []string{len: res.len}
for i,_ in res {
res2[i] = '${res[i]}'
}
return res2.join(" or ")
}
fn main() {
for base in [2, 3, 5, 11] {
println("${base:2} : ${fairshare(25, base):2}")
}
println("\nHow many times does each get a turn in 50000 iterations?")
for base in [191, 1377, 49999, 50000, 50001] {
t := turns(base, fairshare(50000, base))
println(" With $base people: $t")
}
}</syntaxhighlight>
 
{{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]
 
How many times does each get a turn in 50000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: only 50000 have a turn
</pre>
 
=={{header|Wren}}==
{{trans|Go}}
{{libheader|Wren-fmt}}
{{libheader|Wren-sort}}
<syntaxhighlight lang="wren">import "./fmt" for Fmt
import "./sort" for Sort
 
var fairshare = Fn.new { |n, base|
var res = List.filled(n, 0)
for (i in 0...n) {
var j = i
var sum = 0
while (j > 0) {
sum = sum + (j%base)
j = (j/base).floor
}
res[i] = sum % base
}
return res
}
 
var turns = Fn.new { |n, fss|
var m = {}
for (fs in fss) {
var k = m[fs]
if (!k) {
m[fs] = 1
} else {
m[fs] = k + 1
}
}
var m2 = {}
for (k in m.keys) {
var v = m[k]
var k2 = m2[v]
if (!k2) {
m2[v] = 1
} else {
m2[v] = k2 + 1
}
}
var res = []
var sum = 0
for (k in m2.keys) {
var v = m2[k]
sum = sum + v
res.add(k)
}
if (sum != n) return "only %(sum) have a turn"
Sort.quick(res)
var res2 = List.filled(res.count, "")
for (i in 0...res.count) res2[i] = res[i].toString
return res2.join(" or ")
}
 
for (base in [2, 3, 5, 11]) {
Fmt.print("$2d : $2d", base, fairshare.call(25, base))
}
System.print("\nHow many times does each get a turn in 50,000 iterations?")
for (base in [191, 1377, 49999, 50000, 50001]) {
var t = turns.call(base, fairshare.call(50000, base))
Fmt.print(" With $5d people: $s", base, t)
}</syntaxhighlight>
 
{{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
 
How many times does each get a turn in 50,000 iterations?
With 191 people: 261 or 262
With 1377 people: 36 or 37
With 49999 people: 1 or 2
With 50000 people: 1
With 50001 people: only 50000 have a turn
</pre>
 
=={{header|XPL0}}==
<syntaxhighlight lang="xpl0">proc Fair(Base); \Show first 25 terms of fairshare sequence
int Base, Count, Sum, N, Q;
[RlOut(0, float(Base)); Text(0, ": ");
for Count:= 0 to 25-1 do
[Sum:= 0; N:= Count;
while N do
[Q:= N/Base;
Sum:= Sum + rem(0);
N:= Q;
];
RlOut(0, float(rem(Sum/Base)));
];
CrLf(0);
];
 
[Format(3,0);
Fair(2); Fair(3); Fair(5); Fair(11);
]</syntaxhighlight>
 
{{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
</pre>
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl">fcn fairShare(n,b){ // b<=36
n.pump(List,'wrap(n){ n.toString(b).split("").apply("toInt",b).sum(0)%b })
}
foreach b in (T(2,3,5,11)){
println("%2d: %s".fmt(b,fairShare(25,b).pump(String,"%2d ".fmt)));
}</langsyntaxhighlight>
{{out}}
<pre>
Line 776 ⟶ 2,811:
</pre>
For any base > 1
<langsyntaxhighlight lang="zkl">fcn fairShare(n,base){
sum,r := 0,0; while(n){ n,r = n.divr(base); sum+=r }
sum%base
Line 782 ⟶ 2,817:
foreach b in (T(2,3,5,11)){
println("%2d: %s".fmt(b,[0..24].pump(String,fairShare.fp1(b),"%2d ".fmt)));
}</langsyntaxhighlight>
Aspen138
338

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/297991...354061"