富の再配分 - bonotakeの日記

http://d.hatena.ne.jp/m-hiyama/20060701/1151716681より。

任意のネットワークで考えるのは面倒なので、リストでやってみました。つまり、N人の人が一列に並んでいて、隣同士の人だけ「知っている」ような、元の問題のサブセット。
初期値のリストを与えると、その先頭から順に「富の再配分」をしていきます。
それを100回繰り返した結果をCSV形式で吐き出す、そんなHaskellのコード。きれいじゃないけど。

import Char
import System

times = 100

share :: [Float] -> [Float]
share [] = []
share xs@(x:[]) = xs
share (x:y:ys) |  x > y = (2/3*x):(share ((1/3*x + y):ys))
               |  x < y = (1/3*y + x):(share ((2/3*y):ys))
               | otherwise = x:(share (y:ys))

multiplicate :: Int -> (a -> a) -> a -> a
multiplicate 0 _ = id
multiplicate n f = f.(multiplicate (n-1) f)

showCSV :: Show a => [[a]] -> String
showCSV rs = foldl1 (\x y -> x ++ "\n" ++ y)  $ map showRowCSV rs
 where showRowCSV :: Show a => [a] -> String
       showRowCSV xs = foldl1 (\x y -> x ++ "," ++ y) $ map show xs

getSeq :: [String] -> [Float]
getSeq xs = map (\s -> fromIntegral $ strToInt s 0) xs
 where strToInt :: String -> Integer -> Integer
       strToInt "" a = a
       strToInt (x:xs) a = strToInt xs $ a * 10 + (toInteger $ digitToInt x)

main = do
    xs <- getArgs
    init <- return $ getSeq xs
    putStrLn $ showCSV $ map (\n -> multiplicate n share init) [1..times]

これで得られた、[1,1000] を再配分した結果。

600.5704,400.4299
400.38025,600.62
600.5869,400.41333
400.3913,600.609
600.5943,400.406
400.3962,600.6041
...
400.40002,600.6004
600.60016,400.40027
400.40012,600.60034
600.6002,400.40024
400.40015,600.60034
600.6003,400.40024
...

40回目で（見た目）完全な周期が始まりました。周期2で、約600:400 と約400:600 を繰り返します。（Excelでグラフにでもしようかと思ったけど、このPCにOffice入れてないんだった。）
[1,100,3]の再配分。

34.333336,44.44445,25.222225
49.148155,19.75309,35.09877
32.765438,24.090542,47.144043
21.843626,50.727036,31.429363
38.75264,22.54535,42.702038
…
41.596695,22.151068,40.252388
27.73113,49.434097,26.834927
44.209164,21.97071,37.820282
29.472776,49.31386,25.213522
45.91073,21.917273,36.172157
30.607153,24.8139,48.57911
20.40477,51.20932,32.386074
37.474545,22.7597,43.765923
24.98303,49.83986,29.177282
41.596317,22.15105,40.252808
...

9回周期らしきものが発生しますが、完全に値は一致しませんね。

これを一定値に収束させるには、例えば「所持金の1/3」ではなく「所持金の差の1/3」とすればよいと思われます。実際、さっきのプログラムを、一部次のように書き換えると収束するようになりました。

share (x:y:ys) |  x > y = (x - diff):(share ((y + diff):ys))
               |  x < y = (x + diff):(share ((y - diff):ys))
               | otherwise = x:(share (y:ys))
                where diff = 1/3 * (abs (x-y))

元の問題設定だと、再配分によって配分された側が配分した側を逆に上回る現象が起こっていたので、再配分の額が互いの所持金の差の1/2を下回るようにすれば振動を回避できるのでは、と推測。