Skip to content

Commit

Permalink
Add ontology accession number as tag in ref columns (Issue #100).
Browse files Browse the repository at this point in the history
  • Loading branch information
@Freymaurer
Freymaurer committed Feb 10, 2021
1 parent 51928c0 commit 4bf33cb
Show file tree
Hide file tree
Showing 15 changed files with 343 additions and 104 deletions.
17 changes: 9 additions & 8 deletions src/Client/CustomComponents/AutocompleteSearch.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,10 +91,10 @@ with

AdvancedSearchLinkText = "Can't find the unit you are looking for?"
OnInputChangeMsg = (fun str -> SearchUnitTermTextChange (str, Unit1) |> AddBuildingBlock)
OnSuggestionSelect = (fun sugg -> (sugg.Name, Unit1) |> UnitTermSuggestionUsed |> AddBuildingBlock)
OnSuggestionSelect = (fun sugg -> (sugg, Unit1) |> UnitTermSuggestionUsed |> AddBuildingBlock)

HasAdvancedSearch = true
OnAdvancedSearch = (fun sugg -> (sugg.Name, Unit1) |> UnitTermSuggestionUsed |> AddBuildingBlock)
OnAdvancedSearch = (fun sugg -> (sugg, Unit1) |> UnitTermSuggestionUsed |> AddBuildingBlock)
}

static member ofAddBuildingBlockUnit2State (state:AddBuildingBlockState) : AutocompleteParameters<DbDomain.Term> = {
Expand All @@ -109,10 +109,10 @@ with

AdvancedSearchLinkText = "Can't find the unit you are looking for?"
OnInputChangeMsg = (fun str -> SearchUnitTermTextChange (str,Unit2) |> AddBuildingBlock)
OnSuggestionSelect = (fun sugg -> (sugg.Name, Unit2) |> UnitTermSuggestionUsed |> AddBuildingBlock)
OnSuggestionSelect = (fun sugg -> (sugg, Unit2) |> UnitTermSuggestionUsed |> AddBuildingBlock)

HasAdvancedSearch = true
OnAdvancedSearch = (fun sugg -> (sugg.Name, Unit2) |> UnitTermSuggestionUsed |> AddBuildingBlock)
OnAdvancedSearch = (fun sugg -> (sugg, Unit2) |> UnitTermSuggestionUsed |> AddBuildingBlock)
}

static member ofAddBuildingBlockState (state:AddBuildingBlockState) : AutocompleteParameters<DbDomain.Term> = {
Expand All @@ -126,12 +126,11 @@ with
DropDownIsLoading = state.HasBuildingBlockTermSuggestionsLoading

OnInputChangeMsg = (BuildingBlockNameChange >> AddBuildingBlock)
OnSuggestionSelect = (fun sugg -> sugg.Name |> BuildingBlockNameSuggestionUsed |> AddBuildingBlock)
OnSuggestionSelect = (fun sugg -> sugg |> BuildingBlockNameSuggestionUsed |> AddBuildingBlock)

HasAdvancedSearch = true
AdvancedSearchLinkText = "Cant find the Term you are looking for?"
OnAdvancedSearch = (fun sugg -> sugg.Name |> BuildingBlockNameSuggestionUsed |> AddBuildingBlock
)
OnAdvancedSearch = (fun sugg -> sugg |> BuildingBlockNameSuggestionUsed |> AddBuildingBlock)
}


Expand Down Expand Up @@ -284,7 +283,9 @@ let autocompleteTermSearchComponentOfParentOntology
match inputSize with
| Some size -> Button.Size size
| _ -> ()
] [str (sprintf "%A" model.TermSearchState.ParentOntology.Value)]
] [str (
sprintf "%A" (if model.TermSearchState.ParentOntology.IsSome then model.TermSearchState.ParentOntology.Value.Name else "")
)]
]

