How to add and export custom metainformation with image

Question

v.10 In the documentation, it shows you can add custom metainformation to an image under Metainformation. However, I would like to export the image with the custom metainformation and be able to subsequently import the image with the metainformation. Also I am unsure on which image formats support exporting of the metainformation. I have looked into DICOM, FITS, and TIFF with no success. How do I approach this problem and is it even supported yet by Mathematica 10? Here is an example. Import a image of a protein gel, add custom metainformation to the image, and then export the image. This would allow documenting important experiment information directly within the image file.

metatitles = {"Date Created", "Researcher", "Technique", "Lysate", 
"Block", "700 Primary Ab & conc.", "800 Primary Ab & conc.", 
"Wash1 Conditions", "700 Secondary Ab & conc.", 
"800 Secondary Ab & conc.", "Wash2 Conditions", 
"Ab/ Stain Incubation Time", "Number of Lanes", 
"Lane Descriptions"};
Manipulate[
metainformation = (#[[1]] -> #[[2]] & /@ 
Transpose[{{"Date Created", "Researcher", "Technique", "Lysate", 
   "Block", "700 Primary Ab & conc.", "800 Primary Ab & conc.", 
   "Wash1 Conditions", "700 Secondary Ab & conc.", 
   "800 Secondary Ab & conc.", "Wash2 Conditions", 
   "Ab/ Stain Incubation Time", "Number of Lanes", 
   "Lane Descriptions"}, {date, researcher, technique, lysate, 
   block, primary700, primary800, wash1, secondary700, 
   secondary800, wash2, abincubation, nlanes, lanes}}]);

 img = (Import[#] & /@ g)[[1]]; 
 date = DateString[FileDate[FindFile[g[[1]]], "Creation"]];
 aimg = ImageAdjust[img, {a, b, c}], Button["ClearEntries",
 {researcher =., technique =., 
 date = Style["m/dd/yy", Red, Italic, Opacity[.5]], 
 seven = Style["NEO RPA 1:500", Red, Italic, Opacity[.5]], 
 eight = Style["NEO RPA 1:500", Red, Italic, Opacity[.5]]}],
 Delimiter,
 {{researcher, ""}, {"Mark", "Luke", "John"}},
 {{technique, ""}, {"Western Blot", "Coomassie"}},
 {{lysate, ""}, {"Cytoplasmic", "Nuclear"}},
 {{block, , "Block"}, FieldHint -> "1% PWD Mild 10 min", 
 FieldHintStyle -> {Red}},
 {{primary700, If[technique == "Coomassie", "Coomassie Blue"], 
 "Primary Ab 700 & conc."}, FieldHint -> "NEO RPA 1:500", 
 FieldHintStyle -> {Red}},
 {{primary800, If[technique == "Coomassie", "Coomassie Blue"], 
 "Primary Ab 800 & conc."}, FieldHint -> "AbCam TopBP1 1:500", 
 FieldHintStyle -> {Red}},
 {{wash1, If[technique == "Coomassie", "Coomassie Blue"], 
 "Wash1 Conditions"}, FieldHint -> "0.2% Tween, 3 x 15 min", 
 FieldHintStyle -> {Red}},
 {{secondary700, If[technique == "Coomassie", "Coomassie Blue"], 
 "Secondary Ab 700 & conc."}, FieldHint -> "Rb aM", 
 FieldHintStyle -> {Red}},
 {{secondary800, If[technique == "Coomassie", "Coomassie Blue"], 
 "Secondary Ab 800 & conc."}, FieldHint -> "M aR", 
 FieldHintStyle -> {Red}},
 {{wash2, , "Wash2 Conditions"}, 
 FieldHint -> "0.2% Tween, 3 x 15 min", FieldHintStyle -> {Red}},
 {{abincubation, , "Ab/ Stain  Time & Temp"}, 
  FieldHint -> "1hr Room Temp", FieldHintStyle -> {Red}},
 {{nlanes, 3, "Number of Lanes"}, 1, 20, 1, Appearance -> "Open"},
 {{lanes, , "Sample Descriptions"}, FieldHint -> "Lane1: UMSCC 38, ", 
 FieldHintStyle -> {Red}},
 Delimiter, {{a, 0, "Contrast"}, -2, 2, 
 Appearance -> "Open"}, {{b, 0, "Brightness"}, -2, 2, 
 Appearance -> "Open"}, {{c, 1, "Gamma"}, .001, 2, 
 Appearance -> "Open"}, Delimiter, 
 Button["Export DICOM", Export["image.tiff", Flatten[{"Image"->aimg,"Metainfromation"->metainformation}],"Rules"]]]

Answer 1

What I can see is that you need to include metadata in an accepted format for images, for instance EXIF.

img = Image[Rasterize[x], 
 MetaInformation -> {"Exif" -> {"ImageDescription" -> "An example", 
     "Make" -> "camera brand", "Model" -> "xxx"}}]

Export["test2.jpg", img]

Import["test2.jpg", "ImageWithExif"]

Options[%, MetaInformation]

{MetaInformation -> {"Exif" -> {"ImageDescription" -> "An example", 
 "Make" -> "camera brand", "Model" -> "xxx"}}}

The fields that EXIF accepts are limited, but there is a field called UserComment of arbitrary length and format.

Your example code does not work, so I will do a minimum working example with random data

Export[
 "testimage.jpg"
 , Image[
  Import["ExampleData/lena.tif"]
  , MetaInformation -> {"Exif" -> {"UserComment" -> RandomInteger[255, 1024 1024]}}
  ]]

To recover:

Options[Import["testimage.jpg", "ImageWithExif"], MetaInformation]

EDIT

You could encode anything you want as a list of integers, for instance using Compress and ToCharacterCode

storeInImage[img_Image, data_] := 
 Image[img, 
  MetaInformation -> {"Exif" -> {"UserComment" -> ToCharacterCode[Compress[data]]}}
  ]

extractFromImage[img_Image] := 
 Uncompress[
  FromCharacterCode@
   Association[Nest[Values, Options[img, MetaInformation], 2]][[
    "UserComment"]]]


storeInImage[Import["ExampleData/lena.tif"], ExampleData[{"Text", "ToBeOrNotToBe"}]]

extractFromImage[%]

To be, or not to be,--that is the question:-- Whether 'tis nobler in \ the mind [...]

Answer 2

Implementing rhermans method, here is the code to add custom metainformation to an image under "User Comments". Then search the metainformation from multiple images to locate the image of interest according to your search terms.

Creates a browser to load a file.

loadImg = {FileNameSetter[Dynamic[g], "OpenList", 
   WindowTitle -> "LoadImage"], Dynamic[g]; Dynamic[g[[{1, -1}]]]}

Generates a Manipulate with Input Fields for controls to add your custom metainformation according to your headings with a button to export the image with the metainformation once you are finished. In this case I've standardize fields for documenting information associated with a Western Blot for protein detection.

storeInImage[img_Image, data_] := 
 Image[img, 
  MetaInformation -> {"Exif" -> {"UserComment" -> 
       ToCharacterCode[Compress[data]]}}]

Manipulate[
 metaheadings = {"Date Created", "Researcher", "Technique", "Lysate", 
   "Transfer Conditions", "Block", "700 Primary Ab & conc.", 
   "800 Primary Ab & conc.", "Wash1 Conditions", 
   "700 Secondary Ab & conc.", "800 Secondary Ab & conc.", 
   "Wash2 Conditions", "Ab/ Stain Incubation Time", "Number of Lanes",
    "Lane Descriptions"};
 customMetaInfo = {date, researcher, technique, lysate, transfer, 
   block, primary700, primary800, wash1, secondary700, secondary800, 
   wash2, abincubation, nlanes, lanes};

 metainformation = 
  ToString[InputForm[
    Transpose[{metaheadings, ToString[#] & /@ customMetaInfo}]]];

 img = (Import[#] & /@ g)[[1]]; 
 date = DateString[FileDate[FindFile[g[[1]]], "Creation"]];
 aimg = ImageAdjust[img, {a, b, c}],
 Button["ClearEntries",
  {researcher =.,
   technique =.,
   lysate =.,
   block = Style["1% PWD Mild 10 min", Red, Italic, Opacity[.5]],
   date = Style["m/dd/yy", Red, Italic, Opacity[.5]],
   primary700 = Style["NEO RPA 1:500", Red, Italic, Opacity[.5]],
   primary800 = Style["AbCam TopBP1 1:500", Red, Italic, Opacity[.5]],
   wash1 = Style["0.2% Tween, 3 x 15 min", Red, Italic, Opacity[.5]],
   secondary700 = Style["Rb aM", Red, Italic, Opacity[.5]],
   secondary800 = Style["M aR", Red, Italic, Opacity[.5]],
   wash2 = Style["0.2% Tween, 3 x 15 min", Red, Italic, Opacity[.5]]}],
 Delimiter,
 {{researcher, ""}, {"Matthew", "Mark", "Luke"}},
 {{technique, ""}, {"Western Blot", "Coomassie"}},
 {{lysate, ""}, {"Cytoplasmic", "Nuclear"}},
 {{transfer, , "Overnight xVolts 4C"}, 
  FieldHint -> "Overnight xVolts 4C", FieldHintStyle -> {Red}},
 {{block, , "Block"}, FieldHint -> "1% PWD Mild 10 min", 
  FieldHintStyle -> {Red}},
 {{primary700, If[technique == "Coomassie", "Coomassie Blue"], 
   "Primary Ab 700 & conc."}, FieldHint -> "NEO RPA 1:500", 
  FieldHintStyle -> {Red}},
 {{primary800, If[technique == "Coomassie", "Coomassie Blue"], 
   "Primary Ab 800 & conc."}, FieldHint -> "AbCam TopBP1 1:500", 
  FieldHintStyle -> {Red}},
 {{wash1, If[technique == "Coomassie", "Coomassie Blue"], 
   "Wash1 Conditions"}, FieldHint -> "0.2% Tween, 3 x 15 min", 
  FieldHintStyle -> {Red}},
 {{secondary700, If[technique == "Coomassie", "Coomassie Blue"], 
   "Secondary Ab 700 & conc."}, FieldHint -> "Rb aM", 
  FieldHintStyle -> {Red}},
 {{secondary800, If[technique == "Coomassie", "Coomassie Blue"], 
   "Secondary Ab 800 & conc."}, FieldHint -> "M aR", 
  FieldHintStyle -> {Red}},
 {{wash2, , "Wash2 Conditions"}, 
  FieldHint -> "0.2% Tween, 3 x 15 min", FieldHintStyle -> {Red}},
 {{abincubation, , "Ab/ Stain  Time & Temp"}, 
  FieldHint -> "1hr Room Temp", FieldHintStyle -> {Red}},
 {{nlanes, 3, "Number of Lanes"}, 1, 20, 1, Appearance -> "Open"},
 {{lanes, , "Sample Descriptions"}, FieldHint -> "Lane1: UMSCC 38, ", 
  FieldHintStyle -> {Red}},
 {{filename, "image.jpg", "Filename"}, 
  FieldHint -> "\"image.jpg\"     ( NEEDS \"\")", 
  FieldHintStyle -> {Red}},
 Delimiter, {{a, 0, "Contrast"}, -2, 2, 
  Appearance -> "Open"}, {{b, 0, "Brightness"}, -2, 2, 
  Appearance -> "Open"}, {{c, 1, "Gamma"}, .001, 2, 
  Appearance -> "Open"}, Delimiter, 
 Button["Export Image", 
  Export[filename, storeInImage[aimg, metainformation], 
   ImageResolution -> 600]]]

Select a bunch of files with metainformation ("User Comments") to search for a specific (or multiple) files.

loadImgsToSearch = {FileNameSetter[Dynamic[f], "OpenList", 
   WindowTitle -> "Load Raw Comet Images"], Dynamic[f]; 
  Dynamic[f[[{1, -1}]]]}

Generates a Manipulate to query the metainformation ("User Comments") within the files you just selected.

extractFromImage[img_Image] := 
 ToExpression[
  Uncompress[
   FromCharacterCode@
    Association[
      Nest[Values, Options[img, MetaInformation], 
       2]][["UserComment"]]]]

Manipulate[With[{
   value = Table[searchterm[i], {i, 1, n, 1}], 
   controls =  
    Sequence @@ 
     Table[{{searchterm[i],}, FieldHint -> "Search Term"}, {i, 1, 
       n}]}, 

  Manipulate[{f[[#]], Import[f[[#]]], 
      Grid[List @@@ extractFromImage[Import[f[[#]]]], 
       Alignment -> {Left, Baseline}, Frame -> All, 
       Background -> {{White, None}, {{LightGray, LightBlue}}}]} & /@ 
    Flatten[Position[
      Count[Flatten[
          MapThread[
             StringMatchQ, {Table[#, {n}], 
              StringExpression[ToString[#]] & /@ value, 
              Table[IgnoreCase -> True, {n}], 
              Table[SpellingCorrection -> True, {n}]}] & /@ 
           extractFromImage[Import[#]]], True] & /@ f, n]],

   controls]], {{n, 1, "Number of Search Terms"}, 1, 5, 1, 
  Appearance -> "Open"}, SynchronousUpdating -> False]

Clips of the two Manipulates