When using recursion in R, it would be useful to have recursive environments as well. For example, in the the below example, it would be useful for the below code to print 1 to 9. That is, the x in the environment of each recursion would be one more than the x in the parent environment. Is there an easy way to modify the code such that this is the case?
x = 1
y = function() {
print(x)
x = x + 1
if (x <= 10) y()
}
Edit: a more complicated situation would just involve more variables:
w = 1
x = 2
y = 3
z = 4
y = function() {
print(x)
w = w + 1
x = w + x
y = x + y
z = y + z
if (w <= 10) y()
}
Now instead of four variables, say there's 50 variables. This couldn't be solved very easily through argument passing.
Edit 2:
In edit 1, what I'm hoping for would be something like this:
global: w = 1, x = 2, y = 3, z = 4
recursion 1: w = 2, x = 4, y = 7, z = 11
recursion 2: w = 3, x = 7, y = 14, z = 25
etc. Excuse math errors.
You could use a for loop and build up vectors of the variable states at each iteration. If it runs for long this might become inefficient however.
w <- 1
x <- 2
y <- 3
z <- 4
while(w[1] <= 10){
w <- c(w[1] + 1, w)
x <- c(w[1] + x[1], x)
y <- c(x[1] + y[1], y)
z <- c(y[1] + z[1], z)
}
cbind(w, x, y, z)
If you really want to use recursive environments (although I'd prefer a looping solution) you can get around the problem by passing all four variables along in a vector.
y <- function(v=c(w=1, x=2, y=3, z=4)) {
print(v["x"])
v["w"] <- 1 + v["w"]
v["x"] <- v["w"] + v["x"]
v["y"] <- v["x"] + v["y"]
v["z"] <- v["y"] + v["z"]
if (v["w"] <= 10){
y(v)
} else {
v
}
}
y()
Related
I'm now learning about calculus and want to depict a graph of x^2 + 6x + y^4 = 7, which I can using online graphing tool desmos.
But when I'm not sure how this is achievable on R. The first thing I thought is convert it in a form of y = f(x), but return (x^2 + 6*x - 7)^(1/4) gave me a different result.
At the same time, it seems impossible to return a equation in a function (return (x^2 + 6*x + y^4 = 7)). So how can I depict it on R?
Here is a sample code I usually use to depict a continuous graph.
f <- function(x) {
return () # return an equation
}
ggplot(data.frame(x=seq(-10,10,length.out=10)), aes(x)) + stat_function(fun=f)
You can have separate functions for the positive and negative solutions for y
f1 <- function(x) (7 - x^2 - 6*x)^(1/4)
f2 <- function(x) -f1(x)
Now just create a vector each for positive and negative values along the domain of x:
x <- seq(-7, 1, length = 1000)
y1 <- f1(x)
y2 <- f2(x)
And plot:
ggplot() +
geom_line(aes(x, y1)) +
geom_line(aes(x, y2))
You can use contourLines:
f <- function(x,y) x^2 + 6*x + y^4
x <- seq(-10, 3, len = 200)
y <- seq(-3, 3, len = 200)
z <- outer(x, y, f)
cr <- contourLines(x, y, z, levels = 7)
plot(cr[[1]]$x, cr[[1]]$y, type = "l")
library(ggplot2)
dat <- data.frame(x = cr[[1]]$x, y = cr[[1]]$y)
ggplot(dat) + geom_path(aes(x, y))
I'm trying to create a code such that Y = 5g1(X1) + 3g2(X2) + 4g3(X3) + 6g4(X4) + sqrt(1.74)*eps (the functions g, are defined in the code).
X = (X1,...,Xp) should be an nxp dimensional design matrix, however I'm not sure about how to generate that based on this information where Xj = W+U is simulated according to a random effects model. I tried using X = do.call(cbind, replicate(p, X, simplify=FALSE)) but this just replicates each Xj, i'm not sure that's what should be done, they should be different.
Any advice on what i have missed would be appreciated and any improvements on the code too to make it more concise.
n<- 400
p<- 1000
W = runif(n)
U = runif(n)
eps = rnorm(n)
for (j in 1:p){
X = W+U
X = as.matrix(X)
return(X)} #This is a nx1 matrix...
#alternatively write: X = do.call(cbind, replicate(p, X, simplify=FALSE))
g1 = X
g2 = (2*X-1)^2
g3 = sin(2*pi*X)/(2-sin(2*pi*X))
g4 = 0.1*sin(2*pi*X) + 0.2*cos(2*pi*X) + 0.3*sin(2*pi*X)^2 + 0.4*cos(2*pi*X)^3 + 0.5*sin(2*pi*X)^3
Y = 5*g1 + 3*g2 + 4*g3 + 6*g4 + sqrt(1.74)*eps
return(Y)
}
I am not sure to capture the logic of your calculation, eventually it is something like this:
n <- 40 # 400
p <- 100 # 1000
X <- replicate(p, runif(n) + runif(n)) ## W+U
y <- function(X) {
g1 <- X
g2 <- (2*X-1)^2
g3 <- sin(2*pi*X)/(2-sin(2*pi*X))
g4 <- 0.1*sin(2*pi*X) + 0.2*cos(2*pi*X) + 0.3*sin(2*pi*X)^2 + 0.4*cos(2*pi*X)^3 + 0.5*sin(2*pi*X)^3
eps <- rnorm(length(X))
Y <- 5*g1 + 3*g2 + 4*g3 + 6*g4 + sqrt(1.74)*eps
return(Y)
}
Y <- apply(X, 2, FUN=y)
Also the variant without apply() works:
Y <- y(X)
To compare both variants:
set.seed(42)
Y1 <- apply(X, 2, FUN=y)
set.seed(42)
Y2 <- y(X)
identical(Y1, Y2)
I am trying to plot a heatmap with the library pheatmap in R.
I think that by default the branch length is proportional to the "dissimilarity" of the clusters that got merged at this step. I would like to chance that, so it is a fixed value because for my purpose it looks very weird!
If anyone has an idea how I can fix this, I would be very happy.
Here is a sample code
library(pheatmap)
test = matrix(rnorm(6000), 100, 60)
pheatmap(test)
Cheers!
Here is an example of two column groups with high dissimilarity:
library(pheatmap)
test = cbind(matrix(rnorm(3000), 100, 30),
matrix(rnorm(3000)+10, 100, 30))
pheatmap(test)
TIn pheatmapthe dendrogram is plotted by the pheatmap:::draw_dendrogram function
and branch lengths are stored in the h object.
Below I define equal-length branches adding the command
hc$height <- cumsum(rep(1/length(hc$height), length(hc$height)))
as follows:
draw_dendrogram <- function(hc, gaps, horizontal = T) {
# Define equal-length branches
hc$height <- cumsum(rep(1/length(hc$height), length(hc$height)))
h = hc$height/max(hc$height)/1.05
m = hc$merge
o = hc$order
n = length(o)
m[m > 0] = n + m[m > 0]
m[m < 0] = abs(m[m < 0])
dist = matrix(0, nrow = 2 * n - 1, ncol = 2, dimnames = list(NULL,
c("x", "y")))
dist[1:n, 1] = 1/n/2 + (1/n) * (match(1:n, o) - 1)
for (i in 1:nrow(m)) {
dist[n + i, 1] = (dist[m[i, 1], 1] + dist[m[i, 2], 1])/2
dist[n + i, 2] = h[i]
}
draw_connection = function(x1, x2, y1, y2, y) {
res = list(x = c(x1, x1, x2, x2), y = c(y1, y, y, y2))
return(res)
}
x = rep(NA, nrow(m) * 4)
y = rep(NA, nrow(m) * 4)
id = rep(1:nrow(m), rep(4, nrow(m)))
for (i in 1:nrow(m)) {
c = draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1],
dist[m[i, 1], 2], dist[m[i, 2], 2], h[i])
k = (i - 1) * 4 + 1
x[k:(k + 3)] = c$x
y[k:(k + 3)] = c$y
}
x = pheatmap:::find_coordinates(n, gaps, x * n)$coord
y = unit(y, "npc")
if (!horizontal) {
a = x
x = unit(1, "npc") - y
y = unit(1, "npc") - a
}
res = polylineGrob(x = x, y = y, id = id)
return(res)
}
# Replace the non-exported function `draw_dendrogram` in `pheatmap`:
assignInNamespace(x="draw_dendrogram", value=draw_dendrogram, ns="pheatmap")
pheatmap(test)
The result is:
I want to write an R function that takes a mathematical function in x and returns a new function in x as an output. For example:
The input should be passed in as a mathematical function (or relation) in x:
g <- x^2 + 9*x + log(x)
And the resulting output should be:
function(x) (exp(g))
i.e. I want to return the symbolic exponential expression of the original function in x i.e. exp(x^2 + 9*x + log(x)) in this illustrative example
So ideally it would return the function object:
function(x) (exp(x^2 + 9*x + log(x)))
I tried as follows:
test <- function(g){
h <- function(x){exp(g)}
return(h)
}
m <- test(x^2 + 9*x + log(x))
m(10)
So m(10) should return:
exp(10^2 + 9*10 + log(10))
which is exp(192.3026) in this case.
Could anyone show how to do this please?
You could use package functional:
library(functional)
fun <- Compose(function(x) x^2 + 9*x + log(x), exp)
fun(1)
#[1] 22026.47
Here is one approach:
test <- function(e) {
ee <- substitute(e)
eee <- substitute(exp(X), list(X=ee))
f <- function(x) {}
body(f) <- eee
environment(f) <- parent.frame()
f
}
## Check that it works
m <- test(x^2 + 9*x + log(x))
m
# function (x)
# exp(x^2 + 9 * x + log(x))
m(1)
# [1] 22026.47
m(1) == exp(10)
# [1] TRUE
edit - for functionality in question
f <- function(...) {
l <- eval(substitute(alist(x = x, ...)))
l[[2]] <- substitute(exp(X), list(X = l[[2]]))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
g <- f(x^2 + 2*x + 5)
# function (x = x)
# exp(x^2 + 2 * x + 5)
g(1)
# [1] 2980.958
Here is another way for a general case:
f <- function(...) {
l <- eval(substitute(alist(...)))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
g <- f(x, x^2 + 9*x + log(x))
# function (x = x)
# x^2 + 9 * x + log(x)
g(10)
# [1] 192.3026
This version will also work for any number of variables, just define them followed by the function:
g <- f(x, y, z, x + 2 * y + z ** 3)
# function (x = x, y = y, z = z)
# x + 2 * y + z^3
g(1, 2, 0)
# [1] 5
There may be a better way to add ... to functions, but here is how you can do that
f <- function(..., use_dots = FALSE) {
l <- eval(substitute(alist(...)))
if (use_dots)
l <- c(head(l, -1), list('...' = as.symbol('...')), tail(l, 1))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
So now you don't have to name all the variables/arguments
g <- f(x, y, plot(x, y, ...), use_dots = TRUE)
g(1:5, 1:5, main = 'main title', pch = 16, col = 3, cex = 3, xpd = NA)
I would like to create a plot, where one can see an alternative ticking of the x-axis, e.g. pi/2, pi, 3pi/2, etc. So far, this works for me only with a rather unhandy code (look at the lines where I create pi.halfs, pi.fulls and merge them later into vec.expr):
require (ggplot2)
# Create vectors: breaks and corresponding labels as multiples of pi/2
vec.breaks <- seq(from = pi/2, to = 7*pi/2, by = pi/2)
pi.halfs <- c(paste(expression(pi), "/2"),
paste(seq(from = 3, to = 21, by = 2), "*" , expression(pi), "/2"))
pi.fulls <- c(paste(expression(pi)),
paste(seq(from = 2, to = 11, by = 1), "*" , expression(pi)))
vec.expr <- parse(text = c(rbind(pi.halfs, pi.fulls)))[1:7]
# Create some time and signal
time <- seq(from = 0, to = 4*pi, by = 0.01)
signal <- sin(time)
df <- data.frame(time,signal)
# Now plot the signal with the new x axis labels
fig <- ggplot(data = df, aes(x = time, y = signal)) +
geom_line() +
scale_x_continuous(breaks=vec.breaks, labels=vec.expr)
print(fig)
... resulting in ...
Is anyone aware of an easier approach, where one can change the base of some x-axis labeling in ggplot2, e.g. like here from decimals to multiples of pi? Are there any nice packages, that I missed so far? I found some duplicates of this question, but only in other languages...
You are looking for the scales package, which lets you create arbitrary formatting functions for scales and also has a number of helpful formatting functions already built in. Looking through the scales package help, I was surprised not to find a radian scale, but you should be able to create one using math_formatter(). This code gets the same results, though not with the fractions.
library(ggplot2)
library(scales)
time <- seq(from = 0, to = 4*pi, by = 0.01)
signal <- sin(time)
df <- data.frame(time,signal)
pi_scales <- math_format(.x * pi, format = function(x) x / pi)
fig <- ggplot(data = df, aes(x = time, y = signal)) +
geom_line() +
scale_x_continuous(labels = pi_scales, breaks = seq(pi / 2, 7 * pi / 2, pi / 2))
print(fig)
Here is a function to make fractional labels (maybe a little clunky). It uses fractions from MASS package and allows you to change the multiplier you want to use on the x-axis. You just pass it a symbol (ie. "pi"). If the symbol has a value, the ticks will be scaled by width*value, otherwise just by width.
# Now plot the signal with the new x axis labels
p <- ggplot(data = df, aes(x = time, y = signal)) +
geom_line()
## Convert x-ticks to fractional x-ticks with a symbol multiplier
fracAx <- function(p, symbol, width=0.5) {
require(MASS) # for fractions
val <- tryCatch(eval(parse(text=symbol)), error=function(e) 1)
info <- ggplot_build(p)
xrange <- info[[2]]$ranges[[1]]$x.range/val # get the x-range of figure
vec.breaks <- seq(floor(xrange[1]), ceiling(xrange[2]), by=width)
fracs <- strsplit(attr(fractions(vec.breaks), "fracs"), "/") # convert to fractions
labels <- sapply(fracs, function(i)
if (length(i) > 1) { paste(i[1], "*", symbol, "/", i[2]) }
else { paste(i, "*", symbol) })
p + scale_x_continuous(breaks=vec.breaks*val, labels=parse(text=labels))
}
## Make the graph with pi axis
fracAx(p, "pi")
## Make the graph with e axis, for example
e <- exp(1)
fracAx(p, "e")
## Make the graph with a symbol that has no value
fracAx(p, "theta", width=2)
Based on the other answers here I was able to piece together some functions which implement a general radians format that can be used independently of mucking about with the internals of ggplot2 objects.
numerator <- function(x) {
f = attr(x, "fracs")
s <- as.integer(sign(x))
ifelse(is.finite(x), as.integer(stringr::str_extract(f, "^[^/]*")), s)
}
denominator <- function(x) {
f = attr(x, "fracs")
s <- as.integer(sign(x))
ratio <- str_detect(f, "/")
d <- as.integer(stringr::str_extract(f, "[^/]*$"))
ifelse(is.finite(x), ifelse(ratio, d, 1L), 0L)
}
char_sign <- function(x) {
s <- sign(x)
ifelse(s == 1, "+",
ifelse(s == -1, "-", ""))
}
#' Convert value to radians formatting
radians <- function(x) {
y = x/pi
f = suppressWarnings(MASS::as.fractions(y))
n = suppressWarnings(numerator(f))
d = suppressWarnings(denominator(f))
s <- char_sign(x)
o <- vector(mode = "character", length = length(x))
o <- ifelse(d == 0 & n != 0, paste0(s, "∞"), o)
o <- ifelse(n == 0 & d != 0, "0", o)
o <- ifelse(n != 0 & d != 0, paste0(n, "π/", d), o)
o <- ifelse(n == 1 & d != 0, paste0("π/", d), o)
o <- ifelse(n == -1 & d == 1, paste0(s, "π"), o)
o <- ifelse(n == -1 & d != 0 & d != 1, paste0(s, "π/", d), o)
o <- ifelse(d == 1 & n != 0 & abs(n) != 1, paste0(n, "π"), o)
o <- ifelse(n == d & is.finite(n), "π", o)
o
}
Here it is in use:
```r
time <- seq(from = 0, to = 4*pi, by = 0.01)
signal <- sin(time)
df <- data.frame(time,signal)
ggplot(df, aes(time, signal)) +
geom_line() +
scale_x_continuous(labels = trans_format(radians, force),
breaks = seq(0, 4*pi, pi/2))