% RRSP Expert System
% Author: JX 
% Date: 11.28.2015
%
% To run: type "main."
%
% See README/Description for details

%Descriptive constants only --- I hard coded them instead
rrspEAR([1.05]). % 1 + Eff Annual rate. Will not be used
rrspEMR([1.0040741]). % 1 + Eff monthly rate, converted from EAR
currentYear([2015]).
%
% RRSPs are compounded monthly

askBalance:-
   nl,write('Do you have an RRSP Balance? (yes. / no.)'),nl.
hasBalance(yes,X) :-
   enterBalance,
   read(X).
hasBalance(no,X) :-
   X is 0.

%---Tax calculations------------------------
%---http://www.taxtips.ca/taxrates/mb.htm
askTax:-
   nl,write('Would you like to include income tax for calculations? (yes. / no.)'),nl.
hasTax(yes,IncomeTax):-
   askBracket,
   read(Income),
   provincialTax(Income,X),
   federalTax(Income,Y),
   IncomeTax is X + Y.
hasTax(no,IncomeTax):-
   IncomeTax = 0.

askBracket :-
   nl,write('What is your yearly income? (For income tax bracket calculations)'),nl.

provincialTax(Income,X):-
   Income < 31000.01,
   X is 0.1080.

provincialTax(Income,X):-
   Income < 67000.01,
   X is 0.1275.

provincialTax(Income,X):-
   Income > 67000,
   X is 0.1740.

%Estimated federal tax levels only (Assumes no div/capital investments)
federalTax(Income,X):-
   Income < 31000.01, X is 0.2580;
   Income < 45282.01, Income > 31000, X is 0.2775; 
   Income < 67000.01, Income > 45282, X is 0.3325;
   Income < 90563.01, Income > 67000, X is 0.3790;
   Income < 140388.01, Income > 90563, X is 0.4340;
   Income < 200000.01, Income > 140388, X is 0.4640;
   Income > 200000.01, X is 0.5040.
   
%-----------------------------------------
%Health
askHealthConditions :-
   nl,write('Would you like to answer Health-related questions? (yes. / no.)'),nl.

%Smoker
condition(1, Range1, Range2):-
Range1 is 8,
Range2 is 10.

%Depression
condition(2, Range1, Range2):-
Range1 is 7,
Range2 is 11.

%Personality
condition(3, Range1, Range2):-
Range1 is 13,
Range2 is 22.

%Schizophrenia
condition(4, Range1, Range2):-
Range1 is 10,
Range2 is 20.

%Bipolar
condition(5, Range1, Range2):-
Range1 is 9,
Range2 is 20.

%Substance abuse
condition(6, Range1, Range2):-
Range1 is 9,
Range2 is 24.

searchConditions([],P1,P2,Total1,Total2):-
      Total1 is P1,
      Total2 is P2.

searchConditions([H|T], PenaltyLow, PenaltyHigh,Total1,Total2):-
   condition(H,P1,P2),
   NewP1 is PenaltyLow + P1,
   NewP2 is PenaltyHigh + P2,
   searchConditions(T, NewP1, NewP2,Total1,Total2).

%Penalties must not be instantiated.
healthPenalty(List,PenaltyLow,PenaltyHigh) :- 
   length(List,Size),
   Size \= 0,
   searchConditions(List,0,0,Total1,Total2),
   PenaltyLow is (Total1/Size),
   PenaltyHigh is (Total2/Size).
%-----------------------------------------
%
%Prompt
%
enterBalance:-
   nl,write('Enter your present balance: (#)'),nl.
enterAge:-
   nl,write('Enter your current age: (#)'),nl.
