context('Copy data to clipboard')
source('common.R')
test_that('detect.type',
{
expect_identical(detect.type('' ), list(name='', type=NULL, value=NULL, supported=F))
expect_identical(detect.type(NULL), list(name=NULL, type=NULL, value=NULL, supported=F))
expect_identical(detect.type(NA ), list(name=NA, type=NULL, value=NULL, supported=F))
expect_identical(detect.type(5 ), list(name=5, type=NULL, value=NULL, supported=F))
# detect.type look for variable in the global environment
name <- 'vec'
assign(name, 1:10, envir=.GlobalEnv)
actual <- detect.type(name)
expected <- list(name=name, type='vector', value=get0(name, envir=.GlobalEnv), supported=T)
rm(vec, envir=.GlobalEnv)
expect_identical(actual, expected)
assign(name, letters[1:5], envir=.GlobalEnv)
actual <- detect.type(name)
expected <- list(name=name, type='vector', value=get0(name, envir=.GlobalEnv), supported=T)
rm(vec, envir=.GlobalEnv)
expect_identical(actual, expected)
assign('vec', matrix(1:10, nrow=2), envir=.GlobalEnv)
actual <- detect.type(name)
expected <- list(name=name, type='matrix', value=get0(name, envir=.GlobalEnv), supported=T)
rm(vec, envir=.GlobalEnv)
expect_identical(actual, expected)
assign('vec', data.frame(1:10), envir=.GlobalEnv)
actual <- detect.type(name)
expected <- list(name=name, type='data.frame', value=get0(name, envir=.GlobalEnv), supported=T)
rm(vec, envir=.GlobalEnv)
expect_identical(actual, expected)
assign('vec', array(1:10), envir=.GlobalEnv)
actual <- detect.type(name)
expected <- list(name=name, type='array', value=get0(name, envir=.GlobalEnv), supported=T)
rm(vec, envir=.GlobalEnv)
expect_identical(actual, expected)
assign('vec', table(rpois(100, 5)), envir=.GlobalEnv)
actual <- detect.type(name)
expected <- list(name=name, type='table', value=get0(name, envir=.GlobalEnv), supported=T)
rm(vec, envir=.GlobalEnv)
expect_identical(actual, expected)
})
test_that('get.tsv',
{
# vector
expect_identical( get.tsv(list(type='vector', value=1:3))
, '1\t2\t3')
# matrix
expect_identical( get.tsv(list(type='matrix', value=matrix(1:12, nrow=3, byrow=T)))
, '1\t2\t3\t4\n5\t6\t7\t8\n9\t10\t11\t12')
# data frame
expect_identical( get.tsv(list(type='data.frame', value=data.frame(a=1:3, b=letters[10:12], c=seq(as.Date('2004-01-01'), by='week', len=3), stringsAsFactors=T)))
, 'a\tb\tc\n1\tj\t2004-01-01\n2\tk\t2004-01-08\n3\tl\t2004-01-15')
# array
expect_identical(get.tsv(list(type='array', value=array(1:12, dim=c(3, 4), dimnames=list(x=c('a', 'b', 'c'), y=c('k', 'l', 'm', 'm')))))
, 'x\\y\tk\tl\tm\tm\na\t1\t4\t7\t10\nb\t2\t5\t8\t11\nc\t3\t6\t9\t12')
# table
set.seed(42)
expect_identical(get.tsv(list(type='table', value=table(rpois(100, 5))))
, '0\t1\t2\t3\t4\t5\t6\t7\t8\t9\t10\t11\n3\t4\t5\t14\t14\t15\t20\t8\t6\t6\t4\t1')
})
test_that('get.tsv.vector',
{
expect_identical(get.tsv.vector(), '')
vec <- 1:3
expect_identical(get.tsv.vector(list(value=vec)), '1\t2\t3')
names(vec) <- letters[1:3]
expect_identical(get.tsv.vector(list(value=vec)), 'a\tb\tc\n1\t2\t3')
vec <- c(vec, 4)
expect_identical(get.tsv.vector(list(value=vec)), 'a\tb\tc\t\n1\t2\t3\t4')
vec <- c(vec, NA)
expect_identical(get.tsv.vector(list(value=vec)), 'a\tb\tc\t\t\n1\t2\t3\t4\tNA')
})
test_that('get.tsv.matrix',
{
expect_identical(get.tsv.matrix(), '')
mat <- matrix(1:12, nrow=3, byrow=T)
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), '1\t2\t3\t4\n5\t6\t7\t8\n9\t10\t11\t12')
dimnames(mat) <- list(letters[1:3])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), 'a\t1\t2\t3\t4\nb\t5\t6\t7\t8\nc\t9\t10\t11\t12')
dimnames(mat) <- list(let=letters[1:3])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), 'a\t1\t2\t3\t4\nb\t5\t6\t7\t8\nc\t9\t10\t11\t12')
dimnames(mat) <- list(NULL, month.abb[1:4])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), 'Jan\tFeb\tMar\tApr\n1\t2\t3\t4\n5\t6\t7\t8\n9\t10\t11\t12')
dimnames(mat) <- list(NULL, months=month.abb[1:4])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), 'Jan\tFeb\tMar\tApr\n1\t2\t3\t4\n5\t6\t7\t8\n9\t10\t11\t12')
dimnames(mat) <- list(letters[1:3], month.abb[1:4])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), 'mat\tJan\tFeb\tMar\tApr\na\t1\t2\t3\t4\nb\t5\t6\t7\t8\nc\t9\t10\t11\t12')
dimnames(mat) <- list(let=letters[1:3], month.abb[1:4])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), 'let\\\tJan\tFeb\tMar\tApr\na\t1\t2\t3\t4\nb\t5\t6\t7\t8\nc\t9\t10\t11\t12')
dimnames(mat) <- list(letters[1:3], months=month.abb[1:4])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), '\\months\tJan\tFeb\tMar\tApr\na\t1\t2\t3\t4\nb\t5\t6\t7\t8\nc\t9\t10\t11\t12')
dimnames(mat) <- list(let=letters[1:3], months=month.abb[1:4])
expect_identical(get.tsv.matrix(list(name='mat', value=mat)), 'let\\months\tJan\tFeb\tMar\tApr\na\t1\t2\t3\t4\nb\t5\t6\t7\t8\nc\t9\t10\t11\t12')
})
test_that('get.tsv.data.frame',
{
expect_identical(get.tsv.data.frame(), '')
df <- data.frame( a=1:3
, b=letters[10:12]
, c=seq(as.Date('2004-01-01'), by='week', len=3)
, stringsAsFactors=T)
expect_identical(get.tsv.data.frame(list(name='df', value=df)), 'a\tb\tc\n1\tj\t2004-01-01\n2\tk\t2004-01-08\n3\tl\t2004-01-15')
row.names(df) <- c('first', 'second', 'third')
expect_identical(get.tsv.data.frame(list(name='df', value=df)), 'df\ta\tb\tc\nfirst\t1\tj\t2004-01-01\nsecond\t2\tk\t2004-01-08\nthird\t3\tl\t2004-01-15')
})
test_that('get.tsv.array',
{
expect_identical(get.tsv.array(), '')
arr <- array(1:3)
expect_identical(get.tsv.array(list(name='arr', value=arr)), '1\t2\t3')
dimnames(arr) <- list(x=c('a', 'b', 'c'))
expect_identical(get.tsv.array(list(name='arr', value=arr)), 'a\tb\tc\n1\t2\t3')
arr <- array(1:12, dim=c(3, 4))
expect_identical(get.tsv.array(list(name='arr', value=arr)), '1\t4\t7\t10\n2\t5\t8\t11\n3\t6\t9\t12')
arr <- array(1:12, dim=c(3, 4), dimnames=list(x=c('a', 'b', 'c'), y=c('k', 'l', 'm', 'n')))
expect_identical(get.tsv.array(list(name='arr', value=arr)), 'x\\y\tk\tl\tm\tn\na\t1\t4\t7\t10\nb\t2\t5\t8\t11\nc\t3\t6\t9\t12')
# array with dimension names - one of them is missing
arr <- array(1:24, dim=c(3, 4, 2), dimnames=list(x=c('a', 'b', 'c'), c('k', 'l', 'm', 'n'), z=c('x', 'y')))
expect_identical(get.tsv.array(list(name='arr', value=arr)), 'x\t\tz\tarr\na\tk\tx\t 1\nb\tk\tx\t 2\nc\tk\tx\t 3\na\tl\tx\t 4\nb\tl\tx\t 5\nc\tl\tx\t 6\na\tm\tx\t 7\nb\tm\tx\t 8\nc\tm\tx\t 9\na\tn\tx\t10\nb\tn\tx\t11\nc\tn\tx\t12\na\tk\ty\t13\nb\tk\ty\t14\nc\tk\ty\t15\na\tl\ty\t16\nb\tl\ty\t17\nc\tl\ty\t18\na\tm\ty\t19\nb\tm\ty\t20\nc\tm\ty\t21\na\tn\ty\t22\nb\tn\ty\t23\nc\tn\ty\t24')
# array with no dimension names
arr <- array(1:24, dim=c(3, 4, 2), dimnames=list(c('a', 'b', 'c'), c('k', 'l', 'm', 'n'), c('x', 'y')))
expect_identical(get.tsv.array(list(name='arr', value=arr)), 'a\tk\tx\t 1\nb\tk\tx\t 2\nc\tk\tx\t 3\na\tl\tx\t 4\nb\tl\tx\t 5\nc\tl\tx\t 6\na\tm\tx\t 7\nb\tm\tx\t 8\nc\tm\tx\t 9\na\tn\tx\t10\nb\tn\tx\t11\nc\tn\tx\t12\na\tk\ty\t13\nb\tk\ty\t14\nc\tk\ty\t15\na\tl\ty\t16\nb\tl\ty\t17\nc\tl\ty\t18\na\tm\ty\t19\nb\tm\ty\t20\nc\tm\ty\t21\na\tn\ty\t22\nb\tn\ty\t23\nc\tn\ty\t24')
# array with no names at all
arr <- array(1:24, dim=c(3, 4, 2))
expect_identical(get.tsv.array(list(name='arr', value=arr)), 'A\tA\tA\t 1\nB\tA\tA\t 2\nC\tA\tA\t 3\nA\tB\tA\t 4\nB\tB\tA\t 5\nC\tB\tA\t 6\nA\tC\tA\t 7\nB\tC\tA\t 8\nC\tC\tA\t 9\nA\tD\tA\t10\nB\tD\tA\t11\nC\tD\tA\t12\nA\tA\tB\t13\nB\tA\tB\t14\nC\tA\tB\t15\nA\tB\tB\t16\nB\tB\tB\t17\nC\tB\tB\t18\nA\tC\tB\t19\nB\tC\tB\t20\nC\tC\tB\t21\nA\tD\tB\t22\nB\tD\tB\t23\nC\tD\tB\t24')
})
test_that('get.tsv.table',
{
expect_identical(get.tsv.table(), '')
# 1D table -> to vector
set.seed(42)
expect_identical(get.tsv.table(list(type='table', value=table(rpois(100, 5))))
, '0\t1\t2\t3\t4\t5\t6\t7\t8\t9\t10\t11\n3\t4\t5\t14\t14\t15\t20\t8\t6\t6\t4\t1')
# 2D table -> to matrix
tab <- table(state.division, state.region)
expect_identical( get.tsv.table(list(type='table', value=tab))
, 'state.division\\state.region\tNortheast\tSouth\tNorth Central\tWest\nNew England\t6\t0\t0\t0\nMiddle Atlantic\t3\t0\t0\t0\nSouth Atlantic\t0\t8\t0\t0\nEast South Central\t0\t4\t0\t0\nWest South Central\t0\t4\t0\t0\nEast North Central\t0\t0\t5\t0\nWest North Central\t0\t0\t7\t0\nMountain\t0\t0\t0\t8\nPacific\t0\t0\t0\t5')
# 3D table -> to matrix
tab <- table(datasets::airquality$Month[1:5], datasets::airquality$Day[1:5], datasets::airquality$Temp[1:5])
expect_identical( get.tsv.table(list(name='tab', type='table', value=tab))
, '5\t1\t56\t0\n5\t2\t56\t0\n5\t3\t56\t0\n5\t4\t56\t0\n5\t5\t56\t1\n5\t1\t62\t0\n5\t2\t62\t0\n5\t3\t62\t0\n5\t4\t62\t1\n5\t5\t62\t0\n5\t1\t67\t1\n5\t2\t67\t0\n5\t3\t67\t0\n5\t4\t67\t0\n5\t5\t67\t0\n5\t1\t72\t0\n5\t2\t72\t1\n5\t3\t72\t0\n5\t4\t72\t0\n5\t5\t72\t0\n5\t1\t74\t0\n5\t2\t74\t0\n5\t3\t74\t1\n5\t4\t74\t0\n5\t5\t74\t0')
tab <- table(datasets::airquality$Month[1:5], datasets::airquality$Day[1:5], datasets::airquality$Temp[1:5])
names(dimnames(tab)) <- c('m', 'd', 't')
expect_identical( get.tsv.table(list(name='tab', type='table', value=tab))
, 'm\td\tt\ttab\n5\t1\t56\t0\n5\t2\t56\t0\n5\t3\t56\t0\n5\t4\t56\t0\n5\t5\t56\t1\n5\t1\t62\t0\n5\t2\t62\t0\n5\t3\t62\t0\n5\t4\t62\t1\n5\t5\t62\t0\n5\t1\t67\t1\n5\t2\t67\t0\n5\t3\t67\t0\n5\t4\t67\t0\n5\t5\t67\t0\n5\t1\t72\t0\n5\t2\t72\t1\n5\t3\t72\t0\n5\t4\t72\t0\n5\t5\t72\t0\n5\t1\t74\t0\n5\t2\t74\t0\n5\t3\t74\t1\n5\t4\t74\t0\n5\t5\t74\t0')
})
test_that('copy.to.clipboard',
{
expect_false(copy.to.clipboard(NULL))
# skip when clipboard is not supported
skip_on_os(c('mac', 'linux', 'solaris'))
# skip when it's not RStudio or it's of a version that doesn't support addins
skip_if_not(rstudioapi::isAvailable(REQUIRED.RSTUDIO.VERSION), 'RStudio is not available!')
tsv <- '1\t2\t3\t'
expect_true(copy.to.clipboard(tsv))
expect_identical(getClipboardFormats(T)[1], 1L)
expect_identical(readClipboard(1), tsv)
})
test_that('get.error.message',
{
expect_identical(get.error.message(list(type=NULL)), 'Nothing was copied to the clipboard - variable does not exist.')
expect_identical(get.error.message(list(type='vector')), 'Nothing was copied to the clipboard - variable type is not supported.')
# skip when clipboard is not supported
skip_on_os(c('mac', 'linux', 'solaris'))
# skip when it's not RStudio or it's of a version that doesn't support addins
skip_if_not(rstudioapi::isAvailable(REQUIRED.RSTUDIO.VERSION), 'RStudio is not available!')
tsv <- '1\t2\t3\t'
expect_true(copy.to.clipboard(tsv))
expect_identical(getClipboardFormats(T)[1], 1L)
expect_identical(readClipboard(1), tsv)
})
test_that('adjust.selection',
{
load('.foobar.Rdata')
#' @title Generate tests
place.in.word <- function(expected, info)
{
# first char
context <- my.setCursorPosition(top.context, c(row=expected$row, column=expected$start))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': cursor at the first character'))
# last char
context <- my.setCursorPosition(top.context, c(row=expected$row, column=expected$end))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': cursor after the last character'))
# in the middle
if (nchar(expected$text) > 1) {
context <- my.setCursorPosition(top.context, c(row=expected$row, column=expected$start + 1))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': cursor in the middle of the word'))
}
# subselection
if (nchar(expected$text) > 2) {
context <- my.setSelectionRange(top.context, c( expected$row, expected$start + 1
, expected$row, expected$end - 1))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': selection inside the word'))
}
# selection from the start of the word till the end of line
context <- my.setSelectionRange(top.context, c( expected$row, expected$start
, expected$row, Inf))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': selection from the start of the word till the end of line'))
# selection from the start of the word till the end of file
context <- my.setSelectionRange(top.context, c( expected$row, expected$start
, Inf, Inf ))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': selection from the start of the word till the end of file'))
if (nchar(expected$text) > 1) {
# selection from middle of the word till the end of line
context <- my.setSelectionRange(top.context, c( expected$row, expected$start + 1
, expected$row, Inf))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': selection from the middle of the word till the end of line'))
# selection from the middle of the word till the end of file
context <- my.setSelectionRange(top.context, c( expected$row, expected$start + 1
, Inf, Inf))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': selection from the middle of the word till the end of file'))
}
# selection from the end of the word till the end of line
context <- my.setSelectionRange(top.context, c( expected$row, expected$end
, expected$row, Inf))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': selection from the end of the word till the end of line'))
# selection from the end of the word till the end of file
context <- my.setSelectionRange(top.context, c( expected$row, expected$end
, Inf, Inf))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, paste0(info, ': selection from the end of the word till the end of file'))
}
# value is a line number of the line: '# dummy method'
test.first.line <- 1
# long word at the beginning of the line
place.in.word(list(row=test.first.line + 1, start=1, end=8, text='.foobar'), 'long word at the beginning of the line')
# long word in the middle of the line
place.in.word(list(row=test.first.line + 1, start=12, end=20, text='function'), 'long word in the middle of the line')
# long word at the end of the line
place.in.word(list(row=test.first.line, start=9, end=15, text='method'), 'long word at the end of the line')
# short word at the beginning of the line
place.in.word(list(row=test.first.line + 3, start=1, end=2, text='a'), 'short word at the beginning of the line')
# short word in the middle of the line
place.in.word(list(row=test.first.line + 6, start=27, end=28, text='a'), 'short word in the middle of the line')
# short word at the end of the line
place.in.word(list(row=test.first.line + 11, start=5, end=6, text='a'), 'short word at the end of the line')
# some non-automated examples
# multiline selection before the short word
expected <- list(row=test.first.line + 3, start=1, end=2, text='a')
context <- my.setSelectionRange(top.context, c( test.first.line + 1, 32
, expected$row, expected$start))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, 'multiline selection before the short word')
# multiline selection before the longer word
expected <- list(row=test.first.line + 5, start=5, end=7, text='if')
context <- my.setSelectionRange(top.context, c( test.first.line + 4, 1
, expected$row, expected$start))
expect_identical( adjust.selection(context)[['text']], expected[['text']]
, 'multiline selection before the short word')
})
test_that('is.namelegal',
{
line <- 'abc_012.ABC!@#$%^&*()'
for (pos in 1:11)
{
expect_true(is.namelegal(line, pos))
}
for (pos in 12:nchar(line))
{
expect_false(is.namelegal(line, pos))
}
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.