20251007_報告

パッケージの読み込み

library(dplyr)
library(readr)
library(purrr)
library(ggplot2)
library(rlang)
library(patchwork)

データの読み込み

df_original <- read.csv(here::here("data\\cleaned\\20251126_gdp_office_land_pop.csv"))

df_shigai <- read.csv(here::here("data\\cleaned\\20251127_shigai_6cities.csv"))

df_growth_forecast <- read.csv(here::here("data\\cleaned\\202511005_growth_forecast.csv"))

df_office <- read.csv(here::here("data\\cleaned\\20250922_office_forecast.csv"))

データの加工

コンマを外す

df_all <- df_original |>
  mutate(
    gdp_jpn = parse_number(as.character(gdp_jpn)),
    gdp_jpn_pop = parse_number(as.character(gdp_jpn_pop)),
    gdp_jpn_wapop = parse_number(as.character(gdp_jpn_wapop)),
    gdp_tokyo = parse_number(as.character(gdp_tokyo)),
    gdp_tokyo_pop = parse_number(as.character(gdp_tokyo_pop)),
    gdp_tokyo_wapop = parse_number(as.character(gdp_tokyo_wapop)),
    office_tokubu = parse_number(as.character(office_tokubu)),
    land_tokyo = parse_number(as.character(land_tokyo)),
    land_tokubu = parse_number(as.character(land_tokubu))
      )

logをとる

df_all_log <- df_all |>
  mutate(
    log_gdp_jpn = log(gdp_jpn),
    log_gdp_jpn_pop = log(gdp_jpn_pop),
    log_gdp_jpn_wapop = log(gdp_jpn_wapop),
    log_gdp_tokyo = log(gdp_tokyo),
    log_gdp_tokyo_pop = log(gdp_tokyo_pop),
    log_gdp_tokyo_wapop = log(gdp_tokyo_wapop),
    log_office_tokubu = log(office_tokubu),
    log_land_tokyo = log(land_tokyo),
    log_land_tokubu = log(land_tokubu),
  )

ダミー変数を作る

df_all_log_dummy <- df_all_log |>
  mutate(
    I_1975 = ifelse(year == 1975, 1, 0),
    I_1976 = ifelse(year == 1976, 1, 0),
    I_1977 = ifelse(year == 1977, 1, 0),
    I_1978 = ifelse(year == 1978, 1, 0),
    I_1979 = ifelse(year == 1979, 1, 0),
    I_1980 = ifelse(year == 1980, 1, 0),
    I_1981 = ifelse(year == 1981, 1, 0),
    I_1982 = ifelse(year == 1982, 1, 0),
    I_1983 = ifelse(year == 1983, 1, 0),
    I_1984 = ifelse(year == 1984, 1, 0),
    I_1985 = ifelse(year == 1985, 1, 0),
    I_1986 = ifelse(year == 1986, 1, 0),
    I_1987 = ifelse(year == 1987, 1, 0),
    I_1988 = ifelse(year == 1988, 1, 0),
    I_1989 = ifelse(year == 1989, 1, 0),
    I_1990 = ifelse(year == 1990, 1, 0),
    I_1991 = ifelse(year == 1991, 1, 0),
    I_1992 = ifelse(year == 1992, 1, 0),
    I_1993 = ifelse(year == 1993, 1, 0),
    I_1994 = ifelse(year == 1994, 1, 0),
    I_1995 = ifelse(year == 1995, 1, 0),
    I_1996 = ifelse(year == 1996, 1, 0),
    I_1997 = ifelse(year == 1997, 1, 0),
    I_1998 = ifelse(year == 1998, 1, 0),
    I_1999 = ifelse(year == 1999, 1, 0),
    I_2000 = ifelse(year == 2000, 1, 0),
    I_2001 = ifelse(year == 2001, 1, 0),
    I_2002 = ifelse(year == 2002, 1, 0),
    I_2003 = ifelse(year == 2003, 1, 0),
    I_2004 = ifelse(year == 2004, 1, 0),
    I_2005 = ifelse(year == 2005, 1, 0),
    I_2006 = ifelse(year == 2006, 1, 0),
    I_2007 = ifelse(year == 2007, 1, 0),
    I_2008 = ifelse(year == 2008, 1, 0),
    I_2009 = ifelse(year == 2009, 1, 0),
    I_2010 = ifelse(year == 2010, 1, 0)
  )

