# Visualization of traces of moving objects

An example movie which is made with the listed mathematica code below shows traces of moving objects:

https://youtu.be/8jN2uuSHCEg (Melting ...)

http://youtu.be/5ET62846C-I (Crystallisation ...)

The following question is related to:

Speed up calculation

1. I have thousands of gray scale images.
2. I want to superpose image_1 to image_50, image_2 to image_51, image_3 to image_52, ..., image_951 to image_1000, ... This is always a set of 50 images.
3. For the superposition each image is binarized and then colorized differently. The resulting images are col_Image_1, col_Image_2, ... col_Image_50. The color is varying from col_Image_1 to col_Image_50 following a certain color table (see below).
4. Here is a set of 3 images to illustrate the superposition of circular shaped objects: col_Image_1 has only black and blue pixels, col_Image_2 has only black and green pixels and col_Image_3 has only black and red pixels.

The superposed image shows red over green over blue:

Here you can find a set of 200 gray scale images. http://bit.ly/1CpyIK1 (12.5 MB)

These images I have analyzed with the following code (which produces the expected resulting images (200 images yield 151 superposed images), but is still relatively slow). I have a 4 core i7 processor and have used ParallelTable. For calculating 151 images and writing them to files it takes around 110 sec.

The (until now fastest) solution for the superposition is from https://mathematica.stackexchange.com/users/862/simon-woods

bins = Table[
Clip[Import[fNames[[i]], "GrayLevels"], {0.18, 0.18}, {0,
i/number}], {i, number}];
superImg =
Colorize[Image[Map[Max, Transpose[bins, {3, 1, 2}], {2}]],
ColorFunction -> (Blend[colTable, #] &)];


My code is given here, which I would like to make faster is here:

ChoiceDialog[{FileNameSetter[Dynamic[imageDir], "Directory"],
Dynamic[imageDir]}];

colTable = {{Black},
Table[{Blend[{Blue, Green, Yellow, Red}, x]}, {x, 1/255, 1,
1/255}]}; colTable = Flatten[colTable];

SetDirectory[imageDir];
fNames = FileNames["*.png"];

numFiles = Length[fNames];
number = 50;

ParallelTable[

bins = Table[
Clip[Import[fNames[[i + j]], "GrayLevels"], {0.25, 0.25}, {0,
i/number}], {i, 1, number}];
superImg =
Colorize[Image[Map[Max, Transpose[bins, {3, 1, 2}], {2}]],
ColorFunction -> (Blend[colTable, #] &)];

fileName =
StringJoin[imageDir, "/out_", ToString[j + 1], ".png"];

Export[fileName, superImg, "PNG"];

, {j, 0, numFiles - number}

]