FlickrCalendar

I take (at least) one photo each day and designate it my Photo of the Day. I have a set on Flickr with all of these photos and I thought it would be interesting to look at these in a calendar layout. I wrote a simple Mathematica package to do some basic photoset and photo management on Flickr. Using this package it is a simple matter to download all the Photos of the Day for a given month and arrange them in a calendar layout.

Load the Flickr package.

<<Flickr`

Get a list of all my photosets.

Short[sets = FlickrPhotosets[]]

{72157610604254463->Photo of the Day, <<22>>, 72157609839542329->S…on}

Get the ID of each photo in the "Photo of the Day" set.

set = First[sets]

72157610604254463->Photo of the Day

photos = FlickrPhotosetPhotos[set,
    {2009, 3, 1, 0, 0, 0}, {2009, 4, 1, 0, 0, 0}]

{3320801525, 3325013076, 3327845866, 3330214268, 3332574152, 3333951749, 3336286979, 3339612210, 3343616292, 3346180622, 3347410349, 3349861835, 3352196443, 3355574796, 3358281254, 3361319213, 3364753768, 3366450803, 3368858991, 3372005764, 3374713192, 3377655879, 3381457738, 3384282674, 3386926438, 3389038038, 3390498631, 3394129518, 3396858987, 3400094291, 3402856851}

Length[photos]

31

Import the 75x75 pixel "Square" sized thumbnail of each photo.

squares = FlickrPhotoImport[#, "Square"]& /@ photos;

First[squares]

Overlay the day of the month on top of each thumbnail.

tiles = Table[
    Show[Rasterize[squares[[i]]],
        Graphics[{
            White, Opacity[0.667],
            FontSize -> 64,
            Text[ToString[i], {Center, Center}]
        }]
    ], {i, Length[squares]}
];

First[tiles]

Get the URL of each image and make the tiles hyperlinks.

urls = First["urls" /. FlickrPhotoInfo[#]]& /@ photos;

First[urls]

http://www.flickr.com/photos/ragfield/3320801525/

tiles = Table[Hyperlink[tiles[[i]], urls[[i]]], {i, Length[tiles]}];

Now write a reusable calendar[] function which takes a list of content and lays them out into a grid for the specified month.

daysInMonth[year_Integer, month_Integer] := Part[
    {31,
    Which[
        Mod[year, 400] === 0, 29,
        Mod[year, 100] === 0, 28,
        Mod[year, 4] === 0, 29,
        True, 28
    ], 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}, month
];

calendar[
    year_Integer,
    month_Integer,
    content_List,
    opts___
] := Module[
    {startDate, startDay, daysOfWeek, days},
    startDate = {year, month, 1, 0, 0, 0};
    startDay = DateString[startDate, "DayNameShort"];
    daysOfWeek = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
    
    (*
    if the month starts in the middle of the week
    prepend some empty strings to the content list
    *)
    days = Join[Table["",
        {Position[daysOfWeek, startDay][[1,1]] - 1}], content];
    
    (*
    if less content was specified than days in the month
    pad the end of content list
    *)
    days = Join[days, Table["",
        {daysInMonth[year, month] - Length[content]}]];
    
    (*
    if the month ends in the middle of the week
    append some empty strings to the content list
    *)
    days = Join[days, Table["",
        {Mod[7 - Mod[Length[days], 7], 7]}]];
    
    GraphicsGrid[
        Join[
            {Join[{Text[Style[
                    DateString[startDate,
                        {"MonthName", " ", "Year"}],
                    FontFamily -> "Times",
                    FontSize -> 48
                ]]},
                Table[SpanFromLeft, {6}]
            ]},
            Partition[days, 7]
        ],
        opts
    ]
];

Now add the tile images to the calendar.

c = calendar[2009, 3, tiles,
    Spacings -> 0, ImageSize -> 460,
    Dividers -> All, Background -> LightGray]

We could export directly to JPEG, but since the image contains hyperlinks exporting to HTML will yield both a JPEG and the HTML code for an image map.

SetDirectory[CreateDirectory["/tmp/FlickCalendar"]];

Export["FlickCalendar.html", c, "GraphicsOutput" -> "JPEG"];

Download Mathematica Notebook

Download Flickr Mathematica package

Image stabilization in iMovie '09

I got the chance yesterday to try out the new image stabilization feature in iMovie '09. It works. Sort of.

Last weekend I strapped my Flip video camera onto the handlebars of my bike while descending a big hill. The resulting footage was pretty jerky. I started iMovie for the first time and it decided to build thumbnails for what seemed like forever. Finally I was able to add my clip to a project and enable image stabilization for it. It took around two hours on my 2.2 GHz dual core MacBook Pro to process five minutes of video. Ouch.

It appears to work by cropping the image frame to give it a few extra pixels in each direction with which to work. It then attempts to match up corresponding sections of subsequent video frames. Finally, it re-expands the cropped image to fill the frame again.

With my particular video there were a few sections which it was able to successfully stabilize, but most of it couldn't be helped. In parts the video was actually worse after stabilization (due to the scaling?). Anyway, here's a brief comparison. The top image is the original (scaled down from HD) video. The bottom frame is the stabilized version from iMovie '09.

I assure you the two videos are synchronized. Notice how the iMovie (bottom) video has a noticeably smaller field of view, slightly washed out colors, and slightly more side-to-side movement, but slightly less jerkiness.

The video was easy to put together in Mathematica. First I saved each movie as an Image Sequence in QuickTime Player Pro. Then I combined the two frames using Mathematica 7's image processing functions. Then I assembled the resulting frames back into a movie using QuickTime Player Pro. Here's the Mathematica code.

processFrame[i_Integer] := Module[
    {n, n1, n2, n3, i1, i2, i3},
    n = StringJoin[IntegerString[i, 10, 4], ".png"];
    n1 = StringJoin["Descent/Descent", n];
    n2 = StringJoin["DescentStabilized/DescentStabilized", n];
    n3 = StringJoin["DescentCompare/DescentCompare", n];
    i1 = Import[n1];
    i2 = Import[n2];
    i3 = ImageAssemble[{
        {ImageResize[i1, {480, 270}]},
        {ImageResize[i2, {480, 270}]}
    }];
    Export[n3, i3]
];

With[{start = 1, stop = 9606}, Monitor[
    Do[processFrame[i], {i, start, stop, 1}],
    ProgressIndicator[Dynamic[(i - start)/(stop - start)]]
]]

I'll bet I could do the stabilization in Mathematica...

Expressible as the sum of two cubes

Futurama episode 1ACV06 (The Lesser of Two Evils)

Bender: Hey robot, what's your serial number?
Flexo: 3370318.
Bender: No way, mine's 2716057!
(robot laughter)
Fry: I don't get it.
Bender: We're both expressible as the sum of two cubes!

Well that should be easy enough to test with Mathematica. Let's just use a brute force method to check each pair of numbers {i, j} that adds up to number n where i is in the range of 0 to the cube root of n and j is in the range of 0 to i.

flexo = 3370318;
bender = 2716057;

SumOfTwoCubes[n_Integer] :=
Catch@Do[
    If[i^3 + j^3 == n, Throw[{i, j}]],
    {i, n^(1 / 3)},
    {j, i}
];

SumOfTwoCubes[flexo]

{119, 119}

SumOfTwoCubes[bender]

So this test found the two numbers whose cubes add up to Flexo's serial number, but it did not find the two numbers whose cubes add up to Bender's serial number. Interesting. This problem must be trickier than I first thought. Indeed it is. A coworker pointed out that the first test only searches half of the possible numbers--it completely excludes negative numbers!

Okay, let's rewrite the test to include negative numbers. The absolute value of i must no longer be constrained to the cube root of n since one of the terms can be negative. We must instead search all values between -∞ and ∞. Hmm. That might take a while. Okay, instead we'll just deal with numbers whose cubes are expressible as a 32-bit signed machine integer and we'll stop the search as soon as we find the answer. Additionally, we'll have to add an additional test where the smaller of the two values (in this case j) is negative. We know it must be the smaller of the two since their sum is positive.

BetterSumOfTwoCubes[n_Integer] :=
Catch@Do[
    Which[
        i^3 + j^3 == n, Throw[{i, j}],
        i^3 + ( - j)^3 == n, Throw[{i, - j}]
    ],
    {i, (2^31 - 1)^(1 / 3)},
    {j, i}
];

BetterSumOfTwoCubes[flexo]

{119, 119}

BetterSumOfTwoCubes[bender]

{952, - 951}

Tricky television writers.

Update: Paul Abbott points out in the comments that there's a far better way to solve this problem:

Reduce[i^3 + j^3==3370318, Integers]

i==119&&j==119

Reduce[i^3 + j^3==2716057, Integers]

(i== - 951&&j==952)||(i==952&&j== - 951)

I must admit that I've never used the Reduce function before so this was a bit of a surprise to me, but a welcome one at that.

Download Mathematica notebook

Using stack based object constructors as function parameters

In C++, if the type of a function parameter is a bare class or a const reference to a class then it is not necessary to pre-create an object to pass into that function. You can use one of the class' constructors in place. For example:

class Graphics;
class Point;
...
void drawPoint(Graphics& g, const Point& p);
...
// The first argument is a non-const reference,
//   so the object must already exist
// The second argument is const reference,
//   so it can be created on the spot
drawPoint(g, Point(0, 0));

The constructor for the stack based object is called first, then the function is called, then the destructor for the stack based object is called last.

This is potentially very useful when combined with auto_ptr (or similar classes):

void foo(class Bar* b);
...
// A new "Bar" object is created, passed into
//   the foo() function, then destroyed
//   automatically after foo() is called.
foo(std::auto_ptr<Bar>(new Bar(...)));

Polygons with holes in Mathematica

The Mathematica graphics language has a Polygon primitive, but (as of Mathematica 7) there is no way to create a Polygon with holes punched out (more specifically, any polygon with two or more contours). However, there is a fairly good way to fake this feature.

1. Draw the first polygon contour.
2. Draw a line from the ending point of the first contour to the starting point of the second contour.
3. Draw the second polygon contour.
4. Repeat steps 1-3 for N contours
5. Once all contours are drawn, draw a line from the ending point of contour N-1, then N-2, ..., all the way back to contour 1. These are the same ending points we used earlier, except in reverse order.

MultiContourPolygon[polys_List] := Module[
    {contours=Append[#, First[#]]&/@polys},
    {
        Polygon@Join[Join@@contours, Reverse[First/@contours]],
        Line[contours]
    }
]

Graphics@MultiContourPolygon[{
    {{0, 0}, {0, 1}, {1, 1}, {1, 0}},
    {{.25, .25}, {.75, .25}, {.75, .75}, {.25, .75}},
    {{.4, .4}, {.6, .4}, {.6, .6}, {.4, .6}}
}]

Mathematica's built-in PDF import feature uses this same algorithm to represent arbitrary multi-contoured paths from PDF files.

Import["ExampleData/mathematica.pdf"]

Download Mathematica notebook

Use Quartz2D Python bindings to rasterize HTML

Since (I believe) Mac OS X 10.2, the CoreGraphics framework (Quartz2D) has included incredibly useful bindings for the Python language. This makes it very easy to test code and to automate graphics related tasks.

A few days ago a colleague asked if I knew a simple way to automate the creation of image previews of web pages. In a couple minutes I whipped up a short Python script to do just that.

#!/usr/bin/python
import os, sys
from CoreGraphics import *

# what size image should we create?
w = 600
h = 430

# get the input and output file paths
if len(sys.argv) < 3:
	print 'usage: %s inputfile.html outputfile.png' % sys.argv[0]
	sys.exit()

input = sys.argv[1]
output = sys.argv[2]

# read the input file
f = open(input)
html = ''.join(f.readlines())
f.close()

# draw the HTML into a Quartz bitmap context then write that image to a PNG file
ctx = CGBitmapContextCreateWithColor(w, h, CGColorSpaceCreateDeviceRGB(), (0, 0, 0, 0))
ctx.drawHTMLTextInRect(CGDataProviderCreateWithString(html), CGRectMake(0, 0, w, h))
ctx.writeToFile(output, kCGImageFormatPNG)

Download Python script

Unfortunately, this simple script has a fairly major limitation. It doesn't do any network access, so the HTML file and all accompanying resources must be stored somewhere on your file system.

Call by reference in Mathematica

Parameters values passed into Mathematica functions are immutable. However, one can fake "call by reference" behavior in Mathematica by giving the function a Hold* (HoldAll/HoldFirst/HoldRest) attribute. That way the function can directly modify the variable passed to it.

Attributes[MyFunc] = HoldAll;

MyFunc[a_Symbol]:=(a[[2]] = 2.2);

b = {1., 2., 3., 4.}

{1.`, 2.`, 3.`, 4.`}

MyFunc[b];

b

{1.`, 2.2`, 3.`, 4.`}

Download Mathematica notebook

The drawback to doing this is that you have to pass a variable into the function. Passing a literal value will not work.

cat * > /dev/ragfield

My name is Rob. I write software, ride bicycles, and occasionally write software while riding bicycles. If you're interested in software development, you're in the right place. If you're interested in bicycles, check out my personal blog instead.