printOptions :-
   nl,write('Type an Option #:'),
   nl,write('"1" Balance needed for a Future Balance (No Periodic Attributions/Deposits)'),
   nl,write('"2" Balance needed for a Specified RRSP monthly income after a Specified Retirement date'),
   nl,write('"3" Monthly Attributions needed for a Future Balance'),
   nl,write('"4" Monthly Attributions needed for a Specified RRSP monthly income after a Specified Retirement date'),
   nl,write('Description ---- RRSP contributions are PRETAX and accumulate interest PRETAX. 
Only when withdrawls are taken is when they are taxed as income. So "attribution" input are before-tax.'),
   nl.
   %nl,write('Years required given monthly attributions'), requires logs
enterFV :-
   nl,write('Enter your desired future value in your RRSP Account: (#)'),nl.
enterN :-
   nl,write('Enter your what year you plan on retiring: (YYYY)'),nl.
enterC :-
   nl,write('Enter your end of month monthly attributions: (#)'),nl.
enterRetirementIncome :-
   nl,write('Enter your desired monthly RRSP income(after-tax dollars, if relevant): (#)'),nl.
enterLifeExpectancy :-
   nl,write('Enter your life expectancy age: (#)'),nl.
enterHealthConditions:-
   nl,write('List of conditions:'),
   nl,write('1 Heavy Smoker'),
   nl,write('2 Single/Recurrent Depression'),
   nl,write('3 Personality disorders'),
   nl,write('4 Schizophrenia'),
   nl,write('5 Bipolar'),
   nl,write('6 Substance abuse(Drug/Alcohol addict)'),
   nl,write('List your conditions, typing out the associated number. i.e "[1,2,5].", "[]." if not applicable'),nl,
   nl,write('Effects of conditions are averaged and not summed'),nl.
enterRAge :-
   nl,write('Enter your what age you plan on retiring: (#)'),nl.
writeBalance(V):-
   nl,write('You would need $'), write(V), write(' Canadian dollars at present in your RRSP account.').
writeMonthly(V):-
   nl,write('You would need to deposit $'), write(V), write(' Canadian dollars at the end of each month into your account, starting at the end of Jan 2015').
writeLifeExpectancy(N):-
   nl, write('Your Life Expectancy: '), write(N).
writeRetirementYear(N):-
   nl, write('Retirement Year: '), write(N).
writeCurrentYear(N):-
   nl, write('Current Year: '), write(N).


calculateTVM(PV,N,FV,V) :-
   nonvar(PV),
   nonvar(FV),
   nonvar(N),
   var(V),
   TempN is (N - 2015)*12,
   TempR is 1.0040741^TempN,
   CurrentFV is TempR*PV,
   NeededFV is FV-CurrentFV,
   V is NeededFV/TempR,
   nl,write('5% RRSP EAR, Number of months compounded: '), write(TempN), 
   nl,write('Future RRSP Balance needed: '), write(NeededFV),nl.

calculateTVMPeriodic(PV,N,FV,C) :-
   nonvar(PV),
   nonvar(FV),
   nonvar(N),
   var(C),
   TempN is (N - 2015)*12,
   TempR is (1.0040741^TempN),
   TempR2 is (TempR-1)/0.0040741,
   CurrentFV is TempR*PV,
   NeededFV is FV-CurrentFV,
   C is NeededFV/TempR2,
   nl,write('5% RRSP EAR, Number of months compounded: '), write(TempN), 
   nl,write('Future RRSP Balance needed: '), write(NeededFV),nl.

calculateTVMPeriodic(PV,N,FV,C) :-
   nonvar(C),
   nonvar(FV), %We don't do any positive FV calcs when finding PV given C, the only case for FV given these cases are coupon bonds.
   nonvar(N),
   var(PV),
   TempN is (N*12), %N2 is passed already as a subtracted value.. as the year calculation base wouldn't be 2015 for an after retirement calc.
   TempR is (1.0040741^TempN),
   TempR2 is (1-(1/TempR)),
   PV is ((C*TempR2)/0.0040741),
   nl,write('5% RRSP EAR, Number of months compounded after retirement: '), write(TempN).

convBeforeTax(C2BeforeTax,C2,IncomeTax):-
   nonvar(C2),
   nonvar(IncomeTax),
   C2BeforeTax is (C2/(1-IncomeTax)),
   nl, write("Specified desired Retirement Income: "), write(C2),
   nl, write("Specified desired Retirement BeforeTax Income(Equal if no tax specified): "), write(C2BeforeTax),
   nl, write("Income tax: "), write(IncomeTax),
   nl, write("** Assumes you remain in the same income bracket and taxes remain at 2015 brackets.").

%The life expectancy of a healthy individual above 20 is 84 according to data.csv
processLifeExp(yes, LifeExp):-
   enterHealthConditions,
   read(ConditionList),
   healthPenalty(ConditionList,LowPenalty,HighPenalty),
   LifeExp is (86 - ((HighPenalty + LowPenalty)/2)).

processLifeExp(no, LifeExp):-
   enterLifeExpectancy,
   read(LifeExp).

%Used for option 2 and 4
calculateRetirementBalance(FV,NYear,IncomeTax):-
   enterRetirementIncome,
   read(C2),
   enterAge,
   read(Age),
   enterRAge,
   read(RAge),
   askHealthConditions,
   read(Ask),
   processLifeExp(Ask, LifeExp),
   N2 is (LifeExp - RAge), %Calculate Life exp - retirement age = Years after retirement
   N is (RAge - Age), %Calculate Retirement age - current age = Years before retirement
   NYear is (N + 2015),
   N2Year is (N2 + NYear),
   nl,
   writeLifeExpectancy(LifeExp),
   writeCurrentYear(2015),
   writeRetirementYear(N2Year),
   convBeforeTax(C2BeforeTax,C2,IncomeTax), %Because User Inputs an "after-tax" dollar amount, we must do a conversion
   calculateTVMPeriodic(FV,N2,0,C2BeforeTax). %calculate FV, or PV at retirement age. Compounded at the same rate.

%-----All options------
%Income tax only relevant for option 2 and 4
%Option 1
calculateOption(101,PV,_):-
   enterFV,
   read(FV),
   enterN,
   read(N),
   writeCurrentYear(2015),
   writeRetirementYear(N),
   calculateTVM(PV,N,FV,V), %calculate V
   writeBalance(V).

%Option 2
calculateOption(102,PV,IncomeTax):-
   calculateRetirementBalance(FV,NYear,IncomeTax), %calculate FV, or PV at retirement age. Compounded at the same rate.
   calculateTVM(PV,NYear,FV,V), %calculate PV
   writeBalance(V).

%Option 3
calculateOption(103,PV,_):-
   enterFV,
   read(FV),
   enterN,
   read(N),
   writeCurrentYear(2015),
   writeRetirementYear(N),
   calculateTVMPeriodic(PV,N,FV,C), %calculate C
   writeMonthly(C).

%Option 4
calculateOption(104,PV,IncomeTax):-
   calculateRetirementBalance(FV,NYear,IncomeTax), %calculate FV, or PV at retirement age. Compounded at the same rate.
   calculateTVMPeriodic(PV,NYear,FV,C), %calculate C
   writeMonthly(C).

processOption(Option,PV,IncomeTax):- 
   Option =:= 1,
   calculateOption(101,PV,IncomeTax).

processOption(Option,PV,IncomeTax):- 
   Option =:= 2,
   calculateOption(102,PV,IncomeTax).

processOption(Option,PV,IncomeTax):- 
   Option =:= 3,
   calculateOption(103,PV,IncomeTax).

processOption(Option,PV,IncomeTax):- 
   Option =:= 4,
   calculateOption(104,PV,IncomeTax).

%-----Main------
%repeat, Loop not included in this prototype.
loop(yes).

run(PV,Income) :- 
   printOptions,
   read(Option),
   processOption(Option,PV,Income),
   nl,nl,
   write('Would you like to another calculation? (yes./no.)'),nl,
   read(Input),
   loop(Input),
   run(PV,Income).

intro(PV,IncomeTax):-
   nl,write('Individual RRSP Planning with non-inflated calculations.'),nl,
   askBalance,
   read(B),
   hasBalance(B,PV),
   askTax,
   read(T),
   hasTax(T,IncomeTax).

main :- intro(PV,IncomeTax),run(PV,IncomeTax).

/**********************************************
* Sample output
2 ?- main.

Individual RRSP Planning with non-inflated calculations.

Do you have an RRSP Balance? (yes. / no.)
|: no.

Would you like to include income tax for calculations? (yes. / no.)
|: yes.

What is your yearly income? (For income tax bracket calculations)
|: 31000.

Type an Option #:
"1" Balance needed for a Future Balance (No Periodic Attributions/Deposits)
"2" Balance needed for a Specified RRSP monthly income after a Specified Retirement date
"3" Monthly Attributions needed for a Future Balance
"4" Monthly Attributions needed for a Specified RRSP monthly income after a Specified Retirement date
Description ---- RRSP contributions are PRETAX and accumulate interest PRETAX. 
Only when withdrawls are taken is when they are taxed as income. So "attribution" input are before-tax.
|: 4.

Enter your desired monthly RRSP income(after-tax dollars, if relevant): (#)
|: 20000.

Enter your current age: (#)
|: 20.

Enter your what age you plan on retiring: (#)
|: 65.

Would you like to answer Health-related questions? (yes. / no.)
|: yes.

List of conditions:
1 Heavy Smoker
2 Single/Recurrent Depression
3 Personality disorders
4 Schizophrenia
5 Bipolar
6 Substance abuse(Drug/Alcohol addict)
List your conditions, typing out the associated number. i.e "[1,2,5].", "[]." if not applicable

Effects of conditions are averaged and not summed
|: [1,6].


Your Life Expectancy: 73.25
Current Year: 2015
Retirement Year: 2068.25
Specified desired Retirement Income: 20000
Specified desired Retirement BeforeTax Income(Equal if no tax specified): 31545.741324921135
Income tax: 0.366
** Assumes you remain in the same income bracket and taxes remain at 2015 brackets.
5% RRSP EAR, Number of months compounded after retirement: 99.0
5% RRSP EAR, Number of months compounded: 540
Future RRSP Balance needed: 2565755.653435586

You would need to deposit $1309.1152608387179 Canadian dollars at the end of each month into your account, starting at the end of Jan 2015

Would you like to another calculation? (yes./no.)
|: yes.

Type an Option #:
"1" Balance needed for a Future Balance (No Periodic Attributions/Deposits)
"2" Balance needed for a Specified RRSP monthly income after a Specified Retirement date
"3" Monthly Attributions needed for a Future Balance
"4" Monthly Attributions needed for a Specified RRSP monthly income after a Specified Retirement date
Description ---- RRSP contributions are PRETAX and accumulate interest PRETAX. 
Only when withdrawls are taken is when they are taxed as income. So "attribution" input are before-tax.
|: 1.

Enter your desired future value in your RRSP Account: (#)
|: 1000000.

Enter your what year you plan on retiring: (YYYY)
|: 2200.

Current Year: 2015
Retirement Year: 2200
5% RRSP EAR, Number of months compounded: 2220
Future RRSP Balance needed: 1000000.0

You would need $120.22713821052506 Canadian dollars at present in your RRSP account.

Would you like to another calculation? (yes./no.)
|: no.

****Sometimes it glitches ********* Just type invalid input afterwards.

false.

************************/
