# This code computes whether a firm has a meet-or-beat estimate

library(dplyr, warn.conflicts = FALSE)
library(RPostgreSQL)

pg <- dbConnect(PostgreSQL())
dbExecute(pg, "SET work_mem TO '10GB'") # Speeds-up creation of temporary tables

# Data ----

# Project schema
rs <- dbGetQuery(pg, "SET search_path TO nonans_product, public")

# Outside of project schema

# IBES:
id <- tbl(pg, sql("SELECT * FROM ibes.id"))
actualq_unadj <- tbl(pg, sql("SELECT * FROM ibes.actualq_unadj")) # Actual quarterly I/B/E/S  data
analystq_unadj <- tbl(pg, sql("SELECT * FROM ibes.analystq_unadj")) # Analyst quarterly I/B/E/S  data

# CRSP:
mse <- tbl(pg, sql("SELECT * FROM crsp.mse"))
dsf <- tbl(pg, sql("SELECT * FROM crsp.dsf")) 

# Set params ----

start_date <- '2000-01-01'
last_date <- '2100-01-01'

# Get ids to link to permno ----

# TICKER    I/B/E/S Ticker
# SDATES    Start Date
# Start Dates represent the first date that a data row is effective, as of the Thomson Reuters
# monthly run date, which falls anywhere between the 14th and 20th day of a given month

# Get {startdate, enddate} for {ticker, cusip} pairs
id_alt <- 
    id %>% 
    select(ticker, sdates, cusip) %>% 
    group_by(ticker) %>% 
    arrange(sdates) %>%
    mutate(startdate = sdates, 
           enddate = lead(sdates)) %>%
    ungroup() %>% 
    # Fill in missing enddate
    mutate(enddate = coalesce(enddate, last_date)) %>%
    compute()

# Historical cusips from CRSP
mse_alt <- 
    mse %>% 
    filter(event %in% c("NAMES", "DELIST")) %>% 
    rename(cusip_header = cusip) %>%
    select(permno, event, date, ncusip, cusip_header) %>% 
    # Keep the most recent ncusip if ncusip at delisting is missing
    group_by(permno) %>% 
    arrange(date) %>%
    mutate(ncusip = if_else(event == "DELIST" & is.na(ncusip), lag(ncusip), ncusip)) %>% 
    ungroup() %>% 
    # Set enddate to the following startdate for permno
    group_by(permno) %>% 
    arrange(date) %>% 
    mutate(enddate = lead(date)) %>% 
    ungroup() %>% 
    rename(startdate = date) %>% 
    filter(event == "NAMES" & !is.na(ncusip)) %>% 
    # Fill in missing enddate
    mutate(enddate = coalesce(enddate, last_date)) %>%
    select(permno, ncusip, startdate, enddate) %>%
    distinct() %>%
    compute(index = list("ncusip"))

# Get ticker-permno link
ticker_link <- 
    id_alt %>%
    rename(ncusip = cusip, 
           tstartdate = startdate, 
           tenddate = enddate) %>%
    left_join(mse_alt) %>%
    # Drop non-overlapping dates
    filter(!is.na(permno) & !(tenddate < startdate | enddate < tstartdate)) %>%
    select(ticker, permno, 
           tstartdate, tenddate, 
           startdate, enddate) %>%
    compute(index = "ticker")

# Merge unadjusted actual and forecasts and link to permno
consens <- 
    analystq_unadj %>%
    select(ticker,
           pends = fpedats,
           analys, 
           estimator, 
           pdf,
           anndats_act,
           revdats,
           rev_ts,
           actdats,
           estimate = value) %>%
    left_join(actualq_unadj) %>%
    filter(# Announcement date for actual is between 15 to 90 calendar days following the fiscal period-end 
        sql("pends + interval '15 days' <= anndats_act AND anndats_act <= pends + interval '90 days'")
        # Revision date is  within 90 days of the annual earnings announcements anndats_act
        & sql("rev_ts >= anndats - interval '90 days'") & revdats < anndats) %>% 
    # Keep an estimate with the latest revision time rev_ts
    group_by(ticker, analys, estimator, pends, pdf) %>%
    filter(revdats == max(revdats)) %>%
    ungroup() %>%
    # Link to permno
    left_join(ticker_link) %>%
    # Link should be valid at fpedats for ticker-permno
    filter(!is.na(permno)
           & (pends >= tstartdate & pends <= tenddate)
           & (pends >= startdate & pends <= enddate)) %>%
    select(-tstartdate, -tenddate, -startdate, -enddate) %>%
    # Get the date for the stock price 20 days PRIOR to the earnings announcement
    mutate(anndats_act_20 = sql("(anndats_act - interval '20 days')::date")) %>%
    # Get yrmonth for {revdats, anndats, anndats_20}
    mutate(yrmonth_rev = sql("extract (year from rev_ts)*12 + extract (month from rev_ts)"),
           yrmonth_act = sql("extract (year from anndats_act)*12 + extract (month from anndats)"), 
           yrmonth_act20 = sql("extract (year from anndats_act_20)*12 + extract (month from anndats_act_20)")) %>%
    compute(index = list(c("permno", "yrmonth_rev"), 
                         c("permno", "yrmonth_act"), 
                         c("permno", "yrmonth_act20")))

# Adjust for stock splits
# value as of rev_ts (The Review Date (REVDATS) is the most recent date that an estimate was verified as still being in effect for that analyst / company.)
# actual as of fpedats
# eps/cfacshr to adjust eps
# prc/cfacpr to adjust stock price

