Get the data...

Originally taken from Eric Fischer’s CSV, via the command commented out below.

(* csvData = Import["/Users/swaldman/development/contrib-git/housing-inventory/combined.csv"] *)

Now, the raw data is just embedded to keep things portable.

csvData={{"year","median_rent","housing_units","net_new_housing","employment","total_wages","CPI"},{1906,"NA",84077,8444,"NA","NA","NA"},{1907,"NA",100342,16265,"NA","NA","NA"},{1908,"NA",111220,10878,"NA","NA","NA"},{1909,"NA",117465,6245,"NA","NA","NA"},{1910,"NA",125112,7647,"NA","NA","NA"},{1911,"NA",131757,6645,"NA","NA","NA"},{1912,"NA",139018,7261,"NA","NA","NA"},{1913,"NA",144416,5398,"NA","NA",0.1`},{1914,"NA",149208,4792,"NA","NA",0.101`},{1915,"NA",153048,3840,"NA","NA",0.102`},{1916,"NA",156970,3922,"NA","NA",0.11`},{1917,"NA",159021,2051,"NA","NA",0.129`},{1918,"NA",159864,843,"NA","NA",0.151`},{1919,"NA",161761,1897,"NA","NA",0.174`},{1920,35,163734,1973,"NA","NA",0.201`},{1921,"NA",166143,2409,"NA","NA",0.18`},{1922,"NA",172014,5871,"NA","NA",0.169`},{1923,"NA",180461,8447,"NA","NA",0.172`},{1924,"NA",189278,8817,"NA","NA",0.172`},{1925,"NA",199321,10043,"NA","NA",0.176`},{1926,"NA",208072,8751,"NA","NA",0.178`},{1927,"NA",217456,9384,"NA","NA",0.175`},{1928,"NA",223869,6413,"NA","NA",0.172`},{1929,"NA",227815,3946,"NA","NA",0.172`},{1930,"NA",230456,2641,"NA","NA",0.168`},{1931,"NA",233169,2713,"NA","NA",0.153`},{1932,"NA",234663,1494,"NA","NA",0.137`},{1933,"NA",235376,713,"NA","NA",0.13`},{1934,"NA",235667,291,"NA","NA",0.135`},{1935,"NA",236494,827,"NA","NA",0.138`},{1936,"NA",238463,1969,"NA","NA",0.139`},{1937,"NA",240508,2045,"NA","NA",0.144`},{1938,"NA",242934,2426,"NA","NA",0.142`},{1939,"NA",246102,3168,"NA","NA",0.14`},{1940,"NA",250877,4775,"NA","NA",0.141`},{1941,"NA",255257,4380,"NA","NA",0.148`},{1942,"NA",258686,3429,"NA","NA",0.164`},{1943,"NA",259793,1107,"NA","NA",0.174`},{1944,"NA",261260,1467,"NA","NA",0.177`},{1945,"NA",262863,1603,"NA","NA",0.181`},{1946,"NA",265234,2371,"NA","NA",0.196`},{1947,"NA",268555,3321,"NA","NA",0.225`},{1948,130,271901,3346,"NA","NA",0.242`},{1949,100,274572,2671,"NA","NA",0.24`},{1950,115,277836,3264,"NA","NA",0.242`},{1951,100,281157,3321,"NA","NA",0.261`},{1952,88,282390,1233,"NA","NA",0.267`},{1953,80,283621,1231,"NA","NA",0.269`},{1954,75,285137,1516,"NA","NA",0.27`},{1955,77.5`,287081,1944,"NA","NA",0.269`},{1956,75,288679,1598,"NA","NA",0.273`},{1957,85,289988,1309,"NA","NA",0.283`},{1958,95,291798,1810,"NA","NA",0.291`},{1959,115,294027,2229,"NA","NA",0.293`},{1960,110,295256,1229,"NA","NA",0.298`},{1961,115,297135,1879,"NA","NA",0.301`},{1962,120,300173,3038,"NA","NA",0.304`},{1963,130,303107,2934,"NA","NA",0.308`},{1964,135,307043,3936,"NA","NA",0.312`},{1965,130,310497,3454,"NA","NA",0.317`},{1966,135,313093,2596,"NA","NA",0.326`},{1967,145,313867,774,"NA","NA",0.336`},{1968,165,314645,778,"NA","NA",0.35`},{1969,175,315112,467,"NA","NA",0.369`},{1970,200,315372,260,"NA","NA",0.39`},{1971,205,316312,940,"NA","NA",0.407`},{1972,195,317162,850,"NA","NA",0.421`},{1973,215,317815,653,"NA","NA",0.447`},{1974,220,319495,1680,"NA","NA",0.496`},{1975,250,321551,2056,441614,5423094370,0.541`},{1976,260,322324,773,440498,5792051735,0.572`},{1977,315,323804,1480,446824,6334434056,0.609`},{1978,310,325005,1201,508424,7513067243,0.656`},{1979,375,326407,1402,528041,8403483289,0.731`},{1980,422.775`,327259,852,553861,9668389157,0.829`},{1981,470.265`,327751,492,563506,10797969557,0.914`},{1982,536.751`,328298,547,551774,11628517407,0.969`},{1983,536.751`,329465,1167,547154,12429122015,0.998`},{1984,600,330176,711,561880,13289475500,1.033`},{1985,683.97`,331639,1463,564481,14197798395,1.069`},{1986,778.95`,332973,1334,566327,15060386085,1.086`},{1987,826.44`,334399,1426,568836,15711358688,1.125`},{1988,778.95`,336306,1907,571533,16544183422,1.17`},{1989,821.691`,338651,2345,582115,17255905018,1.226`},{1990,897.675`,340388,1737,580950,18206304313,1.29`},{1991,921.42`,342120,1732,570861,19147767225,1.343`},{1992,911.922`,342845,725,538348,19183097194,1.382`},{1993,888.177`,343133,288,531298,19488299228,1.421`},{1994,968.91`,344319,1186,526881,20058525527,1.456`},{1995,1016.4`,344720,401,528498,20965394091,1.498`},{1996,1253.85`,345403,683,543998,22582561752,1.541`},{1997,1491.3`,346128,725,559696,24798503556,1.576`},{1998,1871.22`,347002,874,574902,27223158825,1.597`},{1999,1866.471`,348287,1285,590391,30318164358,1.632`},{2000,1966.2`,350084,1797,609138,35044909148,1.689`},{2001,2250,351863,1779,586085,35790834351,1.735`},{2002,1740,354271,2408,547304,32022607711,1.759`},{2003,1700,356767,2496,532908,31353901856,1.798`},{2004,1650,358254,1487,520434,32459354675,1.845`},{2005,1625,360109,1855,524940,34955970674,1.91`},{2006,1900,362023,1914,536304,37932234352,1.971`},{2007,2500,364590,2567,556401,41799789955,2.02767`},{2008,2300,367853,3263,573011,43269507745,2.11053`},{2009,2100,371307,3454,549716,40458651115,2.0963`},{2010,2084,372537,1230,545721,41671575557,2.13967`},{2011,2599,372806,269,558990,45096432102,2.21575`},{2012,2700,374123,1317,586538,48947973381,2.26229`},{2013,3100,376083,1960,611717,52477706483,2.29324`},{2014,3300,379597,3514,640378,58836015201,2.32771`},{2015,3500,"NA",150,"NA","NA",2.3181`},{2016,3650,"NA","NA","NA","NA","NA"}};

