Tool to scan PubMed abstracts quickly.

PubmedExplorer.elm

import Html exposing (Html, Attribute, text, toElement, fromElement, div, input, textarea)
import Html.Attributes exposing (..)
import Html.Events exposing (on, targetValue, onClick, onDoubleClick)
import Signal exposing (Address)
import StartApp.Simple as StartApp
import String
import Graphics.Element exposing (spacer, color, show)
import Color exposing (..)
import Dict exposing (Dict)
import Maybe exposing (withDefault)
import Result exposing (toMaybe)
import Array exposing (Array)

main =
  StartApp.start { model = initialModel, view = view, update = update }

type alias Model =
  { inputData: String
  , pmids: List Int
  , activePmid: Int
  , selectedPmids: List Int
  , titles: Dict Int String
  , abstracts: Dict Int String
  , positiveKeywords: List String
  , negativeKeywords: List String
  , articles: List Article
  }
  
initialModel =
  { inputData = ""
  , pmids = [1..5]
  , activePmid = 1
  , selectedPmids = [1, 3]
  , titles =
      Dict.fromList
        [ (1, "This is where the titles will appear, once you've pasted in your data.")
        , (2, "There are four inputs to the side.")
        , (3, "Input your data in the first box, search keywords in the second, exclusion keywords in the third, and copy the url from the last when you're done with everything.")
        , (4, "Double-click a title to add it to the output list.")
        , (5, "Single-click a title to show its abstract.")
        ]
  , abstracts = dummyAbstracts
  , positiveKeywords = []
  , negativeKeywords = []
  , articles = [{ pmid = 0
                , title = ""
                , abstract = ""
                }]
  }
  
  
type Action
  = Select Int
  | ToggleSelection Int
  | SetInput String
  | SetPositiveKeywords String
  | SetNegativeKeywords String
     
     
update: Action -> Model -> Model
update action model =
  case action of
    Select pmid ->
      { model | activePmid = pmid}
    
    ToggleSelection pmid ->
      { model | selectedPmids = (toggle pmid model.selectedPmids) }
    
    SetInput string ->
      if string == ""
        then 
          initialModel
        else 
          updateArticleData model string
      
    SetPositiveKeywords string ->
      { model | positiveKeywords = String.split "\n" string }
      
    SetNegativeKeywords string ->
      { model | negativeKeywords = String.split "\n" string }


updateArticleData: Model -> String -> Model
updateArticleData model string = 
  let articles = parseArticles string
      pmids = List.map (\article -> article.pmid) articles
      titles = List.map (\article -> (article.pmid, article.title)) articles |> Dict.fromList
      abstracts = List.map (\article -> (article.pmid, article.abstract)) articles |> Dict.fromList
  in
    if articles == []
      then 
        initialModel
      else
        { model
        | inputData = string
        , pmids = pmids
        , titles = titles
        , abstracts = abstracts
        , activePmid = List.head pmids |> withDefault 0
        , selectedPmids = []
        , articles = articles
        }



-- If xi is present in xs, get rid of it. If absent, add it.
toggle: a -> List a -> List a
toggle xi xs =
  if List.member xi xs
    then List.filter (\x -> x /= xi) xs
    else xi :: xs

{--
view : Address Action -> Model -> Html
view address model =
  div [ pageStyle ]
    [ upperPanel address model
    --, show model.activePmid |> fromElement
    , abstractPanel address model
    ]
--}

view : Address Action -> Model -> Html
view address model =
  div [ pageStyle ]
    [ abstractPanel address model
    , titlePanel address model
    , inputPanel address model
    ]



{-- Upper Panel --}

upperPanel: Address Action -> Model -> Html
upperPanel address model =
  div [ upperPanelStyle ]
    [ titlePanel address model
    , inputPanel address model
    ]

inputPanel: Address Action -> Model -> Html
inputPanel address model =
  div [ inputPanelStyle ]
    [ myInput address model
    , positiveKeywordInput address model
    , negativeKeywordInput address model
    , myOutput address model
    ]
    
    
myInput: Address Action -> Model -> Html
myInput address model =
  textarea
    [ placeholder "Paste data here"
    , value model.inputData
    , on "input" targetValue (\x -> Signal.message address (SetInput x))
    , myStyle
    ]
    []    

myOutput: Address Action -> Model -> Html
myOutput address model =
  input
    [ placeholder "Output"
    , value (toString model.selectedPmids)
    , myStyle
    ]
    []

