政治資金収支報告書のプログラム

先日のアルゴリズムを実装してみました。
といっても、実際のデータは諸般の事情により利用できないので、サンプルデータを使っての実装です。

• • • -

テストデータは、４つの団体が含まれます。

• Poli_A - 政党Ａ
• Poli_B - 政治家Ｂ
• Poli_C - 政治家Ｃ
• Poli_D - ロビー団体Ｄ

寄付の内訳

	直接の寄付	Poli_Aから	Poli_Bから	Poli_Cから	Poli_Dから
Poli_Aへ	50		20	20	50
Poli_Bへ	30	70			50
Poli_Cへ	30	70
Poli_Dへ	100

表の見方は、たとえば、Poli_Dはロビー団体なので、会員からの寄付のみが収入で、そのお金を他の政治団体に配っています。また、Poli_Aは政党なので、党員の政治家に活動費を配っています。
お金の流れをよく見ると、閉路も含まれています。これは、政治家が政党へ会費を納める一方、政党が政治家に活動費を配るという現象を説明しています。

• • • -

結果は次のようになりました。

収入の内訳

	Poli_A	Poli_B	Poli_C	Poli_D
直接の寄付	50.0	30.0	30.0	100.0
Poli_Aから	10.0	30.0	30.0	0.0
Poli_Bから	4.8	2.4	2.4	0.0
Poli_Cから	7.2	3.6	3.6	0.0
Poli_Dから	68.0	84.0	34.0	0.0
合計	140	150	100	100

これを見ると、政治家Ｂ（Poli_B）が半分以上の収入をロビー団体Ｄ（Poli_D）から得ているほか、政治家Ｃ（Poli_C）も直接は受け取っていませんが、政党を経由して収入の1/3をロビー団体Ｄに依存していることがわかります。
なお、自分自身からも寄付を受け取ったことになっていますが、これは他の団体に寄付したお金が、めぐりめぐってまた自分のところに戻ってきたことを示しているので、バグではありません。

プログラム

module polimoney

import String, StdFile, Misc, List, Real

::Group = {
  name :: String,
  expense :: [(String, Real)],
  income_total :: Real,
  income1 :: Real, // income from people's donation
  income2 :: [(String, Real)]  // [result] income from other political groups
  }

Start w = loop (calc InitialData)
  where
    loop (diff, data) | diff < 0.01 = show data w
                      = loop (calc data)

calc data = let data2 = newdata data in (diff data2 data, data2)
  where
    newdata [] = []
    newdata [group: rest]
      = [{group & income2 = newincome2 group.name}: newdata rest]

    newincome2 target = sortsum [] unsorted
      where
        unsorted = foldr (++) []
                   [foldr (++) []
                      [income_of name income_total v income1 income2
                       \\ (n, v) <- expense | n == target]
                    \\ {name, expense, income_total, income1, income2} <- data]

        income_of name total expense income1 income2
          = [(name, income1 * prop):
             [(n, v * prop) \\ (n, v) <- income2]]
          where
            prop = expense / total

        sortsum re [] = re
        sortsum re [(name, value): rest]
          = sortsum (update re name value) rest

        update [] name value = [(name, value)]
        update [(n0, v0):rest] name value
          | n0 == name = [(name, v0 + value): rest]
          | n0 < name = [(n0, v0): update rest name value]
          = [(name, value), (n0, v0): rest]

    diff [] [] = 0.0
    diff [g0: d0] [g1: d1] = diffincome2 g0.income2 g1.income2 + diff d0 d1

    diffincome2 [] income2 = sum $ map (\(_,v) = v) income2
    diffincome2 income2 [] = sum $ map (\(_,v) = v) income2
    diffincome2 g0`=:[(n0,v0):g0] g1`=:[(n1,v1):g1]
      | n0 == n1 = abs (v0 - v1) + diffincome2 g0 g1
      | n0 < n1 = v0 + diffincome2 g0 g1`
      = v1 + diffincome2 g0` g1

show data w
  # (f, w) = stdio w
    f = foldl writedata f data
    (_, w) = fclose f w
  = w
  where
    writedata f {name, expense, income_total, income1, income2}
      = f |> fwrites name
          |> fwrites "\nTotal Income: "
          |> fwriter income_total
          |> fwrites "\n Direct = "
          |> fwriter income1
          |> (\f = foldl writedetail f income2)
          |> fwrites "\n\n"
    writedetail f (name, value)
      = f |> fwrites "\n "
          |> fwrites name
          |> fwrites " = "
          |> fwriter value

//==== DATA ====//
InitialData = [
  { name = "Poli_A", // party
    expense = [("Poli_B", 70.0), ("Poli_C", 70.0)],
    income_total = 140.0,
    income1 = 50.0,
    income2 = [("*Poli_A", 90.0)] },
  { name = "Poli_B", // politician
    expense = [("Poli_A", 20.0)],
    income_total = 150.0,
    income1 = 30.0,
    income2 = [("*Poli_B", 120.0)] },
  { name = "Poli_C", // politician
    expense = [("Poli_A", 20.0)],
    income_total = 100.0,
    income1 = 30.0,
    income2 = [("*Poli_C", 70.0)] },
  { name = "Poli_D", // lobby
    expense = [("Poli_A", 50.0), ("Poli_B", 50.0)],
    income_total = 100.0,
    income1 = 100.0,
    income2 = [] }
  ]

実行結果

$ ./polimoney 
Poli_A
Total Income: 140
 Direct = 50
 *Poli_A = 0.000321502057613169
 Poli_A = 9.99996427754915
 Poli_B = 4.79998285322359
 Poli_C = 7.19997427983539
 Poli_D = 67.9997570873342

Poli_B
Total Income: 150
 Direct = 30
 *Poli_B = 0.000171467764060357
 *Poli_C = 0.000150034293552812
 Poli_A = 29.9998928326475
 Poli_B = 2.3999914266118
 Poli_C = 3.5999871399177
 Poli_D = 83.9998070987654

Poli_C
Total Income: 100
 Direct = 30
 *Poli_B = 0.000171467764060357
 *Poli_C = 0.000150034293552812
 Poli_A = 29.9998928326475
 Poli_B = 2.3999914266118
 Poli_C = 3.5999871399177
 Poli_D = 33.9998070987654

Poli_D
Total Income: 100
 Direct = 100