Now we write a function to map the data into an easier-to-use associations, and we map it into a list of those.

rowToAssociation[row_]:=<|year->row[[1]],medianRent->row[[2]],housingUnits->row[[3]],netNewHousing->row[[4]], employment->row[[5]], totalWages->row[[6]], cpi->row[[7]]|>

associationData= Map[rowToAssociation,csvData[[2;;]]];

TableForm[associationData[[1;;10]]]

to2015DollarsFactor = Select[associationData,(#[year]==2015)&][[1]][cpi]

associationData2015Dollars=Map[
Function[{assoc},
Module[{updateMe},
updateMe=assoc;
If[assoc[cpi]=="NA",(* do nothing*),updateMe[cpi]=((assoc[cpi])/to2015DollarsFactor)];
updateMe
]
],associationData
];

unitGrowthPercent=Map[{#[year],(100((#[netNewHousing])/(#[housingUnits]-#[netNewHousing]))//N)}&,associationData];

unitGrowthPercent//TableForm

avgUnitGrowthPercent1975to2015=Mean[Select[unitGrowthPercent,(#[[1]]≥1975 && #[[1]]≤2014)&][[All,2]]]

Select[unitGrowthPercent,(#[[1]]≥1967 && #[[1]]≤2014 && #[[2]]≥0.5)&][[All,2]]//Length

2014-1967+1

Define the abstract prediction engine

containsNAUnlabeled[unlabeledTraining_] := MemberQ[unlabeledTraining[[1]],"NA"] || unlabeledTraining[[2]]=="NA"

containsNALabeled[labeledTraining_] := containsNAUnlabeled[labeledTraining[[2]]]

modelPredictor[assocToLabeledTrainingF_, method_] := Block[
{ltd, pf},
ltd = Select[Map[assocToLabeledTrainingF,associationData2015Dollars],( !containsNALabeled[#])&];
<|labeledTrainingData->ltd, predictorFunction ->Predict[ltd[[All,2]],Method->method]|>
]

info[mp_]:=<|summary->PredictorInformation[mp[predictorFunction]], function->PredictorInformation[mp[predictorFunction],"Function"]|>

againstTrainingMeasurements[mp_]:= Module[{pm},
pm = PredictorMeasurements[mp[predictorFunction], mp[labeledTrainingData][[All,2]]];
<|predictionMeasurements->pm, σ->pm["StandardDeviation"],comparisonPlot->pm["ComparisonPlot"]|>
]

linearFit[mp_]:= Module[{convertData,convertedData},
convertData[labeledTraining_] := (labeledTraining[[2]])[[1]]~Join~{(labeledTraining[[2]])[[2]]};
convertedData=Map[convertData, mp[labeledTrainingData]];
LinearModelFit[convertedData,{x1,x2,x3},{x1,x2,x3}]
]

fullComparisonPlot[mp_, transformF_]:=Module[{
yearFromLabeledTraining,
predictionFromLabeledTraining,
predictionPointFromLabeledTraining,
predicted,
actual
},
yearFromLabeledTraining[labeledTraining_]:= labeledTraining[[1]];
predictionFromLabeledTraining[labeledTraining_]:=mp[predictorFunction] [labeledTraining[[2,1]]];
predictionPointFromLabeledTraining[labeledTraining_]:= {yearFromLabeledTraining[labeledTraining],transformF[predictionFromLabeledTraining[labeledTraining]]};
predicted =  Map[predictionPointFromLabeledTraining, mp[labeledTrainingData]];
actual = Map[{#[[1]],transformF[#[[2,2]]]}&,mp[labeledTrainingData]];
ListPlot[{predicted,actual},PlotStyle->{RGBColor[0,0.75,0],Black}]
]

fullComparisonPlot[mp_]:=fullComparisonPlot[mp, Identity]

forecastAny[mp_, updateInputs_, yearsForward_]:= Module[{
baseYearLabeledTraining =Last[mp[labeledTrainingData]],
nextForecast,
forecastLabeledData
},
nextForecast[dataPart_]:= Module[{
newInputs=updateInputs @@dataPart
},
newInputs->mp[predictorFunction][newInputs]
];
forecastLabeledData[base_,accum_]:=Module[{next},
If[
Length[accum]==yearsForward,
accum,
next={base[[1]]+1, nextForecast[base[[2]][[1]]]};
forecastLabeledData[next, Append[accum, next]]
]
];
Map[{#[[1]],#[[2]][[2]]}&,forecastLabeledData[baseYearLabeledTraining, {}]]
]

forecastLinear[mp_, unitsGrowthRate_, employmentGrowthRate_, realWageGrowthRate_, yearsForward_]:= forecastAny[mp, {(#1 (1+unitsGrowthRate)),(#2 (1+employmentGrowthRate)) ,(#3(1+realWageGrowthRate))}&, yearsForward]

forecastLog10Multiplicative[mp_, unitsGrowthRate_, employmentGrowthRate_, realWageGrowthRate_, yearsForward_]:= Map[{#[[1]],((10^(#[[2]])))}&,forecastAny[mp, {(#1 +Log[10,(1+unitsGrowthRate)]),(#2 +Log[10,(1+employmentGrowthRate)]) ,(#3+Log[10,(1+realWageGrowthRate)])}&, yearsForward]]

createManipulateFrameLabel[label_]:={{None,None},{Grid[{{Style["Based on data and modeling by Eric Fischer",Bold]}, {Hyperlink["https://experimental-geography.blogspot.com/2016/05/employment-construction-and-cost-of-san.html"]},
{Hyperlink["https://github.com/ericfischer/housing-inventory"]},
{Style["Mathematica version (and any errors) by Steve Randy Waldman",Italic]}}],Style[("San Francisco Real Median Rents: "<>label<>" (2015 Dollars)"), Bold]}}

createLinearManipulate[mp_, label_]:=
Manipulate[Show[ListPlot[forecastLinear[mp,(ugrp/100),(egrp/100), (rwgrp/100),20]],fullComparisonPlot[mp],PlotRange->{{1975,2035},{0,5000}},Frame->True,Axes->False],{{ugrp,avgUnitGrowthPercent1975to2015,"Units Growth Rate (%)"},-2,10,0.1,Appearance->"Open"},Delimiter,{{egrp, 0.326,"Employment Growth Rate (%)"} ,-2,2,0.1,Appearance->"Open"},Delimiter,{{rwgrp,1.72,"Real Wage Growth Rate (%)"},-2,5,0.1,Appearance->"Open"},ControlPlacement->{Bottom,Bottom,Bottom}, FrameLabel->createManipulateFrameLabel[label],Deployed->True
]

createLog10MultiplicativeManipulate[mp_, label_]:=
Manipulate[Show[ListPlot[forecastLog10Multiplicative[mp,(ugrp/100),(egrp/100), (rwgrp/100),20]],fullComparisonPlot[mp,((10^(#)))&],PlotRange->{{1975,2035},{0,5000}},Frame->True,Axes->False],{{ugrp,avgUnitGrowthPercent1975to2015,"Units Growth Rate (%)"},-2,10,0.1,Appearance->"Open"},Delimiter,{{egrp, 0.326,"Employment Growth Rate (%)"} ,-2,2,0.1,Appearance->"Open"},Delimiter,{{rwgrp,1.72,"Real Wage Growth Rate (%)"},-2,5,0.1,Appearance->"Open"},ControlPlacement->{Bottom,Bottom,Bottom}, FrameLabel->createManipulateFrameLabel[label],Deployed->True
]

buildLinearManipulate[method_, label_]:=Module[{associationToLabeledTraining,mp},
associationToLabeledTraining[assoc_]:={assoc[year],{assoc[housingUnits], assoc[employment],((assoc[totalWages])/(assoc[cpi]))}->((assoc[medianRent])/(assoc[cpi]))};
mp = modelPredictor[associationToLabeledTraining,method];
createLinearManipulate[mp, label]
]

buildMultiplicativeManipulate[method_, label_]:=Module[{associationToLabeledTraining,mp},
associationToLabeledTraining[assoc_]:=Module[{hu,e,rw,rmr},
hu = If[assoc[housingUnits]=="NA","NA",N[Log[10,assoc[housingUnits]]]];
e=If[assoc[employment] == "NA", "NA", N[Log[10,assoc[employment]]]];
rw=If[assoc[totalWages]=="NA" || assoc[cpi] == "NA", "NA", N[Log[10,((assoc[totalWages])/(assoc[cpi]))]]];
rmr=If[assoc[medianRent]=="NA" || assoc[cpi]=="NA", "NA", N[Log[10,((assoc[medianRent])/(assoc[cpi]))]]];
{assoc[year],{hu, e,rw}->rmr}
];
mp = modelPredictor[associationToLabeledTraining,method];
createLog10MultiplicativeManipulate[mp, label]
]

Good Models

buildLinearManipulate["LinearRegression", "Simple Linear Regression Model"]

buildMultiplicativeManipulate["LinearRegression", "Multiplicative Linear Regression Model"]

(* For side-by-side image in post, with Units Growth Rate manually adjusted *)
Grid[{{buildMultiplicativeManipulate["LinearRegression", "Multiplicative Linear Regression Model"],buildMultiplicativeManipulate["LinearRegression", "Multiplicative Linear Regression Model"]}}]