Nothing
# Dialog for reading in tables
#
# Options dialog menu
dfedit.options <- function(...){}
dfedit.options.dialog <- list(
title = "Options", label = "Options for Data Frame Editor",
dfedit.column.width.integerItem = c(value=64, from=20, to=256), label = "Column Width",
dfedit.rownames.width.integerItem = c(value=64, from=20, to=256), label = "Row Names Column Width",
dfedit.copy.col.names.trueFalseItem = FALSE, label = "Copy Column Names",
dfedit.copy.row.names.trueFalseItem = FALSE, label = "Copy Row Names",
dfedit.paste.col.names.trueFalseItem = FALSE, label = "Paste Column Names",
dfedit.paste.row.names.trueFalseItem = FALSE, label = "Paste Row Names"
)
read_in_table <- function(handler=NULL, user.data=NULL, parent.window=NULL){
## read table dialog
dialog <- gtkDialog("Open Table", NULL, c("destroy-with-parent"), "gtk-ok", 1, "gtk-cancel", 0, show = F)
dialog$setPosition(GtkWindowPosition["center-on-parent"])
dialog$setTransientFor(parent.window)
#dialog$setDecorated(FALSE)
box0 <- gtkVBoxNew(FALSE, 5)
fr1 <- gtkFrameNew(label="Choose File")
box1 <- gtkHBoxNew(FALSE, 5)
entry1 <- gtkEntryNew()
label1 <- gtkLabelNew("Lines To Preview:")
entry1$setAlignment(0)
button1 <- gtkButtonNewWithLabel("Select File...")
box1$packStart(entry1, TRUE, TRUE, 0)
box1$packStart(button1, FALSE, FALSE, 0)
gSignalConnect(button1, "clicked", data=entry1, function(obj, label){
tryCatch({
f <- my_choose_files(file.path(getwd(), "*.*"), multi=F)
if(nchar(f) > 0){
setwd(dirname(f))
# modify settings
ext <- strsplit(f, "[.]")[[1]]
ext <- ext[length(ext)]
if(ext == "csv"){
sep1$setActive(2)
} else if (ext == "txt") {
sep1$setActive(3)
} else if (ext == "prn") {
sep1$setActive(1)
} else {
sep1$setActive(0)
}
entry1$setText(f)
preview.txt <- paste(readLines(con = f, n = nlines1$getValue()), collapse="\n")
tb$getBuffer()$setText(preview.txt)
}
}, error = function(e){print(e)})
})
nlines1_adj <- gtkAdjustment(5, 1, 1000, 1, 1)
nlines1 <- gtkSpinButton(nlines1_adj, 1.0, 0)
nlines1$setValue(5)
box1$packEnd(nlines1, FALSE, FALSE, 0)
box1$packEnd(label1, FALSE, FALSE, 0)
fr1$add(box1)
box1 <- gtkHBoxNew(FALSE, 5)
fr0 <- gtkFrameNew(label="File Preview")
scroll <- gtkScrolledWindowNew()
scroll$setPolicy(GtkPolicyType["automatic"], GtkPolicyType["automatic"])
tb <- gtkTextViewNew()
tb$setEditable(FALSE)
tb$setSizeRequest(400, 100)
scroll$add(tb)
fr0$add(scroll)
tb$getBuffer()$setText("No File Loaded")
fr2 <- gtkFrameNew(label="Table Read Options")
box2 <- gtkVBoxNew(FALSE, 5)
sep.types = list("Whitespace" = "", "Space (\" \")" = " ", "Comma (\",\")" = ",", "Tab (\"\t\")" = "\t", "Semicolon (\";\")" = ";")
sep1 <- gtkComboBoxNewText()
for (ll in names(sep.types)) sep1$appendText(ll)
if (.Options$dec[[1]] == ".") sep1$setActive(2)
else sep1$setActive(4)
hbox <- gtkHBoxNew(FALSE, 0)
hbox$add(gtkLabelNew("File Separator Type"))
hbox$add(sep1)
# box2$packStart(hbox, FALSE, FALSE, 0)
dec1 <- gtkComboBoxNewText()
dec1$setSizeRequest(50, -1)
for (ll in c(".", ",")) dec1$appendText(ll)
if (.Options$dec[[1]] == ".") dec1$setActive(0)
else dec1$setActive(1)
# hbox <- gtkHBoxNew(FALSE, 0)
hbox$add(gtkLabelNew("Decimal Point"))
hbox$add(dec1)
box2$packStart(hbox, FALSE, FALSE, 0)
opt.box <- gtkHBoxNew(FALSE, 0)
opt.box1 <- gtkVBoxNew(FALSE, 0)
opt.box2 <- gtkVBoxNew(FALSE, 0)
opt.box$add(opt.box1)
#opt.box$add(opt.box2)
box2$add(opt.box)
opt.table <- gtkTableNew(4, 2, homogeneous=FALSE)
opt.table$setRowSpacings(5)
opt.box$packEnd(opt.table, TRUE, TRUE, 5)
row.names0 <- gtkCheckButtonNewWithLabel(label="File Contains Row Labels")
# row.names0$setActive(TRUE)
opt.box1$packStart(row.names0, FALSE, FALSE, 0)
header1 <- gtkCheckButtonNewWithLabel(label="File Contains Header Row")
header1$setActive(TRUE)
opt.box1$packStart(header1, FALSE, FALSE, 0)
# Stolen from Peter Dalgaard
ASCII <- c("Any White Space", sapply(1:255, function(i) parse(text=paste("\"\\",
structure(i,class="octmode"), "\"", sep=""))[[1]]))
row.names1 <- gtkSpinButton(gtkAdjustment(1, 1, 1000, 1, 1), 1.0, 0)
row.names1$setValue(1)
row.names1$setSensitive(row.names0$getActive())
gSignalConnect(row.names0, "toggled", function(widget){
row.names1$setSensitive(widget$getActive())
})
#hbox <- gtkHBoxNew(FALSE, 0)
label = gtkLabelNew("Row Labels In Column")
label$setAlignment(1, 0.5)
opt.table$attach(label, 0, 1, 0, 1, xpad=10)
opt.table$attach(row.names1, 1, 2, 0, 1)
skip1 <- gtkSpinButton(gtkAdjustment(0, 0, 1000, 1, 1), 1.0, 0)
skip1$setValue(0)
label = gtkLabelNew("Number Of Rows To Skip")
label$setAlignment(1, 0.5)
opt.table$attach(label, 0, 1, 1, 2, xpad=10)
opt.table$attach(skip1, 1, 2, 1, 2)
colClasses1 <- gtkComboBoxNewText()
for (ll in c("Default", "logical", "integer", "numeric", "complex", "character", "raw", "factor", "Date", "POSIXct")) colClasses1$appendText(ll)
colClasses1$setActive(0)
#hbox <- gtkHBoxNew(FALSE, 0)
label = gtkLabelNew("Column Classes")
label$setAlignment(1, 0.5)
opt.table$attach(label, 0, 1, 2, 3, xpad=10)
opt.table$attach(colClasses1, 1, 2, 2, 3)
na.strings1 <- gtkEntryNew()
na.strings1$setText("NA")
hbox <- gtkHBoxNew(FALSE, 0)
label = gtkLabelNew("NA String")
label$setAlignment(1, 0.5)
opt.table$attach(label, 0, 1, 3, 4, xpad=10)
opt.table$attach(na.strings1, 1, 2, 3, 4)
fill1 <- gtkCheckButtonNewWithLabel(label="Fill Unequal Length Rows")
fill1$setActive(TRUE)
opt.box1$packStart(fill1, FALSE, FALSE, 0)
stringsAsFactors1 <- gtkCheckButtonNewWithLabel(label="Read Strings As Factors")
stringsAsFactors1$setActive(FALSE)
opt.box1$packStart(stringsAsFactors1, FALSE, FALSE, 0)
fr2$add(box2)
box0$packStart(fr1, FALSE, FALSE, 0)
box0$packStart(fr0, FALSE, FALSE, 0)
box0$packStart(fr2, FALSE, FALSE, 0)
fr3 <- gtkFrameNew(label="Table Preview")
box3 <- gtkVBoxNew(FALSE, 5)
preview.button <- gtkButtonNewWithLabel(" Preview Table ")
hbox <- gtkHBoxNew(FALSE, 0)
hbox$packEnd(preview.button, FALSE, FALSE, 5)
box3$packStart(hbox, FALSE, FALSE, 0)
#box3$packStart(preview.button, FALSE, FALSE, 0)
tb2 <- gtkTextViewNew()
tb2$setSizeRequest(400, 200)
tb2$getBuffer()$setText("No Table loaded")
box3$packStart(tb2)
read_table <- function(nrows=-1, doMsg=FALSE){
if(nchar(entry1$getText()) == 0) stop("No file selected")
row.names.arg <- NULL
if(row.names0$getActive()) row.names.arg <- as.integer(row.names1$getText())
col.classes.arg <- NA
if(colClasses1$getActiveText() != "Default") {
col.classes.arg <- colClasses1$getActiveText() # preview to get ncols
if(col.classes.arg != "character" && !is.null(row.names.arg)){
xx <- read.table(file=entry1$getText(), sep=sep.types[[sep1$getActiveText()]],
dec = dec1$getActiveText(), header=header1$getActive(), row.names=row.names.arg, nrows=5)
NN <- dim(xx)[2]
col.classes.arg <- c("character", rep(col.classes.arg, NN))
}
}
cmd_list = list(file=entry1$getText(),
header= header1$getActive(),
sep = sep.types[[sep1$getActiveText()]],
skip= as.integer(skip1$getText()),
#row.names = row.names.arg,
nrows = nrows,
colClasses= col.classes.arg,
stringsAsFactors = stringsAsFactors1$getActive(),
dec=dec1$getActiveText(),
fill = fill1$getActive()
)
xx <- do.call(read.table, cmd_list) # read it with row names NULL
if(!is.null(row.names.arg) && length(dim(xx))==2 && 0 < row.names.arg && row.names.arg <= ncol(xx)){
dupes <- duplicated(xx[,row.names.arg])
xx <- xx[!dupes,,drop=F]
if(doMsg) message("Dropping ", sum(dupes), " row(s) from table to create unique row names")
rownames(xx) <- xx[,row.names.arg]
xx <- xx[,-row.names.arg,drop=F]
}
return(list(xx=xx, cmd_list=cmd_list))
}
gSignalConnect(preview.button, "clicked", function(obj, label){
tryCatch({
preview <- read_table(nrows=nlines1$getValue())$xx
obj <- gtkDfEdit(preview, size.request = c(400, 200), col.width=100)
if(!is.null(box3$getChildren()[[2]])) box3$getChildren()[[2]]$destroy()
box3$packEnd(obj)
}, error = function(e) {
tb3 <- gtkTextViewNew()
tb3$setWrapMode(GtkWrapMode['word_char'])
tb3$setSizeRequest(400, 200)
tb3$getBuffer()$setText(as.character(e))
if(!is.null(box3$getChildren()[[2]])) box3$getChildren()[[2]]$destroy()
box3$packEnd(tb3)
})
})
fr3$add(box3)
box0$packStart(fr3)
dialog[["vbox"]]$packStart(box0, TRUE, TRUE, 10)
dialog$showAll()
xx <- NULL
if(dialog$run() == 1 && nchar(entry1$getText())){
on.exit(w$destroy()) # block concurrent user calls with a modal window
w <- gtkWindowNew("Loading...", show=F)
w$setDecorated(FALSE)
w$add(gtkLabelNew("Loading..."))
w$setPosition(GtkWindowPosition["center-on-parent"])
w$setTransientFor(parent.window)
w$setModal(TRUE)
w$showAll()
tryCatch({
rv <- read_table(doMsg=TRUE)
xx <- rv$xx
cmd_list = rv$cmd_list
aa <- basename(entry1$getText())
newname <- make.names(strsplit(aa, "[.]")[[1]][1])
assign(newname, xx, envir=.GlobalEnv)
if(exists(".log.file")){
sub.values <- as.character(substitute(cmd_list))
cidx <- sapply(cmd_list, is.character)
sub.values[cidx] <- sapply(as.character(cmd_list[cidx]), deparse)
cmd.string <- paste(newname, " <- ", "read.table", "(",
paste(paste(names(cmd_list),sub.values, sep="="), collapse=", "),
")\n", sep="")
print(cmd.string)
write(cmd.string, file=get(".log.file"), append=T)
}
}, error = function(e) {quick_message(e$message, caption = "Error Loading Table")})
dialog$destroy()
} else {
dialog$destroy()
}
return(xx)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.