Fairshare between two and more: Difference between revisions
Content added Content deleted
(Added XPL0 example.) |
No edit summary |
||
| Line 2,109: | Line 2,109: | ||
With 50000 people: 1 |
With 50000 people: 1 |
||
With 50001 people: Only 50000 have a turn</pre> |
With 50001 people: Only 50000 have a turn</pre> |
||
=={{header|Vlang}}== |
|||
{{trans|Go}} |
|||
<lang 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") |
|||
} |
|||
}</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] |
|||
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}}== |
=={{header|Wren}}== |
||
Revision as of 12:50, 10 June 2022
You are encouraged to solve this task according to the task description, using any language you may know.
The Thue-Morse sequence is a sequence of ones and zeros that if two people take turns in the given order, the first persons turn for every '0' in the sequence, the second for every '1'; then this is shown to give a fairer, more equitable sharing of resources. (Football penalty shoot-outs for example, might not favour the team that goes first as much if the penalty takers take turns according to the Thue-Morse sequence and took 2^n penalties)
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,
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
- Related tasks
11l
<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])</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
AppleScript
<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</lang>
- Output:
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]
Arturo
<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
]</lang>
- Output:
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
C
<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;
}</lang>
- Output:
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
C++
<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;
}</lang>
- Output:
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
D
<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);
}</lang>
- Output:
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
Factor
<lang factor>USING: formatting kernel math math.parser sequences ;
- nth-fairshare ( n base -- m )
[ >base string>digits sum ] [ mod ] bi ;
- <fairshare> ( n base -- seq )
[ nth-fairshare ] curry { } map-integers ;
{ 2 3 5 11 } [ 25 over <fairshare> "%2d -> %u\n" printf ] each</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 }
FreeBASIC
<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 </lang>
- Output:
Igual que la entrada de Visual Basic .NET.
Go
<lang go>package main
import (
"fmt" "sort" "strconv" "strings"
)
func fairshare(n, base int) []int {
res := make([]int, n)
for i := 0; i < n; i++ {
j := i
sum := 0
for j > 0 {
sum += j % base
j /= base
}
res[i] = sum % base
}
return res
}
func turns(n int, fss []int) string {
m := make(map[int]int)
for _, fs := range fss {
m[fs]++
}
m2 := make(map[int]int)
for _, v := range m {
m2[v]++
}
res := []int{}
sum := 0
for k, v := range m2 {
sum += v
res = append(res, k)
}
if sum != n {
return fmt.Sprintf("only %d have a turn", sum)
}
sort.Ints(res)
res2 := make([]string, len(res))
for i := range res {
res2[i] = strconv.Itoa(res[i])
}
return strings.Join(res2, " or ")
}
func main() {
for _, base := range []int{2, 3, 5, 11} {
fmt.Printf("%2d : %2d\n", base, fairshare(25, base))
}
fmt.Println("\nHow many times does each get a turn in 50000 iterations?")
for _, base := range []int{191, 1377, 49999, 50000, 50001} {
t := turns(base, fairshare(50000, base))
fmt.Printf(" With %d people: %s\n", base, t)
}
}</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] 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
Haskell
<lang haskell>import Data.Bool (bool) import Data.List (intercalate, unfoldr) import Data.Tuple (swap)
FAIR SHARE BETWEEN TWO AND MORE ------------
thueMorse :: Int -> [Int] thueMorse base = baseDigitsSumModBase base <$> [0 ..]
baseDigitsSumModBase :: Int -> Int -> Int baseDigitsSumModBase base n =
mod
( sum $
unfoldr
( 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"
)
show
( ('[' :) . (<> "]") . intercalate ","
. fmap show
)
(take 25 . thueMorse)
[2, 3, 5, 11]
DISPLAY ------------------------
fTable ::
String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
fTable s xShow fxShow f xs =
unlines $
s :
fmap
( ((<>) . justifyRight w ' ' . xShow)
<*> ((" -> " <>) . fxShow . f)
)
xs
where
w = maximum (length . xShow <$> xs)
justifyRight :: Int -> Char -> String -> String justifyRight n c = (drop . length) <*> (replicate n c <>)</lang>
- Output:
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]
J
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|
+-------+-------+-------+-------+-------+------+------+------+------+------+-------+
Java
<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;
}
} </lang>
- Output:
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]
JavaScript
<lang javascript>(() => {
'use strict';
// thueMorse :: Int -> [Int]
const thueMorse = base =>
// Thue-Morse sequence for a given base
fmapGen(baseDigitsSumModBase(base))(
enumFrom(0)
)
// baseDigitsSumModBase :: Int -> Int -> Int
const baseDigitsSumModBase = base =>
// For any integer n, the sum of its digits
// in a given base, modulo that base.
n => sum(unfoldl(
x => 0 < x ? (
Just(quotRem(x)(base))
) : Nothing()
)(n)) % base
// ------------------------TEST------------------------
const main = () =>
console.log(
fTable(
'First 25 fairshare terms for a given number of players:'
)(str)(
xs => '[' + map(
compose(justifyRight(2)(' '), str)
)(xs) + ' ]'
)(
compose(take(25), thueMorse)
)([2, 3, 5, 11])
);
// -----------------GENERIC FUNCTIONS------------------
// Just :: a -> Maybe a
const Just = x => ({
type: 'Maybe',
Nothing: false,
Just: x
});
// Nothing :: Maybe a
const Nothing = () => ({
type: 'Maybe',
Nothing: true,
});
// Tuple (,) :: a -> b -> (a, b)
const Tuple = a => b => ({
type: 'Tuple',
'0': a,
'1': b,
length: 2
});
// compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
const compose = (...fs) =>
x => fs.reduceRight((a, f) => f(a), x);
// enumFrom :: Enum a => a -> [a]
function* enumFrom(x) {
// A non-finite succession of enumerable
// values, starting with the value x.
let v = x;
while (true) {
yield v;
v = 1 + v;
}
}
// fTable :: String -> (a -> String) -> (b -> String)
// -> (a -> b) -> [a] -> String
const fTable = s => xShow => fxShow => f => xs => {
// Heading -> x display function ->
// fx display function ->
// f -> values -> tabular string
const
ys = xs.map(xShow),
w = Math.max(...ys.map(length));
return s + '\n' + zipWith(
a => b => a.padStart(w, ' ') + ' -> ' + b
)(ys)(
xs.map(x => fxShow(f(x)))
).join('\n');
};
// fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
const fmapGen = f =>
function*(gen) {
let v = take(1)(gen);
while (0 < v.length) {
yield(f(v[0]))
v = take(1)(gen)
}
};
// justifyRight :: Int -> Char -> String -> String
const justifyRight = n =>
// The string s, preceded by enough padding (with
// the character c) to reach the string length n.
c => s => n > s.length ? (
s.padStart(n, c)
) : s;
// length :: [a] -> Int
const length = xs =>
// Returns Infinity over objects without finite
// length. This enables zip and zipWith to choose
// the shorter argument when one is non-finite,
// like cycle, repeat etc
(Array.isArray(xs) || 'string' === typeof xs) ? (
xs.length
) : Infinity;
// map :: (a -> b) -> [a] -> [b]
const map = f =>
// The list obtained by applying f to each element of xs.
// (The image of xs under f).
xs => (Array.isArray(xs) ? (
xs
) : xs.split()).map(f);
// quotRem :: Int -> Int -> (Int, Int)
const quotRem = m => n =>
Tuple(Math.floor(m / n))(
m % n
);
// str :: a -> String const str = x => x.toString();
// sum :: [Num] -> Num
const sum = xs =>
// The numeric sum of all values in xs.
xs.reduce((a, x) => a + x, 0);
// take :: Int -> [a] -> [a]
// take :: Int -> String -> String
const take = n =>
// The first n elements of a list,
// string of characters, or stream.
xs => 'GeneratorFunction' !== xs
.constructor.constructor.name ? (
xs.slice(0, n)
) : [].concat.apply([], Array.from({
length: n
}, () => {
const x = xs.next();
return x.done ? [] : [x.value];
}));
// unfoldl :: (b -> Maybe (b, a)) -> b -> [a]
const unfoldl = f => v => {
// Dual to reduce or foldl.
// Where these reduce a list to a summary value, unfoldl
// builds a list from a seed value.
// Where f returns Just(a, b), a is appended to the list,
// and the residual b is used as the argument for the next
// application of f.
// Where f returns Nothing, the completed list is returned.
let
xr = [v, v],
xs = [];
while (true) {
const mb = f(xr[0]);
if (mb.Nothing) {
return xs
} else {
xr = mb.Just;
xs = [xr[1]].concat(xs);
}
}
};
// zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
const zipWith = f =>
xs => ys => {
const
lng = Math.min(length(xs), length(ys)),
vs = take(lng)(ys);
return take(lng)(xs)
.map((x, i) => f(x)(vs[i]));
};
// MAIN --- return main();
})();</lang>
- Output:
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 ]
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. <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)])" </lang>
- Output:
As for Julia.
Julia
<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
</lang>
- Output:
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] Fairshare among 3 people: [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] Fairshare among 5 people: [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] Fairshare among 11 people: [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]
Kotlin
<lang scala>fun turn(base: Int, n: Int): Int {
var sum = 0
var n2 = n
while (n2 != 0) {
val re = n2 % base
n2 /= base
sum += re
}
return sum % base
}
fun fairShare(base: Int, count: Int) {
print(String.format("Base %2d:", base))
for (i in 0 until count) {
val t = turn(base, i)
print(String.format(" %2d", t))
}
println()
}
fun turnCount(base: Int, count: Int) {
val cnt = IntArray(base) { 0 }
for (i in 0 until count) {
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)
} </lang>
- Output:
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
Lua
<lang lua>function turn(base, n)
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)
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)
local cnt = {}
for i=1,base do
cnt[i - 1] = 0
end
for i=1,count do
local t = turn(base, i - 1)
if cnt[t] ~= nil then
cnt[t] = cnt[t] + 1
else
cnt[t] = 1
end
end
local minTurn = count
local maxTurn = -count
local portion = 0
for _,num in pairs(cnt) do
if num > 0 then
portion = portion + 1
end
if num < minTurn then
minTurn = num
end
if maxTurn < num then
maxTurn = num
end
end
io.write(string.format(" With %d people: ", base))
if minTurn == 0 then
print(string.format("Only %d have a turn", portion))
elseif minTurn == maxTurn then
print(minTurn)
else
print(minTurn .. " or " .. maxTurn)
end
end
function main()
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)
end
main()</lang>
- Output:
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
Mathematica / Wolfram Language
<lang Mathematica>ClearAll[Fairshare] Fairshare[n_List, b_Integer : 2] := Fairshare[#, b] & /@ n Fairshare[n_Integer, b_Integer : 2] := Mod[Total[IntegerDigits[n, b]], b] Fairshare[Range[0, 24], 2] Fairshare[Range[0, 24], 3] Fairshare[Range[0, 24], 5] Fairshare[Range[0, 24], 11]</lang>
- Output:
{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}
Nim
<lang Nim>import math, strutils
- ---------------------------------------------------------------------------------------------------
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(" ")</lang>
- Output:
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
Perl
<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);
}</lang>
- Output:
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
Phix
function fairshare(integer n, base) sequence res = repeat(0,n) for i=1 to n do integer j = i-1, t = 0 while j>0 do t += remainder(j,base) j = floor(j/base) end while res[i] = remainder(t,base) end for return {base,res} end function constant tests = {2,3,5,11} for i=1 to length(tests) do printf(1,"%2d : %v\n", fairshare(25, tests[i])) end for
- 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}
Python
Procedural
<lang python>from itertools import count, islice
def _basechange_int(num, b):
""" Return list of ints representing positive num in base b
>>> b = 3
>>> print(b, [_basechange_int(num, b) for num in range(11)])
3 [[0], [1], [2], [1, 0], [1, 1], [1, 2], [2, 0], [2, 1], [2, 2], [1, 0, 0], [1, 0, 1]]
>>>
"""
if num == 0:
return [0]
result = []
while num != 0:
num, d = divmod(num, b)
result.append(d)
return result[::-1]
def fairshare(b=2):
for i in count():
yield sum(_basechange_int(i, b)) % b
if __name__ == '__main__':
for b in (2, 3, 5, 11):
print(f"{b:>2}: {str(list(islice(fairshare(b), 25)))[1:-1]}")</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
Functional
<lang python>Fairshare between two and more
from itertools import count, islice from functools import reduce
- thueMorse :: Int -> [Int] -> [Int]
def thueMorse(base):
Thue-Morse sequence for a given base.
return fmapNext(baseDigitsSumModBase(base))(
count(0)
)
- baseDigitsSumModBase :: Int -> Int -> Int
def baseDigitsSumModBase(base):
For any integer n, the sum of its digits
in a given base, modulo that base.
def go(n):
return sum(unfoldl(
lambda x: Just(divmod(x, base)) if 0 < x else Nothing()
)(n)) % base
return go
- -------------------------- TEST --------------------------
- main :: IO ()
def main():
First 25 fairshare terms for a given number of players
print(
fTable(
main.__doc__ + ':\n'
)(repr)(
lambda xs: '[' + ','.join(
[str(x).rjust(2, ' ') for x in xs]
) + ' ]'
)(
compose(take(25), thueMorse)
)([2, 3, 5, 11])
)
- ------------------------ GENERIC -------------------------
- Just :: a -> Maybe a
def Just(x):
Constructor for an inhabited Maybe (option type) value.
Wrapper containing the result of a computation.
return {'type': 'Maybe', 'Nothing': False, 'Just': x}
- Nothing :: Maybe a
def Nothing():
Constructor for an empty Maybe (option type) value.
Empty wrapper returned where a computation is not possible.
return {'type': 'Maybe', 'Nothing': True}
- compose :: ((a -> a), ...) -> (a -> a)
def compose(*fs):
Composition, from right to left,
of a series of functions.
def go(f, g):
def fg(x):
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
- fTable :: String -> (a -> String) ->
- (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
Heading -> x display function -> fx display function ->
f -> xs -> tabular string.
def go(xShow, fxShow, f, xs):
ys = [xShow(x) for x in xs]
w = max(map(len, ys))
return s + '\n' + '\n'.join(map(
lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)),
xs, ys
))
return lambda xShow: lambda fxShow: lambda f: lambda xs: go(
xShow, fxShow, f, xs
)
- identity :: a -> a
def identity(x):
The identity function. return x
- take :: Int -> [a] -> [a]
- take :: Int -> String -> String
def take(n):
The prefix of xs of length n,
or xs itself if n > length xs.
return lambda xs: (
xs[0:n]
if isinstance(xs, (list, tuple))
else list(islice(xs, n))
)
- unfoldl(lambda x: Just(((x - 1), x)) if 0 != x else Nothing())(10)
- -> [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
- unfoldl :: (b -> Maybe (b, a)) -> b -> [a]
def unfoldl(f):
Dual to reduce or foldl.
Where these reduce a list to a summary value, unfoldl
builds a list from a seed value.
Where f returns Just(a, b), a is appended to the list,
and the residual b is used as the argument for the next
application of f.
When f returns Nothing, the completed list is returned.
def go(v):
x, r = v, v
xs = []
while True:
mb = f(x)
if mb['Nothing']:
return xs
else:
x, r = mb['Just']
xs.insert(0, r)
return xs
return go
- MAIN ---
if __name__ == '__main__':
main()</lang>
- Output:
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 ]
Quackery
digitsum is defined at Sum digits of an integer.
<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 ]</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
Racket
<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))</lang>
- Output:
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)
Raku
(formerly Perl 6)
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.
<lang perl6>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;
}
}</lang>
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
REXX
Programming note: the base function (as coded herein) handles bases from base ten up to 36. <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.*/ if g= | g="," then g= 2 3 5 11 /* " " " " " " */
/* [↑] a list of a number of peoples. */
do p=1 for words(g); r= word(g, p) /*traipse through the bases specfiied. */
$= 'base' right(r, 2)': ' /*construct start of the 1─line output.*/
do j=0 for n; $= $ right( sumDigs( base(j, r)) // r, 2)','
end /*j*/ /* [↑] append # (base R) mod R──►$ list*/
say strip($, , ",") /*elide trailing comma from the $ list.*/
end /*p*/
exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ base: parse arg #,b,,y; @= 0123456789abcdefghijklmnopqrstuvwxyz; @@= substr(@,2)
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 !</lang>
- output when using the default inputs:
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
Ring
<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 + "]"
</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]
Ruby
<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()</lang>
- Output:
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
Rust
<lang rust>struct Digits {
rest: usize, base: usize,
}
impl Iterator for Digits {
type Item = usize;
fn next(&mut self) -> Option<usize> {
if self.rest == 0 {
return None;
}
let (digit, rest) = (self.rest % self.base, self.rest / self.base);
self.rest = rest;
Some(digit)
}
}
fn digits(num: usize, base: usize) -> Digits {
Digits { rest: num, base: base }
}
struct FairSharing {
participants: usize, index: usize,
}
impl Iterator for FairSharing {
type Item = usize;
fn next(&mut self) -> Option<usize> {
let digit_sum: usize = digits(self.index, self.participants).sum();
let selected = digit_sum % self.participants;
self.index += 1;
Some(selected)
}
}
fn fair_sharing(participants: usize) -> FairSharing {
FairSharing { participants: participants, index: 0 }
}
fn main() {
for i in vec![2, 3, 5, 7] {
println!("{}: {:?}", i, fair_sharing(i).take(25).collect::<Vec<usize>>());
}
}</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] 7: [0, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 0, 2, 3, 4, 5, 6, 0, 1, 3, 4, 5, 6]
Sidef
<lang ruby>for b in (2,3,5,11) {
say ("#{'%2d' % b}: ", 25.of { .sumdigits(b) % b })
}</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]
Visual Basic .NET
<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</lang>
- Output:
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
Vlang
<lang 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")
}
}</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] 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
Wren
<lang ecmascript>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)
}</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 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
XPL0
<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); ]</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
zkl
<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)));
}</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
For any base > 1 <lang zkl>fcn fairShare(n,base){
sum,r := 0,0; while(n){ n,r = n.divr(base); sum+=r }
sum%base
} foreach b in (T(2,3,5,11)){
println("%2d: %s".fmt(b,[0..24].pump(String,fairShare.fp1(b),"%2d ".fmt)));
}</lang>