tests/testthat/test4_eventcursors.R

context("cursors and eventcursors complete cylce")

tree<-get_treeinfo(system.file("extdata/2014-07-22_CHO hERG.dat", package = "ephys2"))
ser<-getSeries(tree,1,1,1)
ser2<-getSeries(tree,1,1,7)


test_that("we can use normal cursors as eventcursors", {
  
  set_cursor("hERG", "eventcur",curMax_,c(3,3.2),path=make_path(ser2, 1)) #now valid only for ser2
  expect_error(
    set_cursor("hERG", "eventcur",curMax_,c(1,1.2),path=make_path(ser, 1)), 
    "cannot set cursor: an eventcursor with this name already exisits for a different trace"
  )
  set_cursor("hERG", "eventcur",curMax_,c(3,3.5)) #will not make this cursor "global"
  expect_true ( "eventcur" %in% names(CURSORS$hERG$cursors))
  expect_false ( "eventcur" %in% names(series_events(CURSORS$hERG$cursors,ser$sweeps)))
  expect_true ( "eventcur" %in% names(series_events(CURSORS$hERG$cursors,ser2$sweeps)))
  expect_true ( "eventcur" %in% names(series_events(CURSORS$hERG$cursors,ser2$sweeps)))
  expect_false( "eventcur" %in% names( ser$results()  ) )
  expect_true ( "eventcur" %in% names( ser2$results() ) )
  })

set_cursor("hERG", "event.nummer3",curMax_,c(3,3.72),path=make_path(ser2, 1))
expect_error(
  set_cursor("hERG", "event.nummer3",curMax_,c(3,3.82),path=make_path(ser2, 2)) 
)

rm(CURSORS, envir = globalenv())
set_cursor("hERG", curname = "lateTail", curMax_, c(0,0.1))
set_cursor("hERG", curname = "df", curMax_, c(0,0.1))
set_cursor("hERG", curname = "leak", curMean_, c(0,0.1))
set_cursor("hERG", curname = "peak", curMax_, c(0,0.1))

# set eventcursors with auto naming of cursors
#set_cursor("hERG", "event.",curMax_,c(3,3.2),path=make_path(ser, 1), event=T) 
set_cursor(ser, "event.",curMax_,c(3,3.2),swp=1, event=T) 
set_cursor(ser2, "event.",curMax_,c(3,3.4),swp=1, event=T) 
set_eventcursor(ser2,1,"event.2",curMax_,c(3,3.5)) 
set_eventcursor(ser2,swp=1, "event.", curMax_,c(3,3.62)) # event.3

expect_equal(names(get_eventcursors("hERG")), c("event.1", "event.2","event.3"))

# more tests on how auto names are generated
expect_equal(next_id("hERG", "event"), "event.4")
expect_equal(next_id("hERG", "vent") , "vent.1" )
expect_equal(next_id("hERG", "even"), "even.1" )
expect_equal(next_id("hERG", "eventcur"), "eventcur.1" )

get_all(tree, "hERG")->all
expect_true ("leak" %in% names(all))
expect_true ("leak.x1" %in% names(all))
expect_true ("event.1" %in% names(all))
expect_true ("event.1.x" %in% names(all))


# two eventcursors and one global cursor 
ec<-get_eventcursors("hERG")
ec1<-ec[[1]]
ec2<-ec[[2]]
gc<-CURSORS$hERG$cursors$peak

# example selection (like it occurs during "shotree")
attr(tree[[c(1,1,1,1,1)]], "stselected")<-T  # select node
sel<-shinyTree::get_selected(tree)[[1]]
attr(tree[[c(1,1,1,1,1)]], "stselected")<-F  # restore original tree 

# test filtering of cursor list according to selection
# for the following tests we must use the path stored in the selected node. 
# therefore we transform: 
sel<-get_path(tree, sel)
# now we can test: 
expect_true(    is_cursor_in_selection(  gc,sel)      )
expect_true(    is_cursor_in_selection(  gc,sel[1:2]) )
expect_true(    is_cursor_in_selection(  ec1,sel)     ) 
expect_true(    is_cursor_in_selection(  ec1,sel[1:5]))
expect_true(   !is_cursor_in_selection(  ec1,sel[1:2]))
expect_true(   !is_cursor_in_selection(  ec1,sel[1:3]))
expect_true(   !is_cursor_in_selection(  ec1,sel[1:4]))
expect_true(   !is_cursor_in_selection(  ec2,sel[1:5]))
expect_true(   !is_cursor_in_selection(  ec2,sel[1:3]))
rm(sel) 