回帰

モデルの作成

model_make <- function(df, explained_var, start_year, end_year){
  years_dummy <- start_year:end_year
  dummy_vars <- paste0("I_", years_dummy)
  model <- reformulate(c("year", dummy_vars), response = explained_var)
  lm(model, data = df)
}

explained_vars = c(
  "log_gdp_jpn",
  "log_gdp_jpn_pop",
  "log_gdp_jpn_wapop",
  "log_gdp_tokyo",
  "log_gdp_tokyo_pop",
  "log_gdp_tokyo_wapop",
  "log_office_tokubu",
  "log_land_tokyo",
  "log_land_tokubu"
  )

lm_names = c(
  "lm_gdp_jpn_",
  "lm_gdp_jpn_pop_",
  "lm_gdp_jpn_wapop_",
  "lm_gdp_tokyo_",
  "lm_gdp_tokyo_pop_",
  "lm_gdp_tokyo_wapop_",
  "lm_office_tokubu_",
  "lm_land_tokyo_",
  "lm_land_tokubu_"
  )

name_make_lm <- function(lm_names, start_year, end_year){
  paste0(lm_names, start_year, end_year)
}


# データフレームに予測値を追加
## 変数名の前半を作成
trend_names = c(
  "trend_gdp_jpn_",
  "trend_gdp_jpn_pop_",
  "trend_gdp_jpn_wapop_",
  "trend_gdp_tokyo_",
  "trend_gdp_tokyo_pop_",
  "trend_gdp_tokyo_wapop_",
  "trend_office_tokubu_",
  "trend_land_tokyo_",
  "trend_land_tokubu_"
  )

## 変数名の全体を作成する変数を作成
name_make_trend <- function(trend_names, start_year, end_year){
  paste0(trend_names, start_year, end_year)
}

ダミー変数 : 1985年~2010年

# モデルを作る
models_19852010 <- purrr::map(explained_vars, ~ model_make(df_all_log_dummy, .x, 1985, 2010))

# モデルの名前を付け直す
model_names_19852010 <- name_make_lm(lm_names, 1985, 2010)
names(models_19852010) <- model_names_19852010

## 変数名の全体を作成
trend_names_19852010 <- name_make_trend(trend_names, 1985, 2010)

## 予測値を追加
df_all_trend <- df_all_log_dummy |>
  mutate(
    !!!setNames(lapply(models_19852010, predict, newdata = df_all_log_dummy), trend_names_19852010)
  )


## ダミー期間を除く

dummy_cols_19852010 <- paste0("I_", 1975:2010)

# トレンド用の newdata（ダミーを全部 0 にする）
newdata_trend_19852010 <- df_all_log_dummy |>
  mutate(
    across(all_of(dummy_cols_19852010), ~ 0)
  )

df_all_trend_new <- df_all_log_dummy |>
  mutate(
    !!!setNames(
      lapply(models_19852010, predict, newdata = newdata_trend_19852010),
      trend_names_19852010
    )
  )

グラフ

1985~2010

