ユダヤ人の知恵を借りて資源配分したいときの覚書

ユダヤ人の知恵関数

moratoriamuo

2018年11月9日

ユダヤ人の平等な配分の仕方を自動的にやる方法

【用途】
庭から石油が湧いてきたときを想定してほしい。どうやら年間100万トンの産出ができるようだ。兄弟がそれぞれ権利を主張しており、兄は100万トンの権利を持つと主張しており、弟は50万トンの権利を持つと主張している。権利関係を確かめたところ、二人の主張はどうやら正しい。しかし、二人の権利の総量は150万トンで実際に存在する量の100万トンを超えている。このような場面で、どのように石油を配分するのが良いのだろうか。半分ずつに分けるという方法もあるし、割合に応じて2:1に分ける方法もあるが、ユダヤ人の聖典であるところの『タルムード』が規定する分配方法は少し異なる。このケースでは、75万トンと25万トンに分けられるようだ。石油の量が50万トンだと、25万トンずつになり、石油の量が、石油の量が120万トンだと、85万トンと35万トンになる。
この配分方法は一見不思議に見えるが整合性がある。詳しくは「タルムードの破産問題」や「ミシュナの分配」、「布争いの原理」、「仁（nucleolus）」といったキーワードで調べてほしい。
ここでは、その原理に従って、配分量を楽に計算したくなることがある。そんなときのための関数を作成した。

【内容】
JewishAllocという関数を作成した。引数にはtotalとvdemandをとり、totalには分配対象となるものの総量が入り、vdemandにはそれぞれの権利者の正しい権利の量のベクトルが入る。出力として、その権利者の番号とその人に対応する分配量が書かれたデータフレームが出てくる。
パッケージとして、dplyrとmagrittrが読み込まれるが、コードが書きやすいから使用している。使わなくても、該当箇所を書き換えることは難しくはないだろう。

JewishAlloc <- function(total,vdemand){
  #Loading Packages
  library(dplyr)
  library(magrittr)
  #sum of demand
  sdemand <- sum(vdemand)
  #number of people
  n <- length(vdemand)
  #data.frame
  dfdemand <- data.frame(no = 1:n ,
                       D = vdemand,
                       halfD = vdemand/2,
                       A = rep(0,n))
  counter <- 1 #initial counter
  hw <- 0 #initial height of water (metaphor)
  skip <- 0 #0は通常の配分処理を行う。1はdemand通りに配分。2は設定に問題あり。
  dfdemand <- dfdemand %>% arrange(D) #sort by amount
  if(sdemand <= total){
    #If: sdemand > total -> vallocation = vdemand
    dfdemand$A <- dfdemand$D
    skip <- 1
    } else if(0 < total & total < sdemand/2){
      #If: 0 < total <  sdemand/2
      remain <- total #initial remain
      reverse <- 0
      } else if(sdemand/2 <= total & total< sdemand){
        #If: sdemand/2 < total < sdemand
        remain <- sdemand - total #initial remain reverse
        #(空気を水に,水を空気にのイメージ)
        reverse <- 1
        } else{skip <- 2}
  if(skip == 0){
    while((n - counter + 1)*(dfdemand$halfD[counter] - hw) < remain){
      hw <- dfdemand$halfD[counter]
      remain <- remain - hw*(n-counter+1)
      dfdemand$A[counter] <- hw
      counter <- counter + 1
      }
    #dfに逐一入れる。0のとこに最後追加。
    dfdemand$A <- ifelse(dfdemand$A==0, hw + remain/(n- counter + 1), dfdemand$A)
    #reverseが1なら引き算
    if(reverse == 1){
      dfdemand$A <- dfdemand$D - dfdemand$A
    }
    }
  #no でdfをarrangeして元に戻す。
  dfdemand <- dfdemand %>% arrange(no)
  colnames(dfdemand) <- c("no","D","halfD","Alloc")
  if(skip == 2){
    print("something wrong!")
    }else{return(dfdemand[c("no","Alloc")])}
}

アイデアのイメージとしては、需要量の多い順に並べて、半分に分けて、上下に貼り付けた筒をつくり、横をくりぬいた箱をつくる。上から水を流してやると、その通りの配分となるイメージだ。hwという変数は水の高さを上げていくイメージ。remainは徐々に水面を上げていってまだ水がどのくらい残っているのかを表している。次の高さまでいけないくらいのremainになったら、等分してやるといった具合だ。reverseという変数は、半分を越したところの計算は対称性を利用してあげると上手くいくので、そのようにしている。空気を水に、水を空気にして計算したあと、対称性を用いて元に戻す感覚だ。(たぶんここのパラグラフは文字だけでは人に伝わりにくいとは思う。)

最初の石油のケースを試してみる。最初の使用ではパッケージの読み込みの出力が出てくる。

t <- 100
vd <- c(100,50)
JewishAlloc(total = t, vdemand = vd)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

##   no Alloc
## 1  1    75
## 2  2    25

二番目のケース。

t <- 50
vd <- c(100,50)
JewishAlloc(total = t, vdemand = vd)

##   no Alloc
## 1  1    25
## 2  2    25

三番目のケース

t <- 120
vd <- c(100,50)
JewishAlloc(total = t, vdemand = vd)

##   no Alloc
## 1  1    85
## 2  2    35

想定通りの出力が出ている。権利の総量に対して十分な量がある場合は、需要量分全てが配分される。変なケースが出るときは、something wrongが出力されるようにした。たとえば、totalが負の値のときは、

t <- -200
vd <- c(100,50)
JewishAlloc(total = t, vdemand = vd)

## [1] "something wrong!"

となる。

権利の主張者が二人より多いときでも配分は出力されるように作成されている。たとえば、四人兄弟で、総量が150、それぞれの主張が100,75,50,25の場合は

t <- 150
vd <- c(100,75,50,25)
JewishAlloc(total = t, vdemand = vd)

##   no Alloc
## 1  1  87.5
## 2  2  62.5
## 3  3  25.0
## 4  4  12.5

となる。

【記憶の検索キーワード】
ユダヤ人, 配分, 知恵, 遺産, 布, タルムード, ミシュナ, 仁(nucleolus), 水を落とすイメージ