I know how to delete everything in the console: cat('\014')
But there is a progress bar in 'R'. Somehow, it is possible to delete only one line, and not everything at all?
Example using backspace:
showMe <- function() {
txt <- ' Hello Wonderful World! '
n <- nchar(txt)
for ( i in 1:100 ) {
cat(txt)
flush.console()
Sys.sleep(0.15)
for ( j in 1:n ) { cat('\b') }
aChr <- substr(txt, 1, 1)
txt <- paste0( substr(txt, 2, n), aChr )
}
cat(' Goodbye Cruel World! \n' )
}
showMe()
Related
I don't get any error but I was expecting that when I type an integer that is not 1,2,3,4 the code should enter in else statement and print what is in paste0 function. What is wrong?
escolha <- as.integer(readline(prompt="Enter your choice: "))
if(escolha == 1){
print("Cool you choose addition!")
} else if (escolha == 2) {
print("Cool, you choose subtraction!")
} else if (escolha == 3) {
print("Cool, you choose multiplication!")
} else if (escolha == 4){
print("Cool, you choose division!")
} else{
paste0("It's not possible to use ", escolha," as input.")
escolha<- as.integer(readline(prompt="Choose a valid number (1 a 4): "))
}
num1 <- as.double(readline(prompt="What is the first number? "))
num2 <- as.double(readline(prompt="What is the second number? "))
resultado <- switch (escolha, (num1+num2), (num1-num2), (num1*num2), (num1/num2))
cat("The result is: ", resultado)
paste0() (and paste()) assemble a string and return it. You still need to print the result to the screen with print() or cat(), like this:
cat(paste0("It's not possible to use ", escolha," as input.\n"))
(added the \n at the end, so the readline() prompt that follows will be on a separate line)
I would like to give a little informative message about where I am in the for-loop.
So I have this snippet of code:
for (i in 1:20) {
dashes = paste0(replicate(20, "-"), collapse = "")
cat("This should be above and not change")
cat(paste0("\r", i, " ", dashes))
Sys.sleep(0.3)
}
However, the output in the console looks like this:
9 --------------------This should be above and not change
While the number updates in place (which is the behavior I wanted), the "This should...", should be placed above and not move at all. I tried a couple of things but did not really succeed in doing so.
Not a very good question...
This simple if does the trick.
for (i in 1:20) {
dashes = paste0(replicate(20, "-"), collapse = "")
if (i == 1) {
cat("This should be above and not change\n")
}
cat(paste0("\r", i, " ", dashes))
Sys.sleep(0.3)
}
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
}
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.
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);
}