add <- function(x, y) {
return(x + y)
}
subtract <- function(x, y) {
return(x - y)
}
multiply <- function(x, y) {
return(x * y)
}
divide <- function(x, y) {
return(x / y)
}
factors <- function(x) {
if (choice == 5 | choice == 6) {
choice <- readline(prompt = "Enter the number: ")
}
else {
num1 = as.integer(readline(prompt = "Enter first number: "))
num2 = as.integer(readline(prompt = "Enter second number: "))
}
}
# take input from the user
print("Select operation.")
print("1.Add")
print("2.Subtract")
print("3.Multiply")
print("4.Divide")
print("5. Factors")
print("6. Prime")
choice = as.integer(readline(prompt="Enter choice[1/2/3/4/5/6]: "))
num1 = as.integer(readline(prompt="Enter first number: "))
num2 = as.integer(readline(prompt="Enter second number: "))
operator <- switch(choice,"+","-","*","/")
result <- switch(choice, add(num1, num2), subtract(num1, num2), multiply(num1, num2), divide(num1, num2), factor(i)
print(paste(num1, operator, num2, "=", result))
ERROR IN R CONSOLE -
> choice = as.integer(readline(prompt="Enter choice[1/2/3/45/6]: "))
Enter choice[1/2/3/45/6]: num1 = as.integer(readline(prompt="Enter first number: "))
Warning message:
NAs introduced by coercion
> num2 = as.integer(readline(prompt="Enter second number: "))
Enter second number: operator <- switch(choice,"+","-","*","/")
Warning message:
NAs introduced by coercion
> result <- switch(choice, add(num1, num2), subtract(num1, num2), multiply(num1, num2), divide(num1, num2))
> print(paste(num1, operator, num2, "=", result))
Error in paste(num1, operator, num2, "=", result) :
object 'num1' not found
This is the error thats generated by R.It appears that R is not able to run through the integers as per my commands. I cannot understand whats wrong with it. I have made few changed but even then the errors appear to be the same. When i run the code until the inputs taken from the user it runs quite fine but the inputs are not recognizing num1 and num2 it says -
"Warning message:
NAs introduced by coercion"
I do not understand since I'm a beginner. Please help me out.
Thank you
Related
I have created an R function that doesn't seem to be using the arguments that I give it. It runs but the result is not the one I should be getting given the parameters I pass to it. The code I have is as follows:
test_function <- function(text1, text2, number1) {
if (length(text1) == length(text2)) {
print("Equal")
} else {
print("Not equal")
}
operation <- length(text1) + number1
print(paste("The result for the operation is: "), operation)
}
x <- "Hello"
y <- "World!"
z <- 10
test_function(x, y, z)
Does anyone know why the result I'm getting is the following?
[1] "Equal"
[1] "The result for the operation is: "
Use nchar() instead of length().
In addition, paste("The result for the operation is:", operation).
test_function <- function(text1, text2, number1) {
if (nchar(text1) == nchar(text2)) {
print("Equal")
} else {
print("Not equal")
}
operation <- nchar(text1) + number1
print(paste("The result for the operation is:", operation))
}
x <- "Hello"
y <- "World!"
z <- 10
test_function(x, y, z)
#[1] "Not equal"
#[1] "The result for the operation is: 15"
I have a main string that looks like this:
my_main <- "ABCDEFGHIJ"
What I want to do is to sequentially mask at every position with another pattern string:
my_pattern <- "x*x" # the length could be varied from 1 up to length of my_main
Every character that overlap with * will be kept, other will be replaced with x.
The final result is a vector of strings that contain these:
xBxDEFGHIJ
AxCxEFGHIJ
ABxDxFGHIJ
ABCxExGHIJ
ABCDxFxHIJ
ABCDExGxIJ
ABCDEFxHxJ
ABCDEFGxIx
Next if the pattern is
my_pattern <- "xx**x"
The result would be:
xxCDxFGHIJ
AxxDExGHIJ
ABxxEFxHIJ
ABCxxFGxIJ
ABCDxxGHxJ
ABCDExxHIx
How can I achieve that?
This might be a little over-complicated, but it's a start:
I'm going to reuse Reduce_frame from https://stackoverflow.com/a/70945868/3358272.
Reduce_frame <- function(data, expr, init) {
expr <- substitute(expr)
out <- rep(init[1][NA], nrow(data))
for (rn in seq_len(nrow(data))) {
out[rn] <- init <- eval(expr, envir = data[rn,])
}
out
}
From here, let's split the pattern into a frame (for ease of access, if nothing else):
repl <- subset(
data.frame(p = strsplit(my_pattern, "")[[1]], i = seq_len(nchar(my_pattern))),
p != "*")
repl
# p i
# 1 x 1
# 3 x 3
From here, we can do it once with:
tail(Reduce_frame(repl, `substring<-`(init, i, i, p), init = my_main), 1)
# [1] "xBxDEFGHIJ"
Which means we can iterate fairly easily:
sapply(c(0, seq_len(nchar(my_main) - nchar(my_pattern))), function(offset) {
tail(Reduce_frame(transform(repl, i = i + offset),
`substring<-`(init, i, i, p), init = my_main), 1)
})
# [1] "xBxDEFGHIJ" "AxCxEFGHIJ" "ABxDxFGHIJ" "ABCxExGHIJ" "ABCDxFxHIJ" "ABCDExGxIJ" "ABCDEFxHxJ" "ABCDEFGxIx"
To use your second pattern,
my_pattern <- "xx**x"
repl <- transform(...) # from above
## the rest of this code is unchanged from above
sapply(c(0, seq_len(nchar(my_main) - nchar(my_pattern))), function(offset) {
tail(Reduce_frame(transform(repl, i = i + offset),
`substring<-`(init, i, i, p), init = my_main), 1)
})
# [1] "xxCDxFGHIJ" "AxxDExGHIJ" "ABxxEFxHIJ" "ABCxxFGxIJ" "ABCDxxGHxJ" "ABCDExxHIx"
So this can be easily functionized:
Reduce_frame <- ... # defined above
func <- function(S, pattern) {
stopifnot(nchar(S) >= nchar(pattern))
repl <- subset(
data.frame(p = strsplit(pattern, "")[[1]], i = seq_len(nchar(pattern))),
p != "*")
sapply(c(0, seq_len(nchar(S) - nchar(pattern))), function(offset) {
tail(Reduce_frame(transform(repl, i = i + offset),
`substring<-`(init, i, i, p), init = S), 1)
})
}
func("ABCDEFGHIJ", "x*x")
# [1] "xBxDEFGHIJ" "AxCxEFGHIJ" "ABxDxFGHIJ" "ABCxExGHIJ" "ABCDxFxHIJ" "ABCDExGxIJ" "ABCDEFxHxJ" "ABCDEFGxIx"
func("ABCDEFGHIJ", "xx**x")
# [1] "xxCDxFGHIJ" "AxxDExGHIJ" "ABxxEFxHIJ" "ABCxxFGxIJ" "ABCDxxGHxJ" "ABCDExxHIx"
Here's one way using strsplit, grepl, and paste.
f <- \(mm, mp) {
m <- el(strsplit(mm, ''))
p <- el(strsplit(mp, ''))
i <- which(!grepl(p, pattern='\\*'))
vapply(c(0L, seq_len(length(m) - max(i))), \(j) {
m[i + j] <- p[i]
paste(m, collapse='')
}, vector('character', 1L))
}
f('ABCDEFGHIJ', 'x*x')
# [1] "xBxDEFGHIJ" "AxCxEFGHIJ" "ABxDxFGHIJ" "ABCxExGHIJ" "ABCDxFxHIJ"
# [6] "ABCDExGxIJ" "ABCDEFxHxJ" "ABCDEFGxIx"
f('ABCDEFGHIJ', 'x**x')
# [1] "xBCxEFGHIJ" "AxCDxFGHIJ" "ABxDExGHIJ" "ABCxEFxHIJ" "ABCDxFGxIJ"
# [6] "ABCDExGHxJ" "ABCDEFxHIx"
f('ABCDEFGHIJ', 'xx**x')
# [1] "xxCDxFGHIJ" "AxxDExGHIJ" "ABxxEFxHIJ" "ABCxxFGxIJ" "ABCDxxGHxJ"
# [6] "ABCDExxHIx"
f('ABCDEFGHIJ', 'kk**krr')
# [1] "kkCDkrrHIJ" "AkkDEkrrIJ" "ABkkEFkrrJ" "ABCkkFGkrr"
f('ABCDEFGHIJ', 'kk**kr*r')
# [1] "kkCDkrGrIJ" "AkkDEkrHrJ" "ABkkEFkrIr"
Here is an approach along the same lines as r2evans' answer but relying on some stringr functions which should be more efficient than the base equivalents:
library(stringr)
f <- function(main, r_pattern) {
shift <- nchar(main) - nchar(r_pattern) + 1
idx <- as.data.frame(str_locate_all(r_pattern, "[^*]+")[[1]])
x_pattern <- str_split(r_pattern, "\\*+")[[1]]
Reduce(
function(x, y)
`str_sub<-`(
x,
seq(idx$start[y], length.out = shift),
seq(idx$end[y], length.out = shift),
omit_na = FALSE,
x_pattern[y]
),
seq(nrow(idx)),
init = main
)
}
f("ABCDEFGHIJ", "x*x")
[1] "xBxDEFGHIJ" "AxCxEFGHIJ" "ABxDxFGHIJ" "ABCxExGHIJ" "ABCDxFxHIJ" "ABCDExGxIJ" "ABCDEFxHxJ" "ABCDEFGxIx"
f("ABCDEFGHIJ", "xx**x")
[1] "xxCDxFGHIJ" "AxxDExGHIJ" "ABxxEFxHIJ" "ABCxxFGxIJ" "ABCDxxGHxJ" "ABCDExxHIx"
# Edit after OP comment:
f(my_main, "KK**KRR")
[1] "KKCDKRRHIJ" "AKKDEKRRIJ" "ABKKEFKRRJ" "ABCKKFGKRR"
Here is Ruby code that produces the desired result. I am presenting it in the event that a reader wishes to convert it to R, possibly with modification, of course.
You should be able to read the code even if you don't know Ruby, as long as you understand that:
'abc'.size returns 3;
0..8 is a range of integers between 0 and 8, inclusive;
'abc' << 'd' returns 'abcd';
7.modulo(3) returns 1;
'abcd'[2] returns 'c', 2 being an index; and
s == 'x' ? 'x' : my_main[j] reads, "if the string s (which will be 'x' or '*') equals 'x' return 'x', else return the character of my_main at index j.
The Ruby code (somewhat simplified from what would normally be written) is as follows.
def doit(my_main, my_pattern)
msz = my_main.size
psz = my_pattern.size
(0..msz-psz).map do |i|
s = ''
(0..msz-1).each do |j|
s << (my_pattern[(j-i).modulo(msz)] == 'x' ? 'x' : my_main[j])
end
s
end
end
I wrote a calculator program in which the User enters two numbers and an arithmetic operation between the numbers, then presses Enter and gets the result, or rather did a string parsing, but it doesn't work. What can this be related to? I also wrote the code so that I could exit the function
add<- function(x,y){
return(x+y)
}
subtract <- function(x,y){
return(x-y)
}
multiply <- function(x, y) {
return(x * y)
}
div <- function(x,y){
if(y==0){
return("Error")
break
}
else if(y!=0){
return(x%/%y)
}
}
res<-NA
repeat{
print("9", quote=FALSE)
user_string <-
readline(prompt = ("Enter: "))
if(user_string== 9){
break # to stop the programme
}
components_of_user_string <-
unlist(strsplit(user_string, split = '')) #splitting the line
num1<-as.numeric(components_of_user_string[1]) #first number
num2<-as.numeric(components_of_user_string[3]) # second number
us_chosen_operation <-
components_of_user_string[2]
operations_vector <-
c('+', '-', '*', '/')
choice <- match(us_chosen_operation, operations_vector)
operator <- switch(choice, ' + ', ' - ', ' * ', ' / ')
result <-
switch(
choice,
add(num1, num2),
subtract(num1, num2),
multiply(num1, num2),
divide(num1, num2)
)
print(paste(num1, operator, num2, "=", result))
}
String parsing with eval(parse(...)) could be an option :
repeat {
input <- readline(prompt = ("Enter: "))
print(eval(parse(text = input)))
}
# Enter: (-4)+2
# [1] -2
# Enter: raise_to_degree(2,3)
# [1] 8
Let's say I have a function like the following that only shows a message.
foo <- function(x) {
if (x < 0) message("entered number is negative")
}
Now I want to do something depending on whether the message was shown or not. To this end, I can use capture.output, which will capture the message.
But the problem is that the first message will no longer be shown to the user:
foo(-5)
#> entered number is negative
foo_new <- function(x) {
if (x < 0) m <- capture.output(message(cat("entered number is negative")))
if (length(m) > 0) return("think of a positive number")
}
foo_new(-2)
#>
#> [1] "think of a positive number"
Is there alternative to capture.output which capture the message and also prints it simultaneously?
P.S. This is just a minimal example demonstrating the problem.
You could also use the tee-operator %T>% from the magrittr library:
library(magrittr)
foo_new <- function(x) {
if (x < 0) m <- "entered number is negative" %T>% print()
if (length(m) > 0) return("think of a positive number")
}
foo_new(-2)
[1] "entered number is negative"
[1] "think of a positive number"
Here is more information on the tee-operator and how it works.
Given the code in the question this example is too complicated but the point it tries to make is the following:
If instead of giving a message, the message is first assigned to a variable then that variable can be returned to caller. This has the advantage of making it possible to create a message depending on the exact conditions it came to be needed.
foo <- function(x) {
xname <- deparse(substitute(x))
if(is.numeric(x)){
if(x < 0){
msg <- paste("entered number", sQuote(xname), "is negative")
message(msg)
msg
} else {
2*x
}
} else {
msg <- paste("Wrong class:", sQuote(xname), "is not numeric")
message(msg)
msg
}
}
x <- 1
y <- -2
z <- "1"
foo(x)
#[1] 2
foo(y)
#entered number ‘y’ is negative
#[1] "entered number ‘y’ is negative"
foo(z)
#Wrong class: ‘z’ is not numeric
#[1] "Wrong class: ‘z’ is not numeric"
Using argparser in R, I'm getting an error when specifying the type of an argument in the call to add_argument but not passing an argument to the script at the MacOSX command line. For example, given this R script:
library(argparser)
p <- arg_parser(description = "A test parser")
p <- add_argument(p, "--alpha", type = "double", help = "alpha for p-value")
p <- add_argument(p, "--sig-digits", type = "integer", help="number of significant digits")
args <- parse_args(p)
print(str(args))
and invoking it at the command line:
Rscript argparser-test.R --alpha 0.1
I am returned the error:
Error in (function (object, class, nargs) :
Invalid argument value: expecting integer but got: (NA).
Calls: parse_args -> mapply -> <Anonymous>
Interestingly, there is no error if you let --alpha take it's default:
Rscript argparser-test.R
Returns:
List of 5
$ : logi FALSE
$ help : logi FALSE
$ opts : logi NA
$ alpha : logi NA
$ sig_digits: logi NA
NULL
Notice the NA value here for sig_digits is type logical, not integer, as defined in the add_argument function.
Am I doing something wrong here? In the mean time, I suppose I will get around this by making the default --sig-digits = -1, then handling that as an exception, but I'd prefer not to.
Update: Actually, -1 throws the same error, which is very frustrating because I want to use a number for the exception that non-sensical. 9999 works, and is unlikely to be input by the user, but actually it's valid.
I experienced this error a month back or so. This is a problem with how optional arguments are parsed by the argparser package. Basically it does respect the order of optional arguments as it should in every situation, and sometimes it thus expects the wrong argument type.
I've opened an issue on the package bitbucket page. I highly suggest upvoting this and adding a comment to help adding to the attention of the issue.
In my issue I provided a possible solution to the problem which amounts to changing parse_args to the following definition (one could pull and recreate the package with this function at which point it would [should] work as expected)
parse_args <- function (parser, argv = commandArgs(trailingOnly = TRUE))
{
stopifnot(is(parser, "arg.parser"))
values <- list()
argv <- preprocess_argv(argv, parser)
arg.flags <- parser$args[parser$is.flag]
x <- as.logical(parser$defaults[parser$is.flag])
x[is.na(x)] <- FALSE
names(x) <- sub("^-+", "", arg.flags)
flag.idx <- match(arg.flags, argv)
flag.idx <- flag.idx[!is.na(flag.idx)]
if (length(flag.idx) > 0) {
x[match(argv[flag.idx], arg.flags)] <- TRUE
argv <- argv[-flag.idx]
}
values <- c(values, x)
if (values$help) {
print(parser)
quit()
}
x <- parser$defaults[parser$is.opt.arg]
arg.opt <- parser$args[parser$is.opt.arg]
names(x) <- sub("^-+", "", arg.opt)
i <- match("--opts", argv)
if (!is.na(i)) {
opts <- readRDS(argv[i + 1])
opts <- opts[!names(opts) %in% c("opts", "help")]
idx <- match(sanitize_arg_names(names(opts)), sanitize_arg_names(names(x)))
if (any(is.na(idx))) {
stop("Extra arguments supplied in OPTS file: (",
paste(setdiff(names(opts), names(x)), collapse = ", "),
").")
}
x[idx] <- opts
}
arg.idx <- match(arg.opt, argv)
arg.idx <- arg.idx[!is.na(arg.idx)]
arg.opt.types <- parser$types[parser$is.opt.arg]
arg.opt.nargs <- parser$nargs[parser$is.opt.arg]
### ###
## Altered section ##
### ###
if (length(arg.idx) > 0) {
# extract values following the optional argument label
x[ind <- match(argv[arg.idx], arg.opt)] <- argv[arg.idx+1];
# convert type of extraced values; x is now a list
x[ind] <- mapply(convert_type,
object = x[ind],
class = arg.opt.types[ind],
nargs = arg.opt.nargs[ind],
SIMPLIFY = FALSE);
# remove extracted arguments
to.remove <- c(arg.idx, arg.idx+1);
argv <- argv[-to.remove];
}
### ###
## Altered section ##
### ###
values <- c(values, x)
x <- argv
args.req <- parser$args[parser$is.req.arg]
args.req.types <- parser$types[parser$is.req.arg]
args.req.nargs <- parser$nargs[parser$is.req.arg]
if (length(x) < length(args.req)) {
print(parser)
stop(sprintf("Missing required arguments: expecting %d values but got %d values: (%s).",
length(args.req), length(x), paste(x, collapse = ", ")))
}
else if (length(x) > length(args.req)) {
print(parser)
stop(sprintf("Extra arguments supplied: expecting %d values but got %d values: (%s).",
length(args.req), length(x), paste(x, collapse = ", ")))
}
else if (length(args.req) > 0) {
names(x) <- args.req
x <- mapply(convert_type, object = x, class = args.req.types,
nargs = args.req.nargs, SIMPLIFY = FALSE)
}
values <- c(values, x)
names(values) <- sanitize_arg_names(names(values))
values
}