What is That?

Creating User-Friendly Keys to Make Species Identification Easier and Faster

Whit Farnum

Museum of Comparative Zoology

A Couplet in a Dichotomous Key

DynamicModule[{show="first"},
Dynamic@EventHandler[
Which[show==="first",Show[,ImageSize->900],
show==="second",Grid[{Style[#1,40],TextCell[#2,PageWidth->750,36],Style[#3,40]}&@@@{{1.,"Upper plate (tergite) of the last abdominal segment (pygidium) ﬂattened and with a pair of distally converging rows of spines or peg-like teeth (A). (Cerapachyinae).",2.},{1.,"Pygidium rounded and without a pair of distally converging rows of spines or peg-like teeth. ",3.}}
],show==="third",
Grid[{Style[#1,40],TextCell[#2,PageWidth->750,36]}&@@@{{1.`->2.`,"Upper plate (tergite) of the last abdominal segment (pygidium) ﬂattened and with a pair of distally converging rows of spines or peg-like teeth (A). (Cerapachyinae)."},{1.`->3.`,"Pygidium rounded and without a pair of distally converging rows of spines or peg-like teeth. "}}]
],{"MouseClicked":>Which[show==="first",Set[show,"second"],
show==="second",Set[show,"third"],
show==="third",Set[show,"first"]]}]]

Structure and Navigation of a Key

KeyBrowseFuncGammaTest["Micronesia","Micronesia"]

Scoring a Key

DynamicModule[{tree,start=1,blah},
tree={{1->2,"Trait-1"},{1->3,"Trait-2"},{2->"Sp.1","Trait-3"},{2->"Sp.2","Trait-4"},{3->"Sp.3","Trait-5"}};
Dynamic@Row[{TreePlot[tree,Left,1,
EdgeRenderingFunction->(
{Flatten@{Which[#2[[1]]===start,Thick,
MemberQ[FixedPointList[#/.(Reverse/@(tree[[All,1]]))&,start],#2[[2]]],{Red,Thick},
(MemberQ[FixedPointList[#/.(Reverse/@(tree[[All,1]]))&,start],#2[[1]]]∧#2[[1]]=!=start),{Green,Thick},
True,Thick],Arrowheads[.02],Arrow[#1,.05]},
{LightGray,EdgeForm[Thin],
Rectangle[(First[#1]+Last[#1])/2,(First[#1]+Last[#1])/2+{.3,.1}]},
Text[Style[#3,20],Plus[(First[#1]+Last[#1])/2,(First[#1]+Last[#1])/2+{.3,.1}]/2]}&),
VertexRenderingFunction->(
Button[{If[#2===start,Green,Red],Disk[#,0.05],Black,
Text[Style[#2,16],#1]},
Set[{start,blah},{#2,#2}]]&),ImageSize->450],
Style[TableForm[{TextCell[#1,FontSize->30,Background->If[blah==="Sp.1",Red,White]],
TextCell[#2,FontSize->30,Background->If[blah==="Sp.2",Red,White]],
TextCell[#3,FontSize->30,Background->If[blah==="Sp.3",Red,White]]}&@@@{{1,1,0},{0,0,1},
{1,0,"?"},{0,1,"?"},{"?","?",1}},TableHeadings->{{"Trait-1","Trait-2","Trait-3","Trait-4","Trait-5"},{"Sp.1","Sp.2","Sp.3"}}],24]}]
]

Explanation of a Matrix Key

(test1["# of Legs",6]={"Diptera","Hymenoptera","Coleoptera"};test1["# of Legs",8]={"Arachnid"};
test1["# of Wings",0]={"Arachnid"};test1["# of Wings",2]={"Diptera"};test1["# of Wings",4]={"Hymenoptera","Coleoptera"};
test1["Front Wings","N/A"]={"Arachnid"};test1["Front Wings","Membranous"]={"Diptera","Hymenoptera"};test1["Front Wings","Hardened"]={"Coleoptera"};test1["Hind Wings","N/A"]={"Arachnid","Diptera"};test1["Hind Wings","Membranous"]={"Hymenoptera","Coleoptera"};
test1[_,"Not Selected"]={"Arachnid","Diptera","Hymenoptera","Coleoptera"};)
Column@{Style[TableForm[
{{8,0,"N/A","N/A"},{6,2,"Membranous","N/A"},{6,4,"Membranous","Membranous"},{6,4,"Hardened","Membranous"}},
TableHeadings->{{"Arachnid","Diptera","Hymenoptera","Coleoptera"},TextCell[#,PageWidth->95]&/@{"# of Legs","# of Wings","Front Wings","Hind Wings"}}],FontFamily->"Times",30],
OpenerView[{Style["Interface",24,FontFamily->"Times"],Style[DynamicModule[{t1,t2,t3,t4},
Column@{
Grid[{
{Row@{"# of Legs:",PopupMenu[Dynamic[t1],{"Not Selected",6,8}]},
Row@{"# of Wings:",PopupMenu[Dynamic[t2],{"Not Selected",0,2,4}]}},
{Row@{"Front Wings:",PopupMenu[Dynamic[t3],{"Not Selected","N/A","Membranous","Hardened"}]},
Row@{"Hind Wings:",PopupMenu[Dynamic[t4],{"Not Selected","N/A","Membranous"}]}}
}],
Button[Style["Reset",24],Set[{t1,t2,t3,t4},Table["Not Selected",{4}]],ImageSize->150],
Column@{"Taxa Still under Consideration",
Dynamic@
If[Intersection[
test1["# of Legs",t1],test1["# of Wings",t2],test1["Front Wings",t3],test1["Hind Wings",t4]
]==={},"No Known Taxa Meet This Combination",
Column[Intersection[
test1["# of Legs",t1],test1["# of Wings",t2],test1["Front Wings",t3],test1["Hind Wings",t4]
]]
]
}}],FontFamily->"Times",24]},True]}

The Problem of Unknowns

DynamicModule[{tree,highlightFnc},
highlightFnc[t_,node_]:=Union@Flatten[Select[#,((#≥node)∨StringQ[#])&]&/@(Select[FixedPointList[#/.(Reverse/@t[[All,1]])&,#]&/@Cases[t[[All,1]][[All,2]],_String],
MemberQ[#,node]&
])];
tree={
{1->2,"Trait 1"},{1->3,"Trait 2"},{3->"Sp.5","Trait 3"},{3->5,"Trait 4"},{2->6,"Trait 5"},{2->7,"Trait 6"},{5->"Sp.6","Trait 7"},{5->"Sp.7","Trait 8"},
{6->"Sp.3","Trait 9"},{6->"Sp.4","Trait 10"},{7->"Sp.2","Trait 11"},{7->"Sp.1","Trait 12"}
};
Row@{TreePlot[tree,Top,1,EdgeRenderingFunction->(
{Thick,Which[
MemberQ[highlightFnc[tree,2],#2[[1]]],Red,
(#3==="Trait 8"),Blue,
True,Black
],
Arrow[#1],
Text[Style[#3,Black,16],(First[#1]+Last[#1])/2]
}
&),ImageSize->700],
Column@{
TextCell[Style["Trait 8 is used to indentify species",Blue,24],PageWidth->300],
TextCell[Style["Trait 8 is present in all species but is not used in the key",Red,24],PageWidth->300],
TextCell[Style["Treating the red group as false for Trait 8 would wrongly exclude them",Black,24],PageWidth->300]
}}
]

User Set up and Part Refinement

Key and Body plan import

DynamicModule[{kname="Micronesia",fileextend={"ParsedKey","Images"},organ="ants",importpath=Null,importpathBody=Null,tree=Null},
Column@{
Grid[{
{"KeyName:",InputField[Dynamic[kname],String]},
{"Key File Import Path:",InputField[Dynamic[importpath]],Button["Choose File",FrontEndExecute[FrontEndToken["FileNameDialog"]]]},
{"Export/Import Format:",PopupMenu[Dynamic[fileextend],
{"xls"->"Export Excel Format",
"cvs"->"Export Comma Separated Variable Format",
"ParsedKey"->"Key of Already Parsed Traits",
{"ParsedKey","Images"}->"Key of Already Parsed Traits with Images",
"TruthValueMatrix"->"Data all ready Scored and Assigned"
}]},
{"Body Plan Name:",InputField[Dynamic[organ],String]},
{"Body Plan File Import Path:",InputField[Dynamic[importpathBody]],Button["Choose File",FrontEndExecute[FrontEndToken["FileNameDialog"]]]}
}],
Dynamic[Button["Import Data",
KeyDataSetUp[kname,importpath,fileextend];
CreateBodyPlan[organ,importpathBody];
Set[tree,
TreePlot[Flatten[Thread/@BodyRules[organ]],Top,"body",EdgeRenderingFunction->({Arrowheads[.01],Arrow[#1,.001]}&)]]
]],
OpenerView[{"Body Plan Tree",Dynamic[tree]}]
}]

Refine Synonym Rules

DynamicModule[{kname="Micronesia",organ="ants",z1=-1,z2=-1,z3=-1,chnotsyn=({"abdomen","antenna","body","color","head","leg","metrics","morphisms","thorax","waist"}),

lowpriority={"color","metrics","morphisms"},refineparts={"antenna","abdomen","body","leg","metrics","morphisms","thorax"},finallowpriority={}},
Column@{Grid[{
{"Select a Key Name:",PopupMenu[Dynamic[kname],{"Micronesia"}]},
{"Select a Body Plan:",PopupMenu[Dynamic[organ],{"ants"}]}
}],
Row@{OpenerView[{"Childred Not Synonyms",Row@{Dynamic[
CheckboxBar[
Dynamic[chnotsyn],
(Union[BodyPartofPairs[organ][[All,2]]])[[-z1;;-z1+5]],
Appearance->"Vertical"]],
VerticalSlider[Dynamic[z1],{-Length[Union[BodyPartofPairs[organ][[All,2]]]]+5,-1,1}],Dynamic[Column@chnotsyn],
Button["Reset",Set[chnotsyn,{}]]
}}],
OpenerView[{"Low Priority Parts",Row@{Dynamic
[CheckboxBar[
Dynamic[lowpriority],
(Union[BodyPartofPairs[organ][[All,2]]])[[-z2;;-z2+5]],
Appearance->"Vertical"]],
VerticalSlider[Dynamic[z2],{-Length[Union[BodyPartofPairs[organ][[All,2]]]]+5,-1,1}],
Dynamic[
Column@Flatten[{Union[{##}[[All,2]]],{##}[[All,1]]}&@@@(Function[part,Select[BodyPartofPairs[organ],({#[[2]]}⋂{part})=!={}&]][#]&/@Cases[lowpriority,_String,2])]],Button["Reset",Set[lowpriority,{}]]
}}],
OpenerView[{"Refine Parts",Row@{Dynamic
[CheckboxBar[
Dynamic[refineparts],
(Union[BodyPartofPairs[organ][[All,2]]])[[-z3;;-z3+5]],
Appearance->"Vertical"]],
VerticalSlider[Dynamic[z3],{-Length[Union[BodyPartofPairs[organ][[All,2]]]]+5,-1,1}],
Dynamic[Column@Cases[refineparts,_String,2]]}}],Button["Reset",Set[refineparts,{}]]
},
Dynamic[Button["Refine Part Assignments for Key",
Set[finallowpriority,Flatten[{Union[{##}[[All,2]]],{##}[[All,1]]}&@@@(Function[part,Select[BodyPartofPairs[organ],({#[[2]]}⋂{part})=!={}&]][#]&/@Cases[lowpriority,_String,2])]];
CreateGlobalTraitLookup[kname];
CreateCompleteSynonymRules[organ,Cases[chnotsyn,_String,2]];
RefineSearchTermsAllLevels[organ,kname,Cases[finallowpriority,_String,2],Cases[refineparts,_String,2]];]]
}]

Check for Umatched checks

DynamicModule[{kname="Micronesia",unmatch=Null},
Column@{
Row@{"Select a Key Name:",PopupMenu[Dynamic[kname],{"Micronesia"}]},
Button["Check for Unmatched Traits in "<>kname,Set[unmatch,CheckforUmatchedTraits[kname]]],
OpenerView[{"Unmatched Traits by Keylevel",Dynamic[unmatch]}]
}]

Create the final key

DynamicModule[{kname="Micronesia",organ="ants"},
Column@{
Row@{"Select a Key Name:",PopupMenu[Dynamic[kname],{"Micronesia"}]},
Row@{"Select a Key Name:",PopupMenu[Dynamic[organ],{"ants"}]},
Button["Create Data for "<>kname,AllTreeLevelBigInput[kname,organ]],
OpenerView[{"Key to "<>kname,Dynamic[dynamickeyInterface[kname,"Manipulate"]]}]
}]

Combining Freedom and Guidance

dynamickeyInterface["NAGenera","Images"]

Dealing with Unknown Scores

Fewer unknown scores means a more powerful key but scoring all taxa for all traits is prohibitive. One approach is more specific sorting methods. A second approach is to determine which traits are more powerful for which taxa.

Better refine part assignments and require that taxa be scored for each category.

{Style["Clypeus",24]->
Column@(
Style[#,20]&/@{"Anterior margin of clypeus denticulate (A)","Anterior margin of clypeus not denticulate (AA)","Clypeal margin convex (AA)","Clypeal margin more or less straight (A)","Median impression of anterior margin of clypeus broad and very shallow (AA)."})
}//TableForm

{Style["Clypeus",24]->
Style[Column@{
"Anterior margin"->Column@{"Anterior margin of clypeus denticulate (A)","Anterior margin of clypeus not denticulate (AA)",
"Median impression"->Column@{TextCell["Median impression of anterior margin of clypeus broad and very shallow (AA).",PageWidth->500]}},
"Clypeal margin"->Column@{"Clypeal margin convex (AA)","Clypeal margin more or less straight (A)"},
},20]}//TableForm

Determine which traits to score for which taxa.

Manipulate[
Show[ListPlot[
Tooltip[#[[{2,3}]],Style[#,20]]&/@Flatten[Function[trait,
Flatten[
{#2,taxatally["NAGenera","NAGenera",#1,tvalue]}
][[{2,1,3}]]&@@@traitmatchlookup["NAGenera","NAGenera",trait]
][#]&/@Union[KeyData["NAGenera"][[All,3]]],1],AxesLabel->(Style[#,20]&/@{"Distance from start","# of taxa"}),PlotMarkers->{Automatic,10}
],ImageSize->700],
{{tvalue,True,Style["Score",20]},

((#->Style[ToString[#],20])&/@{True,False,"Null"})
}]

Acknowledgments

Early Tutelage and Advice

Fred Meinberg

Advice and Materials in Matters Taxonomic

Gary Alpert		Ron Clause
Stefan Cover		Brian Fischer
Phil Perkins		Steve Shattuck
E.O. Wilson

Advanced Mathematica Summer School Advisors

Kristen 
Paul-Jean Letourneau		Wiktor Macura
Peter Overmann

Funding

Encyclopedia of Life		National Parks Service