Control.div [Control.IsExpanded] [
Expand Down
21 changes: 15 additions & 6 deletions src/Client/Messages.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,8 @@ type ExcelInteropMsg =
| SyncContext of activeAnnotationTable:TryFindAnnoTableResult*string
| InSync of string
| FillSelection of activeAnnotationTable:TryFindAnnoTableResult * string * (DbDomain.Term option)
| AddAnnotationBlock of activeAnnotationTable:TryFindAnnoTableResult * colname:string * format:string option
| AddUnitToAnnotationBlock of tryFindActiveAnnotationTable:TryFindAnnoTableResult * format:string option
| AddAnnotationBlock of activeAnnotationTable:TryFindAnnoTableResult * colname:string * colTermOpt:DbDomain.Term option * unitNameOpt:string option * unitTermOpt:DbDomain.Term option
| AddUnitToAnnotationBlock of tryFindActiveAnnotationTable:TryFindAnnoTableResult * format:string option * unitTermOpt:DbDomain.Term option
| FormatColumn of activeAnnotationTable:TryFindAnnoTableResult * colname:string * formatString:string * prevmsg:string
/// This message does not need the active annotation table as `PipeCreateAnnotationTableInfo` checks if any annotationtables exist in the active worksheet, and if so, errors.
| CreateAnnotationTable of allTableNames:string [] * isDark:bool
Expand Down Expand Up @@ -76,7 +76,7 @@ type DevMsg =
type ApiRequestMsg =
| TestOntologyInsert of (string*string*string*System.DateTime*string)
| GetNewTermSuggestions of string
| GetNewTermSuggestionsByParentTerm of string*string
| GetNewTermSuggestionsByParentTerm of string*OntologyInfo
| GetNewBuildingBlockNameSuggestions of string
| GetNewUnitTermSuggestions of string*relatedUnitSearch:UnitSearchRequest
| GetNewAdvancedTermSearchResults of AdvancedTermSearchOptions
Expand Down Expand Up @@ -122,11 +122,11 @@ type AddBuildingBlockMsg =
| BuildingBlockNameChange of string
| ToggleSelectionDropdown

| BuildingBlockNameSuggestionUsed of string
| BuildingBlockNameSuggestionUsed of DbDomain.Term
| NewBuildingBlockNameSuggestions of DbDomain.Term []

| SearchUnitTermTextChange of searchString:string * relatedUnitSearch:UnitSearchRequest
| UnitTermSuggestionUsed of unitName:string * relatedUnitSearch:UnitSearchRequest
| UnitTermSuggestionUsed of unitTerm:DbDomain.Term* relatedUnitSearch:UnitSearchRequest
| NewUnitTermSuggestions of DbDomain.Term [] * relatedUnitSearch:UnitSearchRequest
| ToggleBuildingBlockHasUnit

Expand Down Expand Up @@ -190,5 +190,14 @@ let pipeNameTuple3 msg param =
let constructParam =
param |> fun (x,y,z) -> annotationTableOpt,x,y,z
msg (constructParam)
|> PipeActiveAnnotationTable
)

