확률 가중 함수와 가치함수

Behavioral economics:Probability-weighted and value functions

• TESTTEXT.
  TESTTEXT

확률가중함수
확률에 대해 사람들이 가중치를 두어 생각한다는 것을 보여주는 함수
가치함수
사람의 손실회피 성향을 보여주는 것으로, 손실에 대해서 더 많은 가치 부여를 보이는 경향을 보임

library(dplyr)
#확률 가중 함수
w_p = function(p,r=0.65){
  if(p<0){
    k = p * (-1)
    return((k**r)/((k**r)+(1-k)**r)**(1/r)*(-1) * 2.25)
  }
  if(p>0){
    return((p**r)/((p**r)+(1-p)**r)**(1/r))
  }
  if(p==0){
    return(0)
  }
}

# 가치 함수
value_f = function(x){
    if(x>=0){
        y = x**0.88
    }
    if(x<0){
        y = -2.25*(-x)**0.88
    }
    return(y)
}

#확률리스트 생성
p_list = seq(-1,1,by=0.01)
p_df = data.frame(p_list)
p_df$W_P = unlist(Map(w_p, abs(p_list)))
p_df$VALUE_F = unlist(Map(value_f, p_list))
p_df$FELL_VALUE = p_df$W_P*p_df$VALUE_F
#head(p_df)
p_df_reform = tidyr::gather(p_df, key="TYPE",value='value',-p_list) %>% filter(TYPE!='W_P')

library(ggplot2)
ggplot() + geom_point(data=p_df_reform, aes(x=p_list, y=value, group=TYPE, col=TYPE))+
  geom_point(data=p_df_reform, aes(x=p_list, y=p_list), col='grey')+
  xlab('real prob(%)')+
  ylab('Probability of feeling') + theme_bw()

---