Below is a code snippet written for writing the messages. But im not getting why the output prints the way below. Expected output is also given. I first thought the txt is a list type. But it is a character variable
writetext<-function(...){
arguments <- list(...)
if (length(arguments)>0){
txt<- paste(arguments)
if (length(txt)==0) return()
strtime <- format(Sys.time(),"%I:%M:%S%p")
txt <- paste(strtime,txt)
message(txt)
}
}
writetext("abc","efg")
01:05:13PM abc01:05:13PM efg
Expected :
01:05:13PM abcefg
You could use paste0(txt, collapse = "") :
writetext <- function(...) {
arguments <- list(...)
if (length(arguments) > 0) {
txt <- paste(arguments)
if (length(txt) == 0) return()
strtime <- format(Sys.time(), "%I:%M:%S%p")
txt <- paste(strtime, paste0(txt, collapse = ""))
message(txt)
}
}
writetext("abc", "efg")
# 07:13:45PM abcefg
Related
I've written a little function that helps renaming columns by looping through each variable and pasting various punctuation around it so that text is sent to the console. This can then be copied into my script and rename variables as required. This is the function:
library(tidyverse)
tidy_rename <- function (df) {
df_name <- deparse(substitute(df))
names(df) <- tolower(names(df))
cat(paste(df_name, " <- ", paste(df_name, "%>%\n\t rename(")))
for (i in names(df)) {
cat(paste("\t\t", paste(paste("=", paste(paste('"', i), '"'))), ","), sep="\n")
}
writeLines(")"
)
}
If I use this on a dataset:
test_df <- data.frame("VarIable 1" = c(1), "sizrd" = c(1), "dat 1" = c(1),
"x-cord" = c(1), "y-crf" = c(1), "aGe" = c(1), check.names=F)
tidy_rename(test_df)
which gives the following which can be copied and pasted into script:
test_df <- test_df %>%
rename( = " variable 1 " ,
= " sizrd " ,
= " dat 1 " ,
= " x-cord " ,
= " y-crf " ,
= " age " ,
)
What I would like is to automatically copy this output to the clipboard within the function. I'm not sure how to use writeClipboard around the forloop. This doesn't work:
tidy_rename <- function (df) {
df_name <- deparse(substitute(df))
names(df) <- tolower(names(df))
writeClipboard(
cat(paste(df_name, " <- ", paste(df_name, "%>%\n\t rename(")))
for (i in names(df)) {
cat(paste("\t\t", paste(paste("=", paste(paste('"', i), '"'))), ","), sep="\n")
}
writeLines(")"
)
)
}
Any suggestions please?
Expanding on my comment to eliminate any confusion.
A method or suggestion is to store the string in a variable, which can then be output in the end. Note from the value of cat(...) is NULL (it doesnt return the string). This requires 2 variables, lets call them str and newstr. I'll let str store the entire string that you want to copy, and newstr store the current string that is output by cat(...).
tidy_rename <- function (df) {
df_name <- deparse(substitute(df))
names(df) <- tolower(names(df))
str <- paste(df_name, " <- ", paste(df_name, "%>%\n\t rename("))
cat(str)
for (i in names(df)) {
#Store variable at each iteration and expand str. Output newstr.
newstr <- paste("\t\t", paste(paste("=", paste(paste('"', i), '"'))), ",")
str <- paste(str, newstr, sep = "\n")
cat(newstr, sep="\n")
}
newstr <- ")"
str <- paste0(str, newstr)
cat(newstr)
writeClipboard(str)
}
Note how the output is stored in str at each iteration but newstr is output.
As a side note i suggest that OP checks out the collapse argument of paste (alternatively paste0). I don't have the full overview, but it seems like this could eliminate 2 - 3 calls to paste if the strings were collapsed within one of the function calls.
I have some large geoTIFFs, now I want to convert them to ASCII files, after doing some searches, I write these codes:
library(raster)
f <- list.files("inputFolder", pattern = "*.tif", full.names = TRUE)
r <- lapply(f, raster)
a <- lapply(r, writeRaster, filename = "output", format = "ascii")
What confused me is that how can I name the output files respectively, according to its original names?
I tried:
a <- lapply(r, writeRaster, filename = "outputFolder" + f, format = "ascii")
But I received error:
non-numeric argument to binary operator
Then I tried:
a <- lapply(r, writeRaster, filename = paste0(f, ".asc"), format = "ascii")
But I received:
Error in file(filename, "w") : invalid 'description' argument In
addition: Warning messages: 1: In if (filename == "") { : the
condition has length > 1 and only the first element will be used 2: In
if (!file.exists(dirname(filename))) { : the condition has length >
1 and only the first element will be used 3: In if
(toupper(x#file#name) == toupper(filename)) { : the condition has
length > 1 and only the first element will be used 4: In if
(trim(filename) == "") { : the condition has length > 1 and only the
first element will be used 5: In if (!file.exists(dirname(filename)))
{ : the condition has length > 1 and only the first element will be
used 6: In if (filename == "") { : the condition has length > 1 and
only the first element will be used 7: In if (!overwrite &
file.exists(filename)) { : the condition has length > 1 and only the
first element will be used
I think you were basically nearly there, with two corrections:
First, you're calling writeRaster for its side effects (i.e. its ability to write a file to your filesystem) so you don't need to assign the output of your lapply() loop to an object. So, removing a <- we have:
lapply(r, writeRaster, filename = paste0(f, ".asc"), format = "ascii")
Next, the filename argument won't loop through f in this way. You have two options, of which the simplest is probably to pass the #file#name slot of r to the filename argument using an anonymous function:
lapply(r, function(x) {
writeRaster(x, filename = x#file#name, format = "ascii", overwrite = TRUE)
})
Your other option would be to loop through r and f in parallel like you can in python with for r, f in..., which can be done with purrr:
library("purrr")
walk2(r, f, function(x, y) {
writeRaster(x = x, filename = y, format = "ascii")
})
Here we're using walk2() rather than map2() because we need to call the function for side effects. This loops through r and f together so you can pass one to be the object to write, and one to be the filename.
Edit: here's the code I use to reproduce the problem
library("raster")
tmp_dir = tempdir()
tmp = tempfile(tmpdir = tmp_dir, fileext = ".zip")
download.file(
"http://biogeo.ucdavis.edu/data/climate/cmip5/10m/cc26bi50.zip",
destfile = tmp
)
unzip(tmp, exdir = tmp_dir)
f = list.files(tmp_dir, pattern = ".tif$", full.names = TRUE)
r = lapply(f, raster)
# Solution one
lapply(r, function(x) {
writeRaster(x, filename = x#file#name, format = "ascii", overwrite = TRUE)
})
# solution two
library("purrr")
walk2(r, f, function(x, y) {
writeRaster(x = x, filename = y, format = "ascii")
})
To test how to do this with small files:
library(raster)
s <- stack(system.file("external/rlogo.grd", package="raster"))
writeRaster(s, file='testtif', format='GTiff', bylayer=T, overwrite=T)
f <- list.files(pattern="testtif_..tif")
Now you can use f with Phil's nice examples. You can also combine all in one step lapply:
f <- list.files("inputFolder", pattern = "*.tif", full.names = TRUE)
r <- lapply(f, function(i) { writeRaster(raster(i), filename=extension(i, '.asc'), overwrite=TRUE)} )
But if you have trouble with lapply, write a loop (it is fine!):
for (i in 1:length(f)) {
r <- raster(f[i])
ff <- extension(f[i], '.asc')
writeRaster(r, ff)
}
Or like this
for (file in f) {
r <- raster(file)
ff <- extension(file, '.asc')
writeRaster(r, ff)
}
I am trying to read thousands of .csv files into a list. The files are named with running numbers, f.ex. file1.csv, file2.csv. Occasionally a file doesn't exist. When it doesn't exist, I want to assign to that element of the list a placeholder vector rep(NA,9). I've tried the following loop:
file.numbers = 1:2000
data = list()
for (i in 1:2000) {
tryCatch(
data[[i]] = read.csv((paste("file", file.numbers[i], sep = ""))),
error=function(e){data[[i]] = rep(NA,9)}
)
}
Lets say file1052.csv doesn't exist. I would like to have data[[1052]] = rep(NA,9), but instead the above loop gives me data[[1052]] = NULL. What to do?
You can use file.exists
file.numbers = 1:2000
data = list()
for (i in 1:2000) {
filename <- paste("file", file.numbers[i],".csv", sep = "")
if(file.exists(filename)){
data[[i]] = read.csv(filename)
} else {
data[[i]] = rep(NA,9)
}
}
Try:
for (i in 1:2000) {
csv.i <-
tryCatch(read.csv(paste("file", file.numbers[i], sep = "")),
error=function(e){rep(NA,9)}
)
data[[i]] <- csv.i
}
I've put together a function that looks like this, with the first comment lines being an example. Most importantly here is the set.path variable that I use to set the path initially for the function.
# igor.import(set.path = "~/Desktop/Experiment1 Folder/SCNavigator/Traces",
# set.pattern = "StepsCrop.ibw",
# remove.na = TRUE)
igor.multifile.import <- function(set.path, set.pattern, remove.na){
{
require("IgorR")
require("reshape2")
raw_list <- list.files(path= set.path,
pattern= set.pattern,
recursive= TRUE,
full.names=TRUE)
multi.read <- function(f) { # Note that "temp.data" is just a placeholder in the function
temp_data <- as.vector(read.ibw(f)) # Change extension to match your data type
}
my_list <- sapply(X = raw_list, FUN = multi.read) # Takes all files gathered in raw_list and applies multi.read()
my_list_combined <- as.data.frame(do.call(rbind, my_list))
my_list_rotated <- t(my_list_combined[nrow(my_list_combined):1,]) # Matrix form
data_out <- melt(my_list_rotated) # "Long form", readable by ggplot2
data_out$frame <- gsub("V", "", data_out$Var1)
data_out$name <- gsub(set.path, "", data_out$Var2) # FIX THIS
}
if (remove.na == TRUE){
set_name <- na.omit(data_out)
} else if (remove.na == FALSE) {
set_name <- data_out
} else (set_name <- data_out)
}
When I run this function I'll get a large dataframe, where each file that matched the pattern will show up with a name like
/Users/Joh/Desktop/Experiment1 Folder/SCNavigator/Traces/Par994/StepsCrop.ibw`
that includes the entire filepath, and is a bit unwieldy to look at and deal with.
I've tried to remove the path part with the line that says
data_out$name <- gsub(set.path, "", data_out$Var2)
Similar to the command above that removes the dataframe auto-named V1, V2, V3... (which works). I can't remove the string part matching the set.path = "my/path/" though.
Regardless of what your set.path is, you can eliminate it by
gsub(".*/","",mypath)
mypath<-"/Users/Joh/Desktop/Experiment1 Folder/SCNavigator/Traces/Par994/StepsCrop.ibw"
gsub(".*/","",mypath)
[1] "StepsCrop.ibw"
`
I am currently taking in multiple command line parameters within my R script such as :
args<-commandArgs(TRUE)
arg1 <- as.numeric(args[1])
arg2 <- as.numeric(args[2])
I am wanting to use these args within my paste string like below. My problem is that I can only figure out how to use 1 of the arguments and not both (arg1, arg2). Instead of "xxx" that I show below in my where clause (i.e. "columnname1 in (xxx)") how do I use the "arg1" command line parameter in place of "xxx"? I've tried a number of different ways and for some reason I can't figure it out. Should I concatenate two different strings to accomplish this or is there an easier way?
SQL<-paste(
"SELECT
*
FROM
table
WHERE
columnname1 in (xxx)
and
columnname2 in ('",arg2,"')",sep = "")
Thanks for your help!
Try:
SQL<-paste(
"SELECT
*
FROM
table
WHERE
columnname1 in ('",arg1,"')
and
columnname2 in ('",arg2,"')",sep = "", collapse="")
You could also use the following helper function that allows named substitutions:
SQL<-strsubst(
"SELECT * FROM table WHERE
columnname1 in ('$(arg1)') and
columnname2 in ('$(arg2)')",
list(arg1=arg1, arg2=arg2)
)
where strsubst is defined as follows:
strsubst <- function (template, map, verbose = getOption("verbose"))
{
pat <- "\\$\\([^\\)]+\\)"
res <- template
map <- unlist(map)
m <- gregexpr(pat, template)
idx <- which(sapply(m, function(x) x[[1]] != -1))
for (i in idx) {
line <- template[[i]]
if (verbose)
cat("input: |", template[[i]], "|\n")
starts <- m[[i]]
ml <- attr(m[[i]], "match.length")
sym <- substring(line, starts + 2, starts + ml - 2)
if (verbose)
cat("sym: |", sym, "|\n")
repl <- map[sym]
idx1 <- is.na(repl)
if (sum(idx1) > 0) {
warning("Don't know how to replace '", paste(sym[idx1],
collapse = "', '"), "'.")
repl[idx1] <- paste("$(", sym[idx1], ")", sep = "")
}
norepl <- substring(line, c(1, starts + ml), c(starts -
1, nchar(line)))
res[[i]] <- paste(norepl, c(repl, ""), sep = "", collapse = "")
if (verbose)
cat("output: |", res[[i]], "|\n")
}
return(res)
}