# This code computes fundamental variables from Compustat XPF

#.rs.restartR()
#(.packages())
# rm(list = ls())

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

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

# Define PG data ----

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

# Outside of project schema
fundq <- tbl(pg, sql("SELECT * FROM comp.fundq"))
funda <- tbl(pg, sql("SELECT * FROM comp.funda"))

# Collect relevant data ----

start_date <- '1997-01-01'

# Acct. values are in millions
cols <- c("gvkey", "datadate", "fyearq", "fqtr",
          "saleq", # Sales/Turnover (Net)
          "atq", # Assets - Total 
          "ibq", # Income Before Extraordinary Items
          "prccq", #PRCCQ	NUM	PRCCQ -- Price Close - Quarter
          "cshoq", #CSHOQ	NUM	CSHOQ -- Common Shares Outstanding
          "ceqq", #CEQQ	NUM	CEQQ -- Common/Ordinary Equity - Total
          "sstky", # SSTKY -- Sale of Common and Preferred Stock---WARNING: includes option exercises (year-to-date)
          "dltisy", # DLTISY -- Long-Term Debt Issuance (year-to-date)
          "dd1q", # DD1Q-- Long-Term Debt Due in One Year
          "dlttq", # DLTT	NUM	DLTT -- Long-Term Debt - Total
          "cheq" #CHE -- Cash and Short-Term Investments
          )

# Quarterly fundamentals ----

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

fund <- 
    fundq %>%
    # Keep standard reporting
    filter(indfmt == 'INDL' & datafmt == 'STD' & popsrc == 'D' & consol == 'C' & !is.na(fyearq)) %>%   
    filter(datadate > start_date) %>%
    select(one_of(cols)) %>%
    distinct() %>%
    # For duplicates in {gvkey, fyearq, fqtr} keep the earliest date
    group_by(gvkey, fyearq, fqtr) %>%
    filter(datadate == min(datadate)) %>%
    ungroup() %>%
    # For duplicates in {gvkey, datadate} keep the latest fqtr
    # i.e., between Q4 and Q1 keep Q4
    group_by(gvkey, datadate) %>%
    filter(fqtr == max(fqtr)) %>%
    ungroup() %>%
    # Compute variabes sale growth and merge ---
    mutate_at(.vars = vars(saleq, atq, ceqq), 
              .funs = funs(if_else(. <= 0, NA, .))) %>%
    mutate_at(.vars = vars(sstky, dltisy, dd1q),
              .funs = funs(coalesce(., 0))) %>%
    # Compute M/B and ME
    mutate(mbq = abs(prccq*cshoq)/ceqq, 
           mcapq = abs(prccq*cshoq), 
           lev1q = dd1q/atq, 
           levq = (dd1q + dlttq)/atq,
           dd1q_to_cheq = dd1q/NULLIF(cheq, 0)) %>% 
    group_by(gvkey) %>%
    arrange(datadate) %>%
    # Lag mcap variables
    mutate_at(.vars = vars(atq, mcapq), 
              .funs = funs(lag = lag(.))) %>%
    # Compute scaled flow variables as a fraction of assets total
    mutate(ibq_to_atq = ibq/NULLIF(atq_lag, 0)) %>%
    ungroup() %>%
    # Clean up all variables that use wrong lag, i.e., fyear - fyear_lag != 1, ---very few cases
    mutate_at(.vars = vars(ibq_to_atq), 
              .funs = funs(if_else(datadate - lag(datadate) > 100, NA, .))) %>%
    ungroup() %>%
    # Compute seasonal growth rates
    group_by(gvkey, fqtr) %>%
    arrange(fyearq) %>%
    # WARNING: cannot send . and ._lag to sql
    mutate(sue_sale = if_else(saleq == 0 & lag(saleq) == 0, 0, 
                                         (saleq - lag(saleq))/(NULLIF(mcapq, 0))),
           # sue_comp = (ibq - ibq_lag)/mvfqtr_crsp 
           sue_ib = if_else(ibq == 0 & lag(ibq) == 0, 0, 
                       (ibq - lag(ibq))/(NULLIF(mcapq, 0)))) %>%
    # Clean up all variables that use wrong lag, i.e., fyear - fyear_lag != 1, ---very few cases
    mutate_at(.vars = vars(sue_sale, sue_ib), 
              .funs = funs(if_else(fyearq - lag(fyearq) != 1, NA, .))) %>%
    ungroup() %>%
    group_by(gvkey) %>%
    arrange(datadate) %>%
    # Future growth
    mutate(sue_ib_lead = lead(sue_ib)) %>%
    ungroup() %>%
    # Compute lossq
    mutate(lossq = if_else(!is.na(ibq_to_atq), if_else(ibq_to_atq < 0, 1, 0), NA)) %>%
    # Compute capital issuance per quarter
    group_by(gvkey, fyearq) %>%
    arrange(fqtr) %>%
    mutate(sstkq = coalesce(sstky - lag(sstky), sstky), 
           dltisq = coalesce(dltisy - lag(dltisy), dltisy)) %>%
    # Compute variables based on lags
    mutate(sstkq_sc = sstkq/NULLIF(mcapq_lag, 0), 
           dltisq_sc = dltisq/NULLIF(mcapq_lag, 0)) %>%
    ungroup() %>%
    # Merge sich from funda
    left_join(funda %>%
                  select(gvkey, fyearq = fyear, sich)) %>%
    # Extrapolate industry sich
    # Extrapolate backwards within gvkey
    mutate(partition = sql("sum(CASE WHEN sich IS NULL THEN 0 ELSE 1 END) OVER (PARTITION BY gvkey ORDER BY datadate DESC)")) %>%
    mutate(sich = sql("first_value(sich) OVER (PARTITION BY gvkey, partition ORDER BY datadate DESC)")) %>%
    # Extrapolate forwards within gvkey
    mutate(partition = sql("sum(CASE WHEN sich IS NULL THEN 0 ELSE 1 END) OVER (PARTITION BY gvkey ORDER BY datadate)")) %>%
    mutate(sich = sql("first_value(sich) OVER (PARTITION BY gvkey, partition ORDER BY datadate)")) %>%
    select(-partition) %>%
    # Extract 3-digit and 4-digit SIC
    mutate(sic4 = sql("LPAD(sich::text, 4, '0')")) %>%
    mutate(sic3 = sql("substring(sic4 from 1 for 3)")) %>%
    distinct() %>%
    compute()
 
# Compute sales-based HHI
hhi4 <- 
    fund %>%
    # Compute market shares by sic4
    group_by(sic4, fyearq, fqtr) %>%
    mutate(s2 = (saleq/sum(saleq))^2) %>%
    summarize(hhi4 = sum(s2)) %>%
    ungroup() %>%
    compute()

hhi3 <- 
    fund %>%
    # Compute market shares by sic3
    group_by(sic3, fyearq, fqtr) %>%
    mutate(s2 = (saleq/sum(saleq))^2) %>%
    summarize(hhi3 = sum(s2)) %>%
    ungroup() %>%
    compute()

fundq <- 
    fund %>%
    left_join(hhi4) %>%
    left_join(hhi3) %>%
    compute(name = "fundqtr", temporary=FALSE,
            indexes=list(c("gvkey", "datadate"), c("gvkey")))
    

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

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

dbDisconnect(pg)
