I want to get out the solution Ryacas gives me as a character string - but it doesn't work:
> require("Ryacas")
> x <- Sym("x")
> expr <- Solve(x + 1 == 0, x)
> expr
expression(list(x == -1))
> as.character(expr)
[1] "( Solve( ( ( x + 1 ) == 0 ) , x ) )"
Strangely enough when I print the variable I get the solution but when I try to read it out as a string I get the original equation.
My question
How can I transform the solution of Ryacas into a character string? (So that I can modify it further with standard R?)
If you want to get that expression into a string, you should use Eval() to get the results of evaluation
Eval(expr)
# [[1]]
# expression(x == -1)
if you want to extract the result as a character, in this case you can do
Eval(expr)[[1]][[1]]
# [1] "( x == -1 )"
Related
I tried seq(0:2) and it has a weird output. Basically,
Why:
seq(from= c(0,1,2))
outputs:
1 2 3
?
Basically, if you pass a vector of length > 1 to seq, its semantics mirror that of seq_along, or of seq(along.with = …). That is, it gives you a vector of indices of that vector:
seq_along(0 : 2)
# [1] 1 2 3
seq(along.with = 0 : 2)
# [1] 1 2 3
Bizarrely, seq is not implemented in terms of seq_along, and the latter is probably more efficient. Instead, the current (R 4.1) implementation of the relevant part of seq looks as follows.
lf <- length(from)
return(if (mode(from) == "numeric" && lf == 1L) {
if (!is.finite(from)) stop("'from' must be a finite number")
1L:from
} else if (lf) 1L:lf else integer())
And the implementation of seq(along.with = …) is still different:
length.out <- length(along.with)
return(if (length.out) seq_len(length.out) else integer())
… which, incidentally, is redundant; it could be shortened to the following:
length.out <- length(along.with)
return(seq_len(length.out))
… honestly, the implementation of the default seq function is a bit of a mess.
I have created a function that converts "YYYYQQ" to integer YYYYMMDD. The function works well with individual values in a list but not on the whole list. I am not unable to understand the warning message.
GetProperDate <- function(x) {
x <- as.character(x)
q<-substr(x, 5, 6)
y<-substr(x, 1,4) %>% as.numeric()
if(q=="Q1"){
x <- as.integer(paste0(y,"03","31"))
}
if(q=="Q2"){
x <- as.integer(paste0(y,"06","30"))
}
if(q=="Q3"){
x <- as.integer(paste0(y,"09","30"))
}
if(q=="Q4"){
x <- as.integer(paste0(y,"12","31"))
}
return(x)
}
> GetProperDate("2019Q1")
[1] 20190331
> GetProperDate("2019Q2")
[1] 20190630
> GetProperDate("2019Q3")
[1] 20190930
> GetProperDate("2019Q4")
[1] 20191231
> date.list<-c("2019Q1","2019Q2","2019Q3","2019Q4")
> date.list.converted<- date.list %>% GetProperDate()
Warning messages:
1: In if (q == "Q1") { :
the condition has length > 1 and only the first element will be used
2: In if (q == "Q2") { :
the condition has length > 1 and only the first element will be used
3: In if (q == "Q3") { :
the condition has length > 1 and only the first element will be used
4: In if (q == "Q4") { :
the condition has length > 1 and only the first element will be used
> date.list.converted
[1] 20190331 20190331 20190331 20190331
>
As shown above I am getting a warning message and the output is not as expected.
The issue is you have written a function GetProperDate which is not vectorised. if is used for scalar inputs and not vector. You may switch to ifelse which is vectorised and rewrite your function.
Apart from that you can also use as.yearqtr from zoo which is used to handle quarterly dates and get the last date of the quarter by using frac = 1.
as.Date(zoo::as.yearqtr(date.list), frac = 1)
#[1] "2019-03-31" "2019-06-30" "2019-09-30" "2019-12-31"
When you pass a vector to the function,it is comparing vector with a scalar. R automatically takes the first element of the vector. thats why you get warning as the condition has length > 1 and only the first element will be used..Try this
date.list<-c("2019Q1","2019Q2","2019Q3","2019Q4")
date.list.converted <- sapply(date.list, function(s) GetProperDate(s))
Try this:
library(tidyverse)
GetProperDate <- function(x) {
x <- as.character(x)
q <- substr(x, 5, 6)
y <- substr(x, 1,4) %>%
as.numeric()
x <- case_when(
q=="Q1" ~ as.integer(paste0(y,"03","31")),
q =="Q2" ~ as.integer(paste0(y,"06","30")),
q == "Q3" ~ as.integer(paste0(y,"09","30")),
TRUE ~ as.integer(paste0(y,"12","31")))
return(x)
}
date.list<-c("2019Q1","2019Q2","2019Q3","2019Q4")
GetProperDate(date.list)
> GetProperDate(date.list)
[1] 20190331 20190630 20190930 20191231
I have a problem to finish this R code. We are given a string having parenthesis like below
“( ((X)) (((Y))) )”
We need to find the maximum depth of balanced parenthesis, like 4 in above example. Since ‘Y’ is surrounded by 4 balanced parenthesis.
If parenthesis are unbalanced then return -1
My code looks like this:
current_max = 0
max = 0
def = function (S){
n=S
for (i in nchar(n))
if (is.element('(',n[i]))
{
current_max <- current_max + 1
}
if (current_max > max)
{
max <- current_max
}
else if (is.element(')',n[i]))
{
if (current_max > 0)
{
current_max <- current_max - 1
}
else
{
return -1
}
}
if (current_max != 0)
{
return -1
}
return (max)
}
but when i call function def("(A((B)))") answer should be 2. But every time it shows 0 even when the parenthesis is unbalanced. Im not sure if the code is correct or where is the mistake. Im trying to learn R so be patient with me. Thanks
If x <- "( ((X)) (((Y))) )", then remove all of the non-parentheses and split into characters...
y <- unlist(strsplit(gsub("[^\\(\\)]", "", x), ""))
y
[1] "(" "(" "(" ")" ")" "(" "(" "(" ")" ")" ")" ")"
and then the maximum nesting is the highest cumulative sum of +1 (for () and -1 (for ))...
z <- max(cumsum(ifelse(y=="(", 1, -1)))
z
[1] 4
If the parentheses are unbalanced then sum(ifelse(y=="(", 1, -1))) will not equal zero.
Here are three solutions. They are all vectorized, i.e. the input x can be a character vector, and they all handle the case of no parentheses properly.
1) strapply/proto strapply in the gsubfn packages matches the regular expression given as the second argument running the function fun in the proto object p which should also be passed to strapply. The pre function in p initializes the calculation for each component of the input x. The proto object can be used to retain memory of past matches (here lev is the nesting level) allowing counting to be done. We append an arbitrary character, here "X" to each string to ensure that there is always at least one match. If we knew there were no zero length character string inputs this could be omitted. The sapply uses Max which takes the maximum of the returned depths or returns -1 if no balance.
library(gsubfn) # also pulls in proto
# test input
x <- c("(A((B)))", "((A) ((())) (B))", "abc", "", "(A)((B)", "(A(B)))")
p <- proto(pre = function(.) .$lev <- 0,
fun = function(., x) .$lev <- .$lev + (x == "(") - (x == ")") )
Max <- function(x) if (tail(x, 1) == 0 && min(x) == 0) max(x) else -1
sapply(strapply(paste(x, "X"), ".", p), Max)
## [1] 3 4 0 0 -1 -1
2) Reduce This is a base solution. It makes use of Max from (1).
fun <- function(lev, char) lev + (char == "(") - (char == ")")
sapply(x, function(x) Max(Reduce(fun, init = 0, unlist(strsplit(x, "")), acc = TRUE)))
(A((B))) ((A) ((())) (B)) abc
3 4 0 0
(A)((B) (A(B)))
-1 -1
3) strapply/list Another possibility is to extract the parentheses and return with +1 or -1 for ( and ) using strapply with a replacement list. Then run cumsum and Max (from above) over that.
library(gsubfn)
fn$sapply(strapply(x, "[()]", list("(" = +1, ")" = -1), empty = 0), ~ Max(cumsum(x)))
## [1] 3 4 0 0 -1 -1
I wondering why my first if statement returns Error when my input data is an object of class numeric?
I have clearly stated for the first if statement to only turn on IF the data class is "data.frame", but when data class is numeric, this first if statement return an error! am I missing anything here?
Update:
I have changed instances of & to && but when data is a data.frame, the function doesn't produce any output? For example, run: standard(mtcars)
standard <- function(data){
if(class(data) == "data.frame" && ncol(data) > 1){
data[paste0(names(data), ".s")] <- scale(data)
data
}
if(class(data) == "data.frame" && ncol(data) == 1){
colnames(data) <- paste0(names(data), ".s")
data <- scale(data)
data
}
if(class(data) != "data.frame"){
d <- as.data.frame(data)
colnames(d) <- paste0("Var", ncol(d), ".s")
data <- scale(d)
data
}
}
###### EXAMPLES: #######
standard(mtcars[,2]) ##Problem: `Error in if(class(data) == "data.frame" & ncol(data) > 1)`
standard(mtcars["wt"]) ## OK
standard(mtcars) ## after UPDATE, doesn't give any output
am I missing anything here?
& evaluate both elements while && does not
FALSE && stop("boh")
#R> [1] FALSE
TRUE && stop("boh")
#R> Error: boh
FALSE & stop("boh")
#R> Error: boh
See help("Logic")
& and && indicate logical AND and | and || indicate logical OR. The shorter form performs elementwise comparisons in much the same way as arithmetic operators. The longer form evaluates left to right examining only the first element of each vector. Evaluation proceeds only until the result is determined.
After your edits
You do not get any results because you do not call return or use if else. See help("function") and help("if"). Here is a small example
f1 <- function(x){
if(x < 0){
x <- -1
x
}
if(x > 0){
x <- 1
x
}
}
f1(-1)
f2 <- function(x){
if(x < 0){
x <- -1
x
}
else if(x > 0){
x <- 1
x
}
}
f2(-1)
#R> [1] -1
f3 <- function(x){
if(x < 0){
x <- -1
return(x)
}
if(x > 0){
x <- 1
return(x)
}
}
f3(-1)
#R> [1] -1
tl;dr you should use && rather than & when doing flow-control, because & always evaluates its second argument, while && short-circuits if the first argument is false. If the argument isn't a data frame (or matrix) then ncol(x) doesn't make sense: see e.g. this question for more information.
Go ahead and unpack it with a simple example.
x <- 1:5
The first part is fine:
class(x) ## "integer"
class(x)=="data.frame" ## TRUE
(although note that you have to be careful, because class(x) might be a vector with more than one element: inherits(x,"data.frame") is safer).
The second part causes the problem:
ncol(x) ## NULL (uh-oh)
ncol(x)>1 ## numeric(0) (uh-oh)
Put them together:
class(x)=="data.frame" & ncol(x)>1 ## logical(0)
What does this do?
if (logical(0)) print("hello")
Error in if (logical(0)) print("hello") : argument is of length zero
Is it possible to create a unary operator in R? I know it's possible to create binary operator like this:
setGeneric("%power%", function(x, y) x ^ y)
2 %power% 4
But is it possible to create a unary operator like -. I tried something like:
setGeneric("%-%", function(x) -x)
%-% 3
But it doesn't work
The R parser doesn't support custom unary operators.
A copy of the list of supported operators from the R language definition:
- Minus, can be unary or binary
+ Plus, can be unary or binary
! Unary not
~ Tilde, used for model formulae, can be either unary or binary
? Help
: Sequence, binary (in model formulae: interaction)
* Multiplication, binary
/ Division, binary
^ Exponentiation, binary
%x% Special binary operators, x can be replaced by any valid name
%% Modulus, binary
%/% Integer divide, binary
%*% Matrix product, binary
%o% Outer product, binary
%x% Kronecker product, binary
%in% Matching operator, binary (in model formulae: nesting)
< Less than, binary
> Greater than, binary
== Equal to, binary
>= Greater than or equal to, binary
<= Less than or equal to, binary
& And, binary, vectorized
&& And, binary, not vectorized
| Or, binary, vectorized
|| Or, binary, not vectorized
<- Left assignment, binary
-> Right assignment, binary
$ List subset, binary
(The parser supports also the binary operator := which is not documented here, because it is not used by base R.)
Note that the only custom operators ("%x% Special binary operators, x can be replaced by any valid name") are binary.
So, your only option is overloading an existing unary operator respectively writing a method for it.
Although I am not familiar with setGeneric, I can answer the question
Is it possible to create a unary operator in R?
Yes, sort of, but not really. You can fake it:
# LET'S USE A BINARY OPERATOR TO DEFINE A UNARY OPERATOR:
# THE SYMBOL /*/<- IS SUPPOSED TO LOOK LIKE PERCENT-WILDCARD-PERCENT--ASSIGNMENT-ARROW
`%/*/<-%` <- function ( name , FUN , safe = TRUE ) {
`%//%` <- paste0
NAME <- "%" %//% name %//% "%"
PARENT <- parent.frame ()
if ( safe && exists ( NAME , PARENT ) )
stop ( NAME %//% " exists." )
assign (
x = NAME ,
value = function ( x , ignored ) FUN ( x ) ,
envir = PARENT ) }
.. <- NULL # THIS IS WHAT I MEAN BY FAKING IT...
"-" %/*/<-% `-` # ... `%-%` IS ACTUALLY A BINARY OPERATOR....
1 %-%.. # ... IN THIS CALL, `..` IS THE SECOND ARGUMENT.
# [1] -1
1 %-%.. %-%..
# [1] 1
"t" %/*/<-% `t`
m <- matrix(1:4, 2)
m
# [,1] [,2]
# [1,] 1 3
# [2,] 2 4
m %t%..
# [,1] [,2]
# [1,] 1 2
# [2,] 3 4
"-" %/*/<-% `-`
# Error in "-" %/*/<-% `-` : %-% exists.
i <- floor ( runif ( 9 , min = 1 , max = 10 ) )
i
# [1] 2 3 2 1 7 3 9 5 9
unique(i)
# [1] 2 3 1 7 9 5
"u" %/*/<-% function ( x ) sort ( unique ( x ) )
i %u%..
# [1] 1 2 3 5 7 9