positiveKeywords = ["This", "is", "a", "list", "of", "positive", "keywords"]

positiveKeywordInput: Address Action -> Model -> Html
positiveKeywordInput address model =
  textarea
    [ value (String.join "\n" model.positiveKeywords)
    , on "input" targetValue (\x -> Signal.message address (SetPositiveKeywords x))
    , positiveKeywordsInputStyle
    ]
    []
    
negativeKeywords = ["This", "is", "a", "list", "of", "negative", "keywords"]

negativeKeywordInput: Address Action -> Model -> Html
negativeKeywordInput address model =
  textarea
    [ value (String.join "\n" model.negativeKeywords)
    , on "input" targetValue (\x -> Signal.message address (SetNegativeKeywords x))
    , negativeKeywordsInputStyle
    ]
    []
    
titlePanel address model =
  let inSelection = List.map (\pmid -> List.member pmid model.selectedPmids) model.pmids
      titles = List.map (\pmid -> Dict.get pmid model.titles |> withDefault "") model.pmids
      active = List.map (\pmid -> pmid == model.activePmid) model.pmids
  in

  div [ titlePanelStyle ]
    [ div []
        (List.map4 (makeTitle address)
          model.pmids
          titles
          inSelection
          active
          )
    ]

makeTitle address pmid title inSelection active =
  let styleIf bool prop val = if bool then (prop, val) else ("","")
      titleStyle' =
        style
          [ ("box-sizing", "border-box")
          , ("background", "white")
          , ("padding", "5px")
          --, ("border-bottom", "black solid 1px")
          , ("border-left", String.concat ["lightblue solid ", String.length title |> (\x -> x // 10) |> toString, "px"])
          , ("margin-bottom", "2px")
          , styleIf inSelection "background" "rgba(87,187,232,0.1)"
          , styleIf active "font-weight" "bold"
          ]
  in
    div
      [ titleStyle'
      , onClick address (Select pmid)
      , onDoubleClick address (ToggleSelection pmid)]
      [ text title ]

{-- Lower Panel --}

abstractPanel address model =
  div [ abstractPanelStyle ]
    [ div []
        []--[ text (Dict.get model.activePmid model.titles |> withDefault "") ]
    , text (Dict.get model.activePmid model.abstracts |> withDefault "")
  {--  , show (model.inputData |> String.left 100 |> String.split "\n") |> fromElement
    , show (model.positiveKeywords) |> fromElement
    , show model.pmids  |> fromElement
    , show model.articles |> fromElement
    , show 
      ( model.inputData 
        |> String.split "\n"
        |> List.map parseField
        ) |> fromElement
    , model.inputData
      |> parseArticle
      |> show
      |> fromElement
        --}
    ]


{-- Styles --}

myStyle : Attribute
myStyle =
  style
    [ ("width", "100%")
    , ("height", "8%")
    , ("padding", "5px 5px")
    , ("border", "none")
    , ("box-sizing", "border-box")
    , ("overflow", "hidden")
    ]
    
pageStyle =
  style
    [ ("top", "0px")
    , ("bottom", "0px")
    , ("position", "absolute")
    , ("background", "white")
    , ("box-sizing", "border-box")
    , ("padding", "5px")
    ]
    
positiveKeywordsInputStyle =
  style
    [ ("background", "rgba(170,255,138,0.3)")
    , ("width", "100%")
    , ("height", "42%")
    , ("overflow-y", "scroll")
    , ("box-sizing", "border-box")
    , ("border", "none")
    , ("display", "block")
    , ("padding", "5px 5px")
    ]
    
negativeKeywordsInputStyle =
  style
    [ ("background", "rgba(255,86,76,0.1)")
    , ("width", "100%")
    , ("height", "42%")
    , ("overflow-y", "scroll")
    , ("box-sizing", "border-box")
    , ("border", "none")
    , ("display", "block")
    , ("padding", "5px 5px")
    ]
    
upperPanelStyle =
  style
    [ ("background", "white")
    , ("width", "100%")
    , ("height", "50%")
    , ("box-sizing", "border-box")
    , ("border-bottom", "black solid 1px")
    , ("box-sizing", "border-box")
    , ("padding", "10px 10px")
    ]
    
abstractPanelStyle =
  style
    [ ("background", "white")
    , ("width", "40%")
    , ("height", "100%")
    , ("padding", "10px 10px")
    , ("box-sizing", "border-box")
    , ("overflow-y", "scroll")
    , ("float", "left")
    ]
    
inputPanelStyle =
  style
    [ ("background", "white")
    , ("width", "20%")
    , ("height", "100%")
    , ("opacity", "0.5")
    , ("padding-left", "10px")
    , ("box-sizing", "border-box")
    , ("float", "left")
    ]
    
titlePanelStyle =
  style
    [ ("background", "white")
    , ("width", "40%")
    , ("height", "100%")
    , ("float", "left")
    , ("padding", "5px 5px")
    , ("box-sizing", "border-box")
    , ("overflow-y", "scroll")
    , ("float", "left")
    ]
    
titleStyle =
  style
    [ ("box-sizing", "border-box")
    , ("background", "white")
    , ("padding", "5px")
    , ("border-bottom", "black solid 1px")
    ]
    
{-- Helper Functions --}
zip = List.map2 (,)
    
{-- Dummy Data --}

dummyAbstracts =
  Dict.fromList <| zip [1,2,3,4,5] <| ["Abstract # 1", "Abstract # 2","Abstract # 3","Abstract # 4","Abstract # 5"]
  
{-- Medline Parser --}

type alias Article =
  { pmid: Int
  , title: String
  , abstract: String
  }

parseArticles: String -> List Article
parseArticles string =
  string
--  |> String.split "\r\n\r\n"
  |> String.split "\n\n"
  |> List.map parseArticle
  |> dropNothings
  
  
dropNothings: List (Maybe a) -> List a  
dropNothings list = 
  List.concatMap 
    (\item -> 
        case item of
          Just value -> [value]
          Nothing -> []
    )
    list
  
parseArticle: String -> Maybe Article
parseArticle string =
  string
--  |> String.split "\r\n"
  |> String.split "\n"
  |> partitionBy partFunc
  |> List.map (List.map String.trim)
  |> List.filter ((/=) [""])
  |> List.map (String.join " " >> parseField)
  |> Dict.fromList
  |> \d ->
        { pmid =
            Dict.get "PMID" d
            |> withDefault "0"
            |> String.toInt
            |> toMaybe
            |> withDefault 0
        
        , title =
            Dict.get "TI" d
            |> withDefault ""
            -- |> String.right 10
        
        , abstract =
            Dict.get "AB" d
            |> withDefault ""
            -- |> String.right 10
        }
  |> \d -> 
        if d.abstract == ""
          then Nothing
          else Just d
        

parseField: String -> (String, String)
parseField string =
  splitAtFirstHyphen string
  
splitAtFirstHyphen string =
  let xs = String.split "-" string
  in
    ( List.head xs |> withDefault ""
        |> String.trim
    
    , String.join "-" (List.tail xs |> withDefault [])
        |> String.trim
    )
  
  

-- Adds to old partition while true,
--  and creates new partition when false
partFunc a b =
  let aStartsWithLetter = not (String.startsWith " " a)
      bStartsWithLetter = not (String.startsWith " " b)
      newPartition = False
      oldPartition = True
  in case (aStartsWithLetter, bStartsWithLetter) of
    (True, True) -> newPartition
    (True, False) -> oldPartition
    (False, True) -> newPartition
    (False, False) -> oldPartition



--data = ""



nestArray2: a -> Array (Array a)
nestArray2 x =
  Array.fromList
    [ Array.fromList
        [x]
    ]
    
partitionBy: (a -> a -> Bool) -> List a -> List (List a)
partitionBy f list =
  case list of
    [] ->
      []
    (h::t) ->
      List.foldl
        (partitionHelper f)
        (nestArray2 h, h)
        t
      |> fst
      |> Array.toList
      |> List.map Array.toList
      
      
partitionHelper: (a -> a -> Bool) -> a -> (Array (Array a), a) -> (Array (Array a), a)
partitionHelper f value (arrays, prior) =
    if f prior value
      then (appendToLastSubarray value arrays, value)
      else (Array.push (Array.fromList [ value ]) arrays, value)
      

appendToLastSubarray: a -> Array (Array a) -> Array (Array a)
appendToLastSubarray value arrays =
  let (firstArrays, lastArray') = splitPop arrays
      lastArray = lastArray' |> Maybe.withDefault Array.empty
  in
    Array.push (Array.push value lastArray) firstArrays
  

splitPop: Array a -> (Array a, Maybe a)
splitPop array =
  let last = Array.length array - 1
  in
    ( Array.slice 0 -1 array
    , Array.get last array
    )