/*******************************************************************************
SAS program creating duration_portfolios.dta & duration_panel.dta via WRDS cloud
*******************************************************************************/
%macro allbreak_m(s=,sr=,data=);
*s=signal, sr=var name for rank output, data=data input/output;
data dataall;
set &data;
portyr_dec=year(date);
if exchcd in (1,2,3); *NYSE, AMEX, Nasdaq listed;
if month(date)=12; *form portfolios at December-end;
if insample=1; *define sample selection before calling macro;
proc sort nodupkey; by portyr_dec permno;

proc univariate data=dataall noprint;
by portyr_dec;
var &s;
output out=allpct pctlpts=0 to 100 by 10 pctlpre=dec;
run;

proc sort data=allpct; by portyr_dec;
data datam;
merge dataall allpct;
by portyr_dec;

data datam;
set datam;
if &s> . and &s<dec20 then &sr=0;
if &s>=dec20 and &s<dec40 then &sr=1;
if &s>=dec40 and &s<dec60 then &sr=2;
if &s>=dec60 and &s<dec80 then &sr=3;
if &s>=dec80 and &s ne . then &sr=4;
keep &sr portyr_dec permno;

proc sort data=&data; by permno portyr_dec;
proc sort data=datam; by permno portyr_dec;
data &data;
merge &data datam;
by permno portyr_dec;

proc sql;
drop table dataall, allpct, datam;
quit;
run;
%mend;

*******************************************************************************;

%MACRO WINSORIZE (INSET=,OUTSET=,SORTVAR=,VARS=,PERC1=1,TRIM=0);
/* WRDS Macro: WINSORIZE                                                             */
/* Summary   : Winsorizes or Trims Outliers                                          */
/* Date      : April 14, 2009                                                        */
/* Author    : Rabih Moussawi, WRDS                                                  */
/* Variables : - INSET and OUTSET are input and output datasets                      */
/*             - SORTVAR: sort variable used in ranking                              */
/*             - VARS: variables to trim and winsorize                               */
/*             - PERC1: trimming and winsorization percent, each tail (default=1%)   */
/*             - TRIM: trimming=1/winsorization=0, default=0   */
/* List of all variables */
%let vars = %sysfunc(compbl(&vars));
%let nvars = %nwords(&vars);

/* Display Output */
%put ### START.;

/* Trimming / Winsorization Options */
%if &trim=0 %then %put ### Winsorization; %else %put ### Trimming;
%put ### Number of Variables:  &nvars;
%put ### List   of Variables:  &vars;
options nonotes;

/* Ranking within &sortvar levels */
%put ### Sorting... ;
proc sort data=&inset; by &sortvar; run;

/* 2-tail winsorization/trimming */
%let perc2 = %eval(100-&perc1);

%let var2 = %sysfunc(tranwrd(&vars,%str( ),%str(__ )))__;
%let var_p1 = %sysfunc(tranwrd(&vars,%str( ),%str(__&perc1 )))__&perc1 ;
%let var_p2 = %sysfunc(tranwrd(&vars,%str( ),%str(__&perc2 )))__&perc2 ;

/* Calculate upper and lower percentiles */
proc univariate data=&inset noprint;
  by &sortvar;
  var &vars;
  output out=_perc pctlpts=&perc1 &perc2 pctlpre=&var2;
run;

%if &trim=1 %then
  %let condition = %str(if myvars(i)>=perct2(i) or myvars(i)<=perct1(i) then myvars(i)=. );
  %else %let condition = %str(myvars(i)=min(perct2(i),max(perct1(i),myvars(i))) );

%if &trim=0 %then %put ### Winsorizing at &perc1.%... ;
%else %put ### Trimming at &perc1.%... ;

/* Save output with trimmed/winsorized variables */
data &outset;
merge &inset (in=a) _perc;
by &sortvar;
  if a;
  array myvars {&nvars} &vars;
  array perct1 {&nvars} &var_p1;
  array perct2 {&nvars} &var_p2;
  do i = 1 to &nvars;
    if not missing(myvars(i)) then
    do;
      &condition;
    end;
  end;
