Using the Tk table widget in R Tcltk

Using the Tk table widget in R Tcltk

James Wettenhall & Philippe Grosjean bio photo By James Wettenhall & Philippe Grosjean

A short example

The TkTable widget is a very sophisticated spreadsheet-like widget which can display tables or allow the user to enter data in a tabular format. To use it, you must make sure to have the Tktable package installed in Tcl. Firstly, a short example using a tclArray().

library(tcltk2)

# A simple matrix in R
mat1 <- matrix(c("Name", "James Wettenhall", "R-Help",
  "Email", "wettenhall@wehi.edu.au", "R-Help@stat.math.ethz.ch"),
  ncol = 2)

# Data must be transferred one item at a time to the tclArray object
# Also note that Tcl indexes start from 0, while they start from 1 in R
# and that without the strsplit() hack, strings with spaces are displayed
# as {string wuth spaces} in Tk Table
tclTable <- tclArray()
for (i in 1:nrow(mat1))
  for (j in 1:ncol(mat1))
    tclTable[[i-1, j-1]] <- strsplit(mat1[i, j], " ", fixed = TRUE)[[1]]

# Create a window to display this table
win1 <- tktoplevel()
win1$env$table1 <- tk2table(win1, variable = tclTable, rows = 3, cols = 2,
  titlerows = 1, selectmode = "extended", colwidth = 25, background = "white")
tkpack(win1$env$table1, fill = "both", expand = TRUE)

Running the R code above gives the following window:

a Tk table

A more sophisticated example

The next example demonstrates the use of another S3 object that we build to interface Tcl arrays. A tclArrayVar object is created using a function based on Peter Dalgaard’s tclVar() function. An edit() method is defined as well as some subscripting operators. Before showing the code for the tclArrayVar object and methods, we will give an example of their use.

# Define a matrix
mat2 <- matrix(1:2000, nrow = 50, ncol = 40,
  dimnames = list(paste("Row", 1:50), paste("Col", 1:40)))

# Define a tclArrayVar and initialize it to that matrix
tclArr2 <- tclArrayVar(mat2)

# Display the Tcl array in a Tk table widget (using edit method).
# The Tcl name of the array variable is displayed in the title bar.
edit(tclArr2)

# Display the Tcl array, showing only 10 rows and 10 columns
edit(tclArr2, height = 10, width = 5)

edited matrix

# Change the value of one of the elements in tclArrayVar
tclArr2[2, 2] <- 999999

edited matrix with change value

# Check the value of one of the elements in tclArrayVar
tclArr2[2, 2]
## [1] "999999"

tclArr2[5]
## Error in "[.tclArrayVar"(tclArr2, 5) :
##     Object is not a one-dimensional tclArrayVar

For one-dimensional arrays (vectors):

# Define a vector
vec1 <- 1:100

# Define a tclArrayVar object and initialize it to that vector
tclArr3 <- tclArrayVar(vec1)

# Display the tclArrayVar object, showing only 10 rows
edit(tclArr3, height = 10)

edited vector

# Check the value of one of the elements in the tclArrayVar object
tclArr3[5]
## [1] "5"
tclArr3[2, 3]
##Error in "[.tclArrayVar"(tclArr3, 2, 3) :
##        Object is not a two-dimensional tclArrayVar

Using a tclArrayVar object with data frames:

# Define a data frame
df1 <- data.frame(names = c("foo", "bar"), ages = c(20, 30))
tclArr4  <- tclArrayVar(df1)
edit(tclArr4)

edited data frame

Code for the tclArrayVar object

tclArrayVar <- function(x = NULL) {
  # Check argument
  if (!is.null(x) && !is.vector(x) && length(dim(x))!= 2)
    stop("Array must be one-dimensional or two-dimensional, or NULL.")
  
  library(tcltk2)
  
  # Create the Tcl variable and the R Tcl object
  n <- .TkRoot$env$TclVarCount <- .TkRoot$env$TclVarCount + 1
  name <- paste0("::RTcl", n)
  l <- list(env = new.env(), nrow = 0, ncol = 0, ndim = 0)
  assign(name, NULL, envir = l$env)
  reg.finalizer(l$env, function(env) tkcmd("unset", ls(env)))
  class(l) <- "tclArrayVar"
  
  # A NULL array
  if (is.null(x)) {
    .Tcl(paste0("set ", name, "(0,0) \"\""))
    l$nrow <- 0
    l$ncol <- 0
    l$ndim <- 2
    return(l)
  }
  
  # A vector, matrix, or data frame
  if (is.vector(x)) {
    ndim <- 1
    x <- as.data.frame(x)
  } else ndim <- 2
  
  # Populate the Tcl array
  for (i in (1:nrow(x)))
    for (j in (1:ncol(x)))
      .Tcl(paste0("set ", name, "(", i, ",", j,") \"", x[i, j], "\""))
  
  # Process dim names
  if (nrow(x)) {
    if (is.null(rownames(x)))
      rownames(x) <- rep("", nrow(x))
    for (i in 1:nrow(x))
      .Tcl(paste0("set ", name, "(", i, ",", 0, ") \"", 
        rownames(x)[i], "\""))
  } 
  
  if (ncol(x)) {
    if (is.null(colnames(x)))
      colnames(x) <- rep("", ncol(x))
    for (j in 1:ncol(x))
      .Tcl(paste0("set ", name, "(", 0, ",", j, ") \"", 
        colnames(x)[j], "\""))
  }
  
  l$nrow <- nrow(x)
  l$ncol <- ncol(x)
  l$ndim <- ndim
  l
}