# Get daily adjustment factors and prices
dsf_alt <- 
    dsf %>%
    filter(date >= start_date) %>%
    select(permno, date, prc, cfacpr, cfacshr) %>%
    compute(index = list(c("permno"))) %>%
    # Keep IBES permnos only
    inner_join(consens %>%
                   select(permno) %>%
                   distinct() %>%
                   compute(index = list(c("permno")))) %>%
    # prc is the closing price or the negative bid/ask average for a trading day
    mutate(prc_adj = if_else(cfacpr != 0, abs(prc)/cfacpr, abs(prc)), 
           yrmonth = sql("extract (year from date)*12 + extract (month from date)")) %>%
    compute(index = list(c("permno", "yrmonth")))



# Stock-split-adjusted consensus data
consens_adj <- 
    consens %>%
    # Split-adjust actuals at anndats_act, i.e., announcement date for actuals
    left_join(dsf_alt %>%
                  select(permno,
                         date, 
                         yrmonth_act = yrmonth, 
                         cfacshr)) %>%
    # Keep cfacshr just before anndats_act
    mutate(days = abs(sql("(anndats_act - date)::numeric"))) %>%
    group_by(permno, anndats_act) %>%
    filter(days == min(days)) %>%
    ungroup() %>%
    # If duplicates, keep earlier date
    group_by(ticker, pends, analys, estimator, pdf, revdats) %>%
    filter(n() == 1 | (n() > 1 & date <= anndats_act)) %>%
    ungroup() %>%
    rename(cfacshr_act = cfacshr, 
           date_act = date) %>%
    select(-days, -yrmonth_act) %>%
    # Split-adjust actuals at rev-ts
    left_join(dsf_alt %>%
                  select(permno,
                         date, 
                         yrmonth_rev = yrmonth, 
                         cfacshr)) %>%
    # Keep cfacshr just before rev_ts
    mutate(days = abs(sql("(revdats - date)::numeric"))) %>%
    group_by(permno, revdats) %>%
    filter(days == min(days)) %>%
    ungroup() %>%
    # If duplicates, keep earlier date
    group_by(ticker, pends, analys, estimator, pdf, revdats) %>%
    filter(n() == 1 | (n() > 1 & date <= revdats)) %>%
    ungroup() %>%
    rename(cfacshr_rev = cfacshr, 
           date_rev = date) %>%
    select(-days, -yrmonth_rev) %>%
    # Get the stock price 20 days prior to the earnings announcement
    left_join(dsf_alt %>%
                  select(permno,
                         date, 
                         yrmonth_act20 = yrmonth, 
                         prc_adj20 = prc_adj)) %>%
    # Keep price just before ann_ts_act20
    mutate(days = abs(sql("(anndats_act_20 - date)::numeric"))) %>%
    group_by(permno, anndats_act_20) %>%
    filter(days == min(days)) %>%
    ungroup() %>%
    # If duplicates, keep earlier date
    group_by(ticker, pends, analys, estimator, pdf, revdats) %>%
    filter(n() == 1 | (n() > 1 & date <= anndats_act_20)) %>%
    ungroup() %>%
    rename(date_act20 = date) %>%
    select(-days, -yrmonth_act20) %>%
    distinct() %>%
    # Stock-split adjust {actual, value}
    mutate(actual_adj = if_else(cfacshr_act != 0, value/cfacshr_act, value), 
           estimate_adj = if_else(cfacshr_rev != 0, estimate/cfacshr_rev, estimate)) %>%
    compute()


# Compute consensus and dispersion and write to PG ----

dbGetQuery(pg, "DROP TABLE IF EXISTS ibes_mb")

ibes_mb <- 
    consens_adj %>%
    group_by(permno, ticker, pends, pdf, actual_adj, prc_adj20) %>%
    summarise(consens_avg = mean(estimate_adj), 
              consens_med = median(estimate_adj), 
              consens_sd = sd(estimate_adj), 
              consens_n = n()) %>%
    ungroup() %>%
    # If multiple records per {ticker, fpedats}, keep diluted
    group_by(ticker, pends, actual_adj) %>%
    filter(n() == 1 | (n() > 1 & pdf == 'D')) %>%
    ungroup() %>%
    # Compute meet-or-beat, sue, dispersion
    mutate(is_meet_avg = (actual_adj >= consens_avg),
           is_meet_med = (actual_adj >= consens_med),
           is_just_meet_avg = ifelse(actual_adj >= consens_avg & (actual_adj - consens_avg) <= 0.04,
                                     T, F),
           is_just_meet_med = ifelse(actual_adj >= consens_avg & (actual_adj - consens_avg) <= 0.04,
                                     T, F),
           ce_avg = (actual_adj - consens_avg)/prc_adj20, 
           ce_med = (actual_adj - consens_med)/prc_adj20, 
           disp = consens_sd/prc_adj20) %>%
    distinct() %>%
    compute(name = 'ibes_mb', temporary = FALSE, 
            index = list(c("permno", "pends")))

db_comment <- paste0("CREATED USING azakolyukina/nonans_product/create_ibes_mb.R ON ", Sys.time())
dbGetQuery(pg, paste0("COMMENT ON TABLE ibes_mb IS '",
                      db_comment, "';"))

dbGetQuery(pg, "ALTER TABLE ibes_mb OWNER TO nonans_product")
dbGetQuery(pg, "GRANT SELECT ON ibes_mb TO nonans_product_access")
dbGetQuery(pg, "VACUUM ANALYZE ibes_mb")

dbDisconnect(pg)