drop i &var_p1 &var_p2;
run;

/* House Cleaning */
proc sql; drop table _perc; quit;
options notes;

%put ### DONE . ; %put ;

%MEND WINSORIZE;
run;

*******************************************************************************;

*Collapse data to portfolio day for each portfolio;
%macro append(dsn);
proc append base=alldata data=&dsn force;
run;
%mend append;

%macro chars (m=, vars=, data=, out=, w=,vw=);
data data_; set &data;
if cmiss(&m,dmve_1,dret,ddate)=0;
proc sort; by &m ddate;
proc means data=data_ noprint;
weight &w;
var dret &vars; by &m ddate;
output out=&m mean=dret sortvarmean;

data out;
set &m;
rename &m=port;
if &vw=0 then vw=0;
if &vw=1 then vw=1;
sortvar="&m";

%append(out);
%mend;

*******************************************************************************;


*********************************Begin Code************************************;
*********************************Compustat*************************************;
data comp;
set compd.funda;
if consol="C";
if datafmt="STD";
if indfmt="INDL";
if popsrc="D";
if curcd="USD";
if year(datadate)>=1960;
crspdate=intnx("month",datadate,+3,"end"); *lag Compustat data 3 months;
crspdate_=intnx("month",crspdate,+12,"end"); *assume data current for 12 months;
proc sort nodupkey; by gvkey datadate;

data comp;
set comp;
if gvkey=lag(gvkey) and (fyear=lag(fyear)+1) then l1=1; *correct lag indicator;
*Davis, Fama, and French (2000) Book Equity;
ps=.;
if pstkr ne . then ps=pstkr;
if pstkl ne . and ps=. then ps=pstkl;
if pstk ne . and ps=. then ps=pstk;
if ps=. then ps=0;
if pstk=. then pstk=0;
eq=.;
if seq ne . then eq=seq;
if ceq ne . and eq=. then eq=ceq+pstk;
if eq=. then eq=at-lt;
tx=.;
if txdb=. then txdb=0;
if itcb=. then itcb=0;
if txditc ne . then tx=txditc;
if tx=. then tx=txdb+itcb;
if tx=. then tx=0;
if year(datadate)<1993 then bve=eq+tx-ps;
if year(datadate)>=1993 then bve=eq-ps; *SFAS 109;
********************************************;
bve_1=l1*lag(bve);
sale_1=l1*lag(sale);
if bve_1>0 then roea=ib/bve_1;
if sale_1>0 then sga=(sale/sale_1)-1;
xop=sum(xsga,dp);
opleva=xop/at;
leva=sum(dlc,dltt)/at;
if year(datadate)>=1962;
keep gvkey cik datadate crspdate crspdate_ sich fyear sale bve_1
at bve ib roea sga opleva leva;
proc sort nodupkey; by gvkey descending datadate;

***************************Quarterly Compustat*********************************;
data compq;
set compd.fundq;
if consol="C";
if datafmt="STD";
if indfmt="INDL";
if popsrc="D";
if year(datadate)>=1960;
proc sort nodupkey; by gvkey datadate;

data compq;
set compq;
*Davis, Fama, and French (2000) Book Equity;
ps=.;
if pstkrq ne . then ps=pstkrq;
if pstkq ne . and ps=. then ps=pstkq;
if ps=. then ps=0;
if pstkq=. then pstkq=0;
eq=.;
if seqq ne . then eq=seqq;
if ceqq ne . and eq=. then eq=ceqq+pstkq;
if eq=. then eq=atq-ltq;
tx=.;
if txdbq=. then txdbq=0;
if txditcq ne . then tx=txditcq;
if tx=. then tx=txdbq;
if tx=. then tx=0;
if year(datadate)<1993 then bveq=eq+tx-ps;
if year(datadate)>=1993 then bveq=eq-ps; *FASB 109;

xopq=sum(xsgaq,dpq);
lev=sum(dlcq,dlttq)/atq;

