I am trying to make an R scripts generator. The problem is that the new files are presented as text files and not as R scripts. Is there any way to present them as R scripts?
Expected icon:
Result icon:
require("here", character.only = TRUE)
files.to.create <- c("main.R",
"functions.R",
"explore.R",
"initialize.R",
"load_data.R",
"build.R",
"analyze.R",
"build_ppt.R",
"prepare_markdown.R",
"markdown_report.Rmd")
try.to.make.files <- function(file.name, path){
if( .Platform$OS.type == "unix" ) {
new.file.name <- paste(path,"/", file.name, sep = "")
}
else {
new.file.name <- paste(path,"\\", file.name, sep = "")
}
cat(new.file.name,"\n")
unlink(new.file.name)
success <- file.create(new.file.name)
print(success)
return (TRUE)
}
invisible( lapply( files.to.create,
try.to.make.files,
here("src")))
UPDATE
Well it seems that if the file is empty Ubuntu handles it as empty text file, forcing it to show the txt icon and not the R icon. Filling the file solves the problem.
Related
My R code is trying to open a RDS file in a for loop as follows:
for(i in 1:run_loops){
source("./scripts/load_data.R")
model <- readRDS(file=paste(model_directory,"/",modelname,".Rds", sep="")) #STOPS-HERE!!!
source("./scripts/prediction.R")
}
R stops when there is no model file.
How do I get it to move to the next iteration instead of stopping?
P.S. modelname variable changes each time load_data.R is sourced.
This should do the trick:
for(i in 1:run_loops) {
tryCatch(
expr = {
source("./scripts/load_data.R")
model <-
readRDS(file = paste(model_directory, "/", modelname, ".Rds", sep = "")) #STOPS-HERE!!!
source("./scripts/prediction.R")
},
error = function(e) {
print(paste0(i, ' not done'))
}
)
}
You can use file.exists
file_name <- paste0(model_directory,"/",modelname,".Rds")
if(file.exists(file_name)) {
#do something
} else {
#do something else
}
Seems like this should be very simple, but I cannot get it to work. I have a long shell command that I would like to span over multiple lines, but escaping the single/double quotes correctly is giving me trouble. I have searched SO and googled this, but cannot find the solution.
Original, working code:
getVersion <- function() {
version <- shell("powershell -Command $path = 'C:/Windows/notepad.exe'; $versioninfo = [System.Diagnostics.FileVersionInfo]::GetVersionInfo($path); $itemproperties= get-childitem $path; [pscustomobject]#{'File version' = $versioninfo.FileVersion}", intern = TRUE)
version <- gsub(" ", "", version[4])
return(version)
}
Does not work:
getVersion <- function() {
version <- shell(paste0(\""powershell -Command $path = 'C:/Windows/notepad.exe'; $versioninfo = [System.Diagnostics.FileVersionInfo]::GetVersionInfo($path);\",
\"$itemproperties= get-childitem $path; [pscustomobject]#{'File version' = $versioninfo.FileVersion}"\"), intern = TRUE)
version <- gsub(" ", "", version[4])
return(version)
}
Also tried this:
getVersion <- function() {
version <- paste0('shell(\"powershell -Command $path = "C:/Windows/notepad.exe"; $versioninfo = [System.Diagnostics.FileVersionInfo]::GetVersionInfo($path);',
'$itemproperties= get-childitem $path; [pscustomobject]#{"File version" = $versioninfo.FileVersion}\", intern = TRUE)')
version <- gsub(" ", "", version[4])
return(version)
}
Why are you trying to escape? You don't actually have double quotes in the string you need to pass, right? So you can just do a paste() with double quoted strings that happen to contain single quotes. Or am I missing something?
For example, would this work?
getVersion <- function() { version <- shell(paste("powershell -Command $path = 'C:/Windows/notepad.exe';",
"$versioninfo = [System.Diagnostics.FileVersionInfo]::GetVersionInfo($path);",
"$itemproperties= get-childitem $path;",
"[pscustomobject]#{'File version' = $versioninfo.FileVersion}"),
intern = TRUE)
version <- gsub(" ", "", version[4])
return(version) }
I am trying to output either a .html or .csv file depending on a radio input button by the user but the input is not updating inside the downloadHandler. It stays on the default value selected.
output$bidownload <- downloadHandler(
if(input$conreport == 'report') {
filename = paste0(input$conreport, '.html')
} else {
filename = paste0(input$conreport, '.csv')
},
content = function(file) {
if(as.character(input$reporttype) == 'report') {
tempReport <- file.path(tempdir(), paste0(input$conreport, '.Rmd'))
file.copy(paste0(input$conreport, '.Rmd'), tempReport, overwrite = TRUE)
params <- list(range = as.character(input$dateparam))
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
} else {
write.csv(weightbreak_raw(), file)
}
}
)
Since the selected radiobutton is on 'report', I will always produce an .html document even if the user changes the radio button. How do I get the input to update in the downloadhandler? I checked here and still cannot figure out how to fix this
downloadHandler filename argument is either a string or a function. If you use a string, it is evaluated at render time but if you use a function it will be evaluated at download time (so after user select the desired type of download) :
output$bidownload <- downloadHandler(
function(){
if(input$conreport == 'report')
paste0(input$conreport, '.html')
else
paste0(input$conreport, '.csv')
},
...
RStudio provides a nice function View (with uppercase V) to take a look into the data, but with R it's still nasty to get orientation in a large data set. The most common options are...
names(df)
str(df)
If you're coming from SPSS, R seems like a downgrade in this respect. I wondered whether there is a more user-friendly option? I did not find a ready-one, so I'd like to share my solution with you.
Using RStudio's built-in function View, it's white simple to have a variable listing for a data.frame similar to the one in SPSS. This function creates a new data.frame with the variable information and displays in the RStudio GUI via View.
# Better variables view
Varlist = function(sia) {
# Init varlist output
varlist = data.frame(row.names = names(sia))
varlist[["comment"]] = NA
varlist[["type"]] = NA
varlist[["values"]] = NA
varlist[["NAs"]] = NA
# Fill with meta information
for (var in names(sia)) {
if (!is.null(comment(sia[[var]]))) {
varlist[[var, "comment"]] = comment(sia[[var]])
}
varlist[[var, "NAs"]] = sum(is.na(sia[[var]]))
if (is.factor(sia[[var]])) {
varlist[[var, "type"]] = "factor"
varlist[[var, "values"]] = paste(levels(sia[[var]]), collapse=", ")
} else if (is.character(sia[[var]])) {
varlist[[var, "type"]] = "character"
} else if (is.logical(sia[[var]])) {
varlist[[var, "type"]] = "logical"
n = sum(!is.na(sia[[var]]))
if (n > 0) {
varlist[[var, "values"]] = paste(round(sum(sia[[var]], na.rm=T) / n * 100), "% TRUE", sep="")
}
} else if (is.numeric(sia[[var]])) {
varlist[[var, "type"]] = typeof(sia[[var]])
n = sum(!is.na(sia[[var]]))
if (n > 0) {
varlist[[var, "values"]] = paste(min(sia[[var]], na.rm=T), "...", max(sia[[var]], na.rm=T))
}
} else {
varlist[[var, "type"]] = typeof(sia[[var]])
}
}
View(varlist)
}
My recommendation is to store that as a file (e.g., Varlist.R) and whever you need it, just type:
source("Varlist.R")
Varlist(df)
Again please take note of the uppercase V using as function name.
Limitation: When working with data.frame, the listing will not be updated unless Varlist(df) is run again.
Note: R has a built-in option to view data with print. If working with pure R, just replace the View(varlist) by print(varlist). Yet, depending on screen size, Hmisc::describe() could be a better option for the console.
Can someone recommend an efficient way to sift through each row in a dataframe and manually classify it? For example I might be wanting to separate spam from e-mail, or shortlist job adverts, job applicants, or dating agency profiles (I understand Tinder does this by getting you to swipe left or right).
My dataset is small enough to classify manually. I suppose if it was larger I might only want to manually classify a portion of it in order to train a machine-learning algorithm such as Naive Bayes to finish the task for me.
I'll show you what I've got at the moment, but this isn't a particularly original task, so there must be a less crude way to do this that someone has already thought of! (As a newcomer, I'm impressed by the power of R, but also nonplussed when little tasks like clearing the screen or capturing a keystroke turn out to be non-trivial)
# Let us suppose I am using this built-in dataset to draw up a
# shortlist of where I might wish to go on holiday
df <- data.frame(state.x77);
# pp - define a task-specific pretty print function
pp <- function(row) {
print(row); # Example dataset is simple enough to just print the entire row
}
# cls - clear the screen (this hack works on Windows but I've commented it for now)
cls <- function() {
#system("powershell -ExecutionPolicy Bypass -command (New-Object -ComObject Wscript.Shell).SendKeys([string][char]12)");
}
# It would halve the number of keystrokes needed if I knew a way to read
# a single character
readcharacter <- readline;
sift <- function(df, pp)
{
classification = rep('', nrow(df));
for (nRow in 1:nrow(df))
{
cls();
pp(df[nRow,]);
cat("\nEnter 'a' to discard, 'd' to keep, 'q' to quit\n");
char <- '';
while (char != 'a' && char != 'd' && char != 'q') {
char <- readcharacter();
}
if (char == 'q')
break;
classification[nRow] = char;
}
return(cbind(df,classification=classification));
}
result = sift(df, pp);
cls();
cat("Shortlist:\n");
print(row.names(result[result$classification=='d',]));
So how does the StackOverflow community feel about me using this Shiny app to solve my problem? I wouldn't expect to see Shiny used in this early part of data analysis - normally it only comes into play once we have some results we'd like to explore or present dynamically.
Learning Shiny was fun and useful, but I'd much prefer it if a less complicated answer could be found.
library(shiny);
#
# shortlist - function that allows us to shortlist through the rows in a data frame efficiently
#
shortlist <- function(df, sTitle, sRowName) {
createUI <- function() {
listHeading <- list(
textOutput(outputId = "Progress"),
tags$br(),
fluidRow(
column(width=1, sRowName),
column(width=9, textOutput(outputId = "RowName"))));
listFields <- lapply(names(df), function(sFieldname) {
return(fluidRow(
column(width=1, sFieldname),
column(width=9, textOutput(outputId = sFieldname))));
});
listInputs <- list(
tags$br(),
tags$table(
tags$tr(
tags$td(" "),
tags$td(actionButton(inputId="Up", label="W", disabled=TRUE, width="100%"))),
tags$tr(
tags$td(width="100px", actionButton(inputId="Discard", label="Discard, A", width="100%")),
tags$td(width="100px", actionButton(inputId="Down", label="S", disabled=TRUE, width="100%")),
tags$td(width="100px", actionButton(inputId="Keep", label="Keep, D", width="100%")))),
tags$script("
// JavaScript implemented keyboard shortcuts, including lots of conditions to
// ensure we're finished processing one keystroke before we start the next.
var bReady = false;
$(document).on('shiny:recalculating', function(event) {
bReady = false;
});
$(document).on('shiny:recalculated', function(event) {
setTimeout(function() {bReady = true;}, 500);
});
$(document).on('keypress', function(event) {
if (bReady) {
switch(event.key.toLowerCase()) {
case 'a':
document.getElementById('Discard').click();
bReady = false;
break;
case 'd':
document.getElementById('Keep').click();
bReady = false;
break;
}
}
});
// End of JavaScript
"));
listPanel <- list(
title = sTitle,
tags$br(),
conditionalPanel(
condition = paste("input.Keep + input.Discard <", nrow(df)),
append(append(listHeading, listFields), listInputs)));
listShortlist <- list(
tags$hr(),
tags$h4("Shortlist:"),
dataTableOutput(outputId="Shortlist"));
ui <- do.call(fluidPage, append(listPanel, listShortlist));
return(ui);
}
app <- shinyApp(ui = createUI(), server = function(input, output) {
classification <- rep('', nrow(df));
getRow <- reactive({
return (input$Keep + input$Discard + 1);
});
classifyRow <- function(nRow, char) {
if (nRow <= nrow(df)) {
classification[nRow] <<- char;
}
# In interactive mode, automatically stop the app when we're finished
if ( interactive() && nRow >= nrow(df) ) {
stopApp(classification);
}
}
observeEvent(input$Discard, {classifyRow(getRow() - 1, 'a')});
observeEvent(input$Keep, {classifyRow(getRow() - 1, 'd')});
output$Progress = renderText({paste("Showing record", getRow(), "of", nrow(df))});
output$RowName = renderText({row.names(df)[getRow()]});
lapply(names(df), function(sFieldname) {
output[[sFieldname]] <- renderText({df[getRow(), sFieldname]});
});
output$Shortlist <- renderDataTable(options = list(paging = FALSE, searching = FALSE), {
# Mention the 'keep' input to ensure this code is called when the 'keep' button
# is pressed. That way the shortlist gets updated when an item to be added to it.
dummy <- input$Keep;
# Construct the shortlist
shortlist <- data.frame(row.names(df[classification == 'd',]));
colnames(shortlist) <- sRowName;
return(shortlist);
});
});
if (interactive()) {
classification <- runApp(app);
return(cbind(df, classification = classification));
} else {
return(app);
}
}
#
# And now some example code.
# Shortlist the built in state.x77 data set (let us suppose I am drawing up
# a shortlist of where I might wish to go on holiday)
#
df <- data.frame(state.x77);
result <- shortlist(df = df, "Choose states", "State");
if (interactive()) {
cat("Shortlist:\n");
print(row.names(result[result$classification == 'd',]));
} else {
return (result);
}