I am trying to export all the command history from Rstudio in Mac. But in the "History" tab or using savehistory(file = ".Rhistory"), only about 500 hundred latest commands are exported. However, when I directly search commands, I can see the commands way earlier than these 500 commands, for example half of a year ago. So where does Rstudio store all these histories? How can I export them? If the final history contains the date of the commands that I input, it would be even better. Thank you a lot.
After searching with the same question, here's an answer in case anyone else comes across the same issue:
savehistory is a base R function that will save everything from the current session, whereas RStudio has a seperate database that the history window uses. The location of this depends on your operating system (more info here).
Windows:
%localappdata%\RStudio
macOS:
open ~/.local/share/rstudio
Once you've located the history_database, this helpful code by #vzemlys allows you to export the contents to a text file with "nicer formatting" (i.e. data and time stamps for each line of code history):
library(dplyr)
library(magrittr)
library(lubridate)
library(bit64)
library(stringr)
lns <- readLines("yourfilelocation/history_database") %>% str_split(pattern=":",n=2)
hist_db <- data_frame(epoch=as.integer64(sapply(lns,"[[",1)),history=sapply(lns,"[[",2))
hist_db %<>% mutate(nice_date = as.POSIXct(epoch/1000,origin = "1970-01-01",tz = "EET"))
hist_db %<>% mutate(day = ceiling_date(nice_date,unit = "day")-days(1))
hist_db %<>% dplyr::select(-epoch)
dd <- hist_db$day %>% unique %>% sort
ff <- "hist_nice.txt"
cat("R history","\n",rep("-",80),"\n",file=ff,sep="")
for(i in 1:length(dd)) {
cat("\n\n",format(dd[i]),"\n",rep("-",80),"\n",file=ff,sep="",append=TRUE)
hist_db %>% filter(day==dd[i]) %>% dplyr::select(nice_date,history) %>% arrange(nice_date) %>%
write.table(ff,sep="\t", quote=F, row.names=FALSE, col.names=FALSE, append=TRUE)
}
Example output:
--------------------------------------------------------------------------------
R history
--------------------------------------------------------------------------------
2022-06-08
--------------------------------------------------------------------------------
2022-06-08 13:32:57 test <- testfile %>% pivot_wider(names_from=scenario, values_from=sst) %>% na.omit()
2022-06-08 13:32:57 ggplot() + theme_bw() +
2022-06-08 13:32:57 geom_tile(data = test, aes(x,y,colour=layer), alpha=0.8) +
2022-06-08 13:32:57 scale_color_viridis() +
2022-06-08 13:32:57 coord_equal() +
2022-06-08 13:32:57 theme(legend.position="bottom")
--------------------------------------------------------------------------------
Related
I tried to follow the examples in the
Link 1 - Sparse Matrix
https://www.tidyverse.org/blog/2020/11/tidymodels-sparse-support/
Link 2 - Workflow_sets
https://www.tmwr.org/workflow-sets.html
I had trouble including the blue print into the workflow sets.
In the examples where workflow_set is defined in link 2
no_pre_proc <-
workflow_set(
preproc = list(simple = model_vars),
models = list(MARS = mars_spec, CART = cart_spec, CART_bagged = bag_cart_spec,
RF = rf_spec, boosting = xgb_spec, Cubist = cubist_spec)
)
and the way we add blue print into the workflow in link 1
wf_sparse <-
workflow() %>%
add_recipe(text_rec, blueprint = sparse_bp) %>%
add_model(lasso_spec)
wf_default <-
workflow() %>%
add_recipe(text_rec) %>%
add_model(lasso_spec)
Where and how do I add the "blueprint = sparse_bp" option in the workflow_set above?
My attempts were
no_pre_proc <-
workflow_set(
preproc = list(simple = model_vars),
models = list(MARS = mars_spec, CART = cart_spec, CART_bagged = bag_cart_spec,
RF = rf_spec, boosting = xgb_spec, Cubist = cubist_spec)) %>%
option_add(update_blueprint(blueprint = sparse_bp))
Running the racing tune gave me this error
Error: Problem with `mutate()` column `option`.
i `option = purrr::map(option, append_options, dots)`.
x All options should be named.
Run `rlang::last_error()` to see where the error occurred
<error/rlang_error>
There were 9 workflows that had no results.
Backtrace:
1. ggplot2::autoplot(...)
2. workflowsets:::autoplot.workflow_set(...)
3. workflowsets:::rank_plot(...)
4. workflowsets:::pick_metric(object, rank_metric, metric)
6. workflowsets:::collect_metrics.workflow_set(x)
7. workflowsets:::check_incompete(x, fail = TRUE)
8. workflowsets:::halt(msg)
Run `rlang::last_trace()` to see the full context.
> rlang::last_trace()
<error/rlang_error>
There were 9 workflows that had no results.
Backtrace:
x
1. +-ggplot2::autoplot(...)
2. \-workflowsets:::autoplot.workflow_set(...)
3. \-workflowsets:::rank_plot(...)
4. \-workflowsets:::pick_metric(object, rank_metric, metric)
5. +-tune::collect_metrics(x)
6. \-workflowsets:::collect_metrics.workflow_set(x)
7. \-workflowsets:::check_incompete(x, fail = TRUE)
8. \-workflowsets:::halt(msg)
>
thanks,
Thank you for asking this question; we definitely are not supporting this use case (passing non-default arguments to the recipe or model) very well right now. We've opened an issue here where you can track our work on this.
In the meantime, you could try a bit of a hacky workaround by manually using update_recipe() on the workflow you are interested in:
library(tidymodels)
#> Registered S3 method overwritten by 'tune':
#> method from
#> required_pkgs.model_spec parsnip
data(parabolic)
set.seed(1)
split <- initial_split(parabolic)
train_set <- training(split)
test_set <- testing(split)
glmnet_spec <-
logistic_reg(penalty = 0.1, mixture = 0) %>%
set_engine("glmnet")
rec <-
recipe(class ~ ., data = train_set) %>%
step_YeoJohnson(all_numeric_predictors())
sparse_bp <- hardhat::default_recipe_blueprint(composition = "dgCMatrix")
wfs_orig <-
workflow_set(
preproc = list(yj = rec,
norm = rec %>% step_normalize(all_numeric_predictors())),
models = list(regularized = glmnet_spec)
)
new_wf <-
wfs_orig %>%
extract_workflow("yj_regularized") %>%
update_recipe(rec, blueprint = sparse_bp)
Created on 2021-12-09 by the reprex package (v2.0.1)
Then (I know this feels hacky for now) manually take this new_wf and stick it in to the wfs_orig$info[[1]]$workflow slot to replace what is there.
I am trying to create a mask for a project using the packages sf and RGDAL. I have a shapefile which is a SpatiallinesDataFrame and it needs to be a SpatialpolygonsDataFrame to continue.
I have tried these codes
fence1 <- as(fence1 ,"SpatialPolygonsDataFrame")
fence1 <- SpatialPolygonsDataFrame(fence1)
fence1 <- SpatialPolygonsDataFrame(fence1, match.ID = TRUE)
The fence1 is the SpatiallinesDataFrame that i imported from a shp. file using the code:
fence1 <- readOGR('/SECR/', layer = 'building')
The aim of this data is to create a mask so i can create a SECR analysis
If you are using sf, you could read in using:
fence1 <- st_read('/SECR/building.shp')
You could then do a buffer to make these lines polygons, choosing width in units of your projection:
fence_buf <- st_buffer(fence1, 50) # buffer unit of 50 as example
Then if you need your polygons as an sp SpatialPolygonsDataFrame you could convert from sf to sp:
fence_buf <- as(fence_buf, 'Spatial')
I'm looking for some guidance and hope that I did the right thing posting it in here. I'm looking to input data to Quantmod with GetSymbols from SQL Server. I'm new to R but have a background working with SQL Server, not a pro but finding my way.
I have imported all my data into one table in SQL Server named Quotes with the following columns;
- Ticker Varchar(10)
- Name varchar(50)
- [Date] datetime
- [Open] Decimal(19,9)
- High Decimal(19,9)
- Low Decimal(19,9)
- [Close] Decimal(19,9)
- Volume Decimal(19,9)
- Signal Decimal(19,9)
I'm able to connect to the database using the RODBC package:
- (cn <- odbcDriverConnect(connection="Driver={SQL Server Native Client 11.0};server=localhost;database=DB;trusted_connection=yes;"))
and make various select statement in R, but I'm lost in getting the data into Quantmod without having to do other workaround like exporting to csv from SQL. Importing the data from Yahoo is a problem as I cannot find a complete Yahoo-tickerlist.
Is there a way to get data directly into R and quantmod from SQL Server?
Something like this should do the trick.
getPrices.DB <- function(Symbol, from=NA) {
cn <- "add your connection info here"
qry <- sprintf("select [Date], [Open],[High],[Low],[Close],[Volume],[Signal] from MarketPrice where Ticker = '%s'", Symbol)
if (!is.na(from)) { qry <- paste(qry, sprintf(" and [Date]>= '%s'", from)) }
DB <- odbcDriverConnect(cn)
r <- sqlQuery(DB, qry, stringsAsFactors = FALSE)
odbcClose(DB)
if (!is.null(r) && NROW(r) >= 1) {
x <- xts(r[, 2:7], order.by = as.POSIXct(r[, 1], tz = "UTC"))#can eliminate tz if you want in local timezone
indexFormat(x) <- "%Y-%b-%d %H:%M:%OS3 %z" #option. I find useful for debuggging
colnames(x) <- paste(Symbol, c("Open", "High","Low", "Close", "Volume", "Signal"), sep = ".")
return(x)
} else {
return(NULL)
}
}
Now hook into the quantmod infrastructure:
getSymbols.DB <- function(Symbols, env, ...) {
importDefaults("getSymbols.DB")
this.env <- environment()
for (var in names(list(...))) {assign(var, list(...)[[var]], this.env)}
if (!hasArg(from)) from <- NA
if (!hasArg(verbose)) verbose <- FALSE
if (!hasArg(auto.assign)) auto.assign <- FALSE
for (i in 1:length(Symbols)) {
if (verbose) cat(paste("Loading ", Symbols[[i]], paste(rep(".", 10 - nchar(Symbols[[i]])), collapse = ""), sep = ""))
x <- getPrices.DB(Symbols[[i]], from = from)
if (auto.assign) assign(Symbols[[i]], x, env)
if (verbose) cat("done\n")
}
if (auto.assign)
return(Symbols)
else
return(x)
}
example usage:
APPL <- getSymbols("AAPL", src="DB", auto.assign=F)
I have merged different sources of code to make an app that allows one to upload a file (data frame).
However, beyond this I would also like to make it possible to select specific columns from the data frame and analyse them. This is difficult however as one must predefine the given data frame in order to be able to refer to it in the ui.R script....
So when a previously undefined data frame is uploaded to the site, one can not revere to it in the ui.R as it is defined in the server....
predefined variables
vchoices <- 1:ncol(mtcars)
names(vchoices) <- names(mtcars)
ui.R
runApp(
ui = basicPage(
h2('The uploaded file data'),
dataTableOutput('mytable'),
fileInput('file', 'Choose info-file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
),
actionButton("choice", "incorporate external information"),
selectInput("columns", "Select Columns", choices=vchoices, inline = T),
#notice that the 'choices' in selectInput are set to the predefined
#variables above whereas I would like to set them equal to the
#not yet defined uploaded file below in server.R
tableOutput("table_display")
))
Notice that the 'choices' in selectInput are set to the predefined variables above whereas I would like to set them equal to the not yet defined uploaded file below in server.R
server.R
server = function(input, output) {
info <- eventReactive(input$choice, {
inFile <- input$file
if (is.null(inFile))
return(NULL)
isolate(f<-read.table(inFile$datapath, header = T,
sep = "\t"))
f
})
output$table_display<-renderTable({
f<-info()
f<-subset(f, select=input$columns) #subsetting takes place here
head(f)
})
}
Does anyone know of a way to refer to a variable that's defined in in the server, in the ui and thus allow for interactive manipulation?
You can use a family of functions update*Input - in this case updateSelectInput. Its first argument has to be session and you also have to add session to server <- function(input, output) to be able to update your widget.
You could make an update of the widget immediately after clicking on the actionButton - so, you had to use updateSelectInput within eventReactive.
Let's take a look how we can do that:
First, you can save the names of columns of the new uploaded dataset in a variable, say, vars and then pass it to the function updateSelectInput.
(The choices of the selectInput are initially set to NULL - we don't need to specify them before because they are going to be updated anyway)
info <- eventReactive(input$choice, {
inFile <- input$file
# Instead # if (is.null(inFile)) ... use "req"
req(inFile)
# Changes in read.table
f <- read.table(inFile$datapath, header = input$header, sep = input$sep, quote = input$quote)
vars <- names(f)
# Update select input immediately after clicking on the action button.
updateSelectInput(session, "columns","Select Columns", choices = vars)
f
})
I've added a small upload interface to your code.
The other way would be to define widgets on the server side and then to pass them to the client side via renderUI function. You can find here an example.
Full example:
library(shiny)
ui <- fluidPage(
h2('The uploaded file data'),
dataTableOutput('mytable'),
fileInput('file', 'Choose info-file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
),
# Taken from: http://shiny.rstudio.com/gallery/file-upload.html
tags$hr(),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','),
radioButtons('quote', 'Quote',
c(None='',
'Double Quote'='"',
'Single Quote'="'"),
'"'),
################################################################
actionButton("choice", "incorporate external information"),
selectInput("columns", "Select Columns", choices = NULL), # no choices before uploading
tableOutput("table_display")
)
server <- function(input, output, session) { # added session for updateSelectInput
info <- eventReactive(input$choice, {
inFile <- input$file
# Instead # if (is.null(inFile)) ... use "req"
req(inFile)
# Changes in read.table
f <- read.table(inFile$datapath, header = input$header, sep = input$sep, quote = input$quote)
vars <- names(f)
# Update select input immediately after clicking on the action button.
updateSelectInput(session, "columns","Select Columns", choices = vars)
f
})
output$table_display <- renderTable({
f <- info()
f <- subset(f, select = input$columns) #subsetting takes place here
head(f)
})
}
shinyApp(ui, server)
I posted before on this and was not able to arrive at a solution with the single posted response. I have tried another approach that gets me what I want, mostly. The current solution would work better if it were in a single dialogue box but I am not sure how to do this. I am putting together other solutions I found on Nabble and stack and just cannot get what I need. I want the following to offer the choices in a single window, instead of having the user input into 3 separate boxes. Please help.
options(guiToolkit="RGtk2")
library(gWidgets)
#Creat selection function
select <- function(x,multiple = TRUE, Title,...){
ans<-new.env()
x1<-ggroup(horizontal=TRUE) # no parent container here
x2<-gcheckboxgroup( x,multiple=multiple,con=x1,expand=TRUE)
ret <- gbasicdialog(title = Title, widget=x1,handler=function(h,...){
value <- svalue(x2)
if (length(value)==0) value=""
assign("selected",value,env=h$action$env)
dispose(x1)
},action=list(env=ans))
ans
}
#Create list to store results
Days. <- c("Day1","Day2","Day3")
Outputs_ <- list()
SelectionOptions. <- c("Bicycle Event1", "Construction Nearby","Path Closure")
#Cycle through each day
for(day in Days.){
ans <- select(SelectionOptions., Title = day)
Outputs_[[day]] <- ans$selected
}
#return results of selection
unlist(Outputs_)
You are making it a bit more complicated than need be.
you are better off making things asynchronous (in most cases), using a handler to be called when the values are selected.
However, if you want it done this way, make a container for your selection widgets, then add them to the container. This container is then passed into gbasicdialog. That way all will show in one window. Using gWidgets2 makes working with the basic dialog a lot easier.
Okay, here is an example, though I'm not quite sure what problem you are trying to solve, so may be off:
library(gWidgets2)
Days. <- c("Day1","Day2","Day3")
SelectionOptions. <- c("Bicycle Event1", "Construction Nearby","Path Closure")
w <- gwindow()
g <- gformlayout(cont=w)
days <- gradio(Days., cont=g, label="Days:")
opts <- gcombobox(SelectionOptions., cont=g, label="Options:")
btn <- gbutton("Show them", cont=g, label="")
addHandlerClicked(btn, handler=function(h,...) {
values <- lapply(list(days, opts), svalue)
print(values)
})
## or using a modal dialog
dlg <- gbasicdialog(handler=function(h,...) {
values <- lapply(list(days, opts), svalue)
print(values)
})
g <- gformlayout(cont=dlg)
days <- gradio(Days., cont=g, label="Days:")
opts <- gcombobox(SelectionOptions., cont=g, label="Options:")
visible(dlg, TRUE)
## third time is a charm? (Though you could clean this up)
library(gWidgets2)
e <- new.env()
e$Days <- ""; e$Sel <- ""
Days. <- c("Day1","Day2","Day3")
SelectionOptions. <- c("Bicycle Event1", "Construction Nearby","Path Closure")
dlg <- gbasicdialog(title="test", do.buttons=FALSE)
g <- ggroup(cont=dlg, horizontal=FALSE)
fl <- gformlayout(cont=g)
days <- gradio(Days., cont=fl, label="Days:")
cb <- gcombobox(SelectionOptions., selected=0, cont=fl, label="Options:")
handler <- function(h,...) {
e$Days <- svalue(days)
e$Sel <- ifelse(length(svalue(cb)) > 0, svalue(cb), "")
if (all(sapply(e, function(x) nchar(x) > 0)))
dlg$dispose_window()
}
sapply(list(days, cb), addHandlerChanged, handler=handler)
visible(dlg, TRUE)
Take 4
library(gWidgets2)
days <- paste("Day", 1:3)
events <- c("none", "Bicycle Event","Construction Nearby","Path Closure")
l <- list()
handler <- function(h,...) {
l[[h$action]] <<- svalue(h$obj)
if(length(l) == 3)
print(l)
}
w <- gwindow()
g <- gvbox(cont=w)
for (day in days) {
l <- glabel(day, cont=g); font(l) <- list(weight="bold")
gradio(events, cont=g, handler=handler, action=day)
}