if gvkey=lag4(gvkey) and (fyearq-lag4(fyearq))=1 and (fqtr-lag4(fqtr))=0 then do;
ibq4=(ibq+lag(ibq)+lag2(ibq)+lag3(ibq));
roeq=ibq4/lag4(bveq);
oplev=(xopq+lag(xopq)+lag2(xopq)+lag3(xopq))/atq;
end;

if gvkey=lag7(gvkey) and
(fyearq-lag4(fyearq))=1 and (fqtr-lag4(fqtr))=0 and
(lag(fyearq)-lag5(fyearq))=1 and (lag(fqtr)-lag5(fqtr))=0 and
(lag2(fyearq)-lag6(fyearq))=1 and (lag2(fqtr)-lag6(fqtr))=0 and
(lag3(fyearq)-lag7(fyearq))=1 and (lag3(fqtr)-lag7(fqtr))=0
then sgq=((saleq+lag(saleq)+lag2(saleq)+lag3(saleq))/
                          (lag4(saleq)+lag5(saleq)+lag6(saleq)+lag7(saleq)))-1;
if year(datadate)>=1962;
keep gvkey datadate fyearq atq ltq niq bveq rdq roeq sgq ibq4 lev oplev;
proc sort nodupkey; by gvkey descending datadate;
data compq;
set compq;
crspdate=intnx("month",datadate,+3,"end"); *lag Compustat data 3 months;
crspdate_=intnx("month",crspdate,+3,"end"); *assume data current for 3 months;

***********************************CRSP****************************************;
*CRSP Monthly Returns;
data ret;
set crspq.msf (keep=date permno ret prc shrout cfacshr cfacpr hsiccd);
eom=date; *last trading day of month (end of month);
date=intnx("month",date,0,"end"); *align date to calendar month end;

*Delisting returns*;
*Monthly;
data monthly_delist;
set crspq.msedelist;
date=intnx("month",dlstdt,0,"end"); *align date to calendar month end;
dlret_m=dlret; *monthly delisting return;
keep permno date dlret_m dlstcd dlstdt;
*Daily;
data daily_delist;
set crspq.dsedelist;
date=intnx("month",dlstdt,0,"end"); *align date to calendar month end;
dlret_d=dlret; *daily delisting return;
keep permno date dlret_d dlstcd dlstdt;
*Merge monthly and daily delisting returns;
proc sql;
create table delist
as select a.*, b.dlret_d, b.date as date2, b.dlstdt as dlstdt2,
b.permno as permno2, b.dlstcd as dlstcd2
from monthly_delist a full join daily_delist b
on a.permno=b.permno and a.date=b.date;
quit;
*Retain daily delisting return data if monthly delisting return data is missing;
data delist;
set delist;
if missing(permno) then permno=permno2;
if missing(date) then date=date2;
if missing(dlstdt) then dlstdt=dlstdt2;
if missing(dlstcd) then dlstcd=dlstcd2;

*Merge delisting returns with monthly returns;
proc sql;
create table ret1
as select a.*, b.dlret_m, b.dlret_d, b.dlstcd, b.dlstdt, b.permno as permno2,
b.date as date2
from ret a full join delist b
on a.permno=b.permno and a.date=b.date;
quit;

data ret1;
set ret1;
*Retain delisting return if monthly return is missing;
if missing(permno) then permno=permno2;
if missing(date) then date=date2;
yearmo=(100*year(date))+month(date)+1;
if month(date)=12 then yearmo=(100*(year(date)+1))+1;

*Dec-end portfolio formation year (annual sort);
if month(date)=12 then portyr_dec=year(date);
if month(date)<12 then portyr_dec=year(date)-1;

*Exchange and share codes;
data names;
set crspq.msenames (keep=shrcd exchcd ncusip ticker permno namedt nameendt siccd comnam);
nameendt=intnx("month",nameendt,0,"end"); *align date to calendar month end;
proc sort; by permno namedt;
data names;
set names;
by permno namedt;
*Extend name end date for last entry (inclusion of delisting rets);
if last.permno then nameendt=today();
proc sort nodupkey; by permno namedt nameendt;

