Preparing the Key

Build up functions

KeyData::usage="This is a function that names your data set. The data is in the column form of {KeyLevel, Start, Character, GoTo}.";

KeyParsingFunction[keyname_String]:=Flatten[Table[Append[Append[KeyData[keyname][[i,{1,2}]],#],KeyData[keyname][[i,4]]]&/@ StringSplit[KeyData[keyname][[i,3]],{". ","; "}],
{i,1,Length[KeyData[keyname]]}],1]

KeyParsingFunction::usage="KeyParsingFunction[keyname_String], I cuts characters in dichotomous keys based on the syntax markers of '. ' and '; '. The argument is a string name you have given to your data. The output is the same KeyData.";

ParseTraits[keyname_String,fileformat_String]:={CutTraits[keyname]=KeyParsingFunction[keyname],
SetDirectory[NotebookDirectory[]<>"/datafiles"],
Export[keyname<>"-CutTraits"<>"."<>fileformat,Prepend[CutTraits[keyname],{"KeyLevel","Start","Character","GoTo"}]]};

ParseTraits::usage="ParseTraits[keyname_String,fileformat_String], This function cuts up traits and exports them to a file for future editing. It also defines an output of CutTraits for future editing.";

CutTraits::usage="This heading applies to KeyData that has split into sentences.";

TraitTreeBuilder[keyname_]:=Module[{createtree},
createtree=CutTraits[keyname]/.{a_,b_,c_,d_}:>{a,b->d,c};
TraitTree[keyname]=createtree;
AllTraitsof[keyname]=(First[{##}[[All,1]]]->{##}[[All,2]])&@@@Split[SortBy[createtree[[All,{1,3}]],First],#1[[1]]===#2[[1]]&];]

TraitTreeBuilder::usage="TraitTreeBuilder[keyname], This function will take a key from {KeyLevel, Start, GoTo, Character}  to {KeyLevel, Start, ->GoTo, Character}. It will then define a new variable which will be used for future use. It also creates a list of all traits collected by key level";

TraitTree::usage="Cut key data in the form {KeyLevel, Start->GoTo, Character}. It will be used to score the tree.";

AllTraitsof::usage="This data is in the form of KeyLevel -> {List of all traits in that level}";

When is htis used later?

GetTraitsFromKeyLevel[keyname_,treeLevel_]:=Union[Flatten[Select[AllTraitsof[keyname],#[[1]]===treeLevel&][[All,2]]]]

GetTraitsFromKeyLevel::usage="Takes the argument GetTraitsFromKeyLevel[keyname,treeLevel]. This Select as the parsed traits from a given level of a tree data set.";

CreateKeyTaxabyLevel[keyname_]:=Function[treelevel,Set[KeyTaxabyLevel[keyname,treelevel],
Select[Select[KeyData[keyname][[All,{1,4}]],#[[1]]===treelevel&][[All,2]],StringQ[#]&]
]][#]&/@KeyLevels[keyname]

KeyLevelTaxa::usage="KeyTaxabyLevel[keyname,treelevel]. This is a lookups that returns all taxa that can be arrived at from a given key.";

CreateKeyTaxabyLevel::usage="CreateKeyTaxabyLevel[keyname_]. Creates the look up with the head KeyLevelbyTaxa for a given key";

All in one function from above functions

KeyDataSetUp[keyname_String,filepath_String,fileformat_]:=Module[{extension},
extension=StringJoin@
Characters[filepath][[(Last[Flatten[Position[Characters[filepath],"."]]])+1;;]];
Set[KeyData[keyname],Cases[Which[extension==="xls",Import[filepath][[1,2;;]],extension==="csv",Import[filepath][[2;;]]],Except[{""...}]]];
CreateKeyTaxabyLevel[keyname];
ParseTraits[keyname,fileformat];
KeyLevels[keyname]=Union[KeyData[keyname][[All,1]]];
TraitTreeBuilder[keyname];]

KeyDataSetUp::usage="KeyDataSetUp[keyname_String,filepath_String,fileformat_]. 
This function import a key and divides in characters into individual sentences. It defines the following categories for a given keyname";

KeyDataSetUp[keyname_String,filepath_String,"ParsedKey"]:=(
KeyData[keyname]=Cases[Import[filepath][[1,2;;]],Except[{""...}]];
KeyLevels[keyname]=Union[KeyData[keyname][[All,1]]];
CreateKeyTaxabyLevel[keyname];
TraitTree[keyname]=KeyData[keyname]/.{a_,b_,c_,d_}:>{a,b->d,c};
AllTraitsof[keyname]=(First[{##}[[All,1]]]->{##}[[All,2]])&@@@Split[SortBy[TraitTree[keyname][[All,{1,3}]],First],#1[[1]]===#2[[1]]&];
)

KeyDataSetUp[keyname_String,filepath_String,"TruthValueMatrix"]:=EditedKeySetUp[keyname,filepath]

Include images in the data set

other functions

ImageImportFunction[keyname_]:=Module[{filepaths,allimages},
allimages=Union[StringReplace[#, (StartOfString ~~Whitespace) | (Whitespace ~~ EndOfString) :> ""]&/@
Flatten[StringSplit[Select[KeyData[keyname][[All,5]],#=!="x"&],","]]];
filepaths=FileNames[#,NotebookDirectory[],∞]&/@allimages;
Set[image[#1],Import[Sequence@@#2]]&@@@Transpose[{allimages,filepaths}];
]

DefineTraitImages[keyname_,treelevel_]:=(
Set[TraitImages[keyname,treelevel,"x"],"No image currently selected"];
Set[TraitImages[keyname,treelevel,#[[1]]],#[[2]]]&/@
Table[#1->#2&@@{KeyData[keyname][[i,3]],
StringReplace[#, (StartOfString ~~Whitespace) | (Whitespace ~~ EndOfString) :> ""]&/@
Flatten[StringSplit[
Select[KeyData[keyname],#[[1]]===treelevel&][[i,5]],","]]},{i,1,Length[Select[KeyData[keyname],#[[1]]===treelevel&]]}]);

DefineTraitImagesAllLevels[keyname_]:=(DefineTraitImages[keyname,#]&/@KeyLevels[keyname]);

ImageViewingFunction[keyname_,treelevel_,trait_]:=Which[
TraitImages[keyname,treelevel,trait]==={"x"},"No Images available for this trait",
TraitImages[keyname,treelevel,trait]==="No image currently selected","No image currently selected",
TraitImages[keyname,treelevel,trait]=!={"x"},Column@{trait,TabView[(#->Show[image[#],ImageSize->400])&/@(Flatten@{TraitImages[keyname,treelevel,trait]})]}
]

final function

KeyDataSetUp[keyname_String,filepath_String,{"ParsedKey","Images"}]:=(
KeyData[keyname]=Module[{extension},
extension=StringJoin@
Characters[filepath][[(Last[Flatten[Position[Characters[filepath],"."]]])+1;;]];Cases[Which[extension==="xls",Import[filepath][[1,2;;]],extension==="csv",Import[filepath][[2;;]]],Except[{""...}]]];
KeyLevels[keyname]=Union[KeyData[keyname][[All,1]]];
ImageImportFunction[keyname];
DefineTraitImagesAllLevels[keyname];
CreateKeyTaxabyLevel[keyname];
TraitTree[keyname]=KeyData[keyname]/.{a_,b_,c_,d_,e_}:>{a,b->d,c};
AllTraitsof[keyname]=(First[{##}[[All,1]]]->{##}[[All,2]])&@@@Split[SortBy[TraitTree[keyname][[All,{1,3}]],First],#1[[1]]===#2[[1]]&];
)

We need to deal with image importation for the truth matrix keys as well.

Creation of Search Terms from the Body plan

Word consolidation

WordConsolidator[word_]:=Module[{start},start=DeleteCases[Union@Flatten[Flatten[WordData[word,#]&/@{"MorphologicalDerivatives","InflectedForms","SubsetTerms"},1]/.Rule[a_,b_]:>{First[a],b}],
_WordData|_Missing];
If[start=!={},Prepend[start,word],{}]]

WordConsolidator::usage="It looks up a word in WordData and the finds and groups the results returned from the options
{MorphologicalDerivatives,InflectedForms,SubsetTerms} ";

SynomynList::usage="A list of synonyms for common body parts in the tree structure and the species group given in the argument.";

Body structure- needs work on importation

CreateBodyPlan[organism_,filepath_]:=Module[{start},
Set[BodyPartofPairs[organism],Import[filepath][[1,2;;]]];
BodyPartList[organism]=Union[Flatten[BodyPartofPairs[organism]]];
BodyRules[organism]=First[#1]->{##}[[All,2]]&@@@Split[SortBy[#2->#1&@@@BodyPartofPairs[organism],First],#1[[1]]===#2[[1]]&];
SynomynList[organism]=
If[Length[{##}]>1,Union[##],Flatten[{##},1]]&@@@Split[SortBy[Select[WordConsolidator/@BodyPartList[organism],#=!={}&],#[[1]]&],#1⋂#2=!={}&];
SynomynRules[organism]=SortBy[(First[{##}]->Union[Flatten[{##}]]&@@@BodyRules[organism]),First];
TreePlot[Flatten[Thread/@BodyRules[organism]],Top,"body",EdgeRenderingFunction->({Arrowheads[.01],Arrow[#1,.001]}&)]]

CreateBodyPlan::usage="CreateBodyPlan[organism,filepath]. This takes the argument of a name for a desired taxa and a filepath to the bodypart rules of the organism. It also creates value for the following Heads:
BodyPartofPairs, BodyPartList, BodyRules, SynomynList, SynomynRules";

BodyPartofPairs::usage="List is a list of body part pairings in form {Child, Parent}";

BodyPartList::usage="A list of all body parts from both columns of BodyPartofPairs with the same argument";

BodyRules::usage="Creates rules of the form Parent->{Children}";

SynomynRules::usage="Creates a rule structure for word look up.";

we need to figure out how to define tree top. this will be done by finding  rhs with out left

Synonym creation

CreateCompleteSynonymRules[organism_,childrennotsynonyms_List]:=
Module[{wordalt1,wordalt2,selectRHS,lefthandsides,start,rulebuild},
wordalt1=Select[
#1->Flatten[List[{#1,#2}]]&@@@BodyRules["ants"]
,¬MemberQ[childrennotsynonyms,#[[1]]]&];
selectRHS=Flatten[Select[
#1->Flatten[List[{#1,#2}]]&@@@BodyRules["ants"]
,MemberQ[childrennotsynonyms,#[[1]]]&][[All,2]]];
lefthandsides=BodyRules[organism][[All,1]];
wordalt2=(#->{#})&/@Complement[selectRHS,lefthandsides];
start=Union[Flatten[{#1->{##}&@@@SynomynList["ants"],wordalt1,wordalt2}]];
rulebuild=First[#1]->Flatten[{##}[[All,2]]]&@@@Split[SortBy[start,First],#1[[1]]===#2[[1]]&];
CompleteSynonymRules[organism]=(WordBoundary~~Alternatives@@#2~~WordBoundary->#1)&@@@rulebuild]

CreateCompleteSynonymRules::usage="CreateCompleteSynonymRules[organism_]. It creates a list of synonym rules for searching and assigning traits";

CompleteSynonymRules::usage="This set is porduced before removing doublecases to the more specific body part.";

Compile abovefunctions into one big function

MasterSynonymFunction[organism_,childrennotsynonyms_List,filepath_]:=(CreateBodyPlan[organism,filepath];
CreateCompleteSynonymRules[organism,childrennotsynonyms];)

Scoring the Data

Trait scores and sort

AppendTo[$Path,
"/Users/charlesfarnum/WolframWorkspaces/Base/TreeWalkingFunctions/TreeWalkingFunctions/"];

<<TreeWalkingFunctions`

TraitTaxaRules[treedata_,treelevel_]:=Module[{step1,step2,step3},
step1=groupTraitwithTaxa[TraitTree[treedata],treelevel,#]&/@treeTips[TraitTree[treedata],treelevel];
step2=Flatten[step1,1];
step3=Split[SortBy[step2,#[[2]]&][[All,{2,1,3}]],#1[[1]]===#2[[1]]&];
(First[#][[1]]->Select[#[[All,{2,3}]],Last[#]=!=False&][[All,1]])&/@step3
]

TraitTaxaRules::usage="TraitTaxaRules[treedata,treelevel]. This scores the taxa for all traits in the tree. creates a list or rules of the form trait ->{List of taxa True or Null for Trait}";

define list for rapid look up

TaxaLookupByTraitandLevel::usage="TaxaLookupByTraitandLevel[treedata,treeLevel,#1]=#2;&@@@TraitTaxaRules[treedata,treeLevel];
We have mapped this functions across the TraitTaxaRules in order to create a more efficient look up.";

This function will allow us to map it acros all levels in a single

CreateGlobalTraitLookup[keyname_]:=Function[treelevel,TaxaLookupByTraitandLevel[keyname,treelevel,#1]=#2;&@@@TraitTaxaRules[keyname,treelevel]][#]&/@(KeyLevels[keyname]);

CreateGlobalTraitLookup::usage="CreateGlobalTraitLookup[keyname]. This creates the trait look ups for all level of the with a given key name";

Refining the search Terms

set up functions

RefineSearchTerms[organism_,keyname_,treelevel_,lowpriority_List,refinelist_List]:=Module[{lowlist,mastersort,mastersort2,mastersort3},
mastersort=#->Replace[Union[StringCases[#,CompleteSynonymRules[organism],IgnoreCase->True]],{}->{"miscellaneous"}]&/@GetTraitsFromKeyLevel[keyname,treelevel];
mastersort2=#1->If[Complement[#2,lowpriority]==={},#2,DeleteCases[#2,Alternatives@@lowpriority]]&@@@mastersort;
mastersort3=#1->If[Complement[#2,refinelist]==={},#2,DeleteCases[#2,Alternatives@@refinelist]]&@@@mastersort2;
PartstoTraits[keyname,treelevel]=First[#1]->{##}[[All,2]]&@@@Split[SortBy[Flatten[Thread/@(Reverse/@mastersort3)],First],#1[[1]]===#2[[1]]&]
]

RefineSearchTerms::usage="RefineSearchTerms[organism_,keyname_,treelevel_,lowpriority_List,refinelist_List]. This create parts a list of all refined bodypart to trait pairings.";

PartstoTraits::usage="list with the form bodypart->{list of traits},
First[#1]->List[##][[All,2]]&@@@ is the code that gets it form pairs of {bodypart, trait}";

Revision plans
We start out by pullin gup those with multiples. We create some categorizing rules based around each headings. this sort will be done after the fact.

Final function

RefineSearchTermsAllLevels[organism_,keyname_,lowpriority_List,refinelist_List]:=(
RefineSearchTerms[organism,keyname,#,lowpriority,refinelist]&/@KeyLevels[keyname]
)

RefineSearchTermsAllLevels::usage="RefineSearchTermsAllLevels[organism_,keyname_,lowpriority_List,refinelist_List]. This argument refines assignments for all levels of a given key.";

Checking for Unmatched Traits

Final function

CheckforUmatchedTraits[keyname_]:=
Module[{start},start[treelevel_]:=(treelevel->Column[Flatten@Select[PartstoTraits[keyname,treelevel],#[[1]]==="miscellaneous"&][[All,2]]]);
TableForm[start/@KeyLevels[keyname]]]

CheckforUmatchedTraits::usage="CheckforUmatchedTraits[organism_,keyname_,treelevel_]. Gives the user the traits that have not been matched to any bodypart. It allows the user to check for any traits they might have missed while creating the body plan.";

Single Import function- will probably not be used.

This will require my extension reading option before importing.

SingleImportFunction[{keyname_,keyfilepath_,fileformat_},{organism_,childrennotsynonyms_List,bodyplanfilepath_},
lowpriority_List:{},refinelist_List:{}]:=
(
KeyDataSetUp[keyname,keyfilepath,fileformat];
MasterSynonymFunction[organism,childrennotsynonyms,bodyplanfilepath];
CreateGlobalTraitLookup[keyname];

RefineSearchTermsAllLevels[organism,keyname,lowpriority,refinelist];
{TreePlot[Flatten[Thread/@BodyRules[organism]],Top,"body",EdgeRenderingFunction->({Arrowheads[.01],Arrow[#1,.001]}&)],
CheckforUmatchedTraits[keyname]}
)

SingleImportFunction[{keyname_,keyfilepath_,"ParsedKey"},{organism_,childrennotsynonyms_List,bodyplanfilepath_},lowpriority_List:{},refinelist_List:{}]:=
(
KeyDataSetUp[keyname,keyfilepath,"ParsedKey"];
MasterSynonymFunction[organism,childrennotsynonyms,bodyplanfilepath];
CreateGlobalTraitLookup[keyname];

RefineSearchTermsAllLevels[organism,keyname,lowpriority,refinelist];
{TreePlot[Flatten[Thread/@BodyRules[organism]],Top,"body",EdgeRenderingFunction->({Arrowheads[.01],Arrow[#1,.001]}&)],
CheckforUmatchedTraits[keyname]}
)

SingleImportFunction[{keyname_,keyfilepath_,"ParsedKey","Images"},{organism_,childrennotsynonyms_List,bodyplanfilepath_},lowpriority_List:{},refinelist_List:{}]:=
(
KeyDataSetUp[keyname,keyfilepath,"ParsedKey","Images"];
MasterSynonymFunction[organism,childrennotsynonyms,bodyplanfilepath];
CreateGlobalTraitLookup[keyname];

RefineSearchTermsAllLevels[organism,keyname,lowpriority,refinelist];
{TreePlot[Flatten[Thread/@BodyRules[organism]],Top,"body",EdgeRenderingFunction->({Arrowheads[.01],Arrow[#1,.001]}&)],
CheckforUmatchedTraits[keyname]}
)

SingleImportFunction[{keyname_,keyfilepath_,"TruthValueMatrix"},{organism_,childrennotsynonyms_List,bodyplanfilepath_}]:=(
KeyDataSetUp[keyname,keyfilepath,"TruthValueMatrix"];
MasterSynonymFunction[organism,childrennotsynonyms,bodyplanfilepath];
TreePlot[Flatten[Thread/@BodyRules[organism]],Top,"body",EdgeRenderingFunction->({Arrowheads[.01],Arrow[#1,.001]}&)]
)

create the big input

set up

CreateBigInput[organism_,parttotraitdata_]:=Module[{reducebodyplan,p,pr,pairsoftraitsandparts,reducedtraits,Bighierarchy,BigInput,testfunc},
reducedtraits=Select[parttotraitdata,#[[2]]=!={}&];
reducebodyplan["first"]=Select[BodyPartofPairs[organism],MemberQ[reducedtraits[[All,1]],#[[1]]]&];
testfunc[list_List]:=Module[{test={list}},
While[
(Complement[BodyPartofPairs[organism][[All,2]],BodyPartofPairs[organism][[All,1]]]⋂{Last[test][[2]]})==={},
AppendTo[test,Flatten[Select[BodyPartofPairs[organism],#[[1]]===Last[test][[2]]&],1]]];
test];
reducebodyplan["second"]=Union[Flatten[testfunc/@reducebodyplan["first"],1]];
pairsoftraitsandparts={#1,#2}&@@@(Flatten[Thread[Rule[#1,#2]]&@@@SortBy[reducedtraits,First]]);
Bighierarchy=Join[reducebodyplan["second"],pairsoftraitsandparts[[All,{2,1}]]];
p=Reap[Sow[#,#[[2]]]&/@Bighierarchy,_,#1->First/@#2&][[2]];
pr=Module[{rd},(rd[#[[1]],(#[[1]]->#[[2]])]&/@p)/.rd->RuleDelayed];
BigInput=Flatten[(Function[part,Select[p//.sl:{_String..}:>(sl/.pr),#[[1]]===part&]][#]&/@Union[Complement[BodyPartofPairs[organism][[All,2]],BodyPartofPairs[organism][[All,1]]],{"miscellaneous"}])]]

CreateBigInput::usage="CreateBigInput[bodyplan_,parttotraitdata_]
This joins the body hierarchy and part->{list of traits} in a final input to construct the matrix key. It removes parts that have no parts attached the there right hand side.";

Final function

AllTreeLevelBigInput[keyname_,organism_]:=
Set[PleaseWork[keyname,#],CreateBigInput[organism,PartstoTraits[keyname,#]]]&/@KeyLevels[keyname];

AllTreeLevelBigInput::usage="AllTreeLevelBigInput[keyname_,organism_]. This create large input for the user so that they can quickly call up keys.";

Interface function

Base interface function w/o Images

KeyInterfaceFunction[keyname_,treelevel_]:=Style[DynamicModule[{settervalues,k="x",createsection3,intersectresults,intersectionfn},
intersectionfn[{}]={};
intersectionfn[{other__}]:=Intersection[other];
settervalues[_]={};
createsection3[hd_->subheads_List]:=
OpenerView[{Style[Pane[hd,300],Bold,12,Background->LightGray],
Column[
Flatten[{createsection3/@Cases[subheads,_Rule],
If[Length[Cases[subheads,_String]]=!=0,
CheckboxBar[Dynamic[settervalues[hd]],Tooltip[EventHandler[#,"MouseClicked":>Set[k,#]],"Click here to see an Illustration of this trait"]&/@Cases[subheads,_String],Appearance->"Vertical"]]}]]}];
Grid[{{Pane[
Column[createsection3/@PleaseWork[keyname,treelevel]],350],
{Dynamic[If[intersectionfn[Append[
TaxaLookupByTraitandLevel[keyname,treelevel,
Cases[#,_String,∞][[1]]]&/@
Flatten[settervalues/@
PartstoTraits[keyname,treelevel][[All,1]],1],
KeyTaxabyLevel[keyname,treelevel]
]]==={},
"No Know Taxa Fit This Set of Traits in North America",intersectionfn[Append[
TaxaLookupByTraitandLevel[keyname,treelevel,
Cases[#,_String,∞][[1]]]&/@
Flatten[settervalues/@PartstoTraits[keyname,treelevel][[All,1]],1],
KeyTaxabyLevel[keyname,treelevel]]]]]},
Column[Button[StringJoin["Clear ",#],Set[settervalues[#],{}]]&/@PartstoTraits[keyname,treelevel][[All,1]]]
}},Alignment->Top]],FontFamily->"Verdana",10]

Dynamic interface function

need a better method of pegging the dynamic to a given key to preven crossing problems.

dynamickeyInterface[keyname_]:=
DynamicModule[{level},
Column[{PopupMenu[ Dynamic[level],KeyLevels[keyname]],
Dynamic[KeyInterfaceFunction[keyname,Dynamic[level]/._[a_]:>a]]
}]]

dynamickeyInterface[keyname_,"Manipulate"]:=
Manipulate[
KeyInterfaceFunction[keyname,level]
,{level,KeyLevels[keyname]}]

Interface with images  beta test

KeyInterfaceFunctionBeta[keyname_,treelevel_,"Images"]:=DynamicModule[{settervalues,k="x",createsection3,currentintersect,intersectionfn,columnform,c=-1,clearfunction,traitsselected={}},
intersectionfn[{}]={};
intersectionfn[{other__}]:=Intersection[other];
settervalues[_]={};
createsection3[hd_->subheads_List]:=
OpenerView[{Style[Pane[hd,300],Bold,12,Background->LightGray],
Column[Flatten[{createsection3/@Cases[subheads,_Rule],
If[Length[Cases[subheads,_String]]=!=0,
TableForm[If[Length[Cases[subheads,_String]]>6 ,
DynamicModule[{z=-3},Row[{Dynamic[CheckboxBar[Dynamic[settervalues[hd]],
TextCell[#,PageWidth->300]&/@
(Tooltip[EventHandler[#,"MouseClicked":>Set[k,#]],"Click here to see an Illustration of this trait"]&/@(Cases[subheads,_String]))[[-z-2;;-z+3]],
Appearance->"Vertical"]],
VerticalSlider[Dynamic[z],{-(Length[Cases[subheads,_String]]-4),-3,1}]}]],
{Dynamic[CheckboxBar[Dynamic[settervalues[hd]],Tooltip[EventHandler[#,"MouseClicked":>Set[k,#]],"Click here to see an Illustration of this trait"]&/@Cases[subheads,_String],Appearance->"Vertical"]]}]],{}]}]]}];
currentintersect=Dynamic[intersectionfn[Append[
TaxaLookupByTraitandLevel[keyname,treelevel,Cases[#,_String,∞][[1]]]&/@
(Flatten[settervalues/@PartstoTraits[keyname,treelevel][[All,1]],1]),
KeyTaxabyLevel[keyname,treelevel]]]];
columnform=Dynamic[Column[intersectionfn[Append[
TaxaLookupByTraitandLevel[keyname,treelevel,Cases[#,_String,∞][[1]]]&/@
(Flatten[settervalues/@PartstoTraits[keyname,treelevel][[All,1]],1]),
KeyTaxabyLevel[keyname,treelevel]]][[-c;;-c+10]]]];
clearfunction[part_]:=
Row@{
EventHandler["Clear "<>part,{"MouseClicked":>Set[settervalues[part],{}]}],
EventHandler["Show "<>part,
{"MouseClicked":>Set[traitsselected,If[settervalues[part]=!={},CheckboxBar[Dynamic[settervalues[part]],settervalues[part],Appearance->"Vertical"],{}]]}
]};

Column@{Grid[{{
Column[createsection3/@PleaseWork[keyname,treelevel]],
Column@{OpenerView[{Dynamic[ToString[Length[currentintersect/._[a_]:>a]]<>" taxa under consideration"],
Dynamic[
Row[{If[currentintersect==={},"No Taxa Fit This Set of Traits in this Key",columnform],
If[Length[currentintersect/._[a_]:>a]>10,VerticalSlider[Dynamic[c],{-(Length[currentintersect/._[a_]:>a]-10),-1,1}],{}]}]]}],
Dynamic[ImageViewingFunction[keyname,treelevel,k]],
Dynamic[traitsselected]},
DynamicModule[{a=-1},
Row@{Dynamic[
Column[
(clearfunction/@Sort[Cases[PleaseWork[keyname,treelevel],_Rule,∞][[All,1]]])[[-a;;-a+5]]]],
VerticalSlider[Dynamic[a],{-Length[(clearfunction/@Sort[Cases[PleaseWork[keyname,treelevel],_Rule,∞][[All,1]]])]+5,-1,1}]
}]
}},Alignment->Top],
OpenerView[{"Tree Structure",
Dynamic[
KeyBrowseFuncGammaTest[keyname,treelevel,"SelectedTraits",
((Cases[#,_String,∞][[1]])&/@
Flatten[(settervalues/@PartstoTraits[keyname,treelevel][[All,1]])])
]]
}]}]

Interface with images

KeyInterfaceFunction[keyname_,treelevel_,"Images"]:=DynamicModule[{settervalues,k="x",createsection3,currentintersect,intersectionfn,columnform,c=-1,clearfunction,traitsselected={}},
intersectionfn[{}]={};
intersectionfn[{other__}]:=Intersection[other];
settervalues[_]={};
createsection3[hd_->subheads_List]:=
OpenerView[{Style[Pane[hd,300],Bold,12,Background->LightGray],
Column[Flatten[{createsection3/@Cases[subheads,_Rule],
If[Length[Cases[subheads,_String]]=!=0,
TableForm[If[Length[Cases[subheads,_String]]>6 ,
DynamicModule[{z=-3},Row[{Dynamic[CheckboxBar[Dynamic[settervalues[hd]],
TextCell[#,PageWidth->300]&/@
(Tooltip[EventHandler[#,"MouseClicked":>Set[k,#]],"Click here to see an Illustration of this trait"]&/@(Cases[subheads,_String]))[[-z-2;;-z+3]],
Appearance->"Vertical"]],
VerticalSlider[Dynamic[z],{-(Length[Cases[subheads,_String]]-4),-3,1}]}]],
{Dynamic[CheckboxBar[Dynamic[settervalues[hd]],Tooltip[EventHandler[#,"MouseClicked":>Set[k,#]],"Click here to see an Illustration of this trait"]&/@Cases[subheads,_String],Appearance->"Vertical"]]}]],{}]}]]}];
currentintersect=Dynamic[intersectionfn[Append[
TaxaLookupByTraitandLevel[keyname,treelevel,Cases[#,_String,∞][[1]]]&/@
(Flatten[settervalues/@PartstoTraits[keyname,treelevel][[All,1]],1]),
KeyTaxabyLevel[keyname,treelevel]]]];
columnform=Dynamic[Column[intersectionfn[Append[
TaxaLookupByTraitandLevel[keyname,treelevel,Cases[#,_String,∞][[1]]]&/@
(Flatten[settervalues/@PartstoTraits[keyname,treelevel][[All,1]],1]),
KeyTaxabyLevel[keyname,treelevel]]][[-c;;-c+10]]]];
clearfunction[part_]:=
{EventHandler["Clear "<>part,{"MouseClicked":>Set[{settervalues[part],traitsselected},{{},{}}]}],
EventHandler["Show "<>part,
{"MouseClicked":>Set[traitsselected,If[settervalues[part]=!={},CheckboxBar[Dynamic[settervalues[part]],settervalues[part],Appearance->"Vertical"],{}]]}
]};
Column@{Grid[{{
Column[createsection3/@PleaseWork[keyname,treelevel]],
Column@{OpenerView[{Dynamic[ToString[Length[currentintersect/._[a_]:>a]]<>" taxa under consideration"],
Dynamic[
Row[{If[currentintersect==={},"No Taxa Fit This Set of Traits in this Key",columnform],
If[Length[currentintersect/._[a_]:>a]>10,VerticalSlider[Dynamic[c],{-(Length[currentintersect/._[a_]:>a]-10),-1,1}],{}]}]]}],

OpenerView[{"Images of Trait",
Dynamic[ImageViewingFunction[keyname,treelevel,k]]},True]


,
Dynamic[traitsselected]},
DynamicModule[{a=-1,b},
Dynamic[
b=clearfunction/@((Select[Cases[PleaseWork[keyname,treelevel],_Rule,∞],settervalues[#[[1]]]=!={}&][[All,1]]));
OpenerView[{"View Features with Selections",
Which[b==={},"No Traits Selected",
Length[b]<6,Grid[
Sort[clearfunction/@((Select[Cases[PleaseWork[keyname,treelevel],_Rule,∞],settervalues[#[[1]]]=!={}&][[All,1]]))]],
Length[b]≥6,
Row@{Dynamic[Grid[(b)[[-a;;-a+5]]]],
VerticalSlider[Dynamic[a],{-Length[b]+5,-1,1}]}
]},True]
]]}},Alignment->Top],
OpenerView[{"Tree Structure",
Dynamic[
KeyBrowseFuncGammaTest[keyname,treelevel,"SelectedTraits",
((Cases[#,_String,∞][[1]])&/@
Flatten[(settervalues/@PartstoTraits[keyname,treelevel][[All,1]])])
]]}]}]

Inter with images all levelsl

dynamickeyInterface[keyname_,"Images"]:=
DynamicModule[{level},
Column[{PopupMenu[ Dynamic[level],KeyLevels[keyname]],
Dynamic[KeyInterfaceFunction[keyname,Dynamic[level]/._[a_]:>a,"Images"]]
}]]

dynamickeyInterfaceManip[keyname_,"Images"]:=
Manipulate[
KeyInterfaceFunction[keyname,level,"Images"]
,{level,KeyLevels[keyname]}]

Export data for future editing

Setup

1) Get a list of the form {taxa, trait, truthvalue} for all taxa in a given key level.
2) From a list of elements of the form bodypart ->{list of traits} create a pairing of the form {{bodypart...}, trait}
3) We find all traits and append them to the list of {taxa, trait, truthvalue}  to create {taxa, trait, truthvalue, bodypart}

{KeyLevel, Taxa, trait, Truth value, bodypart}.
Getting this will require a novel import function or someform of clever option.

CreateTruthEditOutput[keyname_,treelevel_]:=Module[{traittaxascoredata,parttraitgroups,appendingfunction,forexport},
traittaxascoredata=Union@Flatten[groupTraitwithTaxa[TraitTree[keyname],treelevel,#]&/@KeyTaxabyLevel[keyname,treelevel],1];
parttraitgroups={{##}[[All,1]],{##}[[1,2]]}&@@@Split[SortBy[{#1,#2}&@@@Flatten[(Thread/@PartstoTraits[keyname,treelevel]),1],Last],#1[[2]]===#2[[2]]&];
appendingfunction[input_]:=Module[{start},start=Select[traittaxascoredata,#[[2]]===input[[2]]&];
Flatten[Table[Table[Append[start[[i]],input[[1,j]]],{j,1,Length[input[[1]]]}],
{i,1,Length[start]}],1]];
Prepend[#,treelevel]&/@Flatten[appendingfunction/@(parttraitgroups),1]
]

Final function

BigExport[keyname_]:=Module[{forexport,finalexport},
(Set[forexport[#],CreateTruthEditOutput[keyname,#]]&/@KeyLevels[keyname]);
finalexport=Join@@(forexport[#]&/@KeyLevels[keyname]);
SetDirectory[NotebookDirectory[]<>"/datafiles"];
Export[keyname<>"_TruthValuesToEdit.csv",Prepend[Union[finalexport],{"KeyLevel","Taxa","Traits","TruthValue","BodyPart"}]]
]

Export part -> trait pairs for entire key

exportPartstoTraits[keyname_,keylevel_]:={keylevel,#2,#1}&@@@(Flatten[Thread[#]&/@PartstoTraits[keyname,keylevel]])

exportPartstoTraits::usage="exportPartstoTraits[keyname_,keylevel_]. It takes data in the form part->{list of traits} to {keylevel, trait, part}";

exportPartstoTraitsAllLevels[keyname_]:=Module[{p1},
p1=Prepend[
Flatten[exportPartstoTraits[keyname,#]&/@KeyLevels[keyname],1],{"KeyLevel","Trait","BodyPary"}
];
SetDirectory[NotebookDirectory[]<>"datafiles"];
Export[keyname<>"_ParttoTrait_Export.xls",p1]
]

exportPartstoTraitsAllLevels::usage="exportPartstoTraitsAllLevels[keyname_] creates an Excel files with data in the parts {keylevel, trait, part}. It then exports this data to a file where we can edit them further.";

Re-Importing the Data

It if scores the null case. We need to explictly make thins  string as a work around.

Set Up

EditedKeySetUp::usage="EditedKeySetUp[keyname_,treelevel_], This takes the import of the key that has had its Null values edited. It creates the lookups of PartstoTraitsEdit and PartstoTraitsPairsEdit";

PartstoTraitsEdit::usage="It creates a trait look up in teh form of trait ->{all taxa scoring True or Null}";

PartstoTraitsPairsEdit::usage="Creates pairs of {bodypart, trait}.";

TraitsTaxaEdit[keyname_,treelevel_]:=Module[{start},
start=Select[EditedKey[keyname],#[[1]]===treelevel&];
(First[#][[1]]->Select[#[[All,{2,3}]],Last[#]=!=False&][[All,1]])&/@
(Split[SortBy[start
[[All,{3,2,4}]],#[[1]]&],#1[[1]]===#2[[1]]&])]

CreateKeyTaxabyLevel[keyname_,"TruthMatrix"]:=
(Function[treelevel,
Set[KeyTaxabyLevel[keyname,treelevel],Union[Select[EditedKey[keyname],#[[1]]===treelevel&][[All,2]]]]][#]&/@KeyLevels[keyname])

Final Function

EditedKeySetUp[keyname_,filepath_]:=(
Module[{extension},extension=StringJoin@
Characters[filepath][[(Last[Flatten[Position[Characters[filepath],"."]]])+1;;]];
EditedKey[keyname]=Cases[Which[extension==="xls",Import[filepath][[1,2;;]],extension==="csv",Import[filepath][[2;;]]],Except[{""...}]]
];
KeyLevels[keyname]=Union[EditedKey[keyname][[All,1]]];
CreateKeyTaxabyLevel[keyname,"TruthMatrix"];
(Function[treelevel,(TaxaLookupByTraitandLevel[keyname,treelevel,#1]=#2;&@@@
TraitsTaxaEdit[keyname,treelevel])][#]&/@KeyLevels[keyname]);
(Function[treelevel,PartstoTraits[keyname,treelevel]=First[#1]->{##}[[All,2]]&@@@Split[SortBy[Union[Select[EditedKey[keyname],#[[1]]===treelevel&][[All,{5,3}]]],First],#1[[1]]===#2[[1]]&]][#]&/@KeyLevels[keyname]);)

interface play

we want to create a good system of look up

Interface function

Original

KeyInterfaceFunctionNoImagesSecondPass[keyname_,treelevel_]:=Style[DynamicModule[{settervalues,k="x",createsection3,intersectresults,intersectionfn,valuebuttons},
intersectionfn[{}]={};
intersectionfn[{other__}]:=Intersection[other];
settervalues[_]={};
createsection3[hd_->subheads_List]:=
OpenerView[{Style[Pane[hd,300],Bold,12,Background->LightGray],
Column[
Flatten[{createsection3/@Cases[subheads,_Rule],
If[Length[Cases[subheads,_String]]=!=0,
CheckboxBar[Dynamic[settervalues[hd]],Tooltip[EventHandler[#,"MouseClicked":>Set[k,#]],"Click here to see an Illustration of this trait"]&/@Cases[subheads,_String],Appearance->"Vertical"]]}]]}];
valuebuttons[hd_->subheads_List]:=
OpenerView[{Style[Pane[hd,300],Bold,12,Background->LightGray],
Column[Flatten[
{{{Button[hd,Print["test"]],Button[hd,Print["test1"]]}},
valuebuttons/@Cases[subheads,_Rule]},1]]}];
Grid[{{Pane[
Column[createsection3/@PleaseWork[keyname,treelevel]],350],
{Dynamic[If[intersectionfn[Append[
TaxaLookupByTraitandLevelEdit[keyname,treelevel,
Cases[#,_String,∞][[1]]]&/@
Flatten[settervalues/@
PartstoTraitsPairsEdit[keyname,treelevel][[All,1]],1],
treeTips[TraitTree[keyname],treelevel]
]]==={},
"No Know Taxa Fit This Set of Traits in North America",intersectionfn[Append[
TaxaLookupByTraitandLevelEdit[keyname,treelevel,
Cases[#,_String,∞][[1]]]&/@
Flatten[settervalues/@PartstoTraitsPairsEdit[keyname,treelevel][[All,1]],1],
treeTips[TraitTree[keyname],treelevel]]]]]},
Column[Button[StringJoin["Clear ",#],Set[settervalues[#],{}]]&/@PartstoTraitsPairsEdit[keyname,treelevel][[All,1]]]
}},Alignment->Top]],FontFamily->"Verdana",10]

interface beta testing

KeyInterfaceFunctionNoImagesSecondPassBeta[keyname_,treelevel_]:=Style[DynamicModule[{settervalues,k="x",createsection3,intersectresults,intersectionfn,valuebuttons,checkedtraits={},createsection4},
intersectionfn[{}]={};
intersectionfn[{other__}]:=Intersection[other];
settervalues[_]={};

createsection3[hd_->subheads_List]:=
OpenerView[{Style[Pane[hd,300],Bold,12,Background->LightGray],
Column[
Flatten[{createsection3/@Cases[subheads,_Rule],
If[Length[Cases[subheads,_String]]=!=0,
CheckboxBar[Dynamic[settervalues[hd]],Tooltip[EventHandler[#,"MouseClicked":>Set[k,#]],"Click here to see an Illustration of this trait"]&/@Cases[subheads,_String],Appearance->"Vertical"]]}]]}];

valuebuttons[hd_->subheads_List]:=
OpenerView[{Style[Pane[hd,300],Bold,12,Background->Yellow],
Column[Flatten[
{{{Button["Clear "<>hd,settervalues[hd]={}],Button["Show Selected "<>hd,checkedtraits=settervalues[hd]]}},
valuebuttons/@Cases[subheads,_Rule]},1]]}];
Grid[{{Pane[
Column[createsection3/@PleaseWork[keyname,treelevel]],350],
Column@{Dynamic[If[intersectionfn[Append[
TaxaLookupByTraitandLevelEdit[keyname,treelevel,
Cases[#,_String,∞][[1]]]&/@
Flatten[settervalues/@
PartstoTraitsPairsEdit[keyname,treelevel][[All,1]],1],
treeTips[TraitTree[keyname],treelevel]
]]==={},
"No Known Taxa Fit This Set of Traits in North America",intersectionfn[Append[
TaxaLookupByTraitandLevelEdit[keyname,treelevel,
Cases[#,_String,∞][[1]]]&/@
Flatten[settervalues/@PartstoTraitsPairsEdit[keyname,treelevel][[All,1]],1],
treeTips[TraitTree[keyname],treelevel]]]]],
CheckboxBar[Dynamic[checkedtraits],Dynamic[checkedtraits]]
},
Column[valuebuttons/@PleaseWork[keyname,treelevel]]
}},Alignment->Top]],FontFamily->"Verdana",10]

We need an ability to create a set of look ups

Interface for single input function