Message Boards Message Boards

Creative routines charts

If you ever surfed the web, I'm sure at some point you stumbled over the creative routines of famous people charts. People are often interested in how creative or successful individuals managed their time and when in their daily schedule they did what were famous for.

chart1

I guess for most of us normal human beings the day is centred around some official office hours. Some others, like myself, are more or less free to partition their schedule as long as projects are finished. Lately, I was called out by a friend

@halirutan I'm curious what is your daily schedule that you sprint to bed around 6:30 a.m.

Well, I have to admit that I don't follow a rigorous daily schedule, although I have some clear preferences:

  • I like to work at night because it is quiet; no phones ring; no unexpected visits of someone who needs something.
  • I love to sleep when I'm exhausted and not when Mommy says that it's time for bed.
  • I try to have a good deal of time with my kids and small breaks that reset my brain.

That's when I'm most productive. If I had a daily schedule, it probably would average out to the following

mySchedule explanation

It would be funny to see how others partition their days and I'm very sure that many of us would be delighted to see how people from the WRI development team work. If I could nominate someone for the daily schedule challenge, I would be interested in the timetables of

Before I sprint to bed on a Saturday morning after 6 a.m. let me quickly provide you with the implementation of the schedule chart.

Implementation

Firstly, this is a hack that was tested on exactly one schedule. Feel free to improve it. The graphics above was created with

s = schedule[
   "Patrick Scheibe",
   Import["myImage.jpg"],
   {
    social[10, "Get up"],
    otherwork[11, "Office work"],
    social[17, "Free time"],
    sleep[22, "Nap to refuel"],
    work[23, "Most creative time"],
    social[4, "Read"],
    sleep[5]
    }];
schedulePlot[s]

You have 5 possible activities: work, otherwork, exercise, sleep and social. The usage is simple:

  • Give each activity a starting time (only full hours) between 0 and 24 hours. The end-time of it will be calculated by the time of the next activity
  • The provided image must be a square. Otherwise, it get's squeezed when I map it onto the disk
  • the provided name as the first argument is not used right now