proc sql;
create table ret
as select a.*, b.shrcd, b.exchcd, b.siccd, b.ncusip, b.ticker, b.comnam
from ret1 a, names b
where a.permno=b.permno and b.namedt<=a.date<=b.nameendt;
quit;

data ff; *risk-free rate;
set ff.factors_monthly (keep=date rf);
date=intnx("month",date,0,"end"); *align date to calendar month end;

proc sql;
create table crsp
as select a.*, b.rf
from ret a, ff b
where a.date=b.date;
quit;
proc sort nodupkey data=crsp out=crsp; by permno date;

*End of month dates (last trading day);
proc sort nodupkey data=crsp out=eom; by yearmo;
data eom;
set eom;
eom_=eom;
keep yearmo eom_;
proc sort data=eom out=eom; by yearmo;
proc sort data=crsp out=crsp; by yearmo;
data crsp;
merge crsp eom;
by yearmo;
proc sort nodupkey data=crsp out=crsp; by permno date;
data crsp;
set crsp;
eom=eom_;
*Delisting returns;
if dlret_d in (.a,.p,.s,.t) then dlret_d=.;
if dlret_m in (.a,.p,.s,.t) then dlret_m=.;
*If delisting date is prior to end of month, dlret_m contains partial month
return and delisting return if available;
if cmiss(dlstdt,dlret_d,dlret_m)=0 and dlstdt<eom then dlr=dlret_m;
*Replace missing performance related delisting returns per Shumway 1997 & 1999;
if missing(dlret_d) and (dlstcd=500 or (505<=dlstcd<=588))
and exchcd in (1,2) then dlret_d=-.3; *NYSE/AMEX;
if missing(dlret_d) and (dlstcd=500 or (505<=dlstcd<=588))
and exchcd=3 then dlret_d=-.55; *Nasdaq;
*Compound partial month return and replaced delisting return;
if missing(dlr) and cmiss(dlstdt,dlret_d,dlret_m)=0 and dlstdt<eom
then dlr=((1+dlret_m)*(1+dlret_d))-1;
*If monthly delisting return is missing and delisting is prior to end of month,
use daily delisting return;
if cmiss(dlstdt,dlret_d)=0 and missing(dlret_m) and dlstdt<eom then dlr=dlret_d;
*If delisting date is at end of month,
dlret contains only delisting return if available;
if missing(dlr) and dlstdt=eom then dlr=dlret_m;
if missing(dlr) and dlstdt=eom then dlr=dlret_d;
if cmiss(dlr,ret) in (0,1) then
rr=(sum(1,ret)*sum(1,dlr))-1; *compound monthly return and delisting return;
exret=rr-rf; *return in excess of risk-free rate;
*Compound return from t-12 to t-2 inclusive;
r=1+exret;
if permno=lag11(permno) then r12_2=(lag(r)*lag2(r)*lag3(r)*lag4(r)*lag5(r)*
                        lag6(r)*lag7(r)*lag8(r)*lag9(r)*lag10(r)*lag11(r))-1;

*Descending sorted CRSP for t+1 values;
proc sort nodupkey data=crsp out=crsp; by permno descending date;
data crsp;
set crsp;
exret1=100*lag(exret); *t+1 excess return x 100;
if lag(permno) ne permno then exret1=.;
month=month(date);
if lag(month)-month not in (1,-11) then exret1=.;
mve=(abs(prc)*shrout)/1000; *market value of equity in mm;
proc sort nodupkey; by permno date;

*Merge CRSP and Compustat;
data linktable;
set crsp.ccmxpf_lnkhist;
proc sort; by gvkey linkdt;
data linktable;
set linktable;
by gvkey linkdt;
if LINKTYPE in ("LU","LC") and LINKPRIM in ("P", "C");
*Extend last link end date to include delisting returns;
if last.gvkey then linkenddt=today();
proc sql;
create table ccm
as select a.*, b.lpermno, b.linkdt, b.linkenddt
from comp a, linktable b
where a.gvkey=b.gvkey and (b.linkdt <= a.datadate or missing(b.linkdt)) and
(b.linkenddt >= a.datadate or missing(b.linkenddt));
quit;
*Prefer non-missing link dates;
proc sort; by gvkey datadate descending linkdt descending linkenddt;
proc sort nodupkey; by gvkey datadate;
*Merge CRSP and Compustat;
proc sql;
create table data
as select a.*, b.*
from ccm a, crsp b
where a.lpermno=b.permno and a.crspdate<=b.date<a.crspdate_;
quit;
*Keep most recent lagged Compustat data;
proc sort; by permno date descending datadate;
proc sort nodupkey; by permno date;