graph_gdp_jpn_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_gdp_jpn, color = "Realized")) +
  geom_line(aes(x = year, y = trend_gdp_jpn_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Japan Actual GDP") +
  annotate("text", x = 2015, y = 12.7, label = "slope = 0.185")


graph_gdp_jpn_pop_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_gdp_jpn_pop, color = "Realized")) +
  geom_line(aes(x = year, y = trend_gdp_jpn_pop_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Japan Actual GDP per Population") +
  annotate("text", x = 2015, y = 1, label = "slope = 0.017")


graph_gdp_jpn_wapop_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_gdp_jpn_wapop, color = "Realized")) +
  geom_line(aes(x = year, y = trend_gdp_jpn_wapop_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Japan Actual GDP per Warking Age Population") +
  annotate("text", x = 2015, y = 1.5, label = "slope = 0.020")


graph_gdp_tokyo_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_gdp_tokyo, color = "Realized")) +
  geom_line(aes(x = year, y = trend_gdp_tokyo_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Tokyo Actual GDP") +
  annotate("text", x = 2015, y = 18, label = "slope = 0.021")


graph_gdp_tokyo_pop_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_gdp_tokyo_pop, color = "Realized")) +
  geom_line(aes(x = year, y = trend_gdp_tokyo_pop_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Tokyo Actual GDP per Population") +
  annotate("text", x = 2015, y = 1.75, label = "slope = 0.016")


graph_gdp_tokyo_wapop_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_gdp_tokyo_wapop, color = "Realized")) +
  geom_line(aes(x = year, y = trend_gdp_tokyo_wapop_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Tokyo Actual GDP per Warking Age Population") +
  annotate("text", x = 2015, y = 2.22, label = "slope = 0.019")


graph_office_tokubu_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_office_tokubu, color = "Realized")) +
  geom_line(aes(x = year, y = trend_office_tokubu_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Tokubu Office") +
  annotate("text", x = 2015, y = 11, label = "slope = 0.025")

graph_land_tokyo_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_land_tokyo, color = "Realized")) +
  geom_line(aes(x = year, y = trend_land_tokyo_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Tokyo Land price") +
  annotate("text", x = 2015, y = 13, label = "slope = 0.033")

graph_land_tokubu_19852010 <- ggplot(data = df_all_trend_new) +
  geom_line(aes(x = year, y = log_land_tokubu, color = "Realized")) +
  geom_line(aes(x = year, y = trend_land_tokubu_19852010, color = "Trend"), linetype = "dashed") +
  labs(title = "Tokubu Land Price") +
  annotate("text", x = 2015, y = 13.5, label = "slope = 0.035")



# graph_gdp_jpn_19852010
# graph_gdp_jpn_pop_19852010
# graph_gdp_jpn_wapop_19852010
# graph_gdp_tokyo_19852010
# graph_gdp_tokyo_pop_19852010
# graph_gdp_tokyo_wapop_19852010
# graph_office_tokubu_19852010
# graph_land_tokyo_19852010
# graph_land_tokubu_19852010

乖離

乖離を計算

df_all_trend_dev <- df_all_trend_new |>
  mutate(
    level_gdp_jpn = (gdp_jpn - exp(trend_gdp_jpn_19852010)) / exp(trend_gdp_jpn_19852010),
    level_gdp_jpn_pop = (gdp_jpn_pop - exp(trend_gdp_jpn_pop_19852010)) / exp(trend_gdp_jpn_pop_19852010),
    level_gdp_jpn_wapop = (gdp_jpn_wapop - exp(trend_gdp_jpn_wapop_19852010)) / exp(trend_gdp_jpn_wapop_19852010),
    level_gdp_tokyo = (gdp_tokyo - exp(trend_gdp_tokyo_19852010)) / exp(trend_gdp_tokyo_19852010),
    level_gdp_tokyo_pop = (gdp_tokyo_pop - exp(trend_gdp_tokyo_pop_19852010)) / exp(trend_gdp_tokyo_pop_19852010),
    level_gdp_tokyo_wapop = (gdp_tokyo_wapop - exp(trend_gdp_tokyo_wapop_19852010)) / exp(trend_gdp_tokyo_wapop_19852010),
    level_office_tokubu = (office_tokubu - exp(trend_office_tokubu_19852010)) / exp(trend_office_tokubu_19852010),
    level_land_tokyo = (land_tokyo - exp(trend_land_tokyo_19852010)) / exp(trend_land_tokyo_19852010),
    level_land_tokubu = (land_tokubu - exp(trend_land_tokubu_19852010)) / exp(trend_land_tokubu_19852010)
  )

グラフ化

graph_gdp_jpn_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_gdp_jpn, color = "Deviation"))+
  labs(title = "Japan Actual GDP Deviation from Trend")

graph_gdp_jpn_pop_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_gdp_jpn_pop, color = "Deviation"))+
  labs(title = "Japan Actual GDP per Population Deviation from Trend")

graph_gdp_jpn_wapop_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_gdp_jpn_wapop, color = "Deviation"))+
  labs(title = "Japan Actual GDP per Warking Age Population Deviation from Trend")

graph_gdp_tokyo_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_gdp_tokyo, color = "Deviation"))+
  labs(title = "Tokyo Actual GDP Deviation from Trend")

graph_gdp_tokyo_pop_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_gdp_tokyo_pop, color = "Deviation"))+
  labs(title = "Tokyo Actual GDP per Population Deviation from Trend")

graph_gdp_tokyo_wapop_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_gdp_tokyo_wapop, color = "Deviation"))+
  labs(title = "Tokyo Actual GDP per Warking Age Population Deviation from Trend")

graph_office_tokubu_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_office_tokubu, color = "Deviation"))+
  labs(title = "Office Tokubu Deviation from Trend")

graph_land_tokyo_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_land_tokyo, color = "Deviation"))+
  labs(title = "Land Tokyo GDP Deviation from Trend")

graph_land_tokubu_19852010_dev <- ggplot(data = df_all_trend_dev) +
  geom_line(aes(x = year, y = level_land_tokubu, color = "Deviation"))+
  labs(title = "Land Tokubu GDP Deviation from Trend")


# graph_gdp_jpn_19852010_dev
# graph_gdp_jpn_pop_19852010_dev
# graph_gdp_jpn_wapop_19852010_dev
# graph_gdp_tokyo_19852010_dev
# graph_gdp_tokyo_pop_19852010_dev
# graph_gdp_tokyo_wapop_19852010_dev
# graph_land_tokyo_19852010_dev
# graph_land_tokubu_19852010_dev

グラフを並べる

wrap_plots(
  graph_gdp_jpn_19852010,
  graph_gdp_jpn_19852010_dev,
  graph_gdp_jpn_pop_19852010,
  graph_gdp_jpn_pop_19852010_dev,
  graph_gdp_jpn_wapop_19852010,
  graph_gdp_jpn_wapop_19852010_dev,
  graph_gdp_tokyo_19852010,
  graph_gdp_tokyo_19852010_dev,
  graph_gdp_tokyo_pop_19852010,
  graph_gdp_tokyo_pop_19852010_dev,
  graph_gdp_tokyo_wapop_19852010,
  graph_gdp_tokyo_wapop_19852010_dev,
  graph_land_tokyo_19852010,
  graph_land_tokyo_19852010_dev,
  graph_land_tokubu_19852010,
  graph_land_tokubu_19852010_dev,
  graph_office_tokubu_19852010,
  graph_office_tokubu_19852010_dev,
  ncol = 2)

公示地価と市街地価

違い

# install.packages("gt")  # 初回のみ
library(gt)

df <- data.frame(
  項目 = c("調査主体", "目的", "形式", "頻度", "対象"),
  公示地価 = c("国土交通省", "公的評価の基準", "円/㎡の絶対価格", "年1回", "全国の標準地"),
  市街地価格 = c("日本不動産研究所", "市場動向の把握", "指数", "年2回", "主要都市の市街地")
)

df |>
  gt() |>
  tab_header(
    title = "公示地価と市街地価格の比較表"
  )

公示地価と市街地価格の比較表
項目	公示地価	市街地価格
調査主体	国土交通省	日本不動産研究所
目的	公的評価の基準	市場動向の把握
形式	円/㎡の絶対価格	指数
頻度	年1回	年2回
対象	全国の標準地	主要都市の市街地

グラフ化

graph_shigai <- ggplot(data = df_shigai) +
  geom_line(aes(x = year, y = shigai, color = "Deviation"))+
  labs(title = "Shigaichi_kakaku")
graph_shigai

対数化

df_shigai <- df_shigai |>
  mutate(
    log_shigai = log(shigai)
  )

グラフ化

graph_koji_shigai <- ggplot() +
  geom_line(aes(x = year, y = log_shigai, color = "Shigai"), data = df_shigai) +
  geom_line(aes(x = year, y = log_land_tokyo, color = "Koji"), data = df_all_log) +
  labs(ylab = "Land Price", title = "Shigaichi_kakaku vs Koji_chika")
graph_koji_shigai