相対的貧困率の例

weibull_median.R

#browseURL("https://en.wikipedia.org/wiki/Weibull_distribution")

median_weibull <- function(shape, scale=1){
  ln2 = log(2)
  scale * (ln2^(1/shape))  
}

relativepoverty <- function(shape, scale=1){
  pweibull(0.5*median_weibull(shape, scale), shape, scale)
}

segments2 <- function(x, y, ...){
  segments(x, 0, x, y, ...)
  segments(0, y, x, y, ...)
}

arrows2 <- function(x, y, dir, ...){
  if(dir=="end"){
    arrows(x, 0, x, y, code=1, ...)
    arrows(0, y, x, y, code=0, ...)
  }
  if(dir=="start"){
    arrows(x, 0, x, y, code=0, ...)
    arrows(0, y, x, y, code=1,...)
  }
}

med1 = median_weibull(0.5)
pm1 = pweibull(med1,0.5)
rp1 = relativepoverty(0.5)

med2 = median_weibull(2)
pm2 = pweibull(med2,2)
rp2 = relativepoverty(2)

png("dist1.png", width = 600, height = 600)
par(family="Osaka")
curve(pweibull(x,0.5), from = 0, to=10, ylim=c(0,1),
      ylab="分布関数", xlab="所得", n=501)
arrows2(med1, pm1, col="royalblue", dir="end", length=0.1, lwd=2, lty=3)
arrows2(med1/2, rp1, dir="start", col="orangered", length=0.1, lwd=2)
legend("bottomright",c("中央値", "相対的貧困率"),
       lwd=2, lty=c(3,1),
       col=c("royalblue","orangered"))
dev.off()

png("dist2.png", width = 600, height = 600)
par(family="Osaka")
curve(pweibull(x,2),from = 0, to=10, ylim=c(0,1),
      ylab="分布関数", xlab="所得", n=501)
arrows2(med2, pm2, col="royalblue", dir="end", length=0.1, lwd=2, lty=3)
arrows2(med2/2, rp2, dir="start", col="orangered", length=0.1, lwd=2)
legend("bottomright",c("中央値", "相対的貧困率"),
       lwd=2, lty=c(3,1),
       col=c("royalblue","orangered"))
dev.off()


png("dist1.png", width = 600, height = 600)
par(family="Osaka")
curve(pweibull(x,0.5,lower.tail = FALSE), from = 0, to=5, ylim=c(0,1),
      ylab="補分布関数", xlab="所得", n=501)
arrows2(med1, pm1, col="royalblue", dir="end", length=0.1, lwd=2, lty=3)
arrows2(med1/2, rp1, dir="start", col="orangered", length=0.1, lwd=2)
legend("topright",c("中央値", "相対的貧困率"),
       lwd=2, lty=c(3,1),
       col=c("royalblue","orangered"))
dev.off()

png("dist2.png", width = 600, height = 600)
par(family="Osaka")
curve(pweibull(x,2,lower.tail = FALSE),from = 0, to=5, ylim=c(0,1),
      ylab="補分布関数", xlab="所得", n=501)
arrows2(med2, pm2, col="royalblue", dir="end", length=0.1, lwd=2, lty=3)
arrows2(med2/2, rp2, dir="start", col="orangered", length=0.1, lwd=2)
legend("topright",c("中央値", "相対的貧困率"),
       lwd=2, lty=c(3,1),
       col=c("royalblue","orangered"))
dev.off()