***************************CRSP & Compustat Merged*****************************;
data data;
set data;
if shrcd in (10,11);
if exchcd in (1,2,3);
m=mve;

proc sql; *housekeeping;
drop table ccm, comp, crsp, delist, eom, daily_delist,
monthly_delist, ret, ret1, ff;
quit;

*Get market caps by gvkey;
data gvkeycap; set data;
proc sort; by gvkey date;
proc means data=gvkeycap noprint;
var m; by gvkey date;
output out=gvkeycap sum=me_crsp;

proc sql;
create table dataf
as select a.*, b.me_crsp
from data a left join gvkeycap b
on a.gvkey=b.gvkey and a.date=b.date;
quit;
proc sort nodupkey data=dataf out=data; by permno date;

*add quarterly compustat;
proc sql;
create table dataf
as select a.*, b.roeq, b.sgq, b.lev, b.oplev, b.bveq, b.ibq4, b.datadate as datadateq
from data a left join compq b
on a.gvkey=b.gvkey and b.crspdate<=a.date<b.crspdate_;
quit;
proc sort nodupkey data=dataf out=data; by permno date;

data data;
set data;
if missing(lev) then lev=leva;
if missing(oplev) then oplev=opleva;
roe=roeq; if missing(roe) then roe=roea;
g=sgq; if missing(g) then g=sga;
bv=bveq; if missing(bv) then bv=bve;
%WINSORIZE (INSET=data,OUTSET=data,SORTVAR=date,VARS=roe g,PERC1=1,TRIM=0);
*Duration;
%macro duration (var=, me=, roe_ar=, roe_t=, g_ar=, g_t=, r=, t=, data=);
data &data;
set &data;
sum_dcf=.;
sum_d=.;
array be{&t} bve_1_1-bve_1_&t;
%do i = 1 %to &t;
roe&i.=&roe_t+((roe-&roe_t)*(&roe_ar**&i));
g&i.=&g_t+((g-&g_t)*(&g_ar**&i));
if &i=1 then bve_1_&i.=bv;
if &i>1 then bve_1_&i.=be{&i-1}*(1+g&i);
dcf&i=(bve_1_&i*(roe&i-g&i))/((1+&r)**&i);
d&i.=dcf&i*&i;
sum_dcf=sum(sum_dcf,dcf&i);
sum_d=sum(sum_d,d&i);
if bve_1_&i<0 then neg_bv=1;
%end;
if neg_bv ne 1 and bv>0 and &me>0 then &var=(sum_d/&me)+((&t+((1+&r)/&r))*((&me-sum_dcf)/&me));
%mend;

data data;
set data;
%duration (var=dur,me=me_crsp,roe_ar=.39, roe_t=.12, g_ar=.21, g_t=.06, r=.12, t=15,data=data);
if bveq>0 then bm=bveq/me_crsp;
if missing(bveq) and bve>0 then bm=bve/me_crsp;
if ibq4>0 then em=ibq4/me_crsp;
if missing(ibq4) and ib>0 then em=ib/me_crsp;
if cmiss(mve,r12_2,exret)=0 then insample=1;

%allbreak_m(s=dur,sr=durr,data=data);
%allbreak_m(s=bm,sr=bmr,data=data);
%allbreak_m(s=em,sr=emr,data=data);

data data;
set data;
winsor=1;
%WINSORIZE (INSET=data,OUTSET=data,SORTVAR=winsor,VARS=bm em dur,PERC1=1,TRIM=0);

data data;
set data;
keep ncusip ticker permno gvkey comnam yearmo bm em dur durr me_crsp
bmr emr roeq sgq siccd oplev lev ibq4 ib bve bveq exret1 mve date mktrf roe g;

