4
$\begingroup$

First of all

thanks to:

rm -rf, Mr.Wizard, Simon Woods, Pickett, Piotr Wendykier, Mac, Yves Klett, belisarius, halirutan, bill s, nikie, wxffles, ...

Everybody of you helped me (a mathematica beginner) to solve my image overlapping problem.

Now I would like to show you the outcome and would ask you if there is a way to make my code faster.

The images and the notebook file can be downloaded here:

http://goo.gl/LAV1me

The code also shown here:

imageDir = FileNameJoin[{NotebookDirectory[], "images"}];

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

numFiles = Length[fNames]; 

readImage[ index_] := Import[fNames[[index]]]; 

number = 50;
img = readImage[1];
superImg = ImageData[ImageMultiply[img, 0]];

 For[
    i = 1, i < number + 1, i++,
    img = readImage[i];
    ind = Position[ImageData[Binarize[img, 0.18]], 1];
     superImg = ReplacePart[superImg, ind -> 1/number*i];
    ]
imageOut = 
 Colorize[Image[superImg], ColorFunction -> "TemperatureMap"]

Mathematica graphics

$\endgroup$
5
$\begingroup$

This seems quicker. Importing the images is the slowest bit, there's probably not much you can do about that.

fNames = FileNames["*.png"]; 
n = Length @ fNames;

bins = Table[
   Clip[Import[fNames[[i]], "GrayLevels"], {0.18, 0.18}, {0, i/n}] ,
   {i, n}];

Colorize[
 Image[Map[Max, Transpose[bins, {3, 1, 2}], {2}]],
 ColorFunction -> "TemperatureMap"]
$\endgroup$
  • $\begingroup$ @belisarius, the pixels injected into OP's superImg increase in value as the image list is stepped through. So the final value in any pixel is always the maximum. $\endgroup$ – Simon Woods Dec 18 '14 at 18:38
  • $\begingroup$ Yep, I think this is more efficient than mine. I tried to emulate the OP's logic, and this is better $\endgroup$ – Dr. belisarius Dec 18 '14 at 18:39
  • $\begingroup$ Dear Simon, I exchanged Table by ParallelTable and it makes your code 80% faster .. $\endgroup$ – mrz Dec 19 '14 at 10:51
6
$\begingroup$

This one takes less than one third of the time in my machine. The main idea is NOT converting to ImageData[] to speed up image ops.

imgs = Import /@ fNames; 
fun[img_, idx_] := ImageApply[UnitStep[# - .18]/number idx &, img]; 
imgs1 = MapIndexed[fun[#1, #2[[1]]] &, imgs];
fold = Fold[ ImageAdd[ImageSubtract[#1, ImageMultiply[#1, Binarize[#2, 0]]], #2] &, imgs1];
imageOut1 = Colorize[fold, ColorFunction -> "TemperatureMap"]

Mathematica graphics

You may see there are very small deviations wrt your method (I haven't looked much into them, but they shouldn't be very difficult to spot and correct if there is need for it at all):

ImageSubtract[imageOut, imageOut1] // ImageData // Flatten // Abs // Max
(* 0.00784314 *)
$\endgroup$
  • $\begingroup$ Perhaps the folding operation could be carried along with the Duff-Porter operators of ImageCompose[], but I haven't tried. $\endgroup$ – Dr. belisarius Dec 18 '14 at 17:25
  • $\begingroup$ Dear belisarius, $\endgroup$ – mrz Dec 19 '14 at 9:21
  • $\begingroup$ in the 4th line (fold= ...) after "img1" and "]" Mathematica says something is missing? Do you have the same warning? $\endgroup$ – mrz Dec 19 '14 at 9:54
  • $\begingroup$ >>" Too few arguments given" But I can execute the code .... hmmm $\endgroup$ – mrz Dec 19 '14 at 10:08
  • $\begingroup$ @MilenkoRubin-Zuzic That's probably because I'm using a syntax variant for Fold[] with two arguments instead of three. Not documented but cool :) $\endgroup$ – Dr. belisarius Dec 19 '14 at 11:49

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.