diff --git a/QMRITools/Kernel/GeneralTools.wl b/QMRITools/Kernel/GeneralTools.wl index 2c476f55..b9499cd2 100644 --- a/QMRITools/Kernel/GeneralTools.wl +++ b/QMRITools/Kernel/GeneralTools.wl @@ -261,6 +261,9 @@ MemoryUsage::usage = "MemoryUsage[] gives a table of which definitions use up memory. MemoryUsage[n] gives a table of which definitions use up memory, where n is the amout of definitions to show." +MBCount::usgae = +"MBCount[expr] gives the memory usage of the expression in MB." + ClearTemporaryVariables::usage = "ClearTemporaryVariables[] Clear temporary variables." @@ -1374,6 +1377,13 @@ MADNoZeroi = Compile[{{vec, _Real, 1}}, If[AllTrue[vec, # === 0. &], 0., MedianD (*Memory functions*) +(* ::Subsubsection::Closed:: *) +(*MBCount*) + + +MBCount[exp_] := Round[UnitConvert[N@Quantity[ByteCount[exp], "Byte"], "Megabytes"], .1]; + + (* ::Subsubsection::Closed:: *) (*MemoryUsage*) diff --git a/QMRITools/Kernel/SegmentationTools.wl b/QMRITools/Kernel/SegmentationTools.wl index 387f5858..52094290 100644 --- a/QMRITools/Kernel/SegmentationTools.wl +++ b/QMRITools/Kernel/SegmentationTools.wl @@ -96,6 +96,10 @@ The input method can be a filename of a classify network or a classify network. Additionally the input method can be one of the predefined methods \"LegPosition\" or \"LegSide\"." +ShowTrainLog::usage = +"ShowTrainLog[fol] shows the training log of the network training stored in fol. +ShowTrainLog[fol, min] shows the training log of the network training stored in fol if the log has a minimum of min rounds." + TrainSegmentationNetwork::usage = "TrainSegmentationNetwork[{inFol, outFol}] trains a segmentation network. The correctly prepared training data should be stored in inFol. The progress each round will be saved in outFol. TrainSegmentationNetwork[{inFol, outFol}, netCont] does the same but defines how to continue with netCont. If netCont is \"Start\" training will be restarted. @@ -168,6 +172,10 @@ MuscleNameToLabel[{name, ..}, file] does the same but uses a user defined ITKSna ImportITKLabels::usage = "ImportITKLabels[file] imports the ITKSnap label file." +SegmentDataGUI::usage = " +SegmentDataGUI[] is a function that creates a graphical user interface (GUI) for segmenting data. +It prompts the user to enter the paths for the input and output files, and allows them to select the segmentation type. " + (* ::Subsection::Closed:: *) (*Options*) @@ -225,11 +233,23 @@ The minimal number of patches in each direction is calculated, and then for each PatchPadding::usage = "PatchPadding is an option for DataToPatches. Can be an integer value >= 0. It padds the chosen patch size with the given number." +FindPatchDim::usage = ""; + + (* ::Subsection:: *) (*Error Messages*) +TrainSegmentationNetwork::net = "The net input is not \"Start\", a network, a network file, or a previous train folder." + +TrainSegmentationNetwork::cont = "Could not find a previous network in the specified folder." + +TrainSegmentationNetwork::inp = "The string input given is not a network file or a directory." + +TrainSegmentationNetwork::itt = "Not enough itterations specified for training. Remaining itterations are less than 5." + + (* ::Section:: *) (*Functions*) @@ -237,18 +257,79 @@ PatchPadding::usage = Begin["`Private`"] +(* ::Subsection::Closed:: *) +(*SegmentDataGUI*) + + +SegmentDataGUI[] := DynamicModule[{inputFile, outputFile}, Block[{dat, vox, seg, status, diag, option}, + NotebookClose[segwindow]; + + option = "Legs"; + + diag = DialogNotebook[ + status = TextCell@""; + { + TextCell["Please enter the paths for the input and output files:"], + + Grid[{{ + TextCell["Status: "], Dynamic[status] + }, { + TextCell["Input File: "], + InputField[Dynamic[inputFile], String, + FieldHint -> "Enter input file path", FieldSize -> {25, 1}], + Button["Browse", inputFile = SystemDialogInput["FileOpen"], Method -> "Queued"] + }, { + TextCell["Output File: "], + InputField[Dynamic[outputFile], String, + FieldHint -> "Enter output file path", + FieldSize -> {25, 1}], + Button["Browse", outputFile = SystemDialogInput["FileSave"], Method -> "Queued"] + }, { + TextCell["Segmentation type"], + PopupMenu[Dynamic[option], {"Legs", "LegBones"}] + },{ + Button["Start Segmentation, please be patient", + If[! NiiFileExistQ[inputFile], + MessageDialog["Input file could not be foud."] + , + status = TextCell@"Importing"; + {dat, vox} = ImportNii[inputFile]; + status = TextCell@"Segmenting Data"; + seg = SegmentData[dat, option, TargetDevice -> "CPU"]; + status = TextCell@"Exporting"; + + CopyFile[GetAssetLocation["MusclesLegLabels"], + ConvertExtension[outputFile, ".txt"], + OverwriteTarget -> True]; + ExportNii[seg, vox, outputFile]; + status = Button["Go to " <> FileBaseName@outputFile, + SystemOpen[DirectoryName@outputFile]]; + ], + Method -> "Queued"] + }}, Alignment -> Left], + Row[{ + DefaultButton[], + CancelButton[] + }] + } + ]; + + segwindow = CreateWindow[diag, WindowTitle -> "Muscle segmentation", WindowSize -> All]; +];]; + + (* ::Subsection::Closed:: *) (*GetNeuralNet*) SyntaxInformation[GetNeuralNet] = {"ArgumentsPattern" -> {_}}; -GetNeuralNet[name_?StringQ]:=GetNeuralNetI[name] +GetNeuralNet[name_?StringQ]:= GetNeuralNetI[name] GetNeuralNetI[name_]:=GetNeuralNetI[name]=Which[ - FileExistsQ[name],Import[name], - FileExistsQ[GetAssetLocation[name]],Import[GetAssetLocation[name]], - True,$Failed + FileExistsQ[name], Import[name], + FileExistsQ[GetAssetLocation[name]], Import[GetAssetLocation[name]], + True, $Failed ] @@ -558,16 +639,21 @@ ChangeNetDimensions[netIn_, OptionsPattern[]] := Block[{ SyntaxInformation[AddLossLayer] = {"ArgumentsPattern" -> {_}}; AddLossLayer[net_]:=Block[{dim}, + (*http://arxiv.org/abs/2312.05391*) dim = Length[Information[net,"OutputPorts"][[1]]]-1; NetGraph[<| "net"->net, - "SoftDice" -> SoftDiceLossLayer[dim], + "SoftDice" -> SoftDiceLossLayer[dim, 2], + "Jaccard" -> SofJaccardLossLayer[dim], + "Tversky" -> TverskyLossLayer[dim, 0.7], "SquaredDiff" -> {MeanSquaredLossLayer[], ElementwiseLayer[100 #&]}, - "CrossEntropy" -> {CrossEntropyLossLayer["Binary"], ElementwiseLayer[100 #&]} + "CrossEntropy" -> {CrossEntropyLossLayer["Probabilities"]} |>,{ - {"net",NetPort["Target"]}->"SoftDice"->NetPort["SoftDice"], - {"net",NetPort["Target"]}->"SquaredDiff"->NetPort["SquaredDiff"], - {"net",NetPort["Target"]}->"CrossEntropy"->NetPort["CrossEntropy"] + {"net", NetPort["Target"]}->"SoftDice"->NetPort["SoftDice"],(*using squared dice*) + {"net", NetPort["Target"]}->"Jaccard"->NetPort["Jaccard"], + {"net", NetPort["Target"]}->"Tversky"->NetPort["Tversky"], + {"net", NetPort["Target"]}->"SquaredDiff"->NetPort["SquaredDiff"],(*Brier Score*) + {"net", NetPort["Target"]}->"CrossEntropy"->NetPort["CrossEntropy"] }] ] @@ -576,121 +662,118 @@ AddLossLayer[net_]:=Block[{dim}, (*SoftDiceLossLayer*) -SyntaxInformation[SoftDiceLossLayer] = {"ArgumentsPattern" -> {_}}; +SyntaxInformation[SoftDiceLossLayer] = {"ArgumentsPattern" -> {_, _.}}; + +SoftDiceLossLayer[dim_ ] := SoftDiceLossLayer[dim, 1] -SoftDiceLossLayer[dim_] := NetGraph[ - <| - "sumInp" -> {AggregationLayer[Total, ;; dim]}, - "sumTar" -> {AggregationLayer[Total, ;; dim]}, - "sumProd" -> {ThreadingLayer[Times], AggregationLayer[Total, ;; dim]}, - "dice" -> {ThreadingLayer[1. - ((2. #1) / (#2 + #3 + 10.^-10)) &], AggregationLayer[Mean, 1]} +SoftDiceLossLayer[dim_, n_] := Block[{smooth}, + (*10.48550/arXiv.1911.02855 and 10.48550/arXiv.1606.04797 for scquared dice loss look at v-net*) + smooth =1; + NetGraph[<| + (*flatten input and target; function layer allows to switch to L2 norm if #^2*) + "input" -> {FunctionLayer[#^n &], AggregationLayer[Total, ;; dim]}, + "target" -> {FunctionLayer[#^n &], AggregationLayer[Total, ;; dim]}, + (*intersection or TP*) + "intersection" -> {ThreadingLayer[Times], AggregationLayer[Total, ;; dim]}, + (*the loss function 2*intersection / (input + target)*) + "dice" -> {ThreadingLayer[1. - ((2. #1 + smooth) / (#2 + #3 + smooth)) &], AggregationLayer[Mean, 1]} |>, { - NetPort["Input"] -> "sumInp", - NetPort["Target"] -> "sumTar", - {NetPort["Target"], NetPort["Input"]} -> "sumProd", - {"sumProd", "sumTar", "sumInp"} -> "dice" -> NetPort["Loss"] - }, "Loss" -> "Real" + NetPort["Input"] -> "input", + NetPort["Target"] -> "target", + {NetPort["Target"], NetPort["Input"]} -> "intersection", + {"intersection", "target", "input"} -> "dice" -> NetPort["Loss"] + }, "Loss" -> "Real"] ] -(* ::Subsection:: *) -(*Encoders*) - - (* ::Subsubsection::Closed:: *) -(*ClassEndocer*) +(*SofJaccardLossLayer*) -SyntaxInformation[ClassEncoder] = {"ArgumentsPattern" -> {_, _.}}; - -ClassEncoder[data_]:= ClassEncoderC[data, Max@data] +SyntaxInformation[SofJaccardLossLayer] = {"ArgumentsPattern" -> {_}}; -ClassEncoder[data_, nClass_]:= If[nClass === 1, data, ClassEncoderC[data, nClass]] +SofJaccardLossLayer[dim_ ] := SofJaccardLossLayer[dim, 1] -ClassEncoderC = Compile[{{data, _Integer, 2}, {n, _Integer, 0}}, - Transpose[1 - Unitize[ConstantArray[data, n] - Range[n]], {3, 1, 2}] -, RuntimeAttributes -> {Listable}] +SofJaccardLossLayer[dim_, n_]:= Block[{smooth}, + smooth = 1; + NetGraph[<| + (*flatten input and target; function layer allows to switch to L2 norm if #^2*) + "input" -> {FunctionLayer[#^n &], AggregationLayer[Total, ;; dim]}, + "target" -> {FunctionLayer[#^n &], AggregationLayer[Total, ;; dim]}, + (*intersection or TP*) + "intersection" -> {ThreadingLayer[Times], AggregationLayer[Total, ;; dim]}, + (*the loss function intersection / union with union = (input + target - intersection)*) + "Jaccard" -> {ThreadingLayer[1. - ((#1 + smooth) / ((#2 + #3) - #1 + smooth)) &], AggregationLayer[Mean, 1]} + |>, { + NetPort["Input"] -> "input", + NetPort["Target"] -> "target", + {NetPort["Target"], NetPort["Input"]} -> "intersection", + {"intersection", "target", "input"} -> "Jaccard" -> NetPort["Loss"] + }, "Loss" -> "Real"] +] (* ::Subsubsection::Closed:: *) -(*ClassDecoder*) +(*TwerskyLossLayer*) -SyntaxInformation[ClassDecoder] = {"ArgumentsPattern" -> {_, _.}}; - -ClassDecoder[data_]:= ToPackedArray@Round@ClassDecoderC[data, Last@Dimensions@data] +SyntaxInformation[TwerskyLossLayer] = {"ArgumentsPattern" -> {_, _, _, OptionsPattern[]}}; -ClassDecoder[data_, nClass_]:=ToPackedArray@Round@ClassDecoderC[data, nClass] +TverskyLossLayer[dim_] := TverskyLossLayer[dim, 0.7] -ClassDecoderC = Compile[{{data, _Real, 1}, {n, _Integer, 0}}, Block[{cl}, - cl = (1 - Unitize[Chop[(data/Max[data]) - 1]]); - If[Total[cl] > 1, 1, Total[Range[n] cl]] -], RuntimeAttributes -> {Listable}] +TverskyLossLayer[dim_, beta_?NumberQ] := Block[{smooth, alpha}, + smooth = 1; + alpha = 1- beta; + (* https://doi.org/10.48550/arXiv.1706.05721 *) + NetGraph[<| + (*intersection or TP*) + "truePos" -> {ThreadingLayer[Times], AggregationLayer[Total, ;; dim]}, + "falsePos" -> {ThreadingLayer[(1 - #1) #2 &], AggregationLayer[Total, ;; dim]}, + "falseNeg" -> {ThreadingLayer[#1 (1 - #2) &], AggregationLayer[Total, ;; dim]}, + (*the loss function TP / (TP + a FP + b FN)*) + "Twersky" -> {ThreadingLayer[1. - (#1 + smooth) / (#1 + alpha #2 + beta #3 + smooth) &], AggregationLayer[Mean, 1]} + |>, { + {NetPort["Target"], NetPort["Input"]} -> "truePos", + {NetPort["Target"], NetPort["Input"]} -> "falsePos", + {NetPort["Target"], NetPort["Input"]} -> "falseNeg", + {"truePos", "falsePos", "falseNeg"} -> "Twersky" -> NetPort["Loss"] + }, "Loss" -> "Real"] +] (* ::Subsection:: *) -(*Distance measures*) +(*Encoders*) (* ::Subsubsection::Closed:: *) -(*DiceSimilarity*) - - -SyntaxInformation[DiceSimilarity] = {"ArgumentsPattern" -> {_, _, _}}; - -DiceSimilarity[ref_, pred_, nClasses_?ListQ] := Table[DiceSimilarity[ref, pred, c], {c, nClasses}] - -DiceSimilarity[ref_, pred_] := DiceSimilarityC[Flatten[ref], Flatten[pred], 1] - -DiceSimilarity[ref_, pred_, c_?IntegerQ] := DiceSimilarityC[Flatten[ref], Flatten[pred], c] - - -DiceSimilarityC = Compile[{{ref, _Integer, 1}, {pred, _Integer, 1}, {class, _Integer, 0}}, Block[{refv, predv, denom}, - refv = Flatten[1 - Unitize[ref - class]]; - predv = Flatten[1 - Unitize[pred - class]]; - denom = (Total[refv] + Total[predv]); - If[denom === 0., 1., N[2 Total[refv predv] / denom]] - ], RuntimeOptions -> "Speed"]; +(*ClassEndocer*) -(* ::Subsubsection::Closed:: *) -(*MeanSurfaceDistance*) +SyntaxInformation[ClassEncoder] = {"ArgumentsPattern" -> {_, _.}}; +ClassEncoder[data_]:= ClassEncoder[data, Round[Max@data]] -SyntaxInformation[MeanSurfaceDistance] = {"ArgumentsPattern" -> {_, _, _, _.}}; +ClassEncoder[data_, nClass_]:= ToPackedArray@Round@If[nClass === 1, data, ClassEncoderC[data, nClass]] -MeanSurfaceDistance[ref_, pred_] := MeanSurfaceDistance[ref, pred, 1, {1, 1, 1}] - -MeanSurfaceDistance[ref_, pred_, class_?IntegerQ] := MeanSurfaceDistance[ref, pred, class, {1, 1, 1}] +ClassEncoderC = Compile[{{data, _Integer, 2}, {n, _Integer, 0}}, + Transpose[1 - Unitize[ConstantArray[data, n] - Range[n]], {3, 1, 2}] +, RuntimeAttributes -> {Listable}] -MeanSurfaceDistance[ref_, pred_, nClasses_?ListQ] := MeanSurfaceDistance[ref, pred, nClasses, {1, 1, 1}] -MeanSurfaceDistance[ref_, pred_, nClasses_?ListQ, vox_] := Table[MeanSurfaceDistance[ref, pred, class, vox], {class, nClasses}] +(* ::Subsubsection:: *) +(*ClassDecoder*) -MeanSurfaceDistance[ref_, pred_, class_?IntegerQ, vox_] := Block[{coorRef, coorPred, fun}, - coorRef = Transpose[vox Transpose[GetEdge[ref, class]["ExplicitPositions"]]]; - coorPred = Transpose[vox Transpose[GetEdge[pred, class]["ExplicitPositions"]]]; - If[coorRef==={}||coorPred==={}, - "noSeg", - fun = Nearest[coorRef]; - Mean@Sqrt@Total[(fun[coorPred,1][[All,1]]-coorPred)^2,{2}] - ] -] +SyntaxInformation[ClassDecoder] = {"ArgumentsPattern" -> {_, _.}}; -(* ::Subsubsection::Closed:: *) -(*GetEdge*) +ClassDecoder[data_]:= ClassDecoder[data, Last@Dimensions@data] +ClassDecoder[data_, nClass_]:=ToPackedArray@Round@ClassDecoderC[data, Range[nClass]] -GetEdge[lab_, class_] := Block[{seg, n, per, pts}, - seg = 1 - Unitize[lab - class]; - n = Length[seg]; - per = Flatten[Table[ - pts = Ceiling[Flatten[ComponentMeasurements[Image[seg[[i]]], "PerimeterPositions"][[All, 2]], 2]]; - If[pts === {}, Nothing, Join[ConstantArray[i, {Length[pts], 1}], pts[[All, {2, 1}]], 2]] - , {i, 1, n}], 1]; - Reverse[SparseArray[per -> 1, Dimensions[seg]], 2] -] +ClassDecoderC = Compile[{{data, _Real, 1}, {nl, _Integer, 1}}, Block[{cl}, + cl = (1 - Unitize[Chop[(data/Max[data]) - 1]]); + If[Total[cl] > 1, 1, Total[nl cl]] +], RuntimeAttributes -> {Listable}] (* ::Subsection:: *) @@ -704,9 +787,9 @@ GetEdge[lab_, class_] := Block[{seg, n, per, pts}, Options[MakeClassifyNetwork]={ImageSize->{128,128}}; MakeClassifyNetwork[classes_,OptionsPattern[]]:=Block[{enc, dec, net,imSize}, - imSize=OptionValue[ImageSize]; - enc=NetEncoder[{"Class",classes,"IndicatorVector"}]; - dec=NetDecoder[{"Class",classes}]; + imSize = OptionValue[ImageSize]; + enc = NetEncoder[{"Class",classes,"IndicatorVector"}]; + dec = NetDecoder[{"Class",classes}]; net = NetChain[{ ConvolutionLayer[16,7,"Stride"->1,PaddingSize->3],BatchNormalizationLayer[],ElementwiseLayer["GELU"],PoolingLayer[4,4], ConvolutionLayer[32,5,"Stride"->1,PaddingSize->2],BatchNormalizationLayer[],ElementwiseLayer["GELU"],PoolingLayer[4,4], @@ -859,16 +942,16 @@ ReplaceLabels[seg_, loc_, type_] := Block[{what, side, labNam, labIn, labOut, fi ] -(* ::Subsubsection::Closed:: *) +(* ::Subsubsection:: *) (*ApplySegmentationNetwork*) -Options[ApplySegmentationNetwork]={TargetDevice->"GPU", DataPadding->8, MaxPatchSize->Automatic, Monitor->False} +Options[ApplySegmentationNetwork]={TargetDevice->"GPU", DataPadding->0, MaxPatchSize->Automatic, Monitor->False} SyntaxInformation[ApplySegmentationNetwork] = {"ArgumentsPattern" -> {_, _, OptionsPattern[]}}; ApplySegmentationNetwork[dat_, netI_, OptionsPattern[]]:=Block[{ - dev, pad , lim, data, crp, net, inp, out, dim, sc, ptch, + dev, pad , lim, data, crp, net, dim, ptch, patch, pts, seg, mon, dimi, dimc, lab, class }, @@ -880,7 +963,7 @@ ApplySegmentationNetwork[dat_, netI_, OptionsPattern[]]:=Block[{ dimi = Dimensions@data; {data, crp} = AutoCropData[data, CropPadding->0]; dimc = Dimensions@data; - data = N@ArrayPad[data, 8, 0.]; + data = N@ArrayPad[data, pad, 0.]; dim = Dimensions[data]; If[mon, Echo[{dimi, dimc, dim}, "Data dimensions before and after cropping and padding are: "]]; @@ -888,32 +971,27 @@ ApplySegmentationNetwork[dat_, netI_, OptionsPattern[]]:=Block[{ net = If[StringQ[netI], GetNeuralNet[netI], netI]; If[net===$Failed, $Failed, - - (*get net properties*) - inp = NetDimensions[net,"Input"]; - out = Rest[NetDimensions[net, "LastEncoding"]]; - class = NetDimensions[net,"Output"][[-1]]; - - dim = Dimensions[data]; - sc = Rest[inp]/out; - (*calculate the patch size for the data *) - ptch = FindPatchDim[dim, lim, sc]; - ptch = Max /@ Thread[{ptch, Rest@inp}]; + ptch = FindPatchDim[net, dim, lim]; + + (*create the patches*) {patch, pts} = DataToPatches[data, ptch, PatchNumber -> 0, PatchPadding->pad]; If[mon, Echo[{ptch, Length@patch}, "Patch size and created number of patches is:"]]; (*actualy perform the segmentation with the NN*) net = ChangeNetDimensions[net, "Dimensions" ->ptch]; - - seg = ToPackedArray[Round[ClassDecoder[net[{NormDat[#]}, TargetDevice->dev]]&/@patch]]; + seg = ToPackedArray[Round[ClassDecoder[net[{NormDatH[#]}, TargetDevice->dev]]&/@patch]]; (*reverse all the padding and cropping and merged the patches if needed*) - If[mon, Echo[{Dimensions[seg], Sort@Round@DeleteDuplicates[Flatten[seg]]}, "Segmentations dimensions and labels:"]]; - seg = ArrayPad[PatchesToData[ArrayPad[#, -pad] & /@ seg, Map[# + {pad, -pad} &, pts, {2}], dim, Range[class]], -pad]; + class = NetDimensions[net,"Output"][[-1]]; + If[mon, Echo[{Dimensions[seg], Sort@Round@DeleteDuplicates[Flatten[seg]]}, + "Segmentations dimensions and labels:"]]; + seg = ArrayPad[PatchesToData[ArrayPad[#, -pad] & /@ seg, Map[# + {pad, -pad} &, pts, {2}], + dim, Range[class]], -pad]; seg = Ramp[seg - 1]; (*set background to zero*) seg = ToPackedArray@Round@ReverseCrop[seg, dimi, crp]; - If[mon, Echo[{Dimensions[seg], Sort@Round@DeleteDuplicates[Flatten[seg]]}, "Output segmentations dimensions and labels:"]]; + If[mon, Echo[{Dimensions[seg], Sort@Round@DeleteDuplicates[Flatten[seg]]}, + "Output segmentations dimensions and labels:"]]; (*give the output*) seg @@ -928,23 +1006,53 @@ ApplySegmentationNetwork[dat_, netI_, OptionsPattern[]]:=Block[{ NormDat[dat_] := Block[{q = Quantile[Flatten[dat], 0.9], m = Max[dat]}, If[q <= 0.5 m, If[m===0., dat, dat/m], If[q===0., dat, 0.75 dat/q]]] +NormDatH = Compile[{{dat, _Real, 3}}, Block[{fl, flp, min, max, bins, cdf, n}, + n = 512; + fl = Flatten[dat]; + flp = Pick[fl, Unitize[fl], 1]; + {min, max} = MinMax[flp]; + bins = BinCounts[flp, {min, max, (max - min)/n}]; + cdf = Prepend[N[Accumulate[bins]/Total[bins]], 0.]; + Map[cdf[[# + 1]] &, Clip[Floor[(dat - min)/(max - min) n], {0, n}, {0, n}], {-2}] +], RuntimeAttributes -> {Listable}, RuntimeOptions -> "Speed", Parallelization -> True] + + (* ::Subsubsection::Closed:: *) (*FindPatchDim*) -FindPatchDim[dim_, lim_, sc_] := Block[{u, cont, dimM, dimN}, - dimM = sc Ceiling[dim/sc]; - If[CubeRoot[N[Times @@dimM]] "_" <> #}]&; - netName = outName["itt_" <> StringPadLeft[ToString[#], 4, "0"] <> ".wlnet"]&; - ittName = FileNameJoin[{outFol, "itt_" <> StringPadLeft[ToString[#], 4, "0"] <> ".png"}]&; - makeIm = ImageResize[MakeChannelClassImage[#1, #2, {0, nClass - 1}], 500, Resampling -> "Nearest"]&; (*------------ Define the network -----------------*) - (*make or import network*) + (*make or import network, netCont can be a network or a previous train folder*) {netIn, ittTrain} = Which[ (*start with a clean network*) netCont === "Start", @@ -1171,81 +1275,110 @@ TrainSegmentationNetwork[{inFol_?StringQ, outFol_?StringQ}, netCont_, opts : Opt Return[$Failed] ] , - (*is an output directory look for net*) + (*is an output directory from previous training look for net*) DirectoryQ[netCont], netIn = FileNames["*_itt_*.wlnet", netCont]; If[Length[netIn] > 0, {Import@Last@netIn, ToExpression@Last@StringSplit[FileBaseName@Last@netIn, "_"]}, - Return[$Failed] + Return[ + Message[TrainSegmentationNetwork::net]; + Message[TrainSegmentationNetwork::cont]; + $Failed] ] , - True, Return[$Failed] + True, Return[ + Message[TrainSegmentationNetwork::net]; + Message[TrainSegmentationNetwork::inp]; + $Failed] ], - True, Return[$Failed] + True, Return[Message[TrainSegmentationNetwork::net]; $Failed] ]; + + (*------------ Define the network -----------------*) + + If[rounds - ittTrain < 5, - Print["not engouh round"]; - Return[$Failed] + Return[Message[TrainSegmentationNetwork::itt]; $Failed] , - (*if the network already exists make the dimensions, - classes en channels match the input*) + + (*if the network already exists make the dimensions, classes en channels match the input*) netIn = NetInitialize@ChangeNetDimensions[netIn, "Dimensions" -> patch, "Channels" -> nChan, "Classes" -> nClass]; - Echo[netIn, "Network for training"]; (*---------- Stuff for monitoring ----------------*) - + + (*Functions for consistant file names*) + outName = FileNameJoin[{outFol, Last[FileNameSplit[outFol]] <> "_" <> #}]&; + netName = outName["itt_" <> StringPadLeft[ToString[#], 4, "0"] <> ".wlnet"]&; + ittName = FileNameJoin[{outFol, "itt_" <> StringPadLeft[ToString[#], 4, "0"] <> ".png"}]&; + (*Make and export test data*) {testData, testVox} = MakeTestData[data, 2, patch]; - testSeg = ApplySegmentationNetwork[testData, netIn]; - im = makeIm[testData, testSeg]; - Export[ittName[ittTrain], im]; ExportNii[First@testData, testVox, outName["testSet.nii"]]; + + (*segment test data *) + testSeg = Ramp[ClassDecoder[netIn[testData, TargetDevice -> "GPU"]] - 1]; ExportNii[testSeg, testVox, outName["testSeg.nii"]]; + + (*make and export image*) + makeIm[data_, label_] := ImageAssemble[Partition[ + MakeChannelClassImage[data[[All, #]], label[[#]], {0, nClass - 1} + ] & /@ (Round[Range[2, Length[label] - 1, (Length[label] - 2) / 9.]]) + , 3]]; + im = makeIm[testData, testSeg]; + Export[ittName[ittTrain], im]; (*Print progress function*) Echo[Dynamic[Column[ - {Style["Training Round: " <> ToString[ittTrain], Bold, Large], im} + {Style["Training Round: " <> ToString[ittTrain], Bold, Large], Image[im, ImageSize->400]} , Alignment -> Center]], "Progress"]; (*define the monitor function, exports image and last net and Nii of result*) - monitorFunction = (ittTrain++; - (*perform segmentation*) + monitorFunction = ( + ittTrain++; + (*perform segmentation and export*) netMon = NetExtract[#Net, "net"]; - testSeg = ApplySegmentationNetwork[testData, netMon]; - (*export test Segmentation*) + testSeg = Ramp[ClassDecoder[netMon[testData, TargetDevice -> "GPU"]] - 1]; ExportNii[testSeg, testVox, outName["testSeg.nii"]]; - (*export test image*) + (*make and export test image*) im = makeIm[testData, testSeg]; - Export[FileNameJoin[{outFol, "itt_" <> StringPadLeft[ToString[ittTrain], 4, "0"] <> ".png"}], im]; + Export[ittName[ittTrain], im]; (*export the network and delete the one from the last itteration*) Export[netName[ittTrain], netMon]; Quiet@DeleteFile[netName[ittTrain - 1]]; )&; + (*---------- Train the network ----------------*) Echo[DateString[], "Starting training"]; + (*import all train data or train out of memory*) data = If[OptionValue[LoadTrainingData]===True, Import/@files, files]; - - validation = GetTrainData[data, Round[0.2 roundLength], patch, nClass]; + + (*prepare a validation set*) + validation = GetTrainData[data, Round[0.2 roundLength], patch, nClass, AugmentData->augment]; + + (*train the network*) trained = NetTrain[ - AddLossLayer@netIn, {GetTrainData[data, #BatchSize, patch, nClass, - AugmentData -> augment, PatchesPerSet->patches - ] &, "RoundLength" -> roundLength}, + AddLossLayer@netIn, + {GetTrainData[data, #BatchSize, patch, nClass, AugmentData -> augment, PatchesPerSet->patches] &, + "RoundLength" -> roundLength}, All, ValidationSet -> validation, + + LossFunction -> {"SoftDice", "SquaredDiff", "Tversky" , "CrossEntropy", "Jaccard"}, - LossFunction -> {"SoftDice", "SquaredDiff", "CrossEntropy"}, MaxTrainingRounds -> rounds - ittTrain, BatchSize -> batch, TargetDevice -> "GPU", WorkingPrecision -> "Mixed", - LearningRate -> 0.01, Method -> {"ADAM", "Beta1" -> 0.99}, + LearningRate -> 0.05, Method -> {"ADAM", "Beta1" -> 0.99, "Beta2"->0.999, "Epsilon"->10^-5}, TrainingProgressFunction -> {monitorFunction, "Interval" -> Quantity[1, "Rounds"]}, - TrainingProgressReporting -> File[outName[StringReplace[DateString["ISODateTime"], ":" | "-" -> ""] <> ".json"]] + TrainingProgressReporting -> File[outName[StringReplace[DateString["ISODateTime"], + ":" | "-" -> ""] <> ".json"]] ]; + (*---------- Export the network ----------------*) netOut = NetExtract[trained["TrainedNet"], "net"]; @@ -1256,7 +1389,7 @@ TrainSegmentationNetwork[{inFol_?StringQ, outFol_?StringQ}, netCont_, opts : Opt ] -(* ::Subsubsection::Closed:: *) +(* ::Subsubsection:: *) (*MakeTestData*) @@ -1267,10 +1400,42 @@ MakeTestData[data_, n_, patch_] := Block[{testData, len, sel, testDat}, sel = Range @@ Clip[Round[(Clip[Round[len/3 - (0.5 n) First@patch], {0, Infinity}] + {1, n First@patch})], {1, len}, {1, len}]; testData = First@AutoCropData[testData[[sel]]] ]; - {{PadToDimensions[testData, patch]}, data[[3]]} + {{NormDatH@PadToDimensions[testData, patch]}, data[[3]]} ]; +(* ::Subsubsection::Closed:: *) +(*ShowTrainLog*) + + +ShowTrainLog[fol_] := ShowTrainLog[fol, 5] + +ShowTrainLog[fol_, max_] := Block[{files, log, keys, plots}, + (* Get a list of log files in the specified folder *) + files = Sort[FileNames["*.json", fol]]; + + (* Read the log files and extract the relevant information *) + log = Flatten[Select[(Select[Import[#, "Lines"], StringContainsQ[#, "ProgressFraction"] &] & /@ files), Length[#] > max &], 1]; + + (* Convert the log data into a dataset *) + log = "[\n" <> StringDrop[StringRiffle[If[StringTake[#, -1] === "}", # <> ",", #] & /@ log, "\n"], -1] <> "\n]"; + log = Dataset[Association /@ Import[Export[FileNameJoin[{$TemporaryDirectory, "log.json"}], log, "text"]]]; + + (* Get the unique keys (metrics) in the log data *) + keys = Sort@DeleteDuplicates[Flatten[Normal@log[All, Keys]]]; + + (* Create a dynamic module to display the interactive plot *) + DynamicModule[{pdat = log, klist = keys}, + Manipulate[ + (* Plot the selected metrics *) + ListLinePlot[If[key === {}, {}, Transpose[Values /@ Normal[pdat[All, key]][[All, All]]]], PlotLegends -> key, ImageSize -> 400, PlotRange->All], + Control[{{key, {}, ""}, klist, ControlType -> TogglerBar, Appearance -> "Vertical" -> {Automatic, 4}, BaseStyle -> Medium}], + {{key, {}}, ControlType -> None} + ] + ] +] + + (* ::Subsection:: *) (*Get Train Data*) @@ -1287,27 +1452,18 @@ Options[GetTrainData] = { GetTrainData[datas_, nBatch_, patch_, opts:OptionsPattern[]]:=GetTrainData[datas, nBatch, patch, False, opts] GetTrainData[datas_, nBatch_, patch_, nClass_, OptionsPattern[]] := Block[{ - itt, i, datO, segO, dat, seg, vox, dim, aug, nSet + itt, i, datO, segO, dat, seg, vox, dim, augI, aug, nSet }, itt = 0; datO = segO = {}; - {aug, nSet} = OptionValue[{AugmentData, PatchesPerSet}]; - - Which[ - aug === 1, True, - aug === 0, False, - 0 < aug < 1, RandomChoice[{aug, 1 - aug} -> {True, False}], - BooleanQ[aug], aug, - True, True - ]; - aug = # && aug & /@ {True, True, True, True, True, True, True(*False, False, False*)}; + {augI, nSet} = OptionValue[{AugmentData, PatchesPerSet}]; itt = Ceiling[nBatch/nSet]; Do[ - dat = RandomChoice[datas]; + dat =RandomChoice[datas]; If[StringQ[dat], (*data is wxf file format*) @@ -1323,10 +1479,22 @@ GetTrainData[datas_, nBatch_, patch_, nClass_, OptionsPattern[]] := Block[{ ] ]; + (*normalize the data and segmentations and pad to at least patch dimensions*) dim = Max /@ Transpose[{Dimensions@dat, patch}]; - dat = PadToDimensions[dat, dim]; + dat = NormDatH@PadToDimensions[dat, dim]; seg = PadToDimensions[seg, dim]; + (*check if augmentation is a boolean or a list*) + aug = Which[ + augI === 1, True, + augI === 0, False, + 0 < augI < 1, RandomChoice[{augI, 1 - augI} -> {True, False}], + BooleanQ[augI], augI, + True, True]; + (* {flip, rot, trans, scale, noise, blur, bright} *) + aug = (# && aug) & /@ {True, True, True, True, True, False, False}; + + (*perform augmentation on full data and get the defined number of patches*) {dat, seg} = AugmentTrainingData[{dat, seg}, vox, aug]; {dat, seg} = PatchTrainingData[{dat, seg}, patch, nSet]; @@ -1334,10 +1502,9 @@ GetTrainData[datas_, nBatch_, patch_, nClass_, OptionsPattern[]] := Block[{ segO = Join[segO, seg]; , itt]; - If[IntegerQ[nClass], - Thread[Transpose[{datO[[;; nBatch]]}] -> ClassEncoder[segO[[;; nBatch]] + 1, nClass]], - Thread[Transpose[{datO[[;; nBatch]]}] -> segO[[;; nBatch]] + 1] - ] + datO = datO[[;; nBatch]]; + segO = If[IntegerQ[nClass], ClassEncoder[segO[[;; nBatch]] + 1, nClass], segO[[;; nBatch]] + 1]; + Thread[Transpose[{datO}] -> segO] ]; @@ -1388,7 +1555,9 @@ AugmentTrainingData[{dat_, seg_}, vox_, {flip_, rot_, trans_, scale_, noise_, bl (*Augmentations of sharpness intensity and noise*) If[bright, datT = RandomChoice[{RandomReal[{1, 1.5}], 1/RandomReal[{1, 1.5}]}] datT]; If[blur, datT = GaussianFilter[datT, RandomReal[{0.1, 1.5}]]]; - If[noise && RandomChoice[{True, False, False}], datT = AddNoise[datT, 0.5/RandomReal[{1, 100}]]]; + (*If[noise && RandomChoice[{True, False, False}], datT = AddNoise[datT, 0.5/RandomReal[{1, 100}]]];*) + + If[(nn=noise && RandomChoice[{1/3, 2/3} -> {True, False}]), datT = addNoise[datT, Mean[Flatten[datT]]/RandomReal[{10, 100}], RandomChoice[{0.8, 0.2} -> {0, 1}] RandomReal[{0, 1}]/100]]; {ToPackedArray[N[datT]], ToPackedArray[Round[segT]]} ] @@ -1397,6 +1566,27 @@ AugmentTrainingData[{dat_, seg_}, vox_, {flip_, rot_, trans_, scale_, noise_, bl ReverseC = Compile[{{dat, _Real, 1}}, Reverse[dat], RuntimeAttributes -> {Listable}, RuntimeOptions -> "Speed"]; +addNoise[data_, sigma_, p_] := Block[{dims, g1, g2, num, coors}, + dims = Dimensions[data]; + (*random noise*) + {g1, g2} = + RandomReal[NormalDistribution[0., sigma], Prepend[dims, 2]]; + (*salt and pepper noise*) + num = Max[{1, Round[p*Times @@ dims/2]}]; + coors = Transpose[RandomInteger[{1, #}, 2 num] & /@ dims]; + (*add the noise*) + SaltAndRiceC[data, coors, num, g1, g2] +]; + + +SaltAndRiceC = Compile[{{data, _Real, 3}, {coors, _Integer, 2}, {num, _Integer, 0}, {g1, _Real, 3}, {g2, _Real, 3}}, Block[{newData}, + newData = Sqrt[(data + g1)^2 + g2^2]; + (newData[[#[[1]], #[[2]], #[[3]]]] = 1) & /@ coors[[1 ;; num]]; + (newData[[#[[1]], #[[2]], #[[3]]]] = 0) & /@ coors[[num + 1 ;; -1]]; + newData +], RuntimeAttributes -> {Listable}, Parallelization -> True]; + + (* ::Subsubsection::Closed:: *) (*PatchTrainingData*) @@ -1408,9 +1598,11 @@ PatchTrainingData[{dat_,seg_}, patch_, n_]:=Block[{pts,datP,segP}, ] + (* ::Subsubsection::Closed:: *) (*PrepTrainData*) + PrepTrainData[dat_, seg_]:= PrepTrainData[dat, seg, {0}] PrepTrainData[dat_, seg_, labi_?VectorQ]:= PrepTrainData[dat, seg, {labi, labi}] @@ -1504,7 +1696,7 @@ MakeChannelClassImage[data_, label_, vox_]:=MakeChannelClassImage[data, label, M MakeChannelClassImage[data_, label_, {off_, max_}, vox_]:=Block[{i1, i2}, i1 = MakeClassImage[label, {off, max}, vox]; i2 = MakeChannelImage[data, vox]; - ImageCollage[ImageCompose[#, SetAlphaChannel[i1,0.4 AlphaChannel[i1]]]&/@i2] + ImageCollage[ImageCompose[#, SetAlphaChannel[i1, 0.4 AlphaChannel[i1]]]& /@ i2] ] @@ -1514,23 +1706,23 @@ MakeChannelClassImage[data_, label_, {off_, max_}, vox_]:=Block[{i1, i2}, SyntaxInformation[MakeClassImage]={"ArgumentsPattern"->{_, _., _.}}; -MakeClassImage[label_]:=MakeClassImage[label, MinMax[label],{1,1,1}] +MakeClassImage[label_]:=MakeClassImage[label, MinMax[label], {1,1,1}] MakeClassImage[label_, {off_, max_}]:=MakeClassImage[label, {off, max}, {1,1,1}] -MakeClassImage[label_, vox_]:=MakeClassImage[label,MinMax[label],vox] +MakeClassImage[label_, vox_]:=MakeClassImage[label, MinMax[label], vox] -MakeClassImage[label_,{off_, max_}, vox_]:=Block[{cols, im, rat}, +MakeClassImage[label_,{off_, maxI_}, vox_]:=Block[{max, cols, im, rat}, (*SeedRandom[1345]; cols = Prepend[ColorData["DarkRainbow"][#]&/@RandomSample[Rescale[Range[off+1, max]]],Transparent]; cols = Prepend[ColorData["RomaO"][#]&/@Rescale[Range[off+1, max]],Transparent]; *) - + max = Max[{Max[label], maxI}]; cols = Prepend[ColorData["RomaO"][#]&/@Rescale[Join[Select[Range[off + 1, max], EvenQ], Select[Range[off + 1, max], OddQ]]],Transparent]; - - im = Round@Clip[If[ArrayDepth[label] === 3, label[[Round[Length@label/2]]], label] - off + 1, {1, max + 1}, {1, 1}]; + im = Round@Clip[If[ArrayDepth[label] === 3, + label[[Round[Length@label/2]]], label + ] - off + 1, {1, max + 1}, {1, 1}]; rat=vox[[{2,3}]]/Min[vox[[{2,3}]]]; - ImageResize[Image[cols[[#]]&/@im], Round@Reverse[rat Dimensions[im]], Resampling->"Nearest"] ] @@ -1544,8 +1736,8 @@ SyntaxInformation[MakeChannelImage]={"ArgumentsPattern"->{_, _., _.}}; MakeChannelImage[data_]:=MakeChannelImage[data, {1, 1, 1}] MakeChannelImage[data_, vox_]:=Block[{dat, im, rat}, - (*dat = Rescale[data];*) - dat = NormDat@data; + dat = Rescale[data]; + (*dat = NormDat@data;*) rat = vox[[{2, 3}]] / Min[vox[[{2, 3}]]]; ( @@ -1602,6 +1794,71 @@ MuscleNameToLabel[num_, file_] := Block[{muscleNames, muscleLabels}, ] +(* ::Subsection:: *) +(*Distance measures*) + + +(* ::Subsubsection::Closed:: *) +(*DiceSimilarity*) + + +SyntaxInformation[DiceSimilarity] = {"ArgumentsPattern" -> {_, _, _}}; + +DiceSimilarity[ref_, pred_, nClasses_?ListQ] := Table[DiceSimilarity[ref, pred, c], {c, nClasses}] + +DiceSimilarity[ref_, pred_] := DiceSimilarityC[Flatten[ref], Flatten[pred], 1] + +DiceSimilarity[ref_, pred_, c_?IntegerQ] := DiceSimilarityC[Flatten[ref], Flatten[pred], c] + + +DiceSimilarityC = Compile[{{ref, _Integer, 1}, {pred, _Integer, 1}, {class, _Integer, 0}}, Block[{refv, predv, denom}, + refv = Flatten[1 - Unitize[ref - class]]; + predv = Flatten[1 - Unitize[pred - class]]; + denom = (Total[refv] + Total[predv]); + If[denom === 0., 1., N[2 Total[refv predv] / denom]] + ], RuntimeOptions -> "Speed"]; + + +(* ::Subsubsection::Closed:: *) +(*MeanSurfaceDistance*) + + +SyntaxInformation[MeanSurfaceDistance] = {"ArgumentsPattern" -> {_, _, _, _.}}; + +MeanSurfaceDistance[ref_, pred_] := MeanSurfaceDistance[ref, pred, 1, {1, 1, 1}] + +MeanSurfaceDistance[ref_, pred_, class_?IntegerQ] := MeanSurfaceDistance[ref, pred, class, {1, 1, 1}] + +MeanSurfaceDistance[ref_, pred_, nClasses_?ListQ] := MeanSurfaceDistance[ref, pred, nClasses, {1, 1, 1}] + +MeanSurfaceDistance[ref_, pred_, nClasses_?ListQ, vox_] := Table[MeanSurfaceDistance[ref, pred, class, vox], {class, nClasses}] + +MeanSurfaceDistance[ref_, pred_, class_?IntegerQ, vox_] := Block[{coorRef, coorPred, fun}, + coorRef = Transpose[vox Transpose[GetEdge[ref, class]["ExplicitPositions"]]]; + coorPred = Transpose[vox Transpose[GetEdge[pred, class]["ExplicitPositions"]]]; + If[coorRef==={}||coorPred==={}, + "noSeg", + fun = Nearest[coorRef]; + Mean@Sqrt@Total[(fun[coorPred,1][[All,1]]-coorPred)^2,{2}] + ] +] + + +(* ::Subsubsection::Closed:: *) +(*GetEdge*) + + +GetEdge[lab_, class_] := Block[{seg, n, per, pts}, + seg = 1 - Unitize[lab - class]; + n = Length[seg]; + per = Flatten[Table[ + pts = Ceiling[Flatten[ComponentMeasurements[Image[seg[[i]]], "PerimeterPositions"][[All, 2]], 2]]; + If[pts === {}, Nothing, Join[ConstantArray[i, {Length[pts], 1}], pts[[All, {2, 1}]], 2]] + , {i, 1, n}], 1]; + Reverse[SparseArray[per -> 1, Dimensions[seg]], 2] +] + + (* ::Section:: *) (*End Package*) diff --git a/QMRITools/Kernel/SimulationTools.wl b/QMRITools/Kernel/SimulationTools.wl index 0c774cc3..ee120324 100644 --- a/QMRITools/Kernel/SimulationTools.wl +++ b/QMRITools/Kernel/SimulationTools.wl @@ -410,7 +410,7 @@ Pulses[name_] := Switch[name, 0.89532, 0.8648, 0.83102, 0.79427, 0.75491, 0.71322, 0.66958, 0.62432, 0.57784, 0.53047, 0.48262, 0.43461, 0.38682, 0.33961, 0.29328, 0.24815, 0.20454, 0.16269, 0.12287, 0.08524, 0.05005, 0.01743, -0.01248, -0.03961, -0.06388, -0.08524, -0.10373, -0.11933, -0.13208, -0.14209, -0.14948, -0.15433, -0.1568, -0.15702, -0.15519, -0.15149, -0.14609, -0.13923, -0.13108, -0.12183, -0.1117, -0.10089, -0.0896, -0.07801} - ] +] (* ::Subsubsection::Closed:: *) diff --git a/QMRITools/Kernel/SpectroTools.wl b/QMRITools/Kernel/SpectroTools.wl index 19836329..39f40cbe 100644 --- a/QMRITools/Kernel/SpectroTools.wl +++ b/QMRITools/Kernel/SpectroTools.wl @@ -316,7 +316,7 @@ PhaseCorrectSpectra[spec_?ListQ, dw_?NumberQ, te_?NumberQ, gyro_?NumberQ, ppmRan (*create the full fid*) specOut = ShiftedFourier[Join[missing, fid][[;;Length[fid]]]]; - + (*create the Henkle spectra*) henkelSpec = ShiftedFourier[full]; If[ppmRan =!= Full, henkelSpec = Pick[henkelSpec, Unitize[Clip[GetPpmRange[henkelSpec, dw, gyro], Sort[ppmRan], {0, 0}]], 1]]; diff --git a/QMRITools/PacletInfo.wl b/QMRITools/PacletInfo.wl index 0fe1c98f..ca016fe2 100644 --- a/QMRITools/PacletInfo.wl +++ b/QMRITools/PacletInfo.wl @@ -16,7 +16,9 @@ PacletObject[<| (*context and documentation*) {"Kernel", "Root" -> "Kernel", "Context" -> "QMRITools`"}, {"Documentation", "Language" -> "English", "MainPage" -> "Guides/QMRITools"}, - + + (* ---- OS independent assest ---- *) + (*files that need to be included in the build*) {"Asset", "Root" -> "Resources", "Assets" -> {{"Logo", "icon.png"}}}, {"Asset", "Root" -> "Resources", "Assets" -> {{"Functions", "All-Functions.nb"}}}, @@ -40,33 +42,34 @@ PacletObject[<| {"Asset", "Root" -> "NeuralNetworks", "Assets" -> {{"MusclesLegLowerLabels", "Muscles_leg_lower.txt"}}}, {"Asset", "Root" -> "NeuralNetworks", "Assets" -> {{"MusclesLegUpperLabels", "Muscles_leg_upper.txt"}}}, - (*elastix and transformix*) - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"Elastix", "elastix.exe"}}}, - {"Asset", "Root" -> "Applications/MacOSX-x86-64", "SystemID" -> "MacOSX-x86-64", "Assets" -> {{"Elastix", "bin/elastix"}}}, - {"Asset", "Root" -> "Applications/Linux-x86-64", "SystemID" -> "Linux-x86-64", "Assets" -> {{"Elastix", "bin/elastix"}}}, - - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"Transformix", "transformix.exe"}}}, - {"Asset", "Root" -> "Applications/MacOSX-x86-64", "SystemID" -> "MacOSX-x86-64", "Assets" -> {{"Transformix", "bin/transformix"}}}, - {"Asset", "Root" -> "Applications/Linux-x86-64", "SystemID" -> "Linux-x86-64", "Assets" -> {{"Transformix", "bin/transformix"}}}, - - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"ElastixLib", "ANNlib-5.1.dll"}}}, - {"Asset", "Root" -> "Applications/MacOSX-x86-64", "SystemID" -> "MacOSX-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.dylib"}}}, - {"Asset", "Root" -> "Applications/MacOSX-x86-64", "SystemID" -> "MacOSX-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.1.dylib"}}}, - {"Asset", "Root" -> "Applications/Linux-x86-64", "SystemID" -> "Linux-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.so"}}}, - {"Asset", "Root" -> "Applications/Linux-x86-64", "SystemID" -> "Linux-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.so.1"}}}, - - (*dcm2niix*) - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"DcmToNii", "dcm2niix.exe"}}}, - {"Asset", "Root" -> "Applications/MacOSX-x86-64", "SystemID" -> "MacOSX-x86-64", "Assets" -> {{"DcmToNii", "bin/dcm2niix"}}}, - {"Asset", "Root" -> "Applications/Linux-x86-64", "SystemID" -> "Linux-x86-64", "Assets" -> {{"DcmToNii", "bin/dcm2niix"}}}, - - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"DcmToNii-21", "dcm2niix-20210317.exe"}}}, - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"DcmToNii-20", "dcm2niix-20201102.exe"}}}, - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"DcmToNii-19", "dcm2niix-20190902.exe"}}}, - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"DcmToNii-17", "dcm2niix-20171204.exe"}}}, - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"DcmToNii-0", "dcm2nii.exe"}}}, - - (*pigz.exe*) - {"Asset", "Root" -> "Applications/Windows-x86-64", "SystemID" -> "Windows-x86-64", "Assets" -> {{"pigz", "pigz.exe"}}} + (* ---- OS dependant assest ---- *) + + (*Windows*) + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"Elastix", "elastix.exe"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"Transformix", "transformix.exe"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"ElastixLib", "ANNlib-5.1.dll"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"DcmToNii", "dcm2niix.exe"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"pigz", "pigz.exe"}}}, + + (*windows olf dcm2nii versions*) + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"DcmToNii-21", "dcm2niix-20210317.exe"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"DcmToNii-20", "dcm2niix-20201102.exe"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"DcmToNii-19", "dcm2niix-20190902.exe"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"DcmToNii-17", "dcm2niix-20171204.exe"}}}, + {"Asset", "SystemID" -> "Windows-x86-64", "Root" -> "Applications/Windows-x86-64", "Assets" -> {{"DcmToNii-0", "dcm2nii.exe"}}}, + + (*Mac-x86*) + {"Asset", "SystemID" -> "MacOSX-x86-64", "Root" -> "Applications/MacOSX-x86-64", "Assets" -> {{"Elastix", "bin/elastix"}}}, + {"Asset", "SystemID" -> "MacOSX-x86-64", "Root" -> "Applications/MacOSX-x86-64", "Assets" -> {{"Transformix", "bin/transformix"}}}, + {"Asset", "SystemID" -> "MacOSX-x86-64", "Root" -> "Applications/MacOSX-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.dylib"}}}, + {"Asset", "SystemID" -> "MacOSX-x86-64", "Root" -> "Applications/MacOSX-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.1.dylib"}}}, + {"Asset", "SystemID" -> "MacOSX-x86-64", "Root" -> "Applications/MacOSX-x86-64", "Assets" -> {{"DcmToNii", "bin/dcm2niix"}}}, + + (*Linux-x86*) + {"Asset", "SystemID" -> "Linux-x86-64", "Root" -> "Applications/Linux-x86-64", "Assets" -> {{"Elastix", "bin/elastix"}}}, + {"Asset", "SystemID" -> "Linux-x86-64", "Root" -> "Applications/Linux-x86-64", "Assets" -> {{"Transformix", "bin/transformix"}}}, + {"Asset", "SystemID" -> "Linux-x86-64", "Root" -> "Applications/Linux-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.so"}}}, + {"Asset", "SystemID" -> "Linux-x86-64", "Root" -> "Applications/Linux-x86-64", "Assets" -> {{"ElastixLib", "lib/libANNlib-5.1.so.1"}}}, + {"Asset", "SystemID" -> "Linux-x86-64", "Root" -> "Applications/Linux-x86-64", "Assets" -> {{"DcmToNii", "bin/dcm2niix"}}} } |>] diff --git a/scripts/segmentGUI.nb b/scripts/segmentGUI.nb index a2e215ad..164f290b 100644 --- a/scripts/segmentGUI.nb +++ b/scripts/segmentGUI.nb @@ -10,10 +10,10 @@ NotebookFileLineBreakTest NotebookFileLineBreakTest NotebookDataPosition[ 158, 7] -NotebookDataLength[ 10621, 225] -NotebookOptionsPosition[ 10077, 209] -NotebookOutlinePosition[ 10483, 225] -CellTagsIndexPosition[ 10440, 222] +NotebookDataLength[ 11492, 247] +NotebookOptionsPosition[ 10819, 228] +NotebookOutlinePosition[ 11225, 244] +CellTagsIndexPosition[ 11182, 241] WindowFrame->Normal*) (* Beginning of Notebook Content *) @@ -27,125 +27,132 @@ Cell[BoxData[ RowBox[{ RowBox[{ RowBox[{"SegmentDataGUI", "[", "]"}], ":=", - RowBox[{"Block", "[", + RowBox[{"DynamicModule", "[", RowBox[{ RowBox[{"{", - RowBox[{"dat", ",", "vox", ",", "seg"}], "}"}], ",", - "\[IndentingNewLine]", - RowBox[{ - RowBox[{"NotebookClose", "[", "segwindow", "]"}], ";", - "\[IndentingNewLine]", "\[IndentingNewLine]", - RowBox[{"diag", "=", - RowBox[{"DialogNotebook", "[", "\[IndentingNewLine]", - RowBox[{ - RowBox[{"status", "=", - RowBox[{"TextCell", "@", "\"\<\>\""}]}], ";", "\[IndentingNewLine]", - RowBox[{"{", "\[IndentingNewLine]", + RowBox[{"inputFile", ",", " ", "outputFile"}], "}"}], ",", + RowBox[{"Block", "[", + RowBox[{ + RowBox[{"{", + RowBox[{"dat", ",", "vox", ",", "seg"}], "}"}], ",", + "\[IndentingNewLine]", + RowBox[{ + RowBox[{"NotebookClose", "[", "segwindow", "]"}], ";", + "\[IndentingNewLine]", "\[IndentingNewLine]", + RowBox[{"diag", "=", + RowBox[{"DialogNotebook", "[", "\[IndentingNewLine]", RowBox[{ - RowBox[{ - "TextCell", "[", - "\"\\"", - "]"}], ",", "\[IndentingNewLine]", "\[IndentingNewLine]", - RowBox[{"Grid", "[", + RowBox[{"status", "=", + RowBox[{"TextCell", "@", "\"\<\>\""}]}], ";", + "\[IndentingNewLine]", + RowBox[{"{", "\[IndentingNewLine]", RowBox[{ - RowBox[{"{", + RowBox[{ + "TextCell", "[", + "\"\\"", "]"}], ",", "\[IndentingNewLine]", "\[IndentingNewLine]", + RowBox[{"Grid", "[", RowBox[{ - RowBox[{"{", "\[IndentingNewLine]", - RowBox[{ - RowBox[{"TextCell", "[", "\"\\"", "]"}], ",", - RowBox[{"Dynamic", "[", "status", "]"}]}], - "\[IndentingNewLine]", "}"}], ",", - RowBox[{"{", "\[IndentingNewLine]", + RowBox[{"{", RowBox[{ - RowBox[{"TextCell", "[", "\"\\"", "]"}], ",", - "\[IndentingNewLine]", - RowBox[{"InputField", "[", + RowBox[{"{", "\[IndentingNewLine]", RowBox[{ - RowBox[{"Dynamic", "[", "inputFile", "]"}], ",", "String", - ",", - RowBox[{ - "FieldHint", "->", "\"\\""}], ",", - RowBox[{"FieldSize", "\[Rule]", + RowBox[{"TextCell", "[", "\"\\"", "]"}], ",", + RowBox[{"Dynamic", "[", "status", "]"}]}], + "\[IndentingNewLine]", "}"}], ",", + RowBox[{"{", "\[IndentingNewLine]", + RowBox[{ + RowBox[{"TextCell", "[", "\"\\"", "]"}], + ",", "\[IndentingNewLine]", + RowBox[{"InputField", "[", + RowBox[{ + RowBox[{"Dynamic", "[", "inputFile", "]"}], ",", "String", + ",", + RowBox[{ + "FieldHint", "->", "\"\\""}], ",", + RowBox[{"FieldSize", "\[Rule]", RowBox[{"{", RowBox[{"25", ",", "1"}], "}"}]}]}], "]"}], ",", - "\[IndentingNewLine]", - RowBox[{"Button", "[", - RowBox[{"\"\\"", ",", - RowBox[{"inputFile", "=", + "\[IndentingNewLine]", + RowBox[{"Button", "[", + RowBox[{"\"\\"", ",", + RowBox[{"inputFile", "=", RowBox[{ "SystemDialogInput", "[", "\"\\"", "]"}]}], - ",", - RowBox[{"Method", "->", "\"\\""}]}], "]"}]}], - "\[IndentingNewLine]", "}"}], ",", - RowBox[{"{", "\[IndentingNewLine]", - RowBox[{ - RowBox[{"TextCell", "[", "\"\\"", "]"}], ",", - RowBox[{"InputField", "[", + ",", + RowBox[{"Method", "->", "\"\\""}]}], "]"}]}], + "\[IndentingNewLine]", "}"}], ",", + RowBox[{"{", "\[IndentingNewLine]", RowBox[{ - RowBox[{"Dynamic", "[", "outputFile", "]"}], ",", "String", + RowBox[{"TextCell", "[", "\"\\"", "]"}], + ",", + RowBox[{"InputField", "[", + RowBox[{ + RowBox[{"Dynamic", "[", "outputFile", "]"}], ",", + "String", ",", + RowBox[{ + "FieldHint", "->", "\"\\""}], ",", - RowBox[{ - "FieldHint", "->", "\"\\""}], ",", - RowBox[{"FieldSize", "\[Rule]", + RowBox[{"FieldSize", "\[Rule]", RowBox[{"{", RowBox[{"25", ",", "1"}], "}"}]}]}], "]"}], ",", - "\[IndentingNewLine]", - RowBox[{"Button", "[", - RowBox[{"\"\\"", ",", "\[IndentingNewLine]", - RowBox[{"outputFile", "=", + "\[IndentingNewLine]", + RowBox[{"Button", "[", + RowBox[{"\"\\"", ",", "\[IndentingNewLine]", + RowBox[{"outputFile", "=", RowBox[{ "SystemDialogInput", "[", "\"\\"", "]"}]}], - ",", - RowBox[{"Method", "->", "\"\\""}]}], "]"}]}], - "\[IndentingNewLine]", "}"}], ",", - RowBox[{"{", "\[IndentingNewLine]", - RowBox[{ - RowBox[{"TextCell", "[", "\"\\"", "]"}], - ",", - RowBox[{"PopupMenu", "[", + ",", + RowBox[{"Method", "->", "\"\\""}]}], "]"}]}], + "\[IndentingNewLine]", "}"}], ",", + RowBox[{"{", "\[IndentingNewLine]", RowBox[{ - RowBox[{"Dynamic", "[", "option", "]"}], ",", - RowBox[{"{", + RowBox[{ + "TextCell", "[", "\"\\"", "]"}], ",", + RowBox[{"PopupMenu", "[", + RowBox[{ + RowBox[{"Dynamic", "[", "option", "]"}], ",", + RowBox[{"{", RowBox[{"\"\\"", ",", "\"\\""}], "}"}]}], "]"}]}], "\[IndentingNewLine]", "}"}]}], - "\[IndentingNewLine]", "}"}], ",", - RowBox[{"Alignment", "->", "Left"}]}], "]"}], ",", - "\[IndentingNewLine]", - RowBox[{"Row", "[", - RowBox[{"{", "\[IndentingNewLine]", - RowBox[{ - RowBox[{"Button", "[", - RowBox[{"\"\\"", ",", "\[IndentingNewLine]", - RowBox[{"If", "[", - RowBox[{ - RowBox[{"!", - RowBox[{"NiiFileExistQ", "[", "inputFile", "]"}]}], ",", - "\[IndentingNewLine]", - RowBox[{ - "MessageDialog", "[", - "\"\\"", "]"}], - "\[IndentingNewLine]", ",", "\[IndentingNewLine]", - RowBox[{ - RowBox[{"status", "=", - RowBox[{"TextCell", "@", "\"\\""}]}], ";", - "\[IndentingNewLine]", + "\[IndentingNewLine]", "}"}], ",", + RowBox[{"Alignment", "->", "Left"}]}], "]"}], ",", + "\[IndentingNewLine]", + RowBox[{"Row", "[", + RowBox[{"{", "\[IndentingNewLine]", + RowBox[{ + RowBox[{"Button", "[", + RowBox[{"\"\\"", ",", "\[IndentingNewLine]", + RowBox[{"If", "[", RowBox[{ + RowBox[{"!", + RowBox[{"NiiFileExistQ", "[", "inputFile", "]"}]}], ",", + "\[IndentingNewLine]", + RowBox[{ + "MessageDialog", "[", + "\"\\"", "]"}], + "\[IndentingNewLine]", ",", "\[IndentingNewLine]", + RowBox[{ + RowBox[{"status", "=", + RowBox[{"TextCell", "@", "\"\\""}]}], ";", + "\[IndentingNewLine]", + RowBox[{ RowBox[{"{", RowBox[{"dat", ",", "vox"}], "}"}], "=", RowBox[{"ImportNii", "[", "inputFile", "]"}]}], ";", - "\[IndentingNewLine]", - RowBox[{"status", "=", + "\[IndentingNewLine]", + RowBox[{"status", "=", RowBox[{"TextCell", "@", "\"\\""}]}], - ";", "\[IndentingNewLine]", - RowBox[{"seg", " ", "=", " ", + ";", "\[IndentingNewLine]", + RowBox[{"seg", " ", "=", " ", RowBox[{"SegmentData", "[", RowBox[{"dat", ",", "\"\\"", ",", " ", RowBox[{"TargetDevice", "->", "\"\\""}]}], "]"}]}], - ";", "\[IndentingNewLine]", - RowBox[{"status", "=", + ";", "\[IndentingNewLine]", + RowBox[{"status", "=", RowBox[{"TextCell", "@", "\"\\""}]}], ";", - "\[IndentingNewLine]", - RowBox[{"CopyFile", "[", + "\[IndentingNewLine]", + RowBox[{"CopyFile", "[", RowBox[{ RowBox[{ "GetAssetLocation", "[", "\"\\"", @@ -154,32 +161,33 @@ Cell[BoxData[ RowBox[{"outputFile", ",", " ", "\"\<.txt\>\""}], "]"}], ",", " ", RowBox[{"OverwriteTarget", "->", "True"}]}], "]"}], ";", - "\[IndentingNewLine]", - RowBox[{"ExportNii", "[", + "\[IndentingNewLine]", + RowBox[{"ExportNii", "[", RowBox[{"seg", ",", " ", "vox", ",", " ", "outputFile"}], "]"}], ";", "\[IndentingNewLine]", - RowBox[{"status", "=", + RowBox[{"status", "=", RowBox[{"Button", "[", RowBox[{ - RowBox[{"\"\\"", "<>", + RowBox[{"\"\\"", "<>", RowBox[{"FileBaseName", "@", "outputFile"}]}], ",", RowBox[{"SystemOpen", "[", RowBox[{"DirectoryName", "@", "outputFile"}], "]"}]}], "]"}]}], ";"}]}], "\[IndentingNewLine]", "]"}], - "\[IndentingNewLine]", ",", "\[IndentingNewLine]", - RowBox[{"Method", "->", "\"\\""}]}], - "\[IndentingNewLine]", "]"}], ",", "\[IndentingNewLine]", - RowBox[{"DefaultButton", "[", "]"}], ",", "\[IndentingNewLine]", - RowBox[{"CancelButton", "[", "]"}]}], "\[IndentingNewLine]", - "}"}], "]"}]}], "\[IndentingNewLine]", "}"}]}], - "\[IndentingNewLine]", "]"}]}], ";", "\[IndentingNewLine]", - "\[IndentingNewLine]", - RowBox[{"segwindow", "=", - RowBox[{"CreateWindow", "[", - RowBox[{"diag", ",", - RowBox[{"WindowTitle", "->", "\"\\""}], ",", - RowBox[{"WindowSize", "->", "All"}]}], "]"}]}], ";"}]}], - "\[IndentingNewLine]", "]"}]}], ";"}]], "Input", + "\[IndentingNewLine]", ",", "\[IndentingNewLine]", + RowBox[{"Method", "->", "\"\\""}]}], + "\[IndentingNewLine]", "]"}], ",", "\[IndentingNewLine]", + RowBox[{"DefaultButton", "[", "]"}], ",", + "\[IndentingNewLine]", + RowBox[{"CancelButton", "[", "]"}]}], "\[IndentingNewLine]", + "}"}], "]"}]}], "\[IndentingNewLine]", "}"}]}], + "\[IndentingNewLine]", "]"}]}], ";", "\[IndentingNewLine]", + "\[IndentingNewLine]", + RowBox[{"segwindow", "=", + RowBox[{"CreateWindow", "[", + RowBox[{"diag", ",", + RowBox[{"WindowTitle", "->", "\"\\""}], ",", + RowBox[{"WindowSize", "->", "All"}]}], "]"}]}], ";"}]}], + "\[IndentingNewLine]", "]"}]}], "]"}]}], ";"}]], "Input", CellChangeTimes->{{3.925785752345864*^9, 3.9257858441696873`*^9}, { 3.9257858743845673`*^9, 3.925785942559189*^9}, {3.9257859985263596`*^9, 3.925786000875513*^9}, {3.9257860357167225`*^9, 3.925786112431214*^9}, { @@ -198,14 +206,25 @@ Cell[BoxData[ 3.925788384471934*^9}, 3.925788417947033*^9, {3.925788459020122*^9, 3.925788524027033*^9}, {3.925788681567562*^9, 3.925788714721796*^9}, { 3.9257887523481026`*^9, 3.9257888682923193`*^9}, {3.9258279853491096`*^9, - 3.9258279855652294`*^9}}, - CellLabel->"In[2]:=",ExpressionUUID->"47a8f42c-633c-4040-8f3e-a266b722cb5e"], + 3.9258279855652294`*^9}, {3.925828359547844*^9, 3.9258283769869385`*^9}, { + 3.9258285047034626`*^9, + 3.925828511167654*^9}},ExpressionUUID->"47a8f42c-633c-4040-8f3e-\ +a266b722cb5e"], + +Cell[CellGroupData[{ Cell[BoxData[ RowBox[{"SegmentDataGUI", "[", "]"}]], "Input", CellChangeTimes->{{3.925786032447876*^9, 3.925786032447876*^9}, { 3.925786614704065*^9, 3.9257866160385227`*^9}}, - CellLabel->"In[3]:=",ExpressionUUID->"ec25646f-30f1-e94e-8333-4d337d221645"] + CellLabel->"In[5]:=",ExpressionUUID->"ec25646f-30f1-e94e-8333-4d337d221645"], + +Cell[BoxData[ + DynamicModuleBox[{$CellContext`inputFile$$}, "Null", + DynamicModuleValues:>{}]], "Output", + CellChangeTimes->{3.92582837994141*^9}, + CellLabel->"Out[5]=",ExpressionUUID->"0dfea100-255f-1249-8c8e-3559520cc324"] +}, Open ]] }, WindowSize->{1440, 747.75}, WindowMargins->{{-6, Automatic}, {Automatic, -6}}, @@ -225,8 +244,11 @@ CellTagsIndex->{} (*NotebookFileOutline Notebook[{ Cell[558, 20, 201, 3, 21, "Input",ExpressionUUID->"deba30a3-f409-2445-bd1a-c0504b40da38"], -Cell[762, 25, 9051, 176, 678, "Input",ExpressionUUID->"47a8f42c-633c-4040-8f3e-a266b722cb5e"], -Cell[9816, 203, 257, 4, 21, "Input",ExpressionUUID->"ec25646f-30f1-e94e-8333-4d337d221645"] +Cell[762, 25, 9531, 186, 678, "Input",ExpressionUUID->"47a8f42c-633c-4040-8f3e-a266b722cb5e"], +Cell[CellGroupData[{ +Cell[10318, 215, 257, 4, 21, "Input",ExpressionUUID->"ec25646f-30f1-e94e-8333-4d337d221645"], +Cell[10578, 221, 225, 4, 24, "Output",ExpressionUUID->"0dfea100-255f-1249-8c8e-3559520cc324"] +}, Open ]] } ] *)