#how we make new eventcurosrs in shiny showtree:
attr(tree[[c(1,1,1,1,1)]], "stselected")<-T  # select node
path<-make_path_from_selection(tree, shinyTree::get_selected(tree)[[1]])
path2<-make_path(ser,1) #the way we did it historically, and we do it furtther up here
expect_equal(path,path2)

attr(tree[[c(1,1,1,1,1)]], "stselected")<-F

# how we get the cursorlist when plotting:
# in plot_Ana: series_events(anaDef$cursors,sweep_data)
series_events(CURSORS$hERG$cursors, ser$sweeps) %>% names() -> cursors_ser
series_events(CURSORS$hERG$cursors, ser2$sweeps) %>% names() ->cursors_ser2

#how we get the cursorlist for radiobuttons:
attr(tree[[c(1,1,1,1,1)]], "stselected")<-T  # select node
curnames<-get_curnames(tree, shinyTree::get_selected(tree)[[1]])
attr(tree[[c(1,1,1,1,1)]], "stselected")<-F
expect_equal(curnames, cursors_ser) 

attr(tree[[c(1,1,7,1,1)]], "stselected")<-T
curnames<-get_curnames(tree, shinyTree::get_selected(tree)[[1]])
attr(tree[[c(1,1,7,1,1)]], "stselected")<-F
expect_equal(curnames,  cursors_ser2 )
expect_equal(curnames, c("lateTail", "df",       "leak",     "peak","event.2" , "event.3")) 


attr(tree[[c(1,1,7)]], "stselected")<-T
curnames<-get_curnames(tree, shinyTree::get_selected(tree)[[1]])
attr(tree[[c(1,1,7)]], "stselected")<-F
expect_equal(curnames, c("lateTail", "df",       "leak",     "peak")) 

# for a selected series with eventcursors, 
# the radiobuttonlist is shorter than the number of cursors in the plot
# the eventcursor radiobuttons are not shown if the series is selected rather than the sweep 
expect_gt(length(cursors_ser2), length(curnames))

#two internal methods to tweak resultnames
get_eventresultname(c("event.1232341.x", "event.1", "event.nummer3", "event.nummer3.x"))
get_eventbasename("event.1")

# calculate a single eventcursor, renaming the method basename into "result"
calculate_eventcursor(tree, ec1)

get_eventresults(tree,"hERG")

test_that("multiple sweeps in a series are handled correctly",{
  rm(CURSORS, envir=globalenv())
  tree2<-get_treeinfo(system.file("extdata/VG_Blocker.dat", package = "ephys2"))
  s1<-getSeries(tree2,1,1,4)
  s1_t2<-getSeries(tree2,1,1,4, trace = 2)
  expect_true(nrow(s1$results())==12)
  set_cursor(s1,curname = "ev",method_ = curMin_,range = c(0.01,0.015))
  
  
  sel=c(1,1,4,3,1)
  attr(tree2[[sel]],"stselected")<-T
  set_cursor(s1,curname = "ev2.",method_ = curMin_,range = c(0.016,0.017), event=T, 
             path=make_path_from_selection(tree2, shinyTree::get_selected(tree2)[[1]]))
  attr(tree2[[sel]],"stselected")<-F

  CURSORS$NaIV$cursors$ev2.1$path
  
  res<-s1$results()  
  #only the selected sweep of the eventcursor has a result:
  expect_true(is.na(res[2,"ev2.1"]))
  expect_false(is.na(res[3,"ev2.1"]))
  expect_true(is.na(res[4,"ev2.1"]))
  
  # ev1. fehlt weil es eine anderer trace ist
  res2<-s1_t2$results()  
  expect_false("ev2.1" %in% names(res2))

  #test_that("eventcursors are only shown if their sweep is selected",{
  expect_true("ev2.1" %in% names(series_events(CURSORS$NaIV$cursors,s1$sweeps)))
  expect_true("ev2.1" %in% names(series_events(CURSORS$NaIV$cursors,s1$sweeps,swp="s3:")))
  expect_false("ev2.1" %in% names(series_events(CURSORS$NaIV$cursors,s1$sweeps,swp="s4:")))
})
tdanker/ephys2 documentation built on Aug. 11, 2019, 12:12 p.m.