* Encoding: UTF-8.
* Analyzujeme supermodels data z Andyho Fielda. 
* Pro účely našeho semináře data modifikujeme následujícím skriptem.
* Příkazy jsou již vykonané, a proto jsou zakomentované. 
* Jakékoli závěry z těchto dat tak nenesou jakoukoli korespondenci s realitou. 
*COMPUTE hair=Rnd(RV.UNIFORM(1,3)).
*EXECUTE.
*Variable labels hair "Hair color".
*value labels hair
1 "blond"
2 "brown"
3 "black".

*IF (hair= 1) salary_new = salary + 5*hair + (beauty-55)*2 -15. 
*IF (hair= 2) salary_new = salary + 3*hair.
*IF (hair= 3) salary_new = salary + 4*hair.
*IF (salary_new < 0) salary_new = 3.
*execute.

*freq hair.
*GRAPH   /HISTOGRAM=salary_new.
*GRAPH   /HISTOGRAM=beauty.

*Uložení dat s přidanými proměnnými.
*SAVE OUTFILE='C:\Users\JEZEK\Dropbox\!Výuka\PSY252\Bloky\2 Regrese\Supermodel_new.sav'
  /DROP=salary
  /COMPRESSED.
*Konec vyrábění fake dat.
*_______________________________________________________________________________________________________.



*Predikujeme mzdu supermodelek.

*Podívejme se na závislou. 
EXAMINE VARIABLES=salary_new
  /PLOT BOXPLOT HISTOGRAM NPPLOT
  /COMPARE GROUPS
  /STATISTICS DESCRIPTIVES
  /CINTERVAL 95
  /MISSING LISTWISE
  /NOTOTAL.

*Je hodně zešikmená. Navíc, zákon marginálního užitku naznačuje, že u vysokých mezd je potřeba přidat víc, aby to bylo vidět, než u nízkých.
compute salary_log = ln(salary_new).
execute.
EXAMINE VARIABLES=salary_new salary_log
  /PLOT BOXPLOT HISTOGRAM NPPLOT
  /COMPARE GROUPS
  /STATISTICS DESCRIPTIVES
  /CINTERVAL 95
  /MISSING LISTWISE
  /NOTOTAL.


*S ohedem na snadnost interpretace budeme modelovat raději modelovat původní ne-transfomovanou proměnnou.
*Ale jsou tam dva zdánliví outlieři, na které transformace upozornila. Nebudu je vyřazovat, ale už si na ně mohu nachystat filtr pro "analýzu senzitivity".
*USE ALL.
*COMPUTE filter_$=(salary_log>1.5).
*FILTER BY filter_$.
*EXECUTE.


*Prediktory.
*Nejprve spojité.
DESC salary_new age years beauty.
CORR salary_new age years beauty.
GRAPH
  /SCATTERPLOT(MATRIX)=salary_new age years beauty
  /MISSING=LISTWISE.

*Pro srovnání, zdá se, že logaritmovaná mzda má o něco lineárnější vztahy s prediktory, byť k ideálu to má daleko. 
GRAPH
  /SCATTERPLOT(MATRIX)=salary_log age years beauty
  /MISSING=LISTWISE.

GRAPH
  /SCATTERPLOT(BIVAR)=age WITH salary_new
  /MISSING=LISTWISE.
GRAPH
  /SCATTERPLOT(BIVAR)=years WITH salary_new
  /MISSING=LISTWISE.
GRAPH
  /SCATTERPLOT(BIVAR)=age WITH years
  /MISSING=LISTWISE.

*Čistě pro zajímavost - kdy se s modelingem začíná?.
compute start_age = age - years.
execute.
XGRAPH CHART=[POINT] BY start_age[s]  /DISPLAY DOT=ASYMMETRIC.


