4
$\begingroup$

I need to delete images that are all or mostly white, here's a sample of them:

enter image description here

Here is my my code finds, my code is not very accurate nor efficient:

WhiteQ[img_] := ColorDistance[DominantColors[img, 1], White][[1]] < 0.2
fimgs = Map[
  Framed[#, FrameStyle -> If[WhiteQ[#], {Thick, Red}, White]] &, 
  imgs]
Magnify[Grid[Partition[fimgs, 10], Dividers -> All], 0.5]

enter image description here

$\endgroup$
  • $\begingroup$ Perhaps define "mostly", and provide some images to play with? $\endgroup$ – MarcoB Jun 14 '16 at 18:14
  • $\begingroup$ Sure, maybe 97% of area is white, it doesn't have to be exactly. And whats the easiest way that can I provide the images? $\endgroup$ – M.R. Jun 14 '16 at 18:27
  • 2
    $\begingroup$ With the Wolfram Cloud, I put the images into Databin 'dsNFr2og'. wolfr.am/dsNFr2og $\endgroup$ – M.R. Jun 14 '16 at 20:18
  • 1
    $\begingroup$ @MarcoB The permissions on the databin is public, can you access it? $\endgroup$ – M.R. Jun 14 '16 at 21:26
  • 1
    $\begingroup$ Please edit your question to include the Databin link. $\endgroup$ – J. M. will be back soon Jun 14 '16 at 23:11
3
$\begingroup$

This seems pretty fast (it takes roughly 0.08s on your set of images):

images = Normal@Databin["dsNFr2og"];

Total[#, 2] & /@ ImageData /@ Binarize /@ images;
% / (Times @@ ImageDimensions[images[[1]]]) // N;
Extract[images, Position[%, p_ /; p < 0.5]]

Mathematica graphics

Adjust the 0.5 threshold to your liking to retain more or fewer images. (Thanks nikie for the suggestion to replace Count with Total!).

Using a fixed threshold for Binarize also leads to a significant speedup:

Total[#, 2] & /@ ImageData /@ (Binarize[#, 0.9] & /@ images); // RepeatedTiming
(* Out: {0.016, Null} *)

Mathematica graphics

$\endgroup$
  • $\begingroup$ That "0.1" seem to not include that import and export? $\endgroup$ – yode Jun 14 '16 at 23:49
  • $\begingroup$ @yode sure, but OP already has those images imported. I think it's the processing that took time. $\endgroup$ – MarcoB Jun 15 '16 at 1:30
  • 5
    $\begingroup$ If you replace Count[1] with Total (should be the same for binary images?), and if you used a fixed threshold for Binarize, you can get that down to about .01s $\endgroup$ – Niki Estner Jun 15 '16 at 6:58
  • 1
    $\begingroup$ @nikie That's a very good point about Total; I'll make the change; additionally, using the second argument of Total removes the need for Flatten as well, and it saves a few ms more. A fixed threshold for Binarize is faster, but the default adaptive algorithm seems to give better results (more uniform color blocks in the B&W images). On that point, I'll leave it up to OP to choose which one is more important to him, speed or accuracy. $\endgroup$ – MarcoB Jun 15 '16 at 15:01
0
$\begingroup$

I suppose all your images to process is in a certain same local fold and they are a same format.In this solution,I give a example that they are all ".png".Of course they can be ".tiff",".jpg" or other something.Let simulate your real case

images = Normal@Databin["dsNFr2og"];
SeedRandom[1]; 
Export[
   FileNameJoin[{Directory[], "testFold", 
      RandomWord[Language -> "English"]}] <> ".png", #] & /@ images;

Start to process,I make a custom function for this.

DeleteWihtePicture[fold_, threshold_] := 
 Module[{count = 0}, SetDirectory[fold];
  Do[If[ImageMeasurements[ChanVeseBinarize[#, White], "Total"]/
        Times @@ ImageDimensions[#] &[
      First@Image`ImportExportDump`ImageReadPNG[img]] > threshold, 
    DeleteFile[img]; count++], {img, FileNames[]}]; 
  Print[TemplateApply["You have deleted `` white picture", count]]
   ResetDirectory[];]

Let's give a try.

AbsoluteTiming[
 DeleteWihtePicture[FileNameJoin[{Directory[], "testFold"}], .6]]

You have deleted 35 white picture

{0.659116,Null}

Then you will get

http://o8aucf9ny.bkt.clouddn.com/2016-06-15-08-14-48.png

I don't like these filenames,because they may include some nouns that you don't like. But don't mind that.For the efficiency,I use ImportExportDump`ImageReadPNG.You can replace First@Image`ImportExportDump`ImageReadPNG with Import for any image format.In my PC(i7-6500U),the time will increase to 1.28.BTW,you can find those specific function which can help to speed up by

Names["Image`ImportExportDump`*"]

It is @MarcoB's contribution in this answer,which makes me deeply impressed.Hope this can help.

$\endgroup$
  • 1
    $\begingroup$ "I don't like these filenames,because it can be include some nouns that you don't like." - neither do I; what the hell is an insecticide doing in there?! :P $\endgroup$ – J. M. will be back soon Jun 15 '16 at 5:53
  • $\begingroup$ @J.M. Ok.I have killed those pests. :) $\endgroup$ – yode Jun 15 '16 at 6:41

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.