Beeminder simulator
Beeminder simulator
Helpers
Helpers
standardizeDate[] returns a copy of the given DateObject with only the year, month, and day, to ensure that it will be comparable to other dates in the standard format. Mathematica throws errors when the two dates being compared have different sets of fields.
In[]:=
standardizeDate[date_]:=DateObject[DateValue[date,{"Year","Month","Day"}]];
resetInterpolation[] copies data from a TimeSeries into a new TimeSeries with MissingDataMethod and ResamplingMethod set to with the given order. You’ll want to do this after some transformations, like Accumulate, which demand a separate interpolation style.
"Interpolation"
In[]:=
resetInterpolation[ts_,order_]:=TimeSeries[ts,MissingDataMethod{"Interpolation",InterpolationOrderorder},ResamplingMethod{"Interpolation",InterpolationOrderorder}];
extrapolatedTimeSeriesOn[] returns the value of a TimeSeries on the given day, returning 0 if the day is before the start of the TimeSeries, or the value returned by extrapolate[] if the day lies past the end. extrapolate[] receives two arguments, the TimeSeries and the number of days past the end of the series that’s being requested. holdLastTimeSeriesOn[] uses extrapolatedTimeSeriesOn[] with extrapolate set to a function that returns the last value of the series.
In[]:=
extrapolatedTimeSeriesOn[ts_,day_,extrapolate_]:=With[{sd=standardizeDate[day],ld=standardizeDate[ts["LastDate"]]},Switch[True,sd<standardizeDate[ts["FirstDate"]],0,sd>ld,extrapolate[ts,QuantityMagnitude@DateDifference[ld,day,"Day"]],_,ts[sd]]];holdLastTimeSeriesOn[ts_,day_]:=extrapolatedTimeSeriesOn[ts,day,{ts2,daysAfter}|->ts2["LastValue"]];
Beeminder state
Beeminder state
make[] returns a Beeminder state that can be used with the rest of the functions in this file. Optional parameters initialData and initialRate set the data and rate for the initial day. Without them, zeroes are inserted, because Mathematica resets options when we add data if a TimeSeries starts completely empty.
Beeminder[] itself contains only an assoc whose entries are:
- The current date.
- A TimeSeries of data entries, indexed by day.
- A TimeSeries of rates, indexed by day.
- A TimeSeries of offsets to the bright red line, indexed by day.
Beeminder[] itself contains only an assoc whose entries are:
-
"day"->
-
"data"->
-
"rates"->
-
"adjustments"->
In[]:=
ClearAll[make,Beeminder];make[day_,initialRate_,initialData_]:=Beeminder[<|"day"->standardizeDate[day],"data"->TimeSeries[{{day,initialData}},MissingDataMethod{"Constant",0},ResamplingMethod{"Constant",0}],"rates"->TimeSeries[{{day,initialRate}},MissingDataMethod{"Interpolation",InterpolationOrder0},ResamplingMethod{"Interpolation",InterpolationOrder0}],"adjustments"->TimeSeries[{{day,0}},MissingDataMethod{"Constant",0},ResamplingMethod{"Constant",0}]|>];make[day_,initialRate_]:=make[day,initialRate,0];make[day_]:=make[day,0,0];
Beeminder state accessors
Beeminder state accessors
getDay[], getData[], getRates[], and getAdjustments[] are the best way to access a Beeminder[]’s fields. They resample TimeSeries to one entry per day, filling in any gaps, which allows them to be plotted more accurately. They’re memoized for performance.
In[]:=
ClearAll[getDay,getFirstDay,getData,getRates,getAdjustments];getDay[state_Beeminder]:=state[[1]]["day"];getFirstDay[state_Beeminder]:=state[[1]]["data"]["FirstDate"];getData[state_Beeminder]:=getData[state]=TimeSeriesResample[state[[1]]["data"],"Day"];getRates[state_Beeminder]:=getRates[state]=TimeSeriesResample[state[[1]]["rates"],"Day"];getAdjustments[state_Beeminder]:=getAdjustments[state]=TimeSeriesResample[state[[1]]["adjustments"],"Day"];
Demo.
In[]:=
make//getDay
Out[]=
getFirstDataDay[] and getLastDataDay[] return the first and last days for which there’s any data anywhere in the Beeminder state.
In[]:=
getFirstDataDay[state_Beeminder]:=getFirstDataDay[state]=Min[Append[Map[standardizeDate[#["FirstDate"]]&,{getData[state],getRates[state],getAdjustments[state]}],standardizeDate[getDay[state]]]];getLastDataDay[state_Beeminder]:=getLastDataDay[state]=Max[Append[Map[standardizeDate[#["LastDate"]]&,{getData[state],getRates[state],getAdjustments[state]}],standardizeDate[getDay[state]]]];
getAccumulatedData[], getAccumulatedRates[], and getAccumulatedAdjustments[] get cumulative versions of the corresponding TimeSeries, defined over the same domains as the originals.
In[]:=
ClearAll[getAccumulatedData,getAccumulatedRates,getAccumulatedAdjustments];getAccumulatedData[state_Beeminder]:=getAccumulatedData[state]=resetInterpolation[Accumulate[getData[state]],0];getAccumulatedRates[state_Beeminder]:=getAccumulatedRates[state]=resetInterpolation[Accumulate[getRates[state]],0];getAccumulatedAdjustments[state_Beeminder]:=getAccumulatedAdjustments[state]=resetInterpolation[Accumulate[getAdjustments[state]],0];
getDataLineOn[] and getBrightRedLineOn[] return the y-coordinates of those two lines (of Beeminder chart fame) accurately for any date. getDataLine[] and getBrightRedLine[] return them as TimeSeries for any given range of dates. If you don’t provide the date range, they use the full range of dates for which there are any data, rate changes, or adjustments.
In[]:=
ClearAll[getDataLineOn,getBrightRedLineOn,getDataLine,getBrightRedLine];getDataLineOn[state_Beeminder,day_]:=holdLastTimeSeriesOn[getAccumulatedData[state],day];getBrightRedLineOn[state_Beeminder,day_]:=Block[{rawRedLine,adjustment},rawRedLine:=extrapolatedTimeSeriesOn[getAccumulatedRates[state],day,{ts,daysAfter}|->ts["LastValue"]+daysAfter*getRates[state]["LastValue"]];adjustment:=holdLastTimeSeriesOn[getAccumulatedAdjustments[state],day];rawRedLine+adjustment];getDataLine[state_Beeminder,startDay_,endDay_]:=TimeSeries[Map[day|->{day,getDataLineOn[state,day]},DateRange[startDay,endDay]]];getDataLine[state_Beeminder]:=getDataLine[state,getFirstDataDay[state],getLastDataDay[state]];getBrightRedLine[state_Beeminder,startDay_,endDay_]:=TimeSeries[Map[day|->{day,getBrightRedLineOn[state,day]},DateRange[startDay,endDay]]];getBrightRedLine[state_Beeminder]:=getBrightRedLine[state,getFirstDataDay[state],getLastDataDay[state]];
dueOn[] returns how far below the data line is than the bright red line on the given day, or 0 if it’s above.
In[]:=
dueOn[state_Beeminder,day_]:=Max[0,getBrightRedLineOn[state,day]-getDataLineOn[state,getDay[state]]];
Demo.
In[]:=
TableWithday=DatePlus,i,day,dueOnmake,1,day,{i,-3,3}
Out[]=
,0,,0,,0,,1,,2,,3,,4
show[] draws 4 charts: the Beeminder graph (data and bright red line), a bar graph of entered data, and a line plot of the goal’s rate, and a bar graph of any adjustments to the bright red line.
In[]:=
show[state_Beeminder]:=GraphicsRow[{DateListPlot[{Labeled[getDataLine[state],"Data"],Labeled[getBrightRedLine[state],"Bright red line"]},GridLines{{getDay[state]},None}],BarChart[getData[state],PlotLabel"Data"],DateListPlot[getRates[state],PlotLabel"Rate"],BarChart[getAdjustments[state],PlotLabel"Adjustments"]},ImageSizeFull]
Beeminder state change operations
Beeminder state change operations
update[] merges associations into the underlying association—use with care.
In[]:=
update[state_Beeminder,change_]:=Beeminder[Merge[{state[[1]],change},Last]];
advanceDate[] just moves the day forward by one. autoratchetDays is the max number of buffer days to allow at the start of any day.
In[]:=
ClearAll[advanceDate];advanceDate[state_Beeminder]:=update[state,"day"->DatePlus[state[[1]]["day"],1]];advanceDate[state_Beeminder,autoratchetDays_]:=Block[{state2,day,diff},state2=advanceDate[state];day=DatePlus[getDay[state2],autoratchetDays-1];diff=getDataLineOn[state,getDay[state]]-getBrightRedLineOn[state,day];If[diff>0,addAdjustment[state2,diff],state2]];
Demo.
In[]:=
make//advanceDate//getDay
Out[]=
addDataOn[] and addData[] add one data point (by default, to the current date). Unlike actual Beeminder, this overrides any other data for that day.
In[]:=
addDataOn[state_Beeminder,day_,value_]:=update[state,"data"->TimeSeriesInsert[state[[1]]["data"],{day,value}]];addData[state_Beeminder,value_]:=addDataOn[state,getDay[state],value];
Demo.
In[]:=
RightComposition[addData[#,10]&,advanceDate,addData[#,0]&,advanceDate,addData[#,4]&]make//show
setRateOn[] and setRate[] set the rate as of a particular date (by default, the current date).
Demo.
addAdjustmentOn[] and addAdjustment[] add an adjustment to the bright red line on the given date. addAdjustment[] uses the current date. This overrides any other adjustment made on that day.
Demo.
Demo: setting auto-ratchet to 0 causes you to derail unless you log every day.
Demo: no matter how much you log on day 1, you derail after 3 days.
Autodialing
Autodialing
Use the average data over the past 30 days to set the rate 8 days from now.
When less than 30 days of data is available, interpolate with the prior rate set for that day, using the fraction of the window that is available.
- strict: If True, then autodial will never lower the rate.
- multiplier: If autodial would have set the rate to rate, then set it to multiplier*rate instead.
- maxRate: If not Null, then this is the maximum rate autodial will set.
When less than 30 days of data is available, interpolate with the prior rate set for that day, using the fraction of the window that is available.
- strict: If True, then autodial will never lower the rate.
- multiplier: If autodial would have set the rate to rate, then set it to multiplier*rate instead.
- maxRate: If not Null, then this is the maximum rate autodial will set.
Demo.
Simulation
Simulation
Starting with rate=0, do 1/day every day
Starting with rate=0, do 1/day every day
Starting with rate=0, do 1/day every day, with auto-ratchet set to 3
Starting with rate=0, do 1/day every day, with auto-ratchet set to 3
Start with rate 7min/day, exercise 30min every beemergency
Start with rate 7min/day, exercise 30min every beemergency
… and with auto-ratchet set to 2?
… and with auto-ratchet set to 2?
… and with auto-ratchet set to 1?
… and with auto-ratchet set to 1?