*Kategorický prediktor.
FREQ hair.
EXAMINE VARIABLES=salary_new salary_new BY hair
  /PLOT BOXPLOT HISTOGRAM
  /COMPARE GROUPS
  /STATISTICS DESCRIPTIVES
  /CINTERVAL 95
  /MISSING LISTWISE
  /NOTOTAL.

*Transformace Hair do dummy proměnných.
recode hair (1=1) (2=0) (3=0) into hair_blond.
recode hair (1=0) (2=1) (3=0) into hair_brown.
execute.




*První krok regrese - kolinearita age - years.
REGRESSION
  /DESCRIPTIVES MEAN STDDEV CORR SIG N
  /MISSING LISTWISE
  /STATISTICS COEFF OUTS CI(95) R ANOVA CHANGE ZPP COLLIN TOL
  /CRITERIA=PIN(.05) POUT(.10)
  /NOORIGIN 
  /DEPENDENT salary_new
  /METHOD=ENTER years
  /METHOD=ENTER age
  /PARTIALPLOT ALL.

* Visual Binning.age.
RECODE  age (MISSING=COPY) (LO THRU 12=1) (LO THRU 16=2) (LO THRU 20=3) (LO THRU 24=4) (LO THRU 
    HI=5) (ELSE=SYSMIS) INTO age_cat.
VARIABLE LABELS  age_cat 'Age (Years) (Binned)'.
FORMATS  age_cat (F5.0).
VALUE LABELS  age_cat 1 '<= 12,00' 2 '12,01 - 16,00' 3 '16,01 - 20,00' 4 '20,01 - 24,00' 5 '24,01+'.    
VARIABLE LEVEL  age_cat (ORDINAL).
EXECUTE.

GRAPH
  /SCATTERPLOT(BIVAR)=years WITH salary_new
  /MISSING=LISTWISE.

GRAPH
  /SCATTERPLOT(BIVAR)=years WITH salary_new
  /PANEL COLVAR=age_cat COLOP=CROSS
  /MISSING=LISTWISE.

*Tohhle je asi nejzřetelnější zobrazení - když si zobrazíme lineární trendy v jednotlivých věkových skupinách.
GRAPH
  /SCATTERPLOT(BIVAR)=years WITH salary_new BY age_cat
  /MISSING=LISTWISE.

*Alternativně se můžeme podívat na regresi, kde namísto years bude residuum z years po predikci věkem.
*Touto regresí vytvoříme rezidua roků strávených modelingem po predikci věkem.
*RES_YEARS nám říkají, o kolik let je modelka v modelingu více/méně než bychom čekali na základě jejího věku.
REGRESSION
  /NOORIGIN 
  /DEPENDENT years
  /METHOD=ENTER age
  /SAVE RESID (RES_YEARS).
VARIABLE LABELS RES_YEARS "Počet roků v modelingu nad rámec očekávání podle věku".
examine res_years. 
 *Rozpětí je as od -1 do 1,5 roku.
 
 REGRESSION
  /MISSING LISTWISE
  /STATISTICS COEFF OUTS R ANOVA
  /CRITERIA=PIN(.05) POUT(.10)
  /NOORIGIN 
  /DEPENDENT salary_new
  /METHOD=ENTER age RES_YEARS
  /PARTIALPLOT ALL.
*Volnější interpretace: Čím dříve jsem nastoupila do modelingu, tím méně mám oproti stejně starým kolegyním, co nastoupily později.






*Přidejme i atraktivitu a kategorický prediktor překódovaný na dummy.
*Předpokládáme, že čímvyšší atraktvita, tím vyšší mzda.
*U kategorické testujeme stereotyp o benefitech blond vlasů oproti černým. 
*I když pro hnědé vlasy nemáme extra hypotézu, nemůžeme je z analýzy vynechat (sadu dummy proměnných bychom vždy měli do modeluzahrnout celou).
REGRESSION
  /DESCRIPTIVES MEAN STDDEV CORR
  /MISSING LISTWISE
  /STATISTICS COEFF OUTS CI(95) R ANOVA COLLIN TOL CHANGE ZPP
  /CRITERIA=PIN(.05) POUT(.10)
  /NOORIGIN 
  /DEPENDENT salary_new
  /METHOD=ENTER years age
  /METHOD=ENTER beauty hair_blond hair_brown.




