App Code

directory = NotebookDirectory[];
  filenames = "";
  fileNamePattern = "700";
  imageIndex = 1;
  bgThresholdQuantile = 0.2;
  maxTab = 1;
  imsize = 800;
  outputDir = "";
  scaledSize = 200;
  versionNumber = 0.1;
  colorScale="PigeonTones";
  originalImages = {Image[{{1, 1}, {1, 1}}]};

  adjustImage[img_?ImageQ, bgThresholdQuantile_?NumericQ] :=
      adjustImage[img, bgThresholdQuantile] =
          ImageAdjust@ImageSubtract[img, Quantile[img, bgThresholdQuantile]];

  backgroundRemove[img_?ImageQ, bgThresholdQuantile_?NumericQ] :=
      backgroundRemove[img, bgThresholdQuantile] =
          ImageMultiply[adjustImage[img, bgThresholdQuantile],
            DeleteSmallComponents[Binarize@adjustImage[img, bgThresholdQuantile]]];

  trimImage[img_?ImageQ] :=
      trimImage[img] =
          ImageTrim[img, ImageKeypoints[#, "KeypointStrength" -> .0001] &];

  entropyThres[img_?ImageQ] :=
      entropyThres[img] = FindThreshold[img, Method -> "Entropy"];

  plot3DMouse[image_?MatrixQ, zlim_?NumericQ,colorScale_?StringQ] :=
      plot3DMouse[image, zlim, colorScale] =
          ListPlot3D[image, MeshFunctions -> {#3 &}, Mesh -> {{zlim}}, MeshStyle -> Yellow,
            ColorFunction -> (ColorData[colorScale][If[#3 > zlim, #3, 0]] &),
            ColorFunctionScaling -> False, ImageSize -> imsize,
            PerformanceGoal -> "Quality", PlotRange -> All];

  SetOptions[$FrontEnd,"DynamicEvaluationTimeout"->45];

  safeExport[file_String, overwriteFiles_?BooleanQ, args___] :=
      If[
        ! FileExistsQ[file] || overwriteFiles,
        Export[file, args],
        $Failed
      ];

  labelStyle[i_] :=
      Function[item, Style[item, FontWeight -> Dynamic[If[i <= maxTab, Bold, "Plain"]]]];

MouseTensity[]:=DynamicModule[{},
  TabView[{labelStyle[1]@"SetDirectory" ->
      Column[{Row[{"File filtering pattern: ", InputField[Dynamic[fileNamePattern],String]}],
      FileNameSetter[
        Dynamic[directory, (filenames =
            Select[FileNames["*.tif", #, 4, IgnoreCase->True],
              StringContainsQ[#1, fileNamePattern] &]) &], "Directory",
        Appearance -> "Select Directory"],
        "Number of Files Found: ",
        Dynamic[Length[Last /@ FileNameSplit /@ filenames]],
        Button["Load Images",
          originalImages = (Import[#, "Image"] &) /@ filenames; maxTab = Max[maxTab,2];
        ]
      }],
    labelStyle[2]@"Check Images" ->
        Column[{Row[{Button["Previous image", imageIndex--,
          Enabled -> Dynamic@If[imageIndex > 1, True, False]],
          Button["Next image", imageIndex++,
            Enabled ->
                Dynamic@If[imageIndex < Length[originalImages], True, False]]}],
Row[{
          "Initial Background Quantile Threshold: ",
          Slider[Dynamic[bgThresholdQuantile], {0.01, 0.6}],
          Button["Find initial thresholds",
            Table[thres[ii] =
                entropyThres[
                  backgroundRemove[originalImages[[ii]], bgThresholdQuantile]];
includeForAnalysis[ii] = True;, {ii, 1,
              Length@originalImages}];
              maxTab = Max[maxTab,4];
              ]
        }],
          Dynamic[
            Show[backgroundRemove[originalImages[[imageIndex]], bgThresholdQuantile],
              ImageSize -> imsize]]}
        ],
    labelStyle[3]@"Find Tumours" ->
        Column[{Row[{Button["Previous image", imageIndex--,
          Enabled -> Dynamic@If[imageIndex > 1, True, False]],
          Button["Next image", imageIndex++,
            Enabled ->
                Dynamic@If[imageIndex < Length[originalImages], True, False]],
          "Detection threshold:", Slider[Dynamic[thres[imageIndex]], {0.01, 1, 0.01}],"Include in Analysis?: ",Checkbox[Dynamic[includeForAnalysis[imageIndex]]],
          Spacer[10], "Displayed 3D Image Size: ",
          Slider[Dynamic[scaledSize], {100, 600, 50}], "ColorScale: ",PopupMenu[Dynamic[colorScale],ColorData["Gradients"]]}],
          Dynamic[
            plot3DMouse[
              ImageData@
                  ImageResize[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                    scaledSize], thres[imageIndex],colorScale], SynchronousUpdating -> False,
            TrackedSymbols :> {imageIndex, thres, originalImages, scaledSize, colorScale}]}
        ],
    labelStyle[4]@"Export Data" ->
        Column[{FileNameSetter[Dynamic[outputDir], "Directory",
          Appearance -> "Set Output Directory"], Spacer[50], outputDir,
          Spacer[50], "Overwrite Files?: ",
          Checkbox[Dynamic[overwriteFiles]],
          Button["Export Data",
            tab = Table[
If[includeForAnalysis[imageIndex],
              Flatten@{Last@FileNameSplit@filenames[[imageIndex]],
                Round[thres[imageIndex], 0.001],
                Round[{length,width,area,TI} = ComponentMeasurements[
                  ImageMultiply[originalImages[[imageIndex]],
                    DeleteSmallComponents@
                        Binarize[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                          thres[imageIndex]]], {"Length", "Width", "Area",
                    "TotalIntensity"}][[1, 2]]],
                Round[TI -
                    thres[imageIndex]*(ComponentMeasurements[
                      ImageMultiply[originalImages[[imageIndex]],
                        DeleteSmallComponents@
                            Binarize[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                              thres[imageIndex]]], {"Count"}][[1, 2, 1]])],
                Round[scaTI =
                    ComponentMeasurements[
                      ImageMultiply[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                        DeleteSmallComponents@
                            Binarize[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                              thres[imageIndex]]], {"TotalIntensity"}][[1, 2]]],
                Round[scaTI -
                    thres[imageIndex]*(ComponentMeasurements[
                      ImageMultiply[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                        DeleteSmallComponents@
                            Binarize[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                              thres[imageIndex]]], {"Count"}][[1, 2, 1]])]
                              }/.Round[_]->"NA", 
Nothing],
                              {imageIndex, 1, Length@originalImages}];
            dataout =
                Join[{{"FileName", "Threshold", "Ellipse Length",
                  "Ellipse Width", "Area", "TotalIntensity", "TotalIntensityAboveThreshold",
                  "ScaledTotalIntensity","ScaledTotalIntensityAboveThreshold"}}, tab];
            safeExport[FileNameJoin[{outputDir, "MouseTensityData.csv"}],
              overwriteFiles, dataout];
            Table[
If[includeForAnalysis[imageIndex],
 safeExport[
                FileNameJoin[{outputDir,
                  FileBaseName@filenames[[imageIndex]] <> "_plot3d.png"}],
                overwriteFiles,
                plot3DMouse[
                  ImageData@
                      ImageResize[adjustImage[originalImages[[imageIndex]], bgThresholdQuantile],
                        scaledSize], thres[imageIndex],colorScale]]], {imageIndex, 1, Length@originalImages}]
          ]}]

  },
  Dynamic[panelIndex, If[# <= maxTab, panelIndex = #] &]
  ]
];

MouseTensity

Introduction and Disclaimer

This notebook was made as a proof-of-concept idea by Dr Simon Pearce (simon.pearce@manchester.ac.uk), and comes with no guarantees. 
It is designed to be used to take a tif image of luceriferase imaging taken from three different machines: a PerkinElmer IVIS Spectrum, Bruker InVivo Xtreme and the Li-Cor Pearl Trilogy. 
It does not currently split the image into individual mice for the platforms which image multiple mice, that must be done outside of the app.

Usage

Select the blue cell below, and press Shift+Enter to run it. When Mathematica asks you to evaluate the initialisation cells, click “Yes”.

MouseTensity[]