Space time diagram of sequential images

Question

If one has sequential images where moving objects are seen of which the coordinates cannot be obtained (e.g. since they overlap) then it is possible to gain additional dynamical information from corresponding "space time diagrams". Often a Fourier transformation of the resulting images can be useful.

The main idea is to measure the mean brightness in columns and rows as function of time (image number).

Below is my code do this. I would like to know how I can improve the speed by replacing the do loop. (A simple mapping does not help here and is even slower? ... see the code).

The corresponding images are available here.

GIF animation of the input images:

(If I find better data I will replace with them).

The following code is based on the answer from Wjx in here.

(*reading of images*)

ChoiceDialog[{FileNameSetter[Dynamic[imageDir], "Directory"], 
   Dynamic[imageDir]}];
SetDirectory[imageDir];
fNames = FileNames["*.png"];
numFiles = Length@fNames;
images = Import/@fNames;

(*calculating mean brightness in columns and rows as function of image number*)

imageData = ImageData[#, "Byte"] &/@ images;
dim = Dimensions[imageData];
compressedBrightnessToColumn = Array[0 &, {dim[[1]], dim[[2]]}];
compressedBrightnessToRow = Array[0 &, {dim[[1]], dim[[3]]}];

Do[
   compressedBrightnessToColumn[[i]] = Round[Mean/@imageData[[i]]];
   compressedBrightnessToRow[[i]] = Round[Mean@imageData[[i]]];
   , {i, 1, numFiles}
   ]; // AbsoluteTiming  
{0.3081059410516599`, Null}

(*two lines below are only for comparison*) 

compressedBrightnessToColumnComparison = 
   Round[Mean/@imageData[[#]]]&/@Range[numFiles]; // AbsoluteTiming  
{0.9095521242390106`, Null}
compressedBrightnessToRowComparison = 
   Round[Mean@imageData[[#]]]&/@Range[numFiles]; // AbsoluteTiming
{0.8687288156152203`, Null}

(*improved brightness of resulting images*)

columnSpaceTimeDiagram = Image@Rescale@compressedBrightnessToColumn;
rowSpaceTimeDiagram = Image@Rescale@compressedBrightnessToRow;

(*Since the first column of images corresponds to the column indices
and the second to the row indices I have to rotate the images*) 

columnSpaceTimeDiagram = ImageRotate[columnSpaceTimeDiagram, -90 Degree];
rowSpaceTimeDiagram = ImageRotate[rowSpaceTimeDiagram, -90 Degree];

Show[columnSpaceTimeDiagram, Axes -> True, AxesOrigin -> {0, 0}, 
 ImageSize -> 550, Frame -> True, FrameLabel -> {"frame numer", "y"}] 

Show[rowSpaceTimeDiagram, Axes -> True, AxesOrigin -> {0, 0}, 
 ImageSize -> 550, Frame -> True, FrameLabel -> {"frame numer", "x"}]

Answer 1

Edit - I just noticed the AbsoluteTiming in my example is not on the very outside meaning it's not as quick as I thought. It give about a 25% speed increase for me (0.4s to 0.3s), so it helps but is not as drastic as I first thought

This seemed to speed things up a lot. It does involve converting integers to reals, but it does not have any visible impact on the output:

With[
  {
    dat = Developer`ToPackedArray[N[imageData]]
  },
  AbsoluteTiming[
    compressedBrightnessToColumn = Round[Mean /@ #] & /@ dat;
    compressedBrightnessToRow  = Round[Mean[#]] & /@ dat;
  ]
]
(*{0.102465, Null}*)

The output from the full code block with the new code segment is this: