Pick any arbitrary date in the year. We can represent the date as a decimal in the format M.DD (for January through September) or MM.DD (for October, November, and December). The “M”s represent the one or two digit month number from 1-12 while the “D”s represent the day of the month. For example, New Year’s Eve would be written as 12.31 while New Year’s Day would be 1.01. This forum post will explain how to find a radical expression for each day in the year such that the first few digits of the the expression match the decimal form of the day’s date. For example, we will see that = 1.01... and = 12.31..., which match the dates for New Year’s Eve and Day.
36
2
3
1866
An Algorithm for Mapping Dates to Radicals
An Algorithm for Mapping Dates to Radicals
We require an algorithm that, given a date represented as a decimal number in the format (M)M.DD, will return a radical expression of the form , where n and m are integers. The algorithm implemented for this project is as follows.
n
m
In[]:=
ClearAll[RootSearch];RootSearch[{date_Real,lowbound_Real,highbound_Real,iterNumber_Integer,wasFound_Symbol,prevLowbound_Real}]:=Module[{modlength,newLowbound,newHighbound,newIterNumber,newWasFound},newLowbound=lowbound*date;newHighbound=highbound*(date+0.01);newWasFound=Floor[lowbound]!=Floor[highbound];newIterNumber=iterNumber+1;{date,newLowbound,newHighbound,newIterNumber,newWasFound,lowbound}];
In[]:=
ClearAll[SearchLoop];SearchLoop[date_Real]:=Module[{found,root,base},found=NestWhile[RootSearch,{date,date,date+0.01,0,False,1.0},(!(#[[5]]))&];root=found[[4]];base=Ceiling[found[[6]]];{base,root}];
In this algorithm, we set a lowbound variable equal to the date we want to find the radical for. We also set a highbound equal to the lowbound + 0.01. For example, for New Year’s Day the lowbound would be 1.01 and the highbound would be 1.02. Any value in between these two numbers will start with the digits 1.01... and thus if we find a root between the lowbound and highbound it will be a valid solution. At each iteration of the loop, we increase the power of the lowbound and highbound by one. So after one iteration of the example, the lowbound is and the highbound is . After each time the power is increased, we test to see whether the integer floor of the lowbound (the lowbound rounded down to the nearest integer) is different from the integer floor of the highbound. If it is, this means that that an integer exists that is greater than the lowbound and less than the highbound. Our solution is then where n is the power that the the lowbound and highbound have currently been raised to and m is the integer that we have discovered between the current lowbound and highbound.
2
1.01
2
1.02
n
m
In order to convert a Mathematica date object into the real number with format (M)M.DD that is used as input for searchLoop, we can use the following function.
In[]:=
dateEquation[date_DateObject]:=Module[{dateNum,root,rootRadical,rootValue,expression},dateNum=(#[[2]]+#[[3]]*0.01)&@DateList[date];root=SearchLoop[dateNum];rootValue=Power[root[[1]],1/root[[2]]];expression=Format[HoldForm[Power["Index",1/"Radicand"]="DecimalValue"...],TraditionalForm]/.{"Index"->root[[1]],"Radicand"->root[[2]],"DecimalValue"->NumberForm[Floor[rootValue,0.01],{Infinity,2}]};expression]
Displaying the Results in a Calendar Format
Displaying the Results in a Calendar Format
Now that we have an algorithm to create radicals that dates, we can run it on all days of the year and display the results in a calendar format. The Wolfram Community post “Design and Construction of Calendar Pages” by John Custy provides an excellent design, which I adapted to display the associated radical for each date.
The formatDate function provides the code necessary to make a graphic of a single date on the calendar (a square showing the day number and the radical the date maps to).
The formatDate function provides the code necessary to make a graphic of a single date on the calendar (a square showing the day number and the radical the date maps to).
In[]:=
ClearAll[formatDate];formatDate[calendarDateSquare_DateObject]:=Module[{plainDayNumber,styledDayNumber,dateEqn},plainDayNumber=DateValue[calendarDateSquare,"Day"];styledDayNumber=Style[plainDayNumber,12,Bold,GrayLevel[0.25]];dateEqn=Style[dateEquation[calendarDateSquare],12,Bold,RGBColor[0.71,0.22,0.04]];Item[Column[{Row[{styledDayNumber}],Row[{}],Row[{dateEqn}]},BaseStyle{"Text",Small}],Alignment->{Left,Top},BackgroundWhite,FrameTrue,ItemSize{10,8}]];
We create a list of days of the week, which will be placed along the top of the calendar above each column. Note: the extra space in the string representing April in the MonthList list is intentional and used as a patch to fix formatting issues that would otherwise have occurred on the navigation bar.
We create a list of days of the week, which will be placed along the top of the calendar above each column. Note: the extra space in the string representing April in the MonthList list is intentional and used as a patch to fix formatting issues that would otherwise have occurred on the navigation bar.
In[]:=
ClearAll[monthList,unformattedWeekdayList,weekdayList];monthList={"Jan ","Feb ","Mar ","Apr ","May ","Jun ","Jul ","Aug ","Sep ","Oct ","Nov ","Dec "};unformattedWeekdayList={"Sun","Mon","Tue","Wed","Thu","Fri","Sat"};weekdayList=Item[Style[#,Italic,Small,GrayLevel[0.5]],Alignment{Center,Bottom},ItemSizeAutomatic]&/@unformattedWeekdayList;
The function generateCalendarMonth creates an entire page of the Calendar. It makes use of the formatDate function to create each date of the page.
In[]:=
ClearAll[generateCalendarMonth];generateCalendarMonth[month_Integer,year_Integer]:=Module[{daysOfMonth=DateRange[DateObject[{year,month,1}],DateObject[{year,month+1,0}]],dayRows,formattedDaysOfMonth,monthName=monthList〚month〛},dayRows=Split[daysOfMonth,DateValue[#2,"DayName"]≠Sunday&];dayRows[[1]]=PadLeft[First[dayRows],7,Null];dayRows[[-1]]=PadRight[Last[dayRows],7,Null];formattedDaysOfMonth=Map[If[Head[#]===DateObject,formatDate[#],#]&,dayRows,{2}];Column[{Style[Row[{monthName," ",year}],"Subsubsection"],Grid[Prepend[formattedDaysOfMonth,weekdayList],FrameStyleThin]},Center]]
Finally, a manipulate is created to allow for navigation between the twelve pages in the calendar.
In[]:=
ClearAll[NumberToMonthConversion,currentYear];NumberToMonthConversion=(#->monthList[[#]])&/@Range[12];currentYear=DateList[CurrentDate["Year"]][[1]];Manipulate[Magnify[generateCalendarMonth[month,currentYear],0.7],{month,NumberToMonthConversion,ControlTypeSetterBar},SaveDefinitionsTrue]
Out[]=
A Note on the Maximum Degree of the Radicals
A Note on the Maximum Degree of the Radicals
The degrees of the roots found decrease as the year progresses. There are many roots with degree ten or greater in January, but in December, only cube and square roots are identified. This is because the initially small difference between the low and high bounds of the algorithm grows more rapidly when the decimal representing the date is larger. In fact, an upper bound can be placed on the degree of the root. If r ≃ where r is the decimal representation of the date and is the radical representation, and if r exceeds where x is an integer, then n ≤ x+1. For example, if r exceeds 10, then x = 2 and n ≤ 3. This means that no roots with degrees higher than 3 are found after September. Of course, such roots do exist, but they are not found by the algorithm because the algorithm returns only the root with the smallest degree.
n
m
n
m
x
100
Concluding Remarks
Concluding Remarks
In this post, I demonstrated how a radical can be found that represents any calendar date and provided an interactive graphic to display the results. As for the practical applications of this discovery... that is left as an exercise for the reader.
References
References
1
.Custy, J. (2021), “Design and Construction of Calendar Pages.” Wolfram Community. https://community.wolfram.com/groups/-/m/t/2173140.
Cite This Notebook
Cite This Notebook
A radical expression for every day of the year
by Curran Flanders
Wolfram Community, STAFF PICKS, February 1, 2025
https://community.wolfram.com/groups/-/m/t/3372602
by Curran Flanders
Wolfram Community, STAFF PICKS, February 1, 2025
https://community.wolfram.com/groups/-/m/t/3372602