/// This function is used to easily pipe a message into `PipeActiveAnnotationTable`. This is designed for a message with (x1,x2,x3,x4) other params.
/// Use this as: (x1,x2,x3) |> pipeNameTuple4 msg
let pipeNameTuple4 msg param =
PipeActiveAnnotationTable
(fun annotationTableOpt ->
let constructParam =
param |> fun (x,y,z,u) -> annotationTableOpt,x,y,z,u
msg (constructParam)
)
25 changes: 15 additions & 10 deletions src/Client/Model.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ type TermSearchState = {
TermSearchText : string
SelectedTerm : DbDomain.Term option
TermSuggestions : DbDomain.Term []
ParentOntology : string option
ParentOntology : OntologyInfo option
SearchByParentOntology : bool
HasSuggestionsLoading : bool
ShowSuggestions : bool
Expand Down Expand Up @@ -294,6 +294,7 @@ type AnnotationBuildingBlock = {
type AddBuildingBlockState = {
CurrentBuildingBlock : AnnotationBuildingBlock

BuildingBlockSelectedTerm : DbDomain.Term option
BuildingBlockNameSuggestions : DbDomain.Term []
ShowBuildingBlockSelection : bool
BuildingBlockHasUnit : bool
Expand All @@ -302,38 +303,42 @@ type AddBuildingBlockState = {

/// This section is used to add a unit directly to a freshly created building block.
UnitTermSearchText : string
UnitSelectedTerm : DbDomain.Term option
UnitTermSuggestions : DbDomain.Term []
HasUnitTermSuggestionsLoading : bool
ShowUnitTermSuggestions : bool

/// This section is used to add a unit directly to an already existing building block
Unit2TermSearchText : string
Unit2TermSuggestions : DbDomain.Term []
HasUnit2TermSuggestionsLoading : bool
ShowUnit2TermSuggestions : bool
Unit2TermSearchText : string
Unit2SelectedTerm : DbDomain.Term option
Unit2TermSuggestions : DbDomain.Term []
HasUnit2TermSuggestionsLoading : bool
ShowUnit2TermSuggestions : bool

} with
static member init () = {
ShowBuildingBlockSelection = false

CurrentBuildingBlock = AnnotationBuildingBlock.init AnnotationBuildingBlockType.Parameter

BuildingBlockSelectedTerm = None
BuildingBlockNameSuggestions = [||]
ShowBuildingBlockTermSuggestions = false
HasBuildingBlockTermSuggestionsLoading = false
BuildingBlockHasUnit = false

/// This section is used to add a unit directly to a freshly created building block.
UnitTermSearchText = ""
UnitSelectedTerm = None
UnitTermSuggestions = [||]
ShowUnitTermSuggestions = false
HasUnitTermSuggestionsLoading = false

/// This section is used to add a unit directly to an already existing building block
Unit2TermSearchText = ""
Unit2TermSuggestions = [||]
ShowUnit2TermSuggestions = false
HasUnit2TermSuggestionsLoading = false
Unit2TermSearchText = ""
Unit2SelectedTerm = None
Unit2TermSuggestions = [||]
ShowUnit2TermSuggestions = false
HasUnit2TermSuggestionsLoading = false
}

/// Validation scheme for Table
Expand Down
62 changes: 52 additions & 10 deletions src/Client/OfficeInterop/HelperFunctions.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ open System.Text.RegularExpressions
open OfficeInterop.Regex
open OfficeInterop.Types
open BuildingBlockTypes
open Shared


let createEmptyMatrixForTables (colCount:int) (rowCount:int) value =
Expand All @@ -23,14 +24,19 @@ let createEmptyMatrixForTables (colCount:int) (rowCount:int) value =
/// This will create the column header attributes for a unit block.
/// as unit always has to be a term and cannot be for example "Source" or "Sample", both of which have a differen format than for exmaple "Parameter [TermName]",
/// we only need one function to generate id and attributes and bring the unit term in the right format.
let unitColAttributes (unitTermName:string) (id:int) =
let unitColAttributes (unitTermName:string) (unitTermOpt:DbDomain.Term option) (id:int) =
match id with
| 1 ->
sprintf "[%s] (#h; #u)" unitTermName
match unitTermOpt with
| Some t -> sprintf "[%s] (#h; #t%s; #u)" unitTermName t.Accession
| None -> sprintf "[%s] (#h; #u)" unitTermName
| _ ->
sprintf "[%s] (#%i; #h; #u)" unitTermName id
match unitTermOpt with
| Some t -> sprintf "[%s] (#%i; #h; #t%s #u)" unitTermName id t.Accession
| None -> sprintf "[%s] (#%i; #h; #u)" unitTermName id

let createUnitColumns (allColHeaders:string []) (annotationTable:Table) newBaseColIndex rowCount (format:string option) =

let createUnitColumns (allColHeaders:string []) (annotationTable:Table) newBaseColIndex rowCount (format:string option) (unitTermOpt:DbDomain.Term option) =
let col = createEmptyMatrixForTables 1 rowCount ""
if format.IsSome then
let findNewIdForUnit() =
Expand All @@ -40,7 +46,7 @@ let createUnitColumns (allColHeaders:string []) (annotationTable:Table) newBaseC
// Should a column with the same name already exist, then count up the id tag.
|> Array.exists (fun existingHeader ->
// We don't need to check TSR or TAN, because the main column always starts with "Unit"
existingHeader = sprintf "Unit %s" (unitColAttributes format.Value int)
existingHeader = sprintf "Unit %s" (unitColAttributes format.Value unitTermOpt int)
)
if isExisting then
loopingCheck (int+1)
Expand All @@ -55,23 +61,23 @@ let createUnitColumns (allColHeaders:string []) (annotationTable:Table) newBaseC
annotationTable.columns.add(
index = newBaseColIndex+3.,
values = U4.Case1 col,
name = sprintf "Unit %s" (unitColAttributes format.Value newUnitId)
name = sprintf "Unit %s" (unitColAttributes format.Value unitTermOpt newUnitId)
)

/// create unit TSR
let createdUnitCol2 =
annotationTable.columns.add(
index = newBaseColIndex+4.,
values = U4.Case1 col,
name = sprintf "Term Source REF %s" (unitColAttributes format.Value newUnitId)
name = sprintf "Term Source REF %s" (unitColAttributes format.Value unitTermOpt newUnitId)
)

/// create unit TAN
let createdUnitCol3 =
annotationTable.columns.add(
index = newBaseColIndex+5.,
values = U4.Case1 col,
name = sprintf "Term Accession Number %s" (unitColAttributes format.Value newUnitId)
name = sprintf "Term Accession Number %s" (unitColAttributes format.Value unitTermOpt newUnitId)
)

Some (
Expand Down Expand Up @@ -229,7 +235,7 @@ module BuildingBlockTypes =
// Build in fail safe.
errorMsg2 nextCol currentBlock

// Building blocks are defined by one visuable column and an undefined number of hidden columns.
// Building blocks are defined by one visable column and an undefined number of hidden columns.
// Therefore we iterate through the columns array and use every column without an `#h` tag as the start of a new building block.
let rec sortColsIntoBuildingBlocks (index:int) (currentBlock:BuildingBlock option) (buildingBlockList:BuildingBlock list) =
// Exit case if we iterated through all columns
Expand Down Expand Up @@ -282,11 +288,47 @@ module BuildingBlockTypes =
failwith (sprintf "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' was not recognized as hidden or main column: %A." nextCol.Header)

/// Sort all columns into building blocks.
let buildingBlocks =
let buildingBlocksPre =
sortColsIntoBuildingBlocks 0 None []
|> List.rev
|> Array.ofList

// UPDATE IN > 0.2.0
/// As we now add the TermAccession as "#txxx" tag in the reference columns we walk over all buildingBlock and update the maincolumn header accordingly.
let buildingBlocks =
buildingBlocksPre
|> Array.map (fun buildingBlock ->
match buildingBlock.TAN, buildingBlock.TSR with
| Some tan, Some tsr ->
match tan.Header.Value.Ontology, tsr.Header.Value.Ontology with
| Some ont1, Some ont2 ->
let isSame = ont1.TermAccession = ont2.TermAccession
if isSame |> not then
failwith (sprintf "During BuildingBlock update with TermAccession found BuildingBlock (%s) with unknow TAN TSR pattern. (3)" buildingBlock.MainColumn.Header.Value.Header)
if ont1.TermAccession <> "" then
let nextMainColumn = {
buildingBlock.MainColumn with
Header = {
buildingBlock.MainColumn.Header.Value with
Ontology = {
buildingBlock.MainColumn.Header.Value.Ontology.Value with
TermAccession = ont1.TermAccession
} |> Some
} |> Some
}
{ buildingBlock with MainColumn = nextMainColumn }
else
buildingBlock
| None, None ->
buildingBlock
| _,_ ->
failwith (sprintf "During BuildingBlock update with TermAccession found BuildingBlock (%s) with unknow TAN TSR pattern. (2)" buildingBlock.MainColumn.Header.Value.Header)
| None, None ->
buildingBlock
| _, _ ->
failwith (sprintf "During BuildingBlock update with TermAccession found BuildingBlock (%s) with unknow TAN TSR pattern." buildingBlock.MainColumn.Header.Value.Header)
)

buildingBlocks

open System
Expand Down
Loading

0 comments on commit 4bf33cb

Please sign in to comment.