Related
I'm trying to solve this equation: ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) =1
Is there a way to do this with R?
ATTEMPT with incorrect solution:
library(Ryacas)
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
# simplify the equation:
library(glue)
yac_str(glue("Simplify({eq})"))
library(evaluate)
evaluate(eq,list(x=c(0,1,10,100,-100)))
evaluate() just returns the equation:
"((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
The answer for the equation is −2004200
It sounds like you want to Solve() for x rather than merely simplifying ... ? The following code solves the equation, strips off the x== from the solution, and evaluates the expression:
eq2 <- gsub("x==","",yac_str(glue("Solve({eq},x)")))
[1] "{(-0.80168e6)/0.4}"
eval(parse(text=eq2))
[1] -2004200
1) Ryacas Use the Ryacas package solve as shown below. (Thanks to #mikldk for improvement to last line.)
library(Ryacas)
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 " # from question
res <- solve(ysym(eq), "x")
as_r(y_rmvars(res)) # extract and convert to R
## [1] -2004200
if eq has R variables in it, here h is referenced in eq2, then use eval to evaluate the result.
h <- 2300
eq2 <- "((h+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 " # from question
res2 <- solve(ysym(eq2), "x")
eval(as_r(y_rmvars(res2)))
## [1] -2004200
2) Ryacas0 or using eq from above with the Ryacas0 package:
library(Ryacas0)
res <- Solve(eq, "x")
eval(Expr(res)[[1:3]]) # convert to R
## [1] -2004200
3a) Base R In light of the fact that this is a linear equation and the solution to the following where A is the slope and B is the intercept:
A * x + B = 0
is
x = - B / A
if we replace x with the imaginary 1i and then move the rhs to the lhs we have that B and A are the real and imaginary parts of that expression. No packages are used.
r <- eval(parse(text = sub("==", "-", eq)), list(x = 1i))
-Re(r) / Im(r)
## [1] -2004200
3b) If we move the rhs to lhs then B equals it at x=0 and A equals the derivative wrt x so another base R solution would be:
e <- parse(text = sub("==", "-", eq))
- eval(e, list(x = 0)) / eval(D(e, "x"))
## [1] -200420
Here is a base R solution.
Rewrite the equation in the form of a function, use curve to get two end points where the function has different signs and put uniroot to work.
f <- function(x) ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) - 1
curve(f, -1e7, 1)
uniroot(f, c(-1e7, 1))
#$root
#[1] -2004200
#
#$f.root
#[1] 0
#
#$iter
#[1] 1
#
#$init.it
#[1] NA
#
#$estim.prec
#[1] 7995800
Following the discussion in the comments to the question, here is a general solution. The function whose roots are to be found now accepts an argument params in order to pass the values of rent, salary, number of workers, price, unit cost and capital cost. This argument must be a named list.
f <- function(x, K = 1, params) {
A <- with(params, rent + salary*workers)
with(params, (A + (x + A)*capitalcost)/(price - unitcost) - K)
}
params <- list(
rent = 2300,
salary = 1900,
workers = 1,
price = 600,
unitcost = 400,
capitalcost = 0.002
)
curve(f(x, params = params), -1e7, 1)
uniroot(f, c(-1e7, 1), params = params)
If you want something quick: rootSolve library is your go-to.
library(rootSolve)
func_ <- function(x) ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400)-1
uniroot.all(func_, c(-1e9, 1e9))
[1] -2004200
Note that most of the time reducing the interval is better.
If you will maintain the same structure, then in Base R, you could do:
solveX <- function(eq){
U <- function(x)abs(eval(parse(text = sub("=+","-", eq)), list(x=x)))
optim(0, U, method = "L-BFGS-B")$par
}
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
solveX(eq)
[1] -2004200
I am having this function to make products between two positive number that returns the product if this it less or equal to 1, otherwise returns 1.
f1 <- function(x, y) ifelse(x*y <= 1, x*y, 1)
It annoys me that I have to do the x*y calculation twice - is there a base R function that can do this, or another way to do the task ? I am aware that the difference in computing time perhaps is small (is it O vs 2*O ?) but still ... and out of curiosity.
We create the object and then do the assignment
out <- x*y
out[out >1] <- 1
Or another option is pmin
out1 <- pmin(x*y, 1)
-checking
identical(out, out1)
#[1] TRUE
data
set.seed(24)
x <- abs(rnorm(10, 0.5))
y <- abs(rnorm(10, 0.7))
The common code in R for rounding a number to say 2 decimal points is:
> a = 14.1234
> round(a, digits=2)
> a
> 14.12
However if the number has zeros as the first two decimal digits, R suppresses zeros in display:
> a = 14.0034
> round(a, digits=2)
> a
> 14
How can we make R to show first decimal digits even when they are zeros? I especially need this in plots. I've searched here and some people have suggested using options(digits=2), but this makes R to have a weird behavior.
We can use format
format(round(a), nsmall = 2)
#[1] "14.00"
As #arvi1000 mentioned in the comments, we may need to specify the digits in round
format(round(a, digits=2), nsmall = 2)
data
a <- 14.0034
Try this:
a = 14.0034
sprintf('%.2f',a) # 2 digits after decimal
# [1] "14.00"
The formatC function works nicely if you apply it to the vector after rounding. Here the inner function round rounds to two decimal places then the outer function formatC formats to the same number of decimal places as the number were rounded to. This essentially re-adds zeros to the number that would otherwise end without the decimal places (e.g., 14.0034 is rounded to 14, which becomes 14.00).
a=c(14.0034, 14.0056)
formatC(round(a,2),2,format="f")
#[1] "14.00", "14.01"
You can use this function instead of round and just use it like you use round function.
import decimal
def printf(x, n):
d = decimal.Decimal(str(x))
d0 = -(d.as_tuple().exponent)
if d0 < n:
print("x = ", x)
else:
d1 = decimal.Decimal(str(round(x, n)))
d2 = d1.as_tuple().exponent
MAX = n + d2
if MAX == 0:
print("x = ", round(x, n))
else:
i = 0
print("x = ", round(x, n), end = '')
while i != MAX:
if i == (MAX - 1):
print("0")
else:
print("0", end = '')
i = i + 1
So you must have something like this.
>>> printf(0.500000000000001, 13)
>>> 0.5000000000000
The human eye can see that no value x satisfies the condition
x<1 & x>2
but how can I make R see that. I want to use this in a function which gets passed comparisons (say as strings) and not necessarily data. Let's say I want to write a function that checks whether a combination of comparisons can ever be fulfilled anyway, like this
areTherePossibleValues <- function(someString){
someCode
}
areTherePossibleValues("x<1 & x>2")
[1] FALSE
I mean one could do that by interpreting the substrings that are comparison signs and so on, but I feel like there's got to be a better way. The R comparison functions ('<','>','=' and so on) themselves actually might be the answer to this, right?
Another option is to use the library validatetools (disclaimer, I'm its author).
library(validatetools)
rules <- validator( r1 = x < 1, r2 = x > 2)
is_infeasible(rules)
# [1] TRUE
make_feasible(rules)
# Dropping rule(s): "r1"
# Object of class 'validator' with 1 elements:
# r2: x > 2
# Rules are evaluated using locally defined options
# create a set of rules that all must hold:
rules <- validator( x > 1, x < 2, x < 2.5)
is_infeasible(rules)
# [1] FALSE
remove_redundancy(rules)
# Object of class 'validator' with 2 elements:
# V1: x > 1
# V2: x < 2
rules <- validator( x >= 1, x < 1)
is_infeasible(rules)
# [1] TRUE
To compare among ranges, min of the range max(s) should always be greater than the max of the range min(s), showed as below:
library(dplyr)
library(stringr)
areTherePossibleValues <- function(s) {
str_split(s, pattern = " *& *", simplify = TRUE)[1, ] %>%
{lapply(c("max" = "<", "min" = ">"), function(x) str_subset(., pattern = x) %>% str_extract(., pattern = "[0-9]+"))} %>%
{as.numeric(min(.$max)) > as.numeric(max(.$min))}
}
Update: add inclusion comparison
The only difference is that min of the range max(s) can be equal to the max of the range min(s).
library(dplyr)
library(stringr)
areTherePossibleValues <- function(s) {
str_split(s, pattern = " *& *", simplify = TRUE)[1, ] %>%
{lapply(c("max" = "<", "min" = ">"), function(x) str_subset(., pattern = x) %>% str_remove(., pattern = paste0("^.*", x)))} %>%
{ifelse(sum(grepl(pattern = "=", unlist(.))),
as.numeric(min(str_remove(.$max, "="))) >= as.numeric(max(str_remove(.$min, "="))),
as.numeric(min(.$max)) > as.numeric(max(.$min)))}
}
areTherePossibleValues("x<1 & x>2")
areTherePossibleValues("x>1 & x<2")
areTherePossibleValues("x>=1 & x<1")
Here is my way of solving it, it may not be the best, but it should work even you have many comparisons.
Let's call the numbers appeared in your comparisons 'cutoffs', then all we need to do is to test 1 number between each pair of cutoffs, 1 number that is larger than the max cutoff, and 1 number that is smaller than the min cutoff.
The intuition is illustrated with the plot:
Here is the code:
areTherePossibleValues <- function(s){
# first get the numbers that appeared in your string, sort them, and call them the cutoffs
cutoffs = sort(as.numeric(gsub("\\D", "", strsplit(s, "&")[[1]])))
# get the numbers that in between each cutoffs, and a bit larger/smaller than the max/min in the cutoffs
testers = (c(min(cutoffs)-1, cutoffs) + c( cutoffs ,max(cutoffs) + 1))/2
# take out each comparisons
comparisons = strsplit(s, "&")[[1]]
# check if ANY testers statisfy all comparisons
any(sapply(testers, function(te){
# check if a test statisfy ALL comparisons
all(sapply(comparisons, function(co){eval(parse(text =gsub(pattern = 'x',replacement =te, co)))}))
}))
}
areTherePossibleValues("x<1 & x>2")
#[1] FALSE
areTherePossibleValues("x>1 & x<2 & x < 2.5")
#[1] TRUE
areTherePossibleValues("x=> 1 & x < 1")
#[1] FALSE
We see x<1 & x>2 is impossible because we are taught a simple rule: if a number x is smaller than another number a then it can not be bigger than another number that is bigger than a, or more fundamentally we are using the transitivity property of any partially ordered set. There is no reason we can not teach a computer (or R) to see that. If your logic string in your question only consists of statements in the forms x # a where # can be <, >, <=, and >=, and the operator is always &, then Yue Y's solution above perfectly answers your question. It can be even generalized to include the | operator. Beyond this you'll have to be more specific what the logic expression can be.
I have created a function that essentially creates a vector of a 1000 binary values. I have been able to count the longest streak of consecutive 1s by using rle.
I was wondering how to find a specific vector (say c(1,0,0,1)) in this larger vector? I would want it to return the amount of occurrences of that vector. So c(1,0,0,1,1,0,0,1) should return 2, while c(1,0,0,0,1) should return 0.
Most solutions that I have found just find whether a sequence occurs at all and return TRUE or FALSE, or they give results for the individual values, not the specific vector that is specified.
Here's my code so far:
# creates a function where a 1000 people choose either up or down.
updown <- function(){
n = 1000
X = rep(0,n)
Y = rbinom(n, 1, 1 / 2)
X[Y == 1] = "up"
X[Y == 0] = "down"
#calculate the length of the longest streak of ups:
Y1 <- rle(Y)
streaks <- Y1$lengths[Y1$values == c(1)]
max(streaks, na.rm=TRUE)
}
# repeat this process n times to find the average outcome.
longeststring <- replicate(1000, updown())
longeststring(p_vals)
This will also work:
library(stringr)
x <- c(1,0,0,1)
y <- c(1,0,0,1,1,0,0,1)
length(unlist(str_match_all(paste(y, collapse=''), '1001')))
[1] 2
y <- c(1,0,0,0,1)
length(unlist(str_match_all(paste(y, collapse=''), '1001')))
[1] 0
If you want to match overlapped patterns,
y <- c(1,0,0,1,0,0,1) # overlapped
length(unlist(gregexpr("(?=1001)",paste(y, collapse=''),perl=TRUE)))
[1] 2
Since Y is only 0s and 1s, we can paste it into a string and use regex, specifically gregexpr. Simplified a bit:
set.seed(47) # for reproducibility
Y <- rbinom(1000, 1, 1 / 2)
count_pattern <- function(pattern, x){
sum(gregexpr(paste(pattern, collapse = ''),
paste(x, collapse = ''))[[1]] > 0)
}
count_pattern(c(1, 0, 0, 1), Y)
## [1] 59
paste reduces the pattern and Y down to strings, e.g. "1001" for the pattern here, and a 1000-character string for Y. gregexpr searches for all occurrences of the pattern in Y and returns the indices of the matches (together with a little more information so they can be extracted, if one wanted). Because gregexpr will return -1 for no match, testing for numbers greater than 0 will let us simply sum the TRUE values to get the number of macthes; in this case, 59.
The other sample cases mentioned:
count_pattern(c(1,0,0,1), c(1,0,0,1,1,0,0,1))
## [1] 2
count_pattern(c(1,0,0,1), c(1,0,0,0,1))
## [1] 0