convertToClockTime <- function(file, lag = Latency) {
colnames(adamcorrectfile)[which(colnames(adamcorrectfile) == "X.1")] <- "Calculated.Run.Time"
adamcorrectfile$Calculated.Run.Time <- round(adamcorrectfile$Calculated.Run.Time, digits = 0)
adamcorrectfile$LPRS.Time <- as.POSIXct(adamcorrectfile$LPRS.Time, format = "%H:%M")
adamcorrectfile <- adamcorrectfile[order(adamcorrectfile$LPRS.Time),]
output <- colnames(adamcorrectfile)
for (j in unique(adamcorrectfile$Folder)) {
adamcorrectfile.Folder <- adamcorrectfile[which(adamcorrectfile$Folder == "print 1"),]
adamcorrectfile.Folder$start.time <- adamcorrectfile.Folder$LPRS.Time + lag
adamcorrectfile.Folder$end.time <- adamcorrectfile.Folder$start.time + adamcorrectfile.Folder$`Calculated.Run.Time`
for (i in 2:nrow(adamcorrectfile)) {
adamcorrectfile.Folder[i,"start.time"] <- max(adamcorrectfile.Folder[i,"LPRS.Time"] + 15*60, adamcorrectfile[i-1, "end.time"]
adamcorrectfile.Folder[i, "end.time"] <- adamcorrectfile.Folder[i,"start.time"] + adamcorrectfile.Folder[i,"Calculated.Run.Time"]
}
output <- rbind(output, adamcorrectfile.Folder)
return(output)
}
}
On line 1 it says unmatched opening bracket '{' even though it is matched. Any help. Are there some tricky things with R indentation, it just keeps popping errors due to indentations it seems
It looks like the problem is that you haven't closed the parentheses on the max function in the middle of the for loop.
Here is the working code:
convertToClockTime <- function(file, lag = Latency) {
colnames(adamcorrectfile)[which(colnames(adamcorrectfile) == "X.1")] <- "Calculated.Run.Time"
adamcorrectfile$Calculated.Run.Time <- round(adamcorrectfile$Calculated.Run.Time, digits = 0)
adamcorrectfile$LPRS.Time <- as.POSIXct(adamcorrectfile$LPRS.Time, format = "%H:%M")
adamcorrectfile <- adamcorrectfile[order(adamcorrectfile$LPRS.Time),]
output <- colnames(adamcorrectfile)
for (j in unique(adamcorrectfile$Folder)) {
adamcorrectfile.Folder <- adamcorrectfile[which(adamcorrectfile$Folder == "print 1"),]
adamcorrectfile.Folder$start.time <- adamcorrectfile.Folder$LPRS.Time + lag
adamcorrectfile.Folder$end.time <- adamcorrectfile.Folder$start.time + adamcorrectfile.Folder$`Calculated.Run.Time`
for (i in 2:nrow(adamcorrectfile)) {
adamcorrectfile.Folder[i,"start.time"] <- max(adamcorrectfile.Folder[i,"LPRS.Time"] + 15*60, adamcorrectfile[i-1, "end.time"])
adamcorrectfile.Folder[i, "end.time"] <- adamcorrectfile.Folder[i,"start.time"] + adamcorrectfile.Folder[i,"Calculated.Run.Time"]
}
output <- rbind(output, adamcorrectfile.Folder)
return(output)
}
}
Related
I have some data from event producer. In a "created_at column I have mixed type of datetime value.
Some NA, some ISO8601 like, some POSIX with and without millisec.
I build a func that should take care of everything meanning let's NA and ISO8601 info as it is, and convert POSIX date to ISO8601.
library(anytime)
convert_time <- function(x) {
nb_char = nchar(x)
if (is.na(x)) return(x)
else if (nb_char == 10 | nb_char == 13) {
num_x = as.numeric(x)
if (nb_char == 13) {
num_x = round(num_x / 1000, 0)
}
return(anytime(num_x))
}
return(x)
}
If I passe one problematic value
convert_time("1613488656")
"2021-02-16 15:17:36 UTC"
Works well !
Now
df_offer2$created_at = df_offer2$created_at %>% sapply(convert_time)
I still have the problematic values.
Any tips here ?
I would suggest the following small changes...
convert_time <- function(x) {
nb_char = nchar(x)
if (is.na(x)) return(x)
else if (nb_char == 10 | nb_char == 13) {
num_x = as.numeric(x)
if (nb_char == 13) {
num_x = round(num_x / 1000, 0)
}
return(num_x) #remove anytime from here
}
return(x)
}
df_offer2$created_at = df_offer2$created_at %>%
sapply(convert_time) %>% anytime() #put it back in at this point
Two things that have worked for me:
col1<-seq(from=1,to=10)
col2<-rep("1613488656",10)
df <- data.frame(cbind(col1,col2))
colnames(df)<-c("index","created_at")
df <- df%>%
mutate(converted = convert_time(df$created_at))`
alternatively
col1<-seq(from=1,to=10)
col2<-rep("1613488656",10)
df <- data.frame(cbind(col1,col2))
colnames(df)<-c("index","created_at")
df$created_at <- convert_time(df$created_at)
Both spit out warnings but appear to make the correction properly
I am a newbie on R. I am trying to create a list within 2 functions. The first one is the extraction function, it takes the data and creates a list with it. The second one is the process one, it calculates some values and I need them to be together in the first list. How do I do that ?
myfun <- function(data,number_meta) { #extraction function
OR <- data$`Odds Ratio`[data$`Identification number`==number_meta]
SE <- ((log(data$`Upper limit`) - (log(data$`Lower limit`))) / 3.92)[data$`Identification number`==number_meta]
res <- metagen(TE=log(OR),seTE=SE,sm="OR")
tableau = cbind(OR, SE)
LIST = list(tableau, res)
return(LIST)
}
myfun(data,number_meta)
number_meta = c(1:33)
i = c(1:33)
number_meta = i
LIST = list()
for (i in 1:33) {
LIST[[i]] = myfun(data, number_meta[i])
}
myfun2 <- function(LIST) { # processing function
dup_OR <- duplicated(LIST[[i]][[1]][,1])
dup_SE <- duplicated(LIST[[i]][[1]][,2])
options(scipen = 999)
Egger <- metabias(LIST[[i]][[2]], method.bias = "linreg", k.min = 1)
Begg <- metabias(LIST[[i]][[2]], method.bias = "rank", k.min = 1)
Result <- c(dup_OR,dup_SE,Egger,Begg)
return(Result)
}
myfun2(LIST)
for (i in 1:33) {
LIST[[i]] = c(LIST, list(myfun2(LIST))) ## This one is not working !
}
I would like to obtain a final list of 33 items in which I could find inside the different values of res, dup_OR, dup_SE, Egger, Begg. These values varies from the values of res. Thanks for your help
Here is my original script :
setwd("U:/Stage M2 Phame")
library(readxl)
library(meta)
data <- read_excel("Tableau_OR.xlsx")
OR <- ((data$`Odds Ratio`[data$`Identification number`==number_meta[i]]))
SE <- (((log(data$`Upper limit`) - (log(data$`Lower limit`)))/3.92)[data$`Identification
number`==number_meta[i]])
dup_OR <- duplicated(OR)
dup_SE <- duplicated(SE)
options(scipen = 999)
res <- metagen(TE=log(OR),seTE=SE,sm="OR")
Egger <- metabias(res, method.bias = "linreg", k.min = 5)
Begg <- metabias(res, method.bias = "rank", k.min = 5)
Trim <- trimfill(res)
LIST=list(dup_OR, dup_SE, Egger, Begg, Trim)
Sorry for my whole block of text.
How about this (I have taken the liberty of generating a minimal working example):
## define a function that appends something to an existing list
appendtolist = function(oldlist, add_element){
if(class(add_element) == "list"){
oldlist = c(oldlist, add_element)
}
else if(class(add_element) != "list"){
oldlist[[length(oldlist) + 1]] = add_element
}
return(oldlist)
}
## define a test list
firstlist = list("a", c(1:10), "test")
## add content to the first list
newlist = appendtolist(firstlist, c(1:1000))
Similarly to .Last.value is there any way to access last call? Below expected results of potential .Last.call.
sum(1, 2)
# [1] 3
str(.Last.call)
# language sum(1, 2)
The bests if it would not require to parse file from file system.
The last.call package is no longer on cran, but you can still get the code:
# -----------------------------------------------------------------------
# FUNCTION: last.call
# Retrieves a CALL from the history and returns an unevaluated
# call.
#
# There are two uses for such abilities.
# - To be able to recall the previous commands, like pressing the up key
# on the terminal.
# - The ability to get the line that called the function.
#
# TODO:
# - does not handle commands seperated by ';'
#
# -----------------------------------------------------------------------
last.call <-
function(n=1) {
f1 <- tempfile()
try( savehistory(f1), silent=TRUE )
try( rawhist <- readLines(f1), silent=TRUE )
unlink(f1)
if( exists('rawhist') ) {
# LOOK BACK max(n)+ LINES UNTIL YOU HAVE n COMMANDS
cmds <- expression()
n.lines <- max(abs(n))
while( length(cmds) < max(abs(n)) ) {
lines <- tail( rawhist, n=n.lines )
try( cmds <- parse( text=lines ), silent=TRUE )
n.lines <- n.lines + 1
if( n.lines > length(rawhist) ) break
}
ret <- rev(cmds)[n]
if( length(ret) == 1 ) return(ret[[1]]) else return(ret)
}
return(NULL)
}
Now, to use it:
sum(1, 2)
# [1] 3
last.call(2)
# sum(1, 2)
I've modified this code to output text strings of the preceding commands / calls in a manner that preserves how there were formatted across lines in the original call, sot that I can use cat() to output the calls (for a function that emails me when the preceding function is done running). Here's the code:
lastCall <- function(num.call = 1) {
history.file <- tempfile()
try(savehistory(history.file), silent = TRUE )
try(raw.history <- readLines(history.file), silent = TRUE )
unlink(history.file)
if (exists('raw.history') ) {
# LOOK BACK max(n)+ LINES UNTIL YOU HAVE n COMMANDS
commands <- expression()
num.line <- max(abs(num.call) + 1)
while (length(commands) < max(abs(num.call) + 1)) {
lines <- tail(raw.history, n = num.line)
try(commands <- parse(text = lines), silent = TRUE)
num.line <- num.line + 1
if (num.line > length(raw.history)) break
}
ret <- rev(commands)[num.call + 1]
if (length(ret) == 1) {
a <- ret[1]
} else {
a <- ret
}
# a <- rev(commands)[num.call + 1]
out <- lapply(a, deparse) %>%
sapply(paste, sep = "\n", collapse = "\n")
}
out
}
Enjoy!
After some manipulation of data, I want to rename automatically the data taking pieces of name from a string, merging togheter these pieces and then assigning to data. I try to use "if" function in for loop but the code doesn't work. I try to use "grep" as condition in "if" function.
filepath<-c("C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_0.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_1.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_2.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_3.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_4.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_5.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_0-P1_6.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_1-P1_0.csv",
"C:/Users/Amministratore/Documents/Isolante-T_0-W_1-P1_1.csv",
....)
for(i in filepath){
......
f <- substr(i,10,23) # first piece of name
f2 <- as.character(substr(i,40,57)) # second piece of name
if (grep("W_0",f2)){
m<-c("_sin")
}
if (grep("W_1",f2)){
m<-c("_jan2_febreal")
}
if (grep("W_2",f2)){
m<-c("_real")
}
if (grep("W_3",f2)){
m<-c("_step")
}
if (grep("P1_0",f2,value = FALSE)){
t<-c("_t0.025")
}
if (grepl("P1_1",f2,value = FALSE)){
t<-c("_t0.05")
}
if (grepl("P1_2",f2,value = FALSE)){
t<-c("_t0.1")
}
if (grepl("P1_3",f2,value = FALSE)){
t<-c("_t0.15")
}
if (grepl("P1_4",f2,value = FALSE)){
t<-c("_t0.2")
}
if (grepl("P1_5",f2,value = FALSE)){
t<-c("_t0.25")
}
if (grepl("P1_6",f2,value = FALSE)){
t<-c("_t0.3")
}
}
Outputfilename <- paste(paste(f,m,sep=""),t,sep="")
the result is:
Errore in if (grep("W_1", f2)) { : l'argomento ha lunghezza zero
Without any for loops or if statements, it seems to me you can simply vectorize everything:
f <- substr(filepath,10,23)
m <- t <- character(length(filepath))
m[grepl("W_0",filepath)]<-"_sin"
m[grepl("W_1",filepath)]<-"_jan2_febral"
m[grepl("W_2",filepath)]<-"_real"
m[grepl("W_3",filepath)]<-"_step"
t[grepl("P1_0",filepath)]<-"_t0.025"
t[grepl("P1_1",filepath)]<-"_t0.05"
t[grepl("P1_2",filepath)]<-"_t0.1"
t[grepl("P1_3",filepath)]<-"_t0.15"
t[grepl("P1_4",filepath)]<-"_t0.2"
t[grepl("P1_5",filepath)]<-"_t0.25"
t[grepl("P1_6",filepath)]<-"_t0.3"
Outputfilename <- paste(f,m,t,sep="")
That you can also probably simplify the following way:
f <- substr(filepath,10,23)
m <- t <- character(length(filepath))
w <- array(c(paste("W",0:3,sep="_"),
"_sin", "_jan2_febral", "_real", "_step"), dim=c(4,2))
p <- array(c(paste("P1",0:6,sep="_"),
paste("t_0.",c("025","05","1","15","2","25","3"),sep="")), dim=c(7,2))
for(i in 1:nrow(w)){m[grepl(w[i,1],filepath)] <- w[i,2]}
for(i in 1:nrow(p)){t[grepl(p[i,1],filepath)] <- p[i,2]}
Outputfilename <- paste(f,m,t,sep="")
That you can wrap in a function if you like:
outputfile.namer <- function(filepath,w,p){
# filepath being your vector of file paths
# w and p your correspondance tables for your "W_" and "P_" series respectively
f <- do.call(rbind,strsplit(gsub("C:/Users/","",filepath),split="/"))[,1]
# the preceding is more general than `f <- substr(filepath,10,23)` to grab the name of the User
m <- t <- character(length(filepath))
for(i in 1:nrow(w)){m[grepl(w[i,1],filepath)] <- w[i,2]}
for(i in 1:nrow(p)){t[grepl(p[i,1],filepath)] <- p[i,2]}
paste(f,m,t,sep="")
}
From the string:
"((VBD)(((JJ))(CC)((RB)(JJ)))((IN)((DT)(JJ)(NNP)(NNPS))))"
I needed the following:
"JJ", "RBJJ", "DTJJNNPNNPS", "JJCCRBJJ", "INDTJJNNPNNPS" "VBDJJCCRBJJINDTJJNNPNNPS"
(this was my earlier query on SO, which was solved by #Brian Diggs. Please refer to "R : how to differentiate between inner and innermost brackets using regex", if necessary)
so I Used the following code:
library("plotrix")
library("plyr")
strr<-c("((VBD)(((JJ))(CC)((RB)(JJ)))((IN)((DT)(JJ)(NNP)(NNPS))))")
tmp <- gsub("\\(([^\\(\\)]*)\\)", '("\\1")', strr)
tmp <- gsub("\\(", "list(", tmp)
tmp <- gsub("\\)list", "),list", tmp)
tmp <- eval(parse(text=tmp))
atdepth <- function(l, d) {
if (d > 0 & !is.list(l)) {
return(NULL)
}
if (d == 0) {
return(unlist(l))
}
if (is.list(l)) {
llply(l, atdepth, d-1)
}
}
pastelist <- function(l) {paste(unlist(l), collapse="", sep="")}
down <- llply(1:listDepth(tmp), atdepth, l=tmp)
out <- if (length(down) > 2) {
c(unlist(llply(length(down):3, function(i) {
unlist(do.call(llply, c(list(down[[i]]), replicate(i-3, llply), pastelist)))
})), unlist(pastelist(down[[2]])))
} else {
unlist(pastelist(down[[2]]))
}
out <- out[out != ""]
And I got what I wanted, But Is it not possible to use the above code through a loop to process multiple strings (strr etc.) at the same time? I roughly need a bunch of strings to be processed and collected in a file. I'm trying to include a loop, but always end up in having just the last string from the set of strings in the out file. How should I run the code through a loop? The string set below.
strr<-c("(((((NNS))((IN)((NNS)(CC)(NNS))))((VBD)((PRP))((IN)((NN))))))",
"((((NNS))((VBD)((TO)(((NNP))((NNP))))((TO)((DT)(NNP))))))",
"((((IN)(((NNP))((NNP))))((NNP)(NNP)(NNPW)(NNP))((VBD)((IN)((DT)(JJ)(NN)(NN))))))"
)
Possibly it could be modified in a more clever way, but a straightforward one would be to define a new function and use sapply()
### Nothing new
library("plotrix")
library("plyr")
strr<-c("(((((NNS))((IN)((NNS)(CC)(NNS))))((VBD)((PRP))((IN)((NN))))))",
"((((NNS))((VBD)((TO)(((NNP))((NNP))))((TO)((DT)(NNP))))))",
"((((IN)(((NNP))((NNP))))((NNP)(NNP)(NNPW)(NNP))((VBD)((IN)((DT)(JJ)(NN)(NN))))))")
strrr <- strr[rep(1:3,200)]
atdepth <- function(l, d) {
if (d > 0 & !is.list(l)) {
return(NULL)
}
if (d == 0) {
return(unlist(l))
}
if (is.list(l)) {
llply(l, atdepth, d-1)
}
}
pastelist <- function(l) {paste(unlist(l), collapse="", sep="")}
###
### New function here
fun <- function(strr){
tmp <- gsub("\\(([^\\(\\)]*)\\)", '("\\1")', strr)
tmp <- gsub("\\(", "list(", tmp)
tmp <- gsub("\\)list", "),list", tmp)
tmp <- eval(parse(text=tmp))
down <- llply(1:listDepth(tmp), atdepth, l=tmp)
out <- if (length(down) > 2) {
c(unlist(llply(length(down):3, function(i) {
unlist(do.call(llply, c(list(down[[i]]), replicate(i-3, llply), pastelist)))
})), unlist(pastelist(down[[2]])))
} else {
unlist(pastelist(down[[2]]))
}
out <- out[out != ""]
out
}
sapply(strr, fun)