You can either copy the implementation below or import the complete code (don't be afraid, it just imports cell expressions without evaluating anything) by evaluating

Import["http://halirutan.github.io/Mathematica-SE-Tools/decode.m"]["http://i.stack.imgur.com/3d8cw.png"]

The implementation is simple. First, we define some activities that that are transformed into different kinds of item

work[args__] := item["Work", args];
otherwork[args__] := item["OtherWork", args];
exercise[args__] := item["Exercise", args];
sleep[args__] := item["Sleep", args];
social[args__] := item["Social", args];

Some colours we use for the various activities

col[n_] := ColorData[97, n];
col["Work"] = col[15];
col["OtherWork"] = Lighter[col[15]];
col["Exercise"] = col[7];
col["Sleep"] = GrayLevel[0.95];
col["Social"] = col[2];

The underlying item can be rendered with Style and Label. Also, we need to convert the provided starting hours to time-spans as this is what SectorChart understands. Therefore, some accessors for item

item[type_, t_] := item[type, t, ""];
item[_, t_, _]["Time"] := t;
item[type_, _, label_]["Refine", t_] := item[type, t, label];
item[type_, t_, label_]["Render"] := With[
   {item = Style[{t, 1}, col[type]]},
   If[label === "",
    item, Labeled[item, label, "VerticalCallout"]
    ]
   ];

The schedule function will convert the starting hours and puts all information into an Association

schedule[name_String, img_Image, l : {_item ..} /; Length[l] > 1] := 
 Module[
  {
   times = #["Time"] & /@ l,
   startTime,
   items
   },
  startTime = First[times];
  items = #1["Refine", #2] & @@@ 
    Transpose[{l, 
      Mod[Differences[Append[times, First[times]]], 24]}];
  <|"StartTime" -> startTime, "Times" -> times, "Items" -> items, 
   "Name" -> name, "Image" -> img|>
  ]

For the image in the centre, we create a disk from polygons and map a texture onto it

With[{pts = Table[{Cos[phi], Sin[phi]}, {phi, 0, 2 Pi, Pi/20.}]},
 texturedDisk[img_Image] := Graphics[{
    Texture[img], 
    Polygon[4 pts, 
     VertexTextureCoordinates -> (1/2 (# + {1, 1}) & /@ pts)]}]
 ]

The rest is just calling SectorChart and putting the image in the centre

schedulePlot[ass_Association] := Module[{ticks},
   ticks = {#1, Style[ToString[#2] <> ":00", 8]} & @@@ 
     Transpose[{Pi*(ass["Times"] - ass["StartTime"])/12, 
       ass["Times"]}];
   Show[{
     texturedDisk[ass["Image"]],
     SectorChart[
      Map[#["Render"] &, ass["Items"]],
      PolarAxes -> {True, False},
      PolarAxesOrigin -> {0, 4},
      PolarTicks -> {ticks, None},
      PolarGridLines -> {Range[0, 2 Pi, Pi/12], False},
      SectorOrigin -> {{Pi/2 - Pi*ass["StartTime"]/12, "Clockwise"}, 4}
      ]},
    PlotRange -> All]
   ];
POSTED BY: Patrick Scheibe
4 Replies

Though maybe in nearest future people will have numerous IoT devices, smart houses with embedded monitoring, etc. to accumulate a wealth of data.

I hope we will NOT! - What a nightmare!

POSTED BY: Henrik Schachner

On a related note please see "The Personal Analytics of My Life" by Stephen Wolfram. @Patrick's idea immediately brought to mind the following related subjects:

  • Assuming we have the data, we probably could easy identify proximity of a specific personal routine to a few famous people routines with similar data. We could also cluster such data into some major "creative routine types".

  • A temporal visualization of such data across a human life could help to determine true steady stages of how a person deals with surrounding world. Infant, child, teenager, adult, senior etc. But again data is the key. Though maybe in nearest future people will have numerous IoT devices, smart houses with embedded monitoring, etc. to accumulate a wealth of data.

POSTED BY: Vitaliy Kaurov

enter image description here - you have earned "Featured Contributor" badge, congratulations!

This is a great post and it has been selected for the curated Staff Picks group. Your profile is now distinguished by a "Featured Contributor" badge.

POSTED BY: Moderation Team

Good Lord, who even knows what my schedule challenge would look like? I do different things every day, with not even any consistency in my sleeping or eating schedule, yet alone anything else. Which means all of this is just too much work. If there aren't big, easy, no fuss buttons to press, I wouldn't do it.

activityButton[bin_Databin, activity_String, 
  Dynamic[currentActivity_]] := 
 Button[activity, 
  Module[{comment = 
     InputString[
      "Add comment for activity. Leave field empty for no comment, or \
press cancel to Cancel the activity addition."]},
   If[StringQ[comment],
    bin["Add", <|"activity" -> activity, "comment" -> comment|>]; 
    currentActivity = activity]],
  Method -> "Queued",
  Background -> 
   Dynamic[If[currentActivity === activity, Darker[Green], 
     Darker[Gray]]], 
  BaseStyle -> {"ControlStyle", FontColor -> White, 
    ControlsRendering -> "Generic"}]

Well, that's kind of a big, easy, no-fuss button. BUT I WANT A PALETTE!

With[{bin = bin}, 
 NotebookSave[
  CreatePalette[DynamicModule[{currentActivity = ""}, Column[{
      activityButton[bin, "work", Dynamic[currentActivity]],
      activityButton[bin, "otherwork", Dynamic[currentActivity]],
      activityButton[bin, "exercise", Dynamic[currentActivity]],
      activityButton[bin, "social", Dynamic[currentActivity]],
      activityButton[bin, "sleep", Dynamic[currentActivity]],
      Button["Copy Databin expr", CopyToClipboard[bin]]},
     Spacings -> 0],
    Initialization :> 
     Quiet@Module[{lastVal = Last[Get[bin]]["Data", "activity"]}, 
       If[StringQ[lastVal], currentActivity = lastVal]],
    UnsavedVariables -> {currentActivity}], Magnification -> 2],
  FileNameJoin[{$UserBaseDirectory, "SystemFiles", "FrontEnd", 
    "Palettes", "Activity.nb"}]];
 FrontEndExecute[FrontEnd`ResetMenusPacket[{Automatic}]]
]

Humph. Well, I still have to assign bin to be a valid Databin. There's always something.

bin = CreateDatabin["Name"->"Daily schedule challenge"]
POSTED BY: John Fultz
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract