Updated answer^2
(the old answer is below)
I have updated the code to manage image selection, class selection and editing. The main annoyance is that event handler needs some box structure to be selected to work and the only way I manage to do it is by keeping the curson in the input field. Such is life ¯_(ツ)_/¯
Animation in WebM
Helpers
Some small updates to the class input field to make it less aggressive in selecting the first proposal
Clear[suggestionField]
suggestionField[Dynamic[x_, f_:Null], Dynamic[list_] | list_, hint_ : ""] :=
InputField[
Dynamic[x, (x = #; f[x])&],
String,
FieldHint -> hint,
FieldCompletionFunction :> getSuggestions[list],
ContinuousAction -> True
]
This code can be use to select up to 10 suggestion from a list sorted by EditDistance and with a simple fuzzy matching (not a cool as the one in sublime text but that is more complex to implement here)
getSuggestions[list_][string_?StringQ] :=
list //
DeleteDuplicates //
Select[StringLength[#] > 0 &] //
Select[StringContainsQ[RegularExpression[StringRiffle[Characters[string], ".*"]], IgnoreCase -> True]] //
SortBy[Function[x, EditDistance[x, string]]] //
Take[#, UpTo[10]]&
getSuggestions[list_][_] := {}
A separate deginition for the locator, because I just don't like the system one. (Probably more code could be factored out)
Clear[locator]
locator[Dynamic[color_] | color_, opts___?OptionQ] :=
Graphics[{
{
Opacity[.4], ColorNegate[color],
AbsoluteThickness[3], Circle[{0,0}, 10{1,1}],
Line[{{{-15, 0}, {-5, 0}}, {{5, 0}, {15, 0}}, {{0, -15}, {0, -5}}, {{0, 5}, {0, 15}}}]
},
color,
Circle[{0,0}, 10{1,1}],
Line[{{{-15, 0}, {-5, 0}}, {{5, 0}, {15, 0}}, {{0, -15}, {0, -5}}, {{0, 5}, {0, 15}}}],
},
opts, ImageSize -> {25, 25}
]
Some formatting for the bounding boxes to take a little less space. Used in the new box list.
formatBox[Rectangle[{x1_,x2_},{x3_,x4_}]] := Sequence[Round[x1],Round[x2],"|", Round[x3],Round[x4],"\[Rule]"]
A utility to get a fixed window around a point. Used in the carousel
slidingWindow[i_, max_, size_] := Take[
DeleteCases[0] @ DeleteDuplicates @ Flatten @ Thread[{
PadRight[Range[i, Max[1,i - size], -1], size, 0],
PadRight[Range[i, Min[max, i + size], +1], size, 0]
}], UpTo[size]] // Sort
This is to generate a consistent (and hopefully decent) color given a label
exprColor[expr_] :=
Lighter[ColorData["BalancedHue", Mod[Hash[Unevaluated[expr]], 360]/360], .2]
A helper to load in-core and out-of-core images
Clear[getImage]
getImage[list_List, size_ : Automatic] := Map[getImage[#, size]&, list]
getImage[file_String?FileExistsQ, size_ : Automatic] := getImage[fastImageImport[file], size] (* fixed this line *)
getImage[image_Image?ImageQ, size_: Automatic] := ImageResize[Image[image, ImageSize -> 500, ImageResolution -> 72], Replace[size, Automatic -> Scaled[1]]]
getImage[e_, _] := Graphics[Text[Row[{"Failed to load image: ", e}]], ImageSize -> 500, AspectRatio -> 1/GoldenRatio]
Some internal function to skip the Import framework on common filenames
fastImageImport[file_String] := Module[
{ext, imported},
ext = FileExtension[file];
Switch[ext,
"jpg" | "jpeg",
imported = First @ Image`ImportExportDump`ImageReadJPEG[file],
"png",
imported = First @ Image`ImportExportDump`ImageReadPNG[file];
Image`ImportExportDump`DeleteCachePNG[],
"tif" | "tiff",
imported = First @ Image`ImportExportDump`ImageReadTIFF[file]
];
(* If not an image yet, try Import *)
If[!ImageQ[imported], imported = Import[file]];
If[!ImageQ[imported], Throw[$Failed]];
imported
]
fastImageImport[File[string_]] := fastImageImport[string]
Code
Now the gory part. It's still not out-of-core but that is a small adaptation (I might edit again if I have time).
The main changes are
- out-of-core support
- the support for a list of images (and annotations)
- thumbnail carousel
- arrow movement
- the edit button which enables
- box selection by clicking
- box resizing and moving using locators
The latter is implemented via an parallel GraphicsBox with locator to move the box center and adjust the corners. The box id can be picked from the list of current boxes that are drown on the side. While in edit mode, writing in the class field with edit the class name for the current box.
I have also tweak the code to make more use of MousePosition because setting it via EventHandler was sending a lot of unnecessary traffic between the kernel and the frontend.
That said, is it probably still full of bugs so bear with me... =)
ClearAll[boxCreatorList]
SetAttributes[boxCreatorList, HoldAll]
boxCreatorList[imageList_, previousResults_ : Automatic] :=
DynamicModule[
{
max, classes,
(* to keep only one serialized copy of the input data *)
images = imageList,
data = previousResults,
(* states *)
image, class, dims, range, color,
id = 1, (*box id*)
i = 1, (* image id*)
j = 1, (* class id*)
thumbID = 1, (* image thumbnail id*)
first = True, mouseDown = False, left = {0,0}, current = {0,0},
mouse = Dynamic@MousePosition[{"Graphics", PaneSelector}, {-5, -5}],
(* settings*)
clipQ = True, guidesQ = True, draggingQ = False, editQ = False, editClassQ = False,
(* variables *)
margin = 20, size, sizeC, minMove = 2, boxcenter, boxsize, thumbnail,
(* herlpers *)
safePos, getClasses, loadImage, addBox, deleteBox, editBox, checkCoord, carousel, styled
},
(* used to load a image from a list, can be modified to work out of core *)
loadImage[k_] := (
image = getImage[images[[k]]];
dims = ImageDimensions[image];
range = Tuples[{{0}, dims}];
color = If[ImageMeasurements[image, "MeanIntensity"] < .4, White, Black];
editQ = False; (* new image might not have associated boxes *)
);
(* used to get an updated class list *)
getClasses[] := Union[Catenate[data[[All, All, 2]]]];
(* to avoid wrting garbage to the box *)
safePos[] := If[VectorQ[MousePosition["Graphics"]],
current = checkCoord@MousePosition["Graphics"],
current
];
(* code to add a new box,
it does not trigger if the box is too small to prevent accidentaly adding one
the box id will be set to the new box
the class list is updated to pick up new classes *)
addBox[] := If[
EuclideanDistance[left, safePos[]] > minMove,
AppendTo[data[[i]], pointsToRec[left, safePos[]] -> class];
classes = getClasses[];
id = Length[data[[i]]];
first = True
];
(* code to delete a box,
the box id will be set to the next available one
the class list is updated to remove unused classes *)
deleteBox[] := If[Length[data[[i]]] > 0,
data[[i]] = Delete[data[[i]], id];
classes = getClasses[];
id = Min[id, Length[data[[i]]]]
];
(* code to initialize the edited box info *)
editBox[] := (
boxcenter = Mean[List @@ data[[i]][[id, 1]]];
boxsize = Abs[Subtract @@ data[[i]][[id, 1]]];
);
checkCoord[new_] := If[clipQ, clipCoords[new, dims], new];
styled[data_] := MapThread[
{#2, EdgeForm[#2], Button[#1, id = #3; editBox[];, Appearance -> "Frameless"]}&,
{data[[All, 1]], exprColor /@ data[[All, 2]], Range[Length[data]]}
];
(* memoized to reduce overhead, these are small images*)
thumbnail[pos_] := thumbnail[pos] = getImage[images[[pos]], 50];
carousel[] = Dynamic[With[{window = slidingWindow[thumbID, Length[images], 9]},
Row[MapIndexed[
Button[#, (i = thumbID = window[[#2[[1]]]]; loadImage[i]), Appearance -> "Frameless"]&,
MapAt[Framed, Position[window, i]]@
MapAt[Framed[#, FrameStyle->Transparent]&, Position[window, Except[i, _Integer]]]@
ConformImages[thumbnail /@ window, 60, "Fit", Padding -> GrayLevel[.8]]
]]
], TrackedSymbols :> {id, thumbID}];
(* variable initialization *)
loadImage[1];
data = PadRight[Replace[data, Automatic -> {}], Length[images], {{}}];
classes = Replace[getClasses[], {} -> {"None"}];
max = Length[images];
size = {700, 500};
sizeC = N @ Log[size[[1]]/200];
class = First[classes];
(* main interface *)
EventHandler[
Deploy @
Framed[#, FrameMargins -> 10, FrameStyle -> LightGray]& @
Grid[{
(* image carousel *)
{Row[{
Button["\[LeftAngleBracket]\[LeftAngleBracket]", thumbID = Max[1, thumbID - 5 9]], Button["\[LeftAngleBracket]", thumbID = Max[1, thumbID - 9]],
Column[{carousel[],
Dynamic[Style[StringForm["Showing `` to `` of ``", Sequence@@MinMax[slidingWindow[thumbID, Length[images], 9]], Length[images]], "Text"]]}],
Button["\[RightAngleBracket]", thumbID = Min[Length[images], thumbID + 9]], Button["\[RightAngleBracket]\[RightAngleBracket]", thumbID = Min[Length[images], thumbID + 5 9]]
}], SpanFromLeft},
{
(* info and controls *)
Column[{
(* controls *)
Grid[{
{"Clip", Checkbox[Dynamic[clipQ]]},
{"Guides", Checkbox[Dynamic[guidesQ]]},
{"Edit", Checkbox[Dynamic[editQ, (editQ = #; editBox[])&], Enabled -> Dynamic[Length[data[[i]]] > 0]]},
{Slider[Dynamic[sizeC, (sizeC = #; size = 200{1, 5/7}*E^#)&], {0, 3}], SpanFromLeft},
{Button["Clear", data[[i]] = {}; first = True; draggingQ = False; editQ = False], SpanFromLeft},
{Button["Save", Print[Iconize[data]]; $LastAnnotation = data], SpanFromLeft},
{suggestionField[Dynamic[class, (class = #; If[editQ, data[[i]][[id, 2]] = #]; classes = Append[getClasses[], class])&], Dynamic[classes], "label"],
SpanFromLeft}
}, Alignment -> Left, BaseStyle -> "Text"],
(* box list *)
Pane[
Dynamic[If[Length[data[[i]]] > 0, Grid[
MapIndexed[
Prepend[#, RadioButton[Dynamic[id, (id = #; editBox[])&], #2[[1]]]]&,
MapAt[formatBox, List @@@ data[[i]], {All, 1}]
],
Alignment -> Left], ""]],
250, ImageSizeAction->"ShrinkToFit", BaseStyle -> {"Text", FontSize -> 14}]
}],
(* image panel *)
Framed[#, FrameMargins -> 0, FrameStyle -> LightGray, Background -> GrayLevel[.98]]& @
PaneSelector[{
True -> Graphics[{
(* image *)
Dynamic[Image[image, ImageSize -> size]],
Dynamic@FaceForm[Opacity[.2, color]], Dynamic@EdgeForm[color],
(* drawn boxes *)
Dynamic[styled[data[[i]]]],
(* controls to edit the current box *)
Locator[Dynamic[boxcenter, (
boxcenter = #;
data[[i]][[id, 1, 1]] = checkCoord[boxcenter + boxsize/2];
data[[i]][[id, 1, 2]] = checkCoord[boxcenter - boxsize/2];
)&
], locator[Dynamic[color], ImageSize -> 15]],
Locator[Dynamic[data[[i]][[id, 1, 1]], (data[[i]][[id, 1, 1]] = checkCoord[#]; editBox[])&], locator[Dynamic[color]]],
Locator[Dynamic[data[[i]][[id, 1, 2]], (data[[i]][[id, 1, 2]] = checkCoord[#]; editBox[])&], locator[Dynamic[color]]]
},
ImageSize -> Dynamic[size], PlotRange -> Dynamic[range], ImageMargins -> margin
],
False ->
EventHandler[
MouseAppearance[Graphics[{
(* image *)
Dynamic[Image[image, ImageSize -> size]],
Dynamic[color], (*Dynamic@FaceForm[Opacity[.2, color]], Dynamic@EdgeForm[color],*) Opacity[.2],
(* boxes present in list *)
{Dynamic[styled[data[[i]]]]},
Dynamic@If[TrueQ @ first,
(* box being currently drawn *)
{Opacity[Dynamic[If[guidesQ, .5, 0]]], InfiniteLine[mouse, {1,0}], InfiniteLine[mouse, {0,1}]},
(* guide lines *)
{FaceForm[], EdgeForm[Opacity[1]], Rectangle[Dynamic@left, mouse]}
],
(* locator *)
Inset[locator[Dynamic[color]], mouse, Center, Offset[{25, 25}]]
},
ImageSize -> Dynamic[size], PlotRange -> Dynamic[range], ImageMargins -> margin
], Graphics[]],
{
{"MouseDown", 1} :> If[first,
(* record first box corner *)
left = safePos[];
first = False,
(* record second box corner and save box *)
addBox[]
],
{"MouseUp", 1} :> (
If[!first && draggingQ,
(* record second box corner and save box *)
addBox[]
];
draggingQ = False
),
{"MouseClicked", 2} :> If[!first,
(* cancel current selection *)
first = True; draggingQ = False,
(* cancel last selection *)
deleteBox[]; draggingQ = False
],
"MouseDragged" :> (
draggingQ = True;
)
}
]},
Dynamic[editQ]
]
}}, Alignment->Top],
{
"LeftArrowKeyDown" :> (thumbID = i = Max[1, i - 1]; loadImage[i];),
"RightArrowKeyDown" :> (thumbID = i = Min[max, i + 1]; loadImage[i];),
"UpArrowKeyDown" :> (j = Min[Length[classes], j + 1]; class = classes[[j]]),
"DownArrowKeyDown" :> (j = Max[1, j - 1]; class = classes[[j]])
}
]
]
Old answer
I used to have an old prototype for this that was in need of a revamp. This gives me the occasion to do it.
The goal is to have an interface which makes the drawing of the boxes as easy as possible an eventually returns something that can be used for training.
This version was built to support the following features:
interactions
- boxes can be drawn by clicking on a corner and then dragging to the other corner
- boxes can be drawn by clicking on a corner and then clicking on the other corner
- right click while drawing should cancel the current box
- right click should cancel the last box drawn
options
- the coordinates can be clipped to the image range
- the range can be scaled or the image size
- the UI should offer information about the box edges
- the UI should be scalable
With the goals in mind let's start by putting together each element
Helpers
- convert coordinates to a region
pointsToRec[{x1_, y1_}, {x2_, y2_}] := Rectangle[{Min[x1, x2], Min[y1, y2]}, {Max[x1, x2], Max[y1, y2]}]
- clip coordinates to a max range
clipCoords[{x_, y_}, {w_, h_}] := {Clip[x, {0, w}], Clip[y, {0, h}]}
- scale coordinates to a new range
scaleBox[{w_, h_}][Rectangle[{x1_, y1_}, {x2_, y2_}]] := Rectangle[{x1 w, y1 h}, {x2 w, y2 h}]
scaleBox[{w_, h_}][list: {__Rectangle}] := scaleBox[{w,h}] /@ list
Actions
"MouseMoved" :> (
(* store current mouse position *)
pos = MousePosition["Graphics"];
If[VectorQ[pos], current = If[clipQ, clipCoords[pos, If[scaledQ, {1, 1}, dims]], pos]];
)
- checking for dragging motion
"MouseDragged" :> (
draggingQ = True;
)
{"MouseDown", 1} :> If[first,
(* record first box corner *)
left = current;
first = False,
]
- second clik or "unpress" (here the boxes are saved as
Rectangle[] -> class)
{"MouseDown", 1} :> If[!first,
(* record second box corner and save box *)
If[
EuclideanDistance[left, current] > If[scaledQ, .005, 2],
AppendTo[box, pointsToRec[left, current] -> class];
first = True
]
]
{"MouseUp", 1} :> (
If[!first && draggingQ,
(* record second box corner and save box *)
If[
EuclideanDistance[left, current] > If[scaledQ, .005, 2],
AppendTo[box, pointsToRec[left, current] -> class];
first = True
]
];
draggingQ = False
)
- right click while dragging or moving
{"MouseClicked", 2} :> If[!first,
(* cancel current selection *)
first = True; draggingQ = False,
(* cancel last selection *)
If[Length[box] > 0, box = Most[box]]; draggingQ = False
],
Controls
Checkbox[Dynamic[clipQ]]
Checkbox[Dynamic[guidesQ]]
Checkbox[Dynamic[scaledQ,
(scaledQ = #;
If[# && Length[box] > 0,
box[[All,1]] = scaleBox[1/dims][box[[All,1]]],
box[[All,1]] = scaleBox[dims][box[[All,1]]]
])&
]]
Slider[Dynamic[sizeC, (sizeC = #; size = 10^#)&], {2, 4}]
Now we need to put everthing together in a decent UI. My main structure is giong to be
Column[{
controls,
EventHandler[
Graphics[],
actions
]
}]
And here is the UI in all its gory details
ClearAll[boxCreator]
SetAttributes[boxCreator, HoldAll]
boxCreator[Dynamic[box_], Dynamic[class_], Dynamic[i_]] := boxCreator[box, class, i]
boxCreator[box_, class_, i_] :=
DynamicModule[
{
(* states *)
first = True, mouseDown = False, left = {0,0}, current = {0,0}, draggingQ = False, pos = None,
(* settings*)
clipQ = True, scaledQ = True, guidesQ = True,
(* variables *)
dims, color, margin = 20, size = 400, sizeC, locator
},
dims = ImageDimensions[i];
size = 700;
sizeC = N @ Log[10, size];
color = If[ImageMeasurements[i, "MeanIntensity"] < .4, White, Black];
locator = Graphics@{
{
Opacity[Dynamic[.4 Boole[MousePosition["Graphics"] =!= None]]], ColorNegate[color],
AbsoluteThickness[3], Circle[{0,0}, 10{1,1}],
Line[{{{-15, 0}, {-5, 0}}, {{5, 0}, {15, 0}}, {{0, -15}, {0, -5}}, {{0, 5}, {0, 15}}}]
},
Opacity[Dynamic[Boole[MousePosition["Graphics"] =!= None]]], color,
Circle[{0,0}, 10{1,1}],
Line[{{{-15, 0}, {-5, 0}}, {{5, 0}, {15, 0}}, {{0, -15}, {0, -5}}, {{0, 5}, {0, 15}}}]
};
Deploy@Column[{
Row[{
"Clip", Checkbox[Dynamic[clipQ]],
"Scale", Checkbox[Dynamic[scaledQ,
(scaledQ = #; If[# && Length[box] > 0, box[[All,1]] = scaleBox[1/dims][box[[All,1]]], box[[All,1]] = scaleBox[dims][box[[All,1]]]])&]],
"Guides", Checkbox[Dynamic[guidesQ]],
Button["Clear", box = {}; first = True; draggingQ = False]
}],
Slider[Dynamic[sizeC, (sizeC = #; size = 10^#)&], {2, 4}],
Framed[#, FrameMargins->0, FrameStyle->LightGray]& @
EventHandler[
MouseAppearance[Graphics[{
(* image *)
Inset[i, Center, Center, Scaled[1]],
FaceForm[Opacity[.2, color]], EdgeForm[color],
(* boxes present in list *)
{Dynamic[box[[All, 1]]]},
(* box being currently drawn *)
{
Opacity[Dynamic[Boole[!first]]], EdgeForm[Opacity[Dynamic[Boole[!first]]]],
FaceForm[], Rectangle[Dynamic@left, Dynamic@current]
},
(* guide lines *)
{Opacity[Dynamic[.5 Boole[guidesQ && first && MousePosition["Graphics"] =!= None]], color], InfiniteLine[Dynamic@current, {1,0}], InfiniteLine[Dynamic@current, {0,1}]},
(* locator *)
Inset[locator, Dynamic[current], Center, Offset[{25, 25}]]
},
ImageSize -> Dynamic[size], PlotRange -> Dynamic@If[scaledQ, {{0,1}, {0,1}}, Tuples[{{0}, dims}]],
AspectRatio -> ImageAspectRatio[i],
ImageMargins -> margin
], Graphics[]],
{
{"MouseDown", 1} :> If[first,
(* record first box corner *)
left = current;
first = False,
(* record second box corner and save box *)
If[
EuclideanDistance[left, current] > If[scaledQ, .005, 2],
AppendTo[box, pointsToRec[left, current] -> class];
first = True
]
],
{"MouseUp", 1} :> (
If[!first && draggingQ,
(* record second box corner and save box *)
If[
EuclideanDistance[left, current] > If[scaledQ, .005, 2],
AppendTo[box, pointsToRec[left, current] -> class];
first = True
]
];
draggingQ = False
),
{"MouseClicked", 2} :> If[!first,
(* cancel current selection *)
first = True; draggingQ = False,
(* cancel last selection *)
If[Length[box] > 0, box = Most[box]]; draggingQ = False
],
"MouseMoved" :> (
(* store current mouse position *)
pos = MousePosition["Graphics"];
If[VectorQ[pos], current = If[clipQ, clipCoords[pos, If[scaledQ, {1, 1}, dims]], pos]];
),
"MouseDragged" :> (
draggingQ = True;
)
}
]
}]
]
Feedback from OP:
This is great work, thank you!
Your function could easily be a system function with a only 3 tweaks:
Missing essential features:
Needs to work for multiple images (e.g. out-of-core directory of files) and store the labels per image, which requires navigation controls (right and left arrow keys) to cycle through the images as well as a saving/loading to resume work.
Users need to be able to click on a box to edit it after it is drawn, e.g. to move/pan it, resize, or delete it.
Users need to be able to change the class (each should have it's own color) with up and down arrow keys.
Missing nice-to-haves:
Display a scrollable carousel of thumbnails of all the images to visually navigate the directory.
Ability to edit "a master list" of classes and toggle them per box or even add new classes.
This one is very cool: Accelerate the labeling process by continually retraining the detector (in the background on the labels made thus far) to pre-populate high scoring detections (add a slider for users to set thresholds). Then users can simply accept or edit the proposals on unlabeled images instead of dragging them.
