As a part of the final project for Math Modeling course, I would like to propose a mathematical solution to the following problem (given on page 620 in “A first course in Mathematical Modeling (5th ed)”).
This problem is given on page 620.
1995: Aluacha Balaclava College
Aluacha Balaclava College, an undergraduate facility, has just hired a new Provost whose first priority is the institution of a fair and reasonable faculty compensation system. She has hired your consulting team to design a compensation system that reflects the following circumstances and principles.
Faculty are ranked as Instructor, Assistant Professor, Associate Professor, and Professor. Those with Ph.D. degrees are hired at the rank of Assistant Professor. Ph.D. candidates are hired at the rank of Instructor and promoted automatically to Assistant Professor upon completion of their degrees. Faculty may apply for promotion from Associate Professor to Professor after serving at the rank of Associate for 7 or more years. Promotions are determined by the Provost, with recommendations from a faculty committee. Faculty salaries are for the 10-month period September through June, with raises effective beginning in September. The total amount of money available for raises varies yearly and is generally disclosed in March for the following year.
The starting salary this year for an Instructor with no prior teaching experience was $27,000; $32,000 for an Assistant Professor. Upon hire, faculty can receive credit for up to 7 years of teaching experience at other institutions.
Principles
All faculty should get a raise any year that money is available.
Promotion should incur a substantial benefit; e.g., promotion in the minimum possible time should result in a benfiet roughly equal to 7 years of normal raises.
Faculty promoted after 7 or 8 years in rank with careers of at least 25 years should make roughly twice as much at retirement as a starting Ph.D.
Experienced faculty should be paid more than less experienced in the same rank. The effect of additional years of experience should diminish over time; that is, if two faculty stay in the same rank, their salaries should equalize over time.
Design a new pay system, first without cost-of-living increases. Incorporate cost of living increases, and then design a transition process for current faculty that will move all salaries toward your system without reducing anyone’s salary. Existing faculty salaries, ranks, and years of service are shown in Table A.11. Discuss any refinements you think would improve your system.
The Provost requires a detailed compensation system plan for implementation, as well as a brief, clear, executive summary outlining the model, its assumptions, its strengths, its weaknesses, and its expected results, which she can present to the Board and faculty.
I modified the given table to include two additional variables: ID and Designation_Number. ID will uniquely identify a row in the table, and Designation_Number represents the numerical designation of the faculty (1 for Instructor, 2 for Assistant Professor, 3 for Associate Professor, and 4 for Professor)
Table A.11
| ID | Experience | Designation | Salary | Designation_Number |
|---|---|---|---|---|
| 1 | 4 | ASSO | 54000 | 3 |
| 2 | 19 | ASST | 43508 | 2 |
| 3 | 20 | ASST | 39072 | 2 |
| 4 | 11 | PROF | 53900 | 4 |
| 5 | 15 | PROF | 44206 | 4 |
| 6 | 17 | ASST | 37538 | 2 |
| 7 | 23 | PROF | 48844 | 4 |
| 8 | 10 | ASST | 32841 | 2 |
| 9 | 7 | ASSO | 49981 | 3 |
| 10 | 20 | ASSO | 42549 | 3 |
| 11 | 18 | ASSO | 42649 | 3 |
| 12 | 19 | PROF | 60087 | 4 |
| 13 | 15 | ASSO | 38002 | 3 |
| 14 | 4 | ASST | 30000 | 2 |
| 15 | 34 | PROF | 60576 | 4 |
| 16 | 28 | ASST | 44562 | 2 |
| 17 | 9 | ASST | 30893 | 2 |
| 18 | 22 | ASSO | 46351 | 3 |
| 19 | 21 | ASSO | 50979 | 3 |
| 20 | 20 | ASST | 48000 | 2 |
| 21 | 4 | ASST | 32500 | 2 |
| 22 | 14 | ASSO | 38462 | 3 |
| 23 | 23 | PROF | 53500 | 4 |
| 24 | 21 | ASSO | 42488 | 3 |
| 25 | 20 | ASSO | 43892 | 3 |
| 26 | 5 | ASST | 35330 | 2 |
| 27 | 19 | ASSO | 41147 | 3 |
| 28 | 15 | ASST | 34040 | 2 |
| 29 | 18 | PROF | 48944 | 4 |
| 30 | 7 | ASST | 30128 | 2 |
| 31 | 5 | ASST | 35330 | 2 |
| 32 | 6 | ASSO | 35942 | 3 |
| 33 | 8 | PROF | 57295 | 4 |
| 34 | 10 | ASST | 36991 | 2 |
| 35 | 23 | PROF | 60576 | 4 |
| 36 | 20 | ASSO | 48926 | 3 |
| 37 | 9 | PROF | 57956 | 4 |
| 38 | 32 | ASSO | 52214 | 3 |
| 39 | 15 | ASST | 39259 | 2 |
| 40 | 22 | ASSO | 43672 | 3 |
| 41 | 6 | INST | 45500 | 1 |
| 42 | 5 | ASSO | 52262 | 3 |
| 43 | 5 | ASSO | 57170 | 3 |
| 44 | 16 | ASST | 36958 | 2 |
| 45 | 23 | ASST | 37538 | 2 |
| 46 | 9 | PROF | 58974 | 4 |
| 47 | 8 | PROF | 49971 | 4 |
| 48 | 23 | PROF | 62742 | 4 |
| 49 | 39 | ASSO | 52058 | 3 |
| 50 | 4 | INST | 26500 | 1 |
| 51 | 5 | ASST | 33130 | 2 |
| 52 | 46 | PROF | 59749 | 4 |
| 53 | 4 | ASSO | 37954 | 3 |
| 54 | 19 | PROF | 45833 | 4 |
| 55 | 6 | ASSO | 35270 | 3 |
| 56 | 6 | ASSO | 43037 | 3 |
| 57 | 20 | PROF | 59755 | 4 |
| 58 | 21 | PROF | 57797 | 4 |
| 59 | 4 | ASSO | 53500 | 3 |
| 60 | 6 | ASST | 32319 | 2 |
| 61 | 17 | ASST | 35668 | 2 |
| 62 | 20 | PROF | 59333 | 4 |
| 63 | 4 | ASST | 30500 | 2 |
| 64 | 16 | ASSO | 41352 | 3 |
| 65 | 15 | PROF | 43264 | 4 |
| 66 | 20 | PROF | 50935 | 4 |
| 67 | 6 | ASST | 45365 | 2 |
| 68 | 6 | ASSO | 35941 | 3 |
| 69 | 6 | ASST | 49134 | 2 |
| 70 | 4 | ASST | 29500 | 2 |
| 71 | 4 | ASST | 30186 | 2 |
| 72 | 7 | ASST | 32400 | 2 |
| 73 | 12 | ASSO | 44501 | 3 |
| 74 | 2 | ASST | 31900 | 2 |
| 75 | 1 | ASSO | 62500 | 3 |
| 76 | 1 | ASST | 34500 | 2 |
| 77 | 16 | ASSO | 40637 | 3 |
| 78 | 4 | ASSO | 35500 | 3 |
| 79 | 21 | PROF | 50521 | 4 |
| 80 | 12 | ASST | 35158 | 2 |
| 81 | 4 | INST | 28500 | 1 |
| 82 | 16 | PROF | 46930 | 4 |
| 83 | 24 | PROF | 55811 | 4 |
| 84 | 6 | ASST | 30128 | 2 |
| 85 | 16 | PROF | 46090 | 4 |
| 86 | 5 | ASST | 28570 | 2 |
| 87 | 19 | PROF | 44612 | 4 |
| 88 | 17 | ASST | 36313 | 2 |
| 89 | 6 | ASST | 33479 | 2 |
| 90 | 14 | ASSO | 38624 | 3 |
| 91 | 5 | ASST | 32210 | 2 |
| 92 | 9 | ASSO | 48500 | 3 |
| 93 | 4 | ASST | 35150 | 2 |
| 94 | 25 | PROF | 50583 | 4 |
| 95 | 23 | PROF | 60800 | 4 |
| 96 | 17 | ASST | 38464 | 2 |
| 97 | 4 | ASST | 39500 | 2 |
| 98 | 3 | ASST | 52000 | 2 |
| 99 | 24 | PROF | 56922 | 4 |
| 100 | 2 | PROF | 78500 | 4 |
| 101 | 20 | PROF | 52345 | 4 |
| 102 | 9 | ASST | 35798 | 2 |
| 103 | 24 | ASST | 43925 | 2 |
| 104 | 6 | ASSO | 35270 | 3 |
| 105 | 14 | PROF | 49472 | 4 |
| 106 | 19 | ASSO | 42215 | 3 |
| 107 | 12 | ASST | 40427 | 2 |
| 108 | 10 | ASST | 37021 | 2 |
| 109 | 18 | ASSO | 44166 | 3 |
| 110 | 21 | ASSO | 46157 | 3 |
| 111 | 8 | ASST | 32500 | 2 |
| 112 | 19 | ASSO | 40785 | 3 |
| 113 | 10 | ASSO | 38698 | 3 |
| 114 | 5 | ASST | 31170 | 2 |
| 115 | 1 | INST | 26161 | 1 |
| 116 | 22 | PROF | 47974 | 4 |
| 117 | 10 | ASSO | 37793 | 3 |
| 118 | 7 | ASST | 38117 | 2 |
| 119 | 26 | PROF | 62370 | 4 |
| 120 | 20 | ASSO | 51991 | 3 |
| 121 | 1 | ASST | 31500 | 2 |
| 122 | 8 | ASSO | 35941 | 3 |
| 123 | 14 | ASSO | 39294 | 3 |
| 124 | 23 | ASSO | 51991 | 3 |
| 125 | 1 | ASST | 30000 | 2 |
| 126 | 15 | ASST | 34638 | 2 |
| 127 | 20 | ASSO | 56836 | 3 |
| 128 | 6 | INST | 35451 | 1 |
| 129 | 10 | ASST | 32756 | 2 |
| 130 | 14 | ASST | 32922 | 2 |
| 131 | 12 | ASSO | 36451 | 3 |
| 132 | 1 | ASST | 30000 | 2 |
| 133 | 17 | PROF | 48134 | 4 |
| 134 | 6 | ASST | 40436 | 2 |
| 135 | 2 | ASSO | 54500 | 3 |
| 136 | 4 | ASSO | 55000 | 3 |
| 137 | 5 | ASST | 32210 | 2 |
| 138 | 21 | ASSO | 43160 | 3 |
| 139 | 2 | ASST | 32000 | 2 |
| 140 | 7 | ASST | 36300 | 2 |
| 141 | 9 | ASSO | 38624 | 3 |
| 142 | 21 | PROF | 49687 | 4 |
| 143 | 22 | PROF | 49972 | 4 |
| 144 | 7 | ASSO | 46155 | 3 |
| 145 | 12 | ASST | 37159 | 2 |
| 146 | 9 | ASST | 32500 | 2 |
| 147 | 3 | ASST | 31500 | 2 |
| 148 | 13 | INST | 31276 | 1 |
| 149 | 6 | ASST | 33378 | 2 |
| 150 | 19 | PROF | 45780 | 4 |
| 151 | 4 | PROF | 70500 | 4 |
| 152 | 27 | PROF | 59327 | 4 |
| 153 | 9 | ASSO | 37954 | 3 |
| 154 | 5 | ASSO | 36612 | 3 |
| 155 | 2 | ASST | 29500 | 2 |
| 156 | 3 | PROF | 66500 | 4 |
| 157 | 17 | ASST | 36378 | 2 |
| 158 | 5 | ASSO | 46770 | 3 |
| 159 | 22 | ASST | 42772 | 2 |
| 160 | 6 | ASST | 31160 | 2 |
| 161 | 17 | ASST | 39072 | 2 |
| 162 | 20 | ASST | 42970 | 2 |
| 163 | 2 | PROF | 85500 | 4 |
| 164 | 20 | ASST | 49302 | 2 |
| 165 | 21 | ASSO | 43054 | 3 |
| 166 | 21 | PROF | 49948 | 4 |
| 167 | 5 | PROF | 50810 | 4 |
| 168 | 19 | ASSO | 51378 | 3 |
| 169 | 18 | ASSO | 41267 | 3 |
| 170 | 18 | ASST | 42176 | 2 |
| 171 | 23 | PROF | 51571 | 4 |
| 172 | 12 | PROF | 46500 | 4 |
| 173 | 6 | ASST | 35798 | 2 |
| 174 | 7 | ASST | 42256 | 2 |
| 175 | 23 | ASSO | 46351 | 3 |
| 176 | 22 | PROF | 48280 | 4 |
| 177 | 3 | ASST | 55500 | 2 |
| 178 | 15 | ASSO | 39265 | 3 |
| 179 | 4 | ASST | 29500 | 2 |
| 180 | 21 | ASSO | 48359 | 3 |
| 181 | 23 | PROF | 48844 | 4 |
| 182 | 1 | ASST | 31000 | 2 |
| 183 | 6 | ASST | 32923 | 2 |
| 184 | 2 | INST | 27700 | 1 |
| 185 | 16 | PROF | 40748 | 4 |
| 186 | 24 | ASSO | 44715 | 3 |
| 187 | 9 | ASSO | 37389 | 3 |
| 188 | 28 | PROF | 51064 | 4 |
| 189 | 19 | INST | 34265 | 1 |
| 190 | 22 | PROF | 49756 | 4 |
| 191 | 19 | ASST | 36958 | 2 |
| 192 | 16 | ASST | 34550 | 2 |
| 193 | 22 | PROF | 50576 | 4 |
| 194 | 5 | ASST | 32210 | 2 |
| 195 | 2 | ASST | 28500 | 2 |
| 196 | 12 | ASSO | 41178 | 3 |
| 197 | 22 | PROF | 53836 | 4 |
| 198 | 19 | ASSO | 43519 | 3 |
| 199 | 4 | ASST | 32000 | 2 |
| 200 | 18 | ASSO | 40089 | 3 |
| 201 | 23 | PROF | 52403 | 4 |
| 202 | 21 | PROF | 59234 | 4 |
| 203 | 22 | PROF | 51898 | 4 |
| 204 | 26 | ASSO | 47047 | 3 |
Our main objective is to design an optimal compensation and promotion system, which is fair, and at the same time minimizes the expenses (related to salary/promotions) of the University.
We will solve the problem without considering the inflation (cost of living)
In the problem it was mentioned that if a faculty serves for more than 25 years in a specific rank, then he should get at least twice the salary of a starting PhD. But in the given data it is not mentioned for how many years the current faculty members have served in their respective roles. So I am assuming that if a faculty member has more than 25 years of experience, then we consider that he has served in that rank for 25 years.
Starting PhD candidate is assumed as Assitant Professor (with a salary of 32000$ per annum)
Since we are not given the faculty’s desired retirement age, and also the age of the faculty when they started their careers, we will make this assumption: All faculty members (excluding the instructors) start at the age of 25 years and retire at the age of 65. But the faculty can continue working even after the age of 65, if they desire. If the faculty retires at the age of 65 or later, and served for at least 25 years (experience), then he should get at least 64000$ (twice the salary of Assistant professor), during his retirement.
Once a faculty attains 25 years of experience, an additional factor (for retirement catch up) will be added, to make sure that he receives at least 64000$, when he retires at 65 years of age (or 40 years of experience). So to get maximum benefit, the faculty, who worked for more than 25 years, should consider retiring at 65 years of age or later, to get the maximum benefit of getting twice the salary of an assistant professor (start up PhD degree holder).
It was mentioned in the problem that the instructors would be automatically prompted to Assistant Professor level, once they obtain their PhD degree. So we will ignore the instructors from our analysis.
Since all the faculty members must get a raise every year for members who are already getting more than the average pay, will be given a raise of just 1$, so that the salaries will have a linear trend.
We need the following R packages to perform the analysis
If these packages are not available, you have to insatll them using the command: “install.packages()”
library(ggplot2)
library(knitr)
library(gridExtra)
library(dplyr)
##
## Attaching package: 'dplyr'
##
## The following object is masked from 'package:gridExtra':
##
## combine
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
Let us do the graphical analysis.
Reading the data to a data frame:
library(knitr)
#setwd("C:/Users/Sekhar/Documents/R Programs/Math Modeling/Project")
df <- read.csv("data.csv")
#kable(df)
We will plot the all the ranks separately, and fit a linear equation:
df_inst_proff <- df[df$Designation_Number == 1,]
df_assist_proff <- df[df$Designation_Number == 2,]
df_asso_proff <- df[df$Designation_Number == 3,]
df_proff <- df[df$Designation_Number == 4,]
##Plotting assistant professor salary
lin_function <- lm(data=df_assist_proff,Salary~Experience)
predict_sal <- predict(lin_function)
predict_df <- data.frame(Experience=df_assist_proff$Experience,Salary=predict_sal)
p1 <- ggplot(df_assist_proff,aes(x = Experience, y = Salary)) +
geom_point(color="blue",size=3)+
geom_line(data=predict_df,aes(y=Salary),color="red") +
labs(title="Assistant Professor \n salary",x="Experience in years", y="Salary")
##Plotting associate professor salary
lin_function <- lm(data=df_asso_proff,Salary~Experience)
predict_sal <- predict(lin_function)
predict_df <- data.frame(Experience=df_asso_proff$Experience,Salary=predict_sal)
p2 <- ggplot(df_asso_proff,aes(x = Experience, y = Salary)) +
geom_point(color="green",size=3)+
geom_line(data=predict_df,aes(y=Salary),color="red") +
labs(title="Associate Professor \n salary",x="Experience in years", y="Salary")
lin_function <- lm(data=df_proff,Salary~Experience)
predict_sal <- predict(lin_function)
predict_df <- data.frame(Experience=df_proff$Experience,Salary=predict_sal)
p3 <- ggplot(df_proff,aes(x = Experience, y = Salary)) +
geom_point(color="violet",size=3)+
geom_line(data=predict_df,aes(y=Salary),color="red") +
labs(title="Professor salary",x="Experience in years", y="Salary")
grid.arrange(p1,p2,p3,ncol=3,top="Figure-1: Salary, Experience and linear fit of all Ranks\n")
In figure-1, we plotted the salary vs experience for three ranks, along with a linear equation line. We can observe that the professors salary is having negative slope. This is because of the presence of outliers. A visual inspection is showing that 4 professors with less than 5 years of experience are getting more than 65000$. These observations are outliers. Unless we have a positive slope, we cannot design a fair compensation system, since we have the constraint that everyone should receive a raise, and due to the presence of outliers, a negative slope line will stay negative (unless the lower salaries are significantly raised, which increases the costs to the University). Hence we have to eliminate the salaries of professors who are getting over paid (whose salaries are already greater than 64000$), from further analysis. For such outliers we will give a nominal increase of just 1$ per year, and avoid them in further analysis. The following observations will be eliminated:
df_proff[df_proff$Salary > 64000,]
## ID Experience Designation Salary Designation_Number
## 100 100 2 PROF 78500 4
## 151 151 4 PROF 70500 4
## 156 156 3 PROF 66500 4
## 163 163 2 PROF 85500 4
df_proff_eliminate <- df_proff[df_proff$Salary > 64000,]
df_proff <- df_proff[df_proff$Salary <= 64000,]
The following graph shows the plot of professors salary, after eliminating the outliers:
lin_function <- lm(data=df_proff,Salary~Experience)
predict_sal <- predict(lin_function)
predict_df <- data.frame(Experience=df_proff$Experience,Salary=predict_sal)
ggplot(df_proff,aes(x = Experience, y = Salary)) +
geom_point(color="violet",size=3)+
geom_line(data=predict_df,aes(y=Salary),color="red") +
labs(title="Figure-2: Professor salary after eliminating outliers",x="Experience in years", y="Salary")
Now we see a positive slope for professors salary.
Our main goal is to make sure that the salaries are paid fairly, and they should be based on the experience. This means, the existing salaries must be adjusted to make sure that \(Salary \propto Experience\). This must be made gradually, satisfying the constraints given in the problem. We will use linear regression (separately for each ranks), and give a nominal increase of salary (just 1$) to members lying above the linear regression line, and for members lying below the regression line will be given a raise based on the linear regresion. If the faculty member has more than 25 years of experience, then the raise should also include an additional component, so that he gets at least 64000$ at his retirement age (65 years).
For promotions, we will promote a member to the next rank for the following 2 scenarios:
If the average experience of the next level is less than the member’s experience, and if the average salary of the next level is more than the member’s salary, then we will promorte him to the next level.
If the increment for a member is significant (at least 7 times the average increment in his rank), then we will promote him to next level.
Based on the logic discussed above we will use the following algorithm for optimal salary raise and promotions of the faculty members:
Step 0: Separate the data into three data frames: Professor, Associate_Professor, and Assistant_Professor. Set the variable Inflation = 1
Repeat the following steps for 10 times (or desired number of times depending on how many years of projection is needed):
Step 1: Examine the data of Assistant_Professor, and if a member has to be promoted to Associate professor, then remove him from Assistant_Professor data frame and add him to Associate_Professor data frame.
Step 2: Examine the data of Associate_Professor, and if a member has to be promoted to Professor, then remove him from Assciate_Professor data frame and add him to Professor data frame.
Step 3: For Assistant_Professor data frame and Associate_Professor data frame, perform the following:
3a. Fit a linear regression line of the form Salary = a . Experience + C.
3b. Using the linear equation obtained above, compute the Predicted_Salary
3c. Get the difference between the predicted salary and the Current_Salary. Diff = Predicted_Salary - Current_Salary
3d. If the difference is positive, then set Increment = Diff + Inflation, else Increment = Inflation
3e. Set New_Salary = Current_Salary + Increment
3f. If the Experience of a member is more than 25 years and less than or equal to 39 years, then
Retirement_Catchup = ((64000)/ (40 - experience) - New_Salary)
Else if Experience >= 40, then
Retirement_Catchup = ((64000) - New_Salary)
Else Retirement_Catchup = 0
3g. If Retirement_Catchup <= 0, then Retirement_Catchup = 0
3h. New_Salary = New_Salary + Retirement_Catchup
3i. Get the average Average_Increment
3j. If the Increment >= 7 times the Average_Increment, then promote to the next level
3k. Get the average salary of the next level and average experience of the next level: Avg_Salary_Next_Level and Avg_Exp_Next_Level.
3l. If the New_Salary < Avg_Salary_Next_Level and Experience > Avg_Exp_Next_Level, then Promote to next level.
Step 4: For Professor data frame (after eliminating the outliers), perform the following:
4a. Fit a linear regression line of the form Salary = a . Experience + C.
4b. Using the linear equation obtained above, compute the Predicted_Salary
4c. Get the difference between the predicted salary and the Current_Salary. Diff = Predicted_Salary - Current_Salary
4d. If the difference is positive, then set Increment = Diff + Inflation, else Increment = Inflation
4e. Set New_Salary = Current_Salary + Increment
4f. If the Experience of a member is more than 25 years and less than or equal to 39 years, then
Retirement_Catchup = ((64000)/ (40 - experience) - New_Salary)
Else if Experience >= 40, then
Retirement_Catchup = ((64000) - New_Salary)
Else Retirement_Catchup = 0
4g. If Retirement_Catchup <= 0, then Retirement_Catchup = 0
4h. New_Salary = New_Salary + Retirement_Catchup
4i. For outliers in professor's data frame, set New_Salary = Salary + 1
Step 5: Increment everyone's experience by 1 year
Step 6: Set Current_Salary = New_Salary
The following R code will implement the above algorithm on the given data:
#Separate the data into 3 data frames:
df_assist_proff <- df[df$Designation_Number == 2,]
df_asso_proff <- df[df$Designation_Number == 3,]
df_proff <- df[df$Designation_Number == 4,]
df_assist_proff$promote <- "NO"
df_asso_proff$promote <- "NO"
df_proff$promote <- "NO"
#Create a data frame to hold the eliminated records
df_eliminate <- data.frame()
for(i in 1:20)
{
#df_assist_proff <- df[df$Designation_Number == 2,]
df_proff <- rbind(df_proff,df_asso_proff[df_asso_proff$promote=="YES",])
df_asso_proff <- df_asso_proff[df_asso_proff$promote=="NO",]
df_asso_proff <- rbind(df_asso_proff,df_assist_proff[df_assist_proff$promote=="YES",])
df_assist_proff <- df_assist_proff[df_assist_proff$promote=="NO",]
df_assist_proff$promote <- "NO"
df_asso_proff$promote <- "NO"
df_proff$promote <- "NO"
#Eliminate the outliers from all the data frames:
df_eliminate <- rbind(df_eliminate,df_proff[df_proff$Salary > 64000,])
df_proff <- df_proff[df_proff$Salary <= 64000,]
df_eliminate <- rbind(df_eliminate,df_assist_proff[df_assist_proff$Salary > 64000,])
df_assist_proff <- df_assist_proff[df_assist_proff$Salary <= 64000,]
df_eliminate <- rbind(df_eliminate,df_asso_proff[df_asso_proff$Salary > 64000,])
df_asso_proff <- df_asso_proff[df_asso_proff$Salary <= 64000,]
df_eliminate
#Get the average salary and experience of the next levels:
proff_exp_mean <- mean(df_proff$Experience)
assoc_exp_mean <- mean(df_asso_proff$Experience)
#assist_exp_mean <- mean(df_assist_proff$Experience)
proff_sal_mean <- mean(df_proff$Salary)
assoc_sal_mean <- mean(df_asso_proff$Salary)
#assist_sal_mean <- mean(df_assist_proff$Salary)
lin_function <- lm(data=df_assist_proff,Salary~Experience)
predict_sal <- predict(lin_function)
predict_df <- data.frame(Experience=df_assist_proff$Experience,Salary=predict_sal)
p1 <- ggplot(df_assist_proff,aes(x = Experience, y = Salary)) +
geom_point(size=2,color="blue")+
geom_line(data=predict_df,aes(y=Salary),color="red") +
labs(title=paste("Assistant Professor salary.\n Beginning of year",i),x="Experience in years", y="Salary")
inflation <- 1
increment <- (predict_sal - df_assist_proff$Salary)
increment <- ifelse(increment <= 0, inflation, increment)
new_salary <- df_assist_proff$Salary + increment
retirement_catchup <- vector()
for(j in 1:length(new_salary))
{
retirement_catchup[j] <- 0
if(df_assist_proff$Experience[j] >= 25 & df_assist_proff$Experience[j] <= 39)
retirement_catchup[j] <- ((64000)/ (40 - df_assist_proff$Experience[j]) - new_salary[j])
if(df_assist_proff$Experience[j] >= 40)
retirement_catchup[j] <- (64000- new_salary[j])
if(retirement_catchup[j] < 0) retirement_catchup[j] <- 0
}
new_salary <- (new_salary + retirement_catchup)
increment <- new_salary - df_assist_proff$Salary
df_assist_proff$promote[which(df_assist_proff$Experience >= assoc_exp_mean & df_assist_proff$Salary <=assoc_sal_mean)] <- "YES"
#inc_indx <- which(df_assist_proff$promote == "YES")
#new_salary[inc_indx] <- (df_assist_proff$Salary[inc_indx] + 7*increment[inc_indx])
avg_increment <- mean(increment)
df_assist_proff[df_assist_proff$promote == "YES",]$Salary <- df_assist_proff[df_assist_proff$promote == "YES",]$Salary + 7 * avg_increment
#new_salary[inc_indx] <- (df_asso_proff$Salary[inc_indx] + 7*avg_increment)
df_assist_proff$promote[which(increment >= 7*avg_increment)] <- "YES"
#df_assist_proff$Salary <- (df_assist_proff$Salary + increment + retirement_catchup)
df_assist_proff$Salary <- new_salary
df_assist_proff$Experience <- (df_assist_proff$Experience + 1)
p2 <- ggplot(df_assist_proff,aes(x = Experience, y = Salary, color=promote)) +
geom_point(size=3)+
geom_line(data=predict_df,aes(y=Salary),color="red") +
labs(title=paste("Assistant Professor salary.\n Ending of year",i),x="Experience in years", y="Salary")
grid.arrange(p1,p2,ncol=2
#,top="Figure-1: Salary, Experience and linear fit of all Ranks\n"
)
print(lin_function)
df_eliminate$Salary <- df_eliminate$Salary + 1
df_eliminate$Experience <- df_eliminate$Experience + 1
}
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 32084.5 408.6
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 33258.1 468.7
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 34229.4 469.4
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 35092.7 455.7
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 35920.3 430.5
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 36639.5 409.6
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 37399.2 379.3
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 38128 353
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 38876 326
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 39681.9 293.5
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 40462 263
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 41208.9 234.9
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 42119.3 197.2
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 42960.5 165.5
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 43768.5 137.2
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 44557.3 111.2
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 45330.03 87.04
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 46087.01 64.63
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 46827.99 43.79
##
## Call:
## lm(formula = Salary ~ Experience, data = df_assist_proff)
##
## Coefficients:
## (Intercept) Experience
## 47552.71 24.42