Difference between revisions of "OpasnetUtils/Drafts"

From Testiwiki
Jump to: navigation, search
(Answer: makeTimeline)
(Answer)
Line 459: Line 459:
 
}
 
}
  
timing <- function(dat, timecol = NA, weeks = 52, tz = "EET")  
+
timing <- function(dat, timecol = NA, weeks = 6, tz = "EET")  
 
# timing converts character or numeric inputs into times using a few default formats
 
# timing converts character or numeric inputs into times using a few default formats
 
{
 
{
if(is.data.frame(dat)) times <- tolower(dat[[timecol]]) else times <- dat
+
if(is.data.frame(dat)) # Turn dat into a data.frame in all cases.
 +
{
 +
timesall <- (dat[timecol])
 +
} else {
 +
timesall <- data.frame(Timecol = dat)
 +
timecol <- "Timecol"
 +
}
 +
 
 +
temprow <- character() # A whole row of timesall collapsed into a string.
 +
 +
for(i in 1:nrow(timesall))
 +
{
 +
temprow[i] <- tolower(paste(t(timesall)[ , i], collapse = ""))
 +
}
  
 
weekdays <- data.frame(
 
weekdays <- data.frame(
Line 473: Line 486:
 
# day is the number of the weekday in case of repeating events.
 
# day is the number of the weekday in case of repeating events.
  
day <- rep(NA, length(times))
+
day <- rep(NA, nrow(timesall))
 
for(i in 1:nrow(weekdays))  
 
for(i in 1:nrow(weekdays))  
 
{
 
{
temp1 <- grepl(weekdays$Name[i], times) # Is any weekday mentioned in times?
+
temp1 <- grepl(weekdays$Name[i], temprow) # Is any weekday mentioned in temprow?
 
day <- ifelse(is.na(day) & temp1, weekdays$Number[i], day) # Find the weekday number.
 
day <- ifelse(is.na(day) & temp1, weekdays$Number[i], day) # Find the weekday number.
 
}
 
}
  
# repeats are repeating events, x are non-repeating events.
+
# repall are repeating events, x are non-repeating events.
 
 
repeats <- times[!is.na(day)]
+
repall <- timesall[!is.na(day) , ]
repeatsrow <- (1:length(times))[!is.na(day)]
+
xall <- timesall[is.na(day) , ]
x <- times[is.na(day)]
+
starting <- NA
xrow <- (1:length(times))[is.na(day)]
 
 
 
 
########### First, change non-repeating timedates.
 
########### First, change non-repeating timedates.
 
# Change timedate into POSIXct assuming formats 15.3.2013 or 2013-03-15 and 15:24 or 15.24.
 
# Change timedate into POSIXct assuming formats 15.3.2013 or 2013-03-15 and 15:24 or 15.24.
 
# Note! 13 and 2013 mean 1.1.2013 and 3.2013 means 1.3.2013
 
# Note! 13 and 2013 mean 1.1.2013 and 3.2013 means 1.3.2013
+
x <- ifelse(grepl("^[0-9][0-9]$", x), paste("20", x, sep = ""), x)
+
if(nrow(xall) > 0)
x <- ifelse(grepl("^[0-9][0-9][0-9][0-9]$", x), paste("1.1.", x, sep = ""), x)
+
{
x <- ifelse(grepl("^[0-9].[0-9][0-9][0-9][0-9]$", x), paste("1.", x, sep = ""), x)
+
xout <- data.frame(Datrow = (1:nrow(timesall))[is.na(day)]) # Row numbers from dat.
x <- ifelse(grepl("^[0-9][0-9].[0-9][0-9][0-9][0-9]$", x), paste("1.", x, sep = ""), x)
+
 +
for(j in colnames(xall))
 +
{
 +
x <- xall[[j]]
 +
if(is.factor(x)) x <- levels(x)[x]
 +
 +
x <- ifelse(grepl("^[0-9][0-9]$", x), paste("20", x, sep = ""), x)
 +
x <- ifelse(grepl("^[0-9][0-9][0-9][0-9]$", x), paste("1.1.", x, sep = ""), x)
 +
x <- ifelse(grepl("^[0-9].[0-9][0-9][0-9][0-9]$", x), paste("1.", x, sep = ""), x)
 +
x <- ifelse(grepl("^[0-9][0-9].[0-9][0-9][0-9][0-9]$", x), paste("1.", x, sep = ""), x)
 +
 
 +
temp <- x
 +
x <- as.POSIXct(temp, format = "%d.%m.%Y %H:%M", tz = tz)
 +
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%d.%m.%Y %H.%M", tz = tz))
 +
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%Y-%m-%d %H:%M", tz = tz))
 +
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%Y-%m-%d %H.%M", tz = tz))
 +
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%d.%m.%Y", tz = tz))
 +
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%d.%m.%y", tz = tz))
  
temp <- x
+
xout <- cbind(xout, X = as.POSIXct(x, origin = "1970-01-01", tz = tz))  
x <- as.POSIXct(temp, format = "%d.%m.%Y %H:%M", tz = tz)
+
# Intermediate values turn into numeric, therefore turned back to POSIX.
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%d.%m.%Y %H.%M", tz = tz))
 
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%Y-%m-%d %H:%M", tz = tz))
 
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%Y-%m-%d %H.%M", tz = tz))
 
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%d.%m.%Y", tz = tz))
 
x <- ifelse(!is.na(x), x, as.POSIXct(temp, format = "%d.%m.%y", tz = tz))
 
  
x <- data.frame(
+
starting <- min(c(starting, xout$X), na.rm = TRUE)
Datrow = xrow,
+
Timevalues = as.POSIXct(x, origin = "1970-01-01", tz = tz) # Intermediate values turn into numeric, therefore turned back to POSIX.
+
colnames(xout)[colnames(xout) == "X"] <- j
)
+
}
 +
}
 
 
 
############## Then, change weekly repeating timedates.
 
############## Then, change weekly repeating timedates.
 
 
# repeats must have format ma 9:00 or TUESDAY 8.24. Weekday is case-insensitive and can be abbrevieated.
+
# repall must have format ma 9:00 or TUESDAY 8.24. Weekday is case-insensitive and can be abbrevieated.
 +
# The start and end times are assumed to be on the same day. The name of day can be on either column.
 +
 
 +
if(nrow(repall) > 0)
 +
{
 +
 +
for(j in colnames(repall))
 +
{
 +
 +
reptime <- gsub("[[:alpha:] ]", "", repall[[j]]) # Remove alphabets and spaces.
 +
reptime <- gsub("\\.", ":", reptime)
 +
reptime <- strsplit(reptime, split = ":")
  
reptime <- gsub("[[:alpha:] ]", "", repeats) # Remove alphabets and spaces.
+
temp2 <- numeric()
reptime <- gsub("\\.", ":", reptime)
+
for(i in 1:length(reptime))  
reptime <- strsplit(reptime, split = ":")
+
{
 +
temp2[i] <- as.numeric(reptime[[i]][1]) * 3600 + as.numeric(reptime[[i]][2]) * 60
 +
}
  
temp2 <- numeric()
+
reptime <- temp2
for(i in 1:length(reptime))
 
{
 
temp2[i] <- as.numeric(reptime[[i]][1]) * 3600 + as.numeric(reptime[[i]][2]) * 60
 
}
 
  
reptime <- temp2
+
if(is.na(starting)) starting <- paste(format(Sys.Date(), format = "%Y"), "-01-01", sep = "")
 +
starting <-  as.POSIXlt(starting, origin = "1970-01-01") # First day of year.
 +
starting$mday <- starting$mday - as.numeric(format(starting, format = "%w")) + day[!is.na(day)] # Previous Sunday plus weekdaynumber.
  
starting <- as.POSIXlt(paste(format(Sys.Date(), format = "%Y"), "-01-01", sep = "")) # First day of year.
+
reps <- data.frame()
starting$mday <- starting$mday - as.numeric(format(starting, format = "%w")) + day[!is.na(day)] # Previous Sunday plus weekdaynumber.
+
temp3 <- starting  
  
reps <- data.frame()
+
for(i in 1:weeks)
temp3 <- starting
+
{
 +
reps <- rbind(reps, data.frame(
 +
Datrow = (1:nrow(timesall))[!is.na(day)],
 +
X = as.POSIXct(temp3, origin = "1970-01-01", tz = tz) + reptime
 +
))
 +
temp3$mday <- temp3$mday + 7 # Make a weekly event.
 +
}
 +
colnames(reps)[colnames(reps) == "X"] <- j
  
for(i in 1:weeks)
+
if(j == colnames(repall)[1]) repout <- reps else repout <- cbind(repout, reps[j])
{
+
}
temp3$mday <- temp3$mday + 7 # Make a weekly event.
 
reps <- rbind(reps, data.frame(
 
Datrow = repeatsrow,
 
Timevalues = as.POSIXct(temp3, tz = "Europe/Helsinki") + reptime
 
))
 
 
}
 
}
 
+
out <- rbind(xout, repout)
out <- rbind(x, reps)
 
 
 
 
if(is.data.frame(dat))
 
if(is.data.frame(dat))
 
{
 
{
 
dat$Datrow <- 1:nrow(dat)
 
dat$Datrow <- 1:nrow(dat)
 +
dat <- dat[!colnames(dat) %in% timecol]
 
out <- merge(dat, out)
 
out <- merge(dat, out)
out <- out[!colnames(out) %in% c("Datrow", timecol)]
+
out <- out[colnames(out) != "Datrow"]
 
} else {
 
} else {
out <- out$Timevalues
+
out <- out[[timecol]]
 
}
 
}
 
 
 
return(out)
 
return(out)
 
}
 
}
 +
  
 
# Funktio makeTimeline ottaa tapahtumalistauksen ja rakentaa siitä aikajanan. Parametrit:
 
# Funktio makeTimeline ottaa tapahtumalistauksen ja rakentaa siitä aikajanan. Parametrit:
Line 600: Line 639:
 
timeline <- merge(timeline, temp[ , c("Time", "EventrowStart")], all = TRUE) # Lisätään tapahtumat aikajanaan.
 
timeline <- merge(timeline, temp[ , c("Time", "EventrowStart")], all = TRUE) # Lisätään tapahtumat aikajanaan.
 
colnames(temp) <- c("Remove", "Time", "EventrowEnd") # Muutetaan otsikot, koska nyt halutaan mergata loppuhetket aikajanaan.
 
colnames(temp) <- c("Remove", "Time", "EventrowEnd") # Muutetaan otsikot, koska nyt halutaan mergata loppuhetket aikajanaan.
timeline <- merge(timeline, temp[, c("Time", "EventrowEnd")], all=TRUE)
+
timeline <- merge(timeline, temp[, c("Time", "EventrowEnd")], all = TRUE)
 
for(j in 2:nrow(timeline)) {
 
for(j in 2:nrow(timeline)) {
 
# Tämä luuppi käy aikajanan läpi ja täydentää tapahtumat.
 
# Tämä luuppi käy aikajanan läpi ja täydentää tapahtumat.
Line 630: Line 669:
 
timeline <- merge(timeline, event) # Yhdistetään Statuksen eli eventin rivinumeron avulla.
 
timeline <- merge(timeline, event) # Yhdistetään Statuksen eli eventin rivinumeron avulla.
 
timeline <- timeline[!colnames(timeline) %in% c("Eventrow", "Alku", "Loppu", "Toisto", "Kesto")]
 
timeline <- timeline[!colnames(timeline) %in% c("Eventrow", "Alku", "Loppu", "Toisto", "Kesto")]
 +
timeline <- timeline[order(timeline$Time) , ]
  
 
if(timeformat) timeline$Time <- as.POSIXct(timeline$Time, origin = "1970-01-01")
 
if(timeformat) timeline$Time <- as.POSIXct(timeline$Time, origin = "1970-01-01")

Revision as of 21:31, 2 February 2014



Question

Which functions are so useful that they should be taken into OpasnetUtils package? This page contains draft function which will be included when they are good enough and found important.

Answer

Call the objects stored by this code from another rode with this command:

objects.latest("Op_en6007", code_name = "answer")

+ Show code

See also

References


Related files

<mfanonymousfilelist></mfanonymousfilelist>