# edit() generic function is defined in the utils package
edit.tclArrayVar <- function(name, height = 20, width = 10) {
  library(tcltk2)
    
  win <- tktoplevel()
  
  tclArrayName <- ls(name$env)
  tkwm.title(win, tclArrayName)
  
  table <- tk2table(win,
    rows = name$nrow + 1, cols = name$ncol + 1,
    titlerows = 1, titlecols = 1,
    maxwidth = 1000, maxheight = 1000,
    drawmode = "fast",
    height = height + 1, width = width + 1,
    xscrollcommand = function(...) tkset(xscr, ...),
    yscrollcommand = function(...) tkset(yscr,...))
  xscr <-tk2scrollbar(win, orient = "horizontal",
    command = function(...) tkxview(table, ...))
  yscr <- tk2scrollbar(win, orient = "vertical",
    command = function(...) tkyview(table, ...))

  tkgrid(table, yscr)
  tkgrid.configure(yscr, sticky = "nsw")
  tkgrid(xscr, sticky = "new")
  tkgrid.rowconfigure(win, 0, weight = 1)
  tkgrid.columnconfigure(win, 0, weight = 1)
  tkconfigure(table, variable = tclArrayName,
    background = "white", selectmode = "extended")
}

`[.tclArrayVar` <- function(object, i, j = NULL) {
  library(tcltk2)
  
  if (is.null(j) && object$ndim != 1)
    stop("Object is not a one-dimensional tclArrayVar")
  if (!is.null(j) && object$ndim != 2)
    stop("Object is not a two-dimensional tclArrayVar")
  
  if (object$ndim == 1) j <- 1
  tclArrayName <- ls(object$env)
  tclvalue(paste0(tclArrayName, "(", i, ",", j, ")"))
}

`[<-.tclArrayVar` <- function(object, i, j = NULL, value) {
  library(tcltk2)
  
  if (is.null(j) && object$ndim != 1)
    stop("Object is not a one-dimensional tclArrayVar")
  if (!is.null(j) && object$ndim != 2)
    stop("Object is not a two-dimensional tclArrayVar")
  
  if (object$ndim == 1) j <- 1
  tclArrayName <- ls(object$env)
  .Tcl(paste0("set ", tclArrayName, "(", i, ",", j, ") ", value))
  if (i > object$nrow) object$nrow <- i
  object
}

Additional notes

Copying to external spreadsheet programs

To allow copying from a table widget and pasting into a spreadsheet program such as Excel, use:

tkconfigure(table1, selectmode = "extended",
  rowseparator = "\"\n\"", colseparator = "\"\t\"")

To control whether rows and/or columns can be resized, use:

tkconfigure(table1, resizeborders = "none")    # OR
tkconfigure(table1, resizeborders = "both")    # OR
tkconfigure(table1, resizeborders = "row")     # OR
tkconfigure(table1, resizeborders = "col")

Line-wrapping within cells

To prevent line-wrapping within cells, use:

tkconfigure(table1, multiline = FALSE)

Adding/inserting rows and columns

To add a row at the end of the table, use:

tkinsert(table1, "rows", "end", 1)

To add a column at the end of the table, use:

tkinsert(table1, "cols", "end", 1)

To insert a row before the current row, use:

tkinsert(table1, "rows", tclvalue(tkindex(table1, "active", "row")), -1)

(The negative sign means insert before the current row, not after).

To insert a columnm before the current column, use:

tkinsert(table1, "cols", tclvalue(tkindex(table1, "active", "col")), -1)

Deleting rows and columns

To delete a row at the end of the table, use:

tkdelete(table1, "rows", "end", 1)

To delete a column at the end of the table, use:

tkdelete(table1, "cols", "end", 1)

To delete the current row, use:

tkdelete(table1, "rows", tclvalue(tkindex(table1, "active", "row")), 1)

To delete the current columnm, use:

tkdelete(table1, "cols", tclvalue(tkindex(table1, "active", "col")), 1)