*Daily CRSP;
data daily;
set crspq.dsf;
keep permno date ret shrout prc vol;
proc sort nodupkey; by permno date;
*Risk-free rate;
data ff;
set ff.factors_daily (keep=date rf mktrf);
proc sql;
create table crspdaily
as select a.*, b.*
from daily a, ff b
where a.date=b.date;
quit;
proc sort nodupkey data=crspdaily out=crspdaily; by permno date;
proc sql;
drop table daily, ff;
quit;
*Delisting Returns;
data daily_delist;
set crspq.dsedelist;
*Merge exchange codes with delisting rets;
data names;
set crspq.dsenames (keep=permno namedt nameendt exchcd);
proc sort data=names out=names; by permno namedt;
data names;
set names;
by permno namedt;
if last.permno then nameendt=today(); *Extend last name end date;
proc sort nodupkey; by permno namedt nameendt;
proc sql;
create table delist
as select a.*, b.exchcd
from daily_delist a, names b
where a.permno=b.permno and b.namedt<=a.dlstdt<=b.nameendt;
quit;
data delist;
set delist;
if dlret=. and (dlstcd=500 or (505<=dlstcd<=588)) and exchcd in (1,2) then dlret=-.3; *NYSE/AMEX;
if dlret=. and (dlstcd=500 or (505<=dlstcd<=588)) and exchcd=3 then dlret=-.55; *NASDAQ;
keep permno dlstdt dlret dlstcd;
*Merge delisting returns with crsp daily;
proc sql;
create table dailydata_
as select a.*, b.permno as permno2, b.dlstdt
from crspdaily a full join delist b
on a.permno=b.permno and a.date=b.dlstdt;
quit;

data dailydata_;
set dailydata_;
if missing(permno) then permno=permno2;
if missing(date) then date=dlstdt;
proc sort nodupkey; by permno date;

proc sql;
drop table crspdaily;
quit;

data dailydata;
set dailydata_;
mve=(abs(prc)*shrout)/1000;
if ret=. and dlret ne . then ret=0;
if dlret=. and ret ne . then dlret=0;
ret_=((1+ret)*(1+dlret))-1;
exret=(ret_-rf);
ymo=year(date)*100 + month(date);

proc sql;
create table data_
as select a.*,
b.date as ddate, b.exret as dret, b.mve as dmve
from data a left join dailydata b
on a.permno=b.permno and a.yearmo=b.ymo;
quit;
proc sort nodupkey data=data_ out=data; by permno ddate;

data data;
set data;
if permno=lag(permno) then dmve_1=lag(dmve);
ew=1;

data duration_panel;
set data (keep=permno ddate dret dur siccd oplev lev ibq4 bveq ib bve dmve_1 me_crsp roe g);
ret=dret;
me=dmve_1;
if year(ddate)>=1964;
drop dmve_1 dret;
run;
proc export data=duration_panel outfile='/home/usc/rerhard/duration_panel.dta' dbms=dta replace;

%chars(m=durr, vars=dur, data=data, w=ew,vw=0);
%chars(m=durr, vars=dur, data=data, w=dmve_1,vw=1);
%chars(m=bmr, vars=bm, data=data, w=ew,vw=0);
%chars(m=bmr, vars=bm, data=data, w=dmve_1,vw=1);
%chars(m=emr, vars=em, data=data, w=ew,vw=0);
%chars(m=emr, vars=em, data=data, w=dmve_1,vw=1);

data alldata;
set alldata
(keep=ddate dret port sortvar sortvarmean vw);
port=port+1;

data ff;
set ff.factors_daily (keep=date rf mktrf);
*add daily market return;
proc sql;
create table alldata_
as select a.*, b.mktrf as dmktrf
from alldata a left join ff b
on a.ddate=b.date;
quit;
proc sort data=alldata_ out=alldata; by sortvar vw port ddate;
proc export data=alldata outfile='/home/usc/rerhard/duration_portfolios.dta' dbms=dta replace;
run;
********************************End Code***************************************