*--------------------------------------------------------.
*  Moderace                                                       .
*--------------------------------------------------------.
*Předpokládáme ještě, že stereotyp okolo blonďatých vlasů je ještě silnější - že v jejich případě roste mzda s atraktivitou rychleji než u ostatních barev vlasů.
*Aby tento úvodní příklad nebyl tak složitý, zjednodušíme si to tím, že proměnnou hair zredukujeme na dichotomii blond vs. non-blond. 
*Moderace se všemi třemi barvami vlasů je pro referernci níže.

*Vyrobíme si novou promněnnou hair. Non-blond je tak naš referenční kategorií.
recode hair (1=1) (2 thru 3 = 0) INTO hair2.
execute.
value labels hair2 
    1 "blond"
    0 "non-blond".
 
*Vytvoříme si moderační člen.
*Protože jde o součin dvou proměnných, bude tato nová proměnná vysoce korelovat s oběma činitel součinu. 
*Zdánlivě zázračně se tato korelace sníží, když bude ta spojitá vycentrovaná.                    
desc beauty.
compute beautyC = beauty - 75.944705.
compute hair2XbeautyC = hair2 * beautyC.
execute.
variable labels hair2XbeautyC "Blond X beauty(C)".

*Kroky v regresi rozdělíme, abychom se mohl podívat extra na přínos moderačního členu.
*Interpretace není snadná, proto si uložíme predikované skóry. 
REGRESSION
  /DESCRIPTIVES MEAN STDDEV CORR
  /MISSING LISTWISE
  /STATISTICS COEFF OUTS CI(95) R ANOVA COLLIN TOL CHANGE ZPP
  /CRITERIA=PIN(.05) POUT(.10)
  /NOORIGIN 
  /DEPENDENT salary_new
  /METHOD=ENTER years age
  /METHOD=ENTER beautyC hair2
  /METHOD=ENTER hair2XbeautyC
  /SAVE PRED.

*Na pomoc 
GRAPH
  /SCATTERPLOT(BIVAR)=beautyC WITH salary_new BY hair2
  /MISSING=LISTWISE.



*Diagnostický běh na finálním modelu.
REGRESSION
  /DESCRIPTIVES MEAN STDDEV CORR SIG N
  /MISSING LISTWISE
  /STATISTICS COEFF OUTS CI(95) R ANOVA COLLIN TOL CHANGE
  /CRITERIA=PIN(.05) POUT(.10)
  /NOORIGIN 
  /DEPENDENT salary_new
  /METHOD=ENTER age years beautyC hair2 hair2XbeautyC
  /PARTIALPLOT ALL
  /SCATTERPLOT=(*ZRESID ,*ZPRED)
  /RESIDUALS DURBIN HISTOGRAM(ZRESID) NORMPROB(ZRESID)
  /CASEWISE PLOT(ZRESID) OUTLIERS(3)
  /SAVE COOK LEVER.









*Pro všechny 3 kategorie bychom měli 2 moderační členy - pro každou dummy jeden.
*Spočítáme si moderační/interakřní členy.
compute blondXbeautyC =  hair_blond * beautyC.
compute brownXbeautyC =  hair_brown * beautyC.
execute.

REGRESSION
  /DESCRIPTIVES MEAN STDDEV CORR
  /MISSING LISTWISE
  /STATISTICS COEFF OUTS CI(95) R ANOVA COLLIN TOL CHANGE
  /CRITERIA=PIN(.05) POUT(.10)
  /NOORIGIN 
  /DEPENDENT salary_new
  /METHOD=ENTER years age
  /METHOD=ENTER hair_blond hair_brown beautyC 
  /METHOD=ENTER blondXbeautyC brownXbeautyC.