Will vapply work with data classes beyond numeric, character, and logical? Can vapply return as.Date data in the original class? Here's my list:
name <- "Truman"
birth <- as.Date("1884/05/08")
death <- as.Date("1972/12/26")
no33 <- list("name"=name"birth"=birth,"death"=death)
name <- "Eisenhower"
birth <- as.Date("1890/10/14")
death <- as.Date("1969/03/28")
no34 <- list("name"=name"birth"=birth,"death"=death)
presidents <- list(no33,no34)
lapply works fine, but sapply transforms the dates:
lapply(1:length(presidents), FUN= function (x) presidents[[x]]$death)
sapply(1:length(presidents), FUN= function (x) presidents[[x]]$death)
vapply throws an error when specifying Date as data type:
vapply(1:length(presidents), FUN= function (x)
as.character(presidents[[x]]$death), FUN.VALUE = date(1)))
I've got this one line work around
as.Date(vapply(1:length(presidents), FUN= function (x)
as.character(presidents[[x]]$death), FUN.VALUE =
character(1)))
What is sapply doing? And is there a better alternative to my one-line hack?
Related
I apologize for not having a working example atm
All I really need is a sample format for how to load multiple symbols from a csv
The function call says
https://www.rdocumentation.org/packages/quantstrat/versions/0.16.7/topics/applyStrategy
mktdata
"an xts object containing market data. depending on indicators, may need to be in OHLCV or BBO formats, default NULL"
The reason I don't wish to use getSymbols is because I do some preprocessing and load the data from csv's because my internet is shoddy. I do download data, but about once a week. My preprocess produces different symbols from a subset of 400 symbols based on the time periods I scan. I'm trying to frontload all my download processing, and no matter what I try, I can't get it to load from either a dataframe or an xts object. Right now I'm converting from csv to dataframe to xts and attempting to load.
I have noticed my xts objects differ from the getSymbols (error about incorrect dimensions). Specifically if I call colnames. Mine will say none, where as getSymbols subelements list 6 columns.
Anyways. What I would like to do, is see a minimal example of loading custom OHCLV data from a csv into an xts that can be supplied as an object to mktdata = in the applyStrategy call. That way I can format my code to match
I have the code to load and create the xts object from a dataframe.
#loads from a dataframe which includes Symbol, Date, Open, High, Low, Close, Volume, Adjusted
tempData <- symbol_data_set[symbol_data_set$Symbol %in% symbolstring & symbol_data_set$Date >= startDate & symbol_data_set$Date<=endDate,]
#creates a list of xts
vectorXTS <- mclapply(symbolstring,function(x)
{
df <- symbol_data_set[symbol_data_set$Symbol==x & symbol_data_set$Date >= startDate & symbol_data_set$Date<=endDate,]
#temp <- as.xts(
temp <- cbind(as.data.frame(df[,2]),as.data.frame(df[,-1:-2]))
rownames(df) <- df$Date
#,order.by=as.POSIXct(df$Date),)
z <- read.zoo(temp, index = 1, col.names=TRUE, header = TRUE)
#sets names to Symbol.Open ...
colnames(z) <- c(paste0(symbolstring[x],".Open"),paste0(symbolstring[x],".High"),paste0(symbolstring[x],".Low"),paste0(symbolstring[x],".Close"),paste0(symbolstring[x],".Volume"),paste0(symbolstring[x],".Adjusted"))
return(as.xts(z, match.to=AAPL))
#colnames(as.xts(z))
})
names(symbolstring) <- symbolstring
names(vectorXTS) <- symbolstring
for(i in symbolstring) assign(symbolstring[i],vectorXTS[i])
colnames(tempData) <- c(paste0(x,".Symbol"),paste0(x,".Date"),paste0(x,".Open"),paste0(x,".High"),paste0(x,".Low"),paste0(x,".Close"),paste0(x,".Volume"),paste0(x,".Adjusted"))
head(tempData)
rownames(tempData) <- tempData$Date
#attempts to use this xts object I created
results <- applyStrategy(strategy= strategyName, portfolios = portfolioName,symbols=symbolstring,mktdata)
error
Error in mktdata[, keep] : incorrect number of dimensions
This is how you store an xts getSymbols object in a file and reload it for use for quantStrat's applyStrategy (two methods shown, the read.xts method is the ideal as you can see how the csv's are stored)
getSymbols("AAPL",from=startDate,to=endDate,adjust=TRUE,src='yahoo',auto.assign = TRUE)
saveRDS(AAPL, file= 'stuff.Rdata')
AAPL <- readRDS(file= 'stuff.Rdata')
write.zoo(AAPL,file="zoo.csv", index.name = "Date", row.names=FALSE)
rm(AAPL)
AAPL <- as.xts(read.zoo(file="zoo.csv",header = TRUE))
If you want to work with multiple symbols, I had this work.
Note initially I had a reference to the 1st element, i.e. vectorXTS[[1]], and it worked
Note: at least setting it up like this got it to run...
vectorXTS <- mclapply(symbolstring,function(x)
{
df <- symbol_data_set[symbol_data_set$Symbol==x & symbol_data_set$Date >= startDate & symbol_data_set$Date<=endDate,]
temp <- cbind(as.data.frame(df[,2]),as.data.frame(df[,-1:-2]))
rownames(df) <- df$Date
z <- read.zoo(temp, index = 1, col.names=TRUE, header = TRUE)
colnames(z) <- c(paste0(x,".Open"),paste0(x,".High"),paste0(x,".Low"),paste0(x,".Close"),paste0(x,".Volume"),paste0(x,".Adjusted"))
write.zoo(z,file=paste0(x,"zoo.csv"), index.name = "Date", row.names=FALSE)
return(as.xts(read.zoo(file=paste0(x,"zoo.csv"),header = TRUE)))
})
names(vectorXTS) <- symbolstring
#this will assign to memory vs vectorXTS if one wishes to avoid using mktdata = vectorXTS[[]]
for(i in symbolstring) assign(i,vectorXTS[[i]])
results <- applyStrategy(strategy= strategyName, portfolios = portfolioName,symbols=symbolstring, mktdata = vectorXTS[[]])
#alternatively
#results <- applyStrategy(strategy= strategyName, portfolios = portfolioName,symbols=symbolstring)
I am trying to create an app in which part of the UI displays a wordcloud generated by words/strings inputted by the user. To do this, I pass the input to a for loop which is supposed to then store every input in an empty vector with ever press of the action button. However, I am encountering a couple problems, though: one in that no word cloud is displaying, with no error indicated, and another in that the for loop will just overwrite the vector each time the button is pressed, such that it always only has one word in it instead of gradually adding more words. I figured the lack of display is because there is only one word, and it seems like wordcloud needs at least two words to print anything: so how can I get the for loop to work as intended with Shiny?
library(shiny)
library(stringr)
library(stringi)
library(wordcloud2)
ui <- fluidPage(
titlePanel("Strings Sim"),
sidebarLayout(
sidebarPanel(
textInput("string.input", "Create a string:", placeholder = "string <-"),
actionButton("go1", "GO!")
),
mainPanel(
textOutput("dummy"),
wordcloud2Output("the.cloud")
)
)
)
server <- function(input, output, session) {
observeEvent(input$go1, {
high.strung <- as.vector(input$string.input)
empty.words <- NULL
for (i in high.strung) {
empty.words <- c(empty.words, i)
}
word.vector <-matrix(empty.words, nrow = length(empty.words),ncol=1)
num.vector <- matrix(sample(1000), nrow=length(empty.words),ncol=1)
prelim <- cbind(word.vector, num.vector)
prelim.data <- as.data.frame(prelim)
prelim.data$V2 <- as.numeric(as.character(prelim.data$V2))
output$the.cloud <- renderWordcloud2(
wordcloud2(prelim.data)
)
print(empty.words)
})
}
shinyApp(ui=ui,server=server)
The operation works as intended when I run it without Shiny code; I basically just use a string in place of the input, run through the for loop a few times to generate the dataframe to be used by word cloud, and get something like the attached picture, which is what I am after:
Functional code without Shiny:
empty.words <- NULL
#Rerun below here to populate vector with more words and regenerate wordcloud
high.strung <- as.vector("gumbo")
for (i in high.strung) {
empty.words <- c(empty.words, i)
return(empty.words)
}
word.vector <-matrix(empty.words, nrow = length(empty.words),ncol=1)
num.vector <- matrix(sample(1000), nrow=length(empty.words),ncol=1)
prelim <- cbind(word.vector, num.vector)
prelim.data <- as.data.frame(prelim)
prelim.data$V2 <- as.numeric(as.character(prelim.data$V2))
str(prelim.data)
wordcloud2(prelim.data)
Any help is much appreciated!
Edit: More pictures of the desired output using the non-Shiny code. (I editted the dataframe output to overlay the wordcloud just to show the cloud and frame in one picture, i.e. don't need them to display in that way). With each press of the button, the inputted word(s) should be added to the dataframe that builds the cloud, gradually making it larger.The random number vector which determines the size doesn't have to stay the same with each press, but each inputted word should be preserved in a vector.
Your app is missing reactivity. You can read about that concept here. You can input strings and as soon as at least two words are in the dataframe the wordcloud is rendered. If you don't want multi-word strings to be split just take out the str_split() function.
library(shiny)
library(stringr)
library(stringi)
library(wordcloud2)
ui <- fluidPage(
titlePanel("Strings Sim"),
sidebarLayout(
sidebarPanel(
textInput("string.input", "Create a string:", placeholder = "string <-"),
actionButton("go1", "GO!")
),
mainPanel(
textOutput("dummy"),
wordcloud2Output("the.cloud")
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues(high.strung = NULL)
observeEvent(input$go1, {
rv$high.strung <- c(rv$high.strung,str_split(c(input$string.input), pattern = " ") %>% unlist)
})
prelim.data <- reactive({
prelim <- data.frame(
word.vector = rv$high.strung,
num.vector = sample(1000, length(rv$high.strung), replace = TRUE)
)
})
output$the.cloud <- renderWordcloud2(
if (length(rv$high.strung) > 0)
wordcloud2(prelim.data())
)
}
shinyApp(ui=ui,server=server)
I want to measure the performance of a Haskell function. This function is executed concurrently.
Is it correct to measure its performance using timestamps that getCurrentTime function returns? Does lazyness affects the measuring?
I want to save these times on a log. I have looked some logging libraries, but the time they return is not as precise as the timestamp that getCurrentTime returns. I use XES format on my log.
The code i use is something like this: (i did not compile it)
import Data.Time.Clock
measuredFunction:: Int -> IO (Int,UTCTime,UTCTime)
measuredFunction x = do
time' <- getCurrentTime
--performs some IO action that returns x'
time'' <- getCurrentTime
return (x',time',time'')
runTest :: Int -> Int -> IO ()
runTest init end = do
when (init <= end) (do
forkIO (do
(x',time',time'') <- measuredFunction 1
-- saves time' and time '' in a log
)
runTest (init+1) end )
It depends on the function. Some values have all their information immediately, whereas others can have expensive stuff going on "beyond the top layer". Here's a contrived example:
example :: (Int, Int)
example = (1+1, head [ x | x <- [1..], x == 10^6 ])
If you load this up in ghci, you will see (2, printed, and then after some delay, the remainder of the value 1000000) is printed. If you get a value like this, then the function will "return" "before" the expensive sub-value has been computed. But you can use deepseq to ensure that a value is computed all the way and doesn't have any sub-computations left.
Benchmarking is subtle, and there are a lot of ways to do it wrong (especially in Haskell). Fortunately we have a very good benchmarking library called criterion
(tutorial) which I definitely recommend you use if you are trying to get reliable results.
Currently I'm trying to learn Clojure and I would like to write a function that has a variable amount of parameters. This function should filter every input to check if it's a string or not. If it does, every input of type string should be returned..
Clojure is hard for me and different way of thinking, but am I on the right direction here.. I can't seem to solve it:
(defn returnString [& y]
(if (next y)
(filter (fn [x] (= (type x) "java.lang.String"))y)
(recur (next x))))
Thanks!
There is a function called string? that returns true if the argument is a string, or false if not.
=> (string? "hi")
true
=> (string? 100)
false
=> (string? ["a" "b" "c"])
false
So with that in mind, your function would look like:
(defn return-strings [& vals]
(filter string? vals))
The filter function will return a sequence (essentially a collection) of values, so there is no need worry about recursion (that is, using recur) in your custom function for this case.
The anonymous function you use to determine what is a string is very close to being correct. If you take a look at the source for string? by entering (source string?) into your REPL, you'll see:
(fn [x] (instance? String x))
Although, the approach you are taking would work as well. You just need to specify the String class instead of the string value you were giving. (Note, you can leave off java.lang because that package is automatically included just like it is in Java.)
(fn [x] (= (type x) String))
I am trying to find a global counterpart to isdebugged() in R. My scenario is that I have functions that make calls to other functions, all of which I've written, and I am turning debug() on and off for different functions during my debugging. However, I may lose track of which functions are set to be debugged. When I forget and start a loop, I may get a lot more output (nuisance, but not terrible) or I may get no output when some is desired (bad).
My current approach is to use a function similar to the one below, and I can call it with listDebugged(ls()) or list the items in a loaded library (examples below). This could suffice, but it requires that I call it with the list of every function in the workspace or in the packages that are loaded. I can wrap another function that obtains these. It seems like there should be an easier way to just directly "ask" the debug function or to query some obscure part of the environment where it is stashing the list of functions with the debug flag set.
So, a two part question:
Is there a simpler call that exists to query the functions with the debug flag set?
If not, then is there any trickery that I've overlooked? For instance, if a function in one package masks another, I suspect I may return a misleading result.
I realize that there is another method I could try and that is to wrap debug and undebug within functions that also maintain a hidden list of debugged function names. I'm not yet convinced that's a safe thing to do.
UPDATE (8/5/11): I searched SO, and didn't find earlier questions. However, SO's "related questions" list has shown that an earlier question that is similar, though the function in the answer for that question is both more verbose and slower than the function offered by #cbeleites. The older question also doesn't provide any code, while I did. :)
The code:
listDebugged <- function(items){
isFunction <- vector(length = length(items))
isDebugged <- vector(length = length(items))
for(ix in seq_along(items)){
isFunction[ix] <- is.function(eval(parse(text = items[ix])))
}
for(ix in which(isFunction == 1)){
isDebugged[ix] <- isdebugged(eval(parse(text = items[ix])))
}
names(isDebugged) <- items
return(isDebugged)
}
# Example usage
listDebugged(ls())
library(MASS)
debug(write.matrix)
listDebugged(ls("package:MASS"))
Here's my throw at the listDebugged function:
ls.deb <- function(items = search ()){
.ls.deb <- function (i){
f <- ls (i)
f <- mget (f, as.environment (i), mode = "function",
## return a function that is not debugged
ifnotfound = list (function (x) function () NULL)
)
if (length (f) == 0)
return (NULL)
f <- f [sapply (f, isdebugged)]
f <- names (f)
## now check whether the debugged function is masked by a not debugged one
masked <- !sapply (f, function (f) isdebugged (get (f)))
## generate pretty output format:
## "package::function" and "(package::function)" for masked debugged functions
if (length (f) > 0) {
if (grepl ('^package:', i)) {
i <- gsub ('^package:', '', i)
f <- paste (i, f, sep = "::")
}
f [masked] <- paste ("(", f [masked], ")", sep = "")
f
} else {
NULL
}
}
functions <- lapply (items, .ls.deb)
unlist (functions)
}
I chose a different name, as the output format are only the debugged functions (otherwise I easily get thousands of functions)
the output has the form package::function (or rather namespace::function but packages will have namespaces pretty soon anyways).
if the debugged function is masked, output is "(package::function)"
the default is looking throught the whole search path
This is a simple one-liner using lsf.str:
which(sapply(lsf.str(), isdebugged))
You can change environments within the function, see ?lsf.str for more arguments.
Since the original question, I've been looking more and more at Mark Bravington's debug package. If using that package, then check.for.traces() is the appropriate command to list those functions that are being debugged via mtrace.
The debug package is worth a look if one is spending much time with the R debugger and various trace options.
#cbeleites I like your answer, but it didn't work for me. I got this to work but it is less functional than yours above (no recursive checks, no pretty print)
require(plyr)
debug.ls <- function(items = search()){
.debug.ls <- function(package){
f <- ls(package)
active <- f[which(aaply(f, 1, function(x){
tryCatch(isdebugged(x), error = function(e){FALSE}, finally=FALSE)
}))]
if(length(active)==0){
return(NULL)
}
active
}
functions <- lapply (items, .debug.ls)
unlist (functions)
}
I constantly get caught in the browser window frame because of failing to undebug functions. So I have created two functions and added them to my .Rprofile. The helper functions are pretty straight forward.
require(logging)
# Returns a vector of functions on which the debug flag is set
debuggedFuns <- function() {
envs <- search()
debug_vars <- sapply(envs, function(each_env) {
funs <- names(Filter(is.function, sapply(ls(each_env), get, each_env)))
debug_funs <- Filter(isdebugged, funs)
debug_funs
})
return(as.vector(unlist(debug_vars)))
}
# Removes the debug flag from all the functions returned by `debuggedFuns`
unDebugAll <- function(verbose = TRUE) {
toUnDebug <- debuggedFuns()
if (length(toUnDebug) == 0) {
if (verbose) loginfo('no Functions to `undebug`')
return(invisible())
} else {
if (verbose) loginfo('undebugging [%s]', paste0(toUnDebug, collapse = ', '))
for (each_fn in toUnDebug) {
undebug(each_fn)
}
return(invisible())
}
}
I have tested them out, and it works pretty well. Hope this helps!