library(ggplot2)
dev.new()
n = 0
x_accept <- list()
set.seed(1684)
x = seq(15, 33, by = 0.1)
f <- function(x) {
out <- ifelse(
x < 15 | 33 < x,
0,
ifelse(
15 <= x & x <= 24,
(2*(x-15))/((33-15)*(24-15)),
ifelse(
24 < x & x <= 33,
(2*(33-x))/((33-15)*(33-24)),
NA_real_
)))
if (any((is.na(out) | is.nan(out)) & (!is.na(x) & !is.nan(x)))) {
warning("f(x) undefined for some input values")
out
}
while (n != 105) {
n = n + 1
x1 = runif(1, min = 15 , max = 33)
num = runif(1, min = 0 , max = 1)
if (num < (f(x1)/2/(33-15)) && num <- (18*(f(x1)/2)))
x_accept = list(x_accept, x1)
}
}
histo <- data.frame(x_histo = x1, y_histo = x1)
dat <- data.frame(x = x, y = f(x))
ggplot(dat, aes(x, y)) +
geom_line()
ggplot(histo, aes(x_histo, y_histo) +
geom_histogram()
It gives me this error, it's the first time I've seen it and I don't really how what it means or how to solve it. C stack usage 15927808 is too close to the limit.
Related
I want to make a while loop that, until n is not equal to 105, it takes a random value x, and if the value x respects some restrictions, it store that value.
The x has to be between 15 and 33
It also simulates a variable num that has to be a random variable from a uniform distribution betwenn 0 and 1.
library(ggplot2)
dev.new()
n = 0
set.seed(1684)
x = seq(15, 33, by = 0.1)
f <- function(x) {
out <- ifelse(
x < 15 | 33 < x,
0,
ifelse(
15 <= x & x <= 24,
(2*(x-15))/((33-15)*(24-15)),
ifelse(
24 < x & x <= 33,
(2*(33-x))/((33-15)*(33-24)),
NA_real_
)))
if (any((is.na(out) | is.nan(out)) & (!is.na(x) & !is.nan(x)))) {
warning("f(x) undefined for some input values")
}
out
}
while (n != 105) {
n = n + 1
x1 = runif(1, min = 15 , max = 33)
num = runif(1, min = 0 , max = 1)
if ((num < (f(x1)/2/(33-15))) && (num == (18*(f(x1)/2)))) {
x_accept = c(x_accept, x1)
}
}
I've made this but it doesn't work, the x_accept is just an empty list
library(ggplot2)
dev.new()
n = 0
set.seed(1684)
x = seq(15, 33, by = 0.1)
f <- function(x) {
out <- ifelse(
x < 15 | 33 < x,
0,
ifelse(
15 <= x & x <= 24,
(2*(x-15))/((33-15)*(24-15)),
ifelse(
24 < x & x <= 33,
(2*(33-x))/((33-15)*(33-24)),
NA_real_
)))
if (any((is.na(out) | is.nan(out)) & (!is.na(x) & !is.nan(x)))) {
warning("f(x) undefined for some input values")
}
out
}
while (n != 105) {
n = n + 1
x1 = runif(1, min = 15 , max = 33)
num = runif(1, min = 0 , max = 1)
if ((num < (f(x1)/2/(33-15))) && (num == (18*(f(x1)/2)))) {
x_accept = c(x_accept, x1)
}
}
histo <- data.frame(x = x_accept)
dat <- data.frame(x = x, y = f(x))
ggplot(dat, aes(x, y)) +
geom_line(aes(x, y)) +
geom_histogram(aes(x))
From the previous code it gives me this error:
Error in f():
! stat_bin() can only have an x or y aesthetic.
Data from the dput(head(dat)):
structure(list(x = c(15, 15.1, 15.2, 15.3, 15.4, 15.5), y = c(0,
0.00123456790123456, 0.00246913580246913, 0.00370370370370371,
0.00493827160493828, 0.00617283950617284)), row.names = c(NA,
6L), class = "data.frame")
I would appreciate some insight into why it's doing this
I would like to fit a step function (two parameters) to some data. The code below is not doing the job. I wonder if the round() argument is the problem. However, I also tried to divide the parameters to make small (e.g. 0.001) changes in the parameters to cause significant changes. But that did not change the fit. Any idea how to properly fit this function to the data?
dat <- c(rbinom(100, 100, 0.95), rbinom(50, 100, 0.01), rbinom(100, 100, 0.95))
plot(dat/100)
stepFnc <- function(parms, t) {
par <- as.list(parms)
(c(rep(1-(1e-5), par$t1), rep(1e-5, par$t2), rep(1-(1e-5), t)))[1:t]
}
lines(stepFnc(c(t1 = 50, t2 = 50), length(dat)))
loglik <- function(t1 = 50, t2 = 50) {
fit <- snowStepCurve(parms = list(t1=round(t1,0), t2=round(t2,0)), t = length(dat))
lines(fit)
-sum(dbinom(x = dat, size = 100, prob = fit, log = T), na.rm = T)
}
mle <- bbmle::mle2(loglik)
mle#coef
lines(snowStepCurve(mle#coef, length(dat)), lwd = 2, lty = 2, col = "orange")
With discrete x data I'd do a brute-force approach:
x <- seq_along(dat)
foo <- function(x, lwr, upr) {
y <- x
y[x <= lwr | x > upr] <- mean(dat[x <= lwr | x > upr])
y[x > lwr & x <= upr] <- mean(dat[x > lwr & x <= upr])
y
}
SSE <- function(lwr, upr) {
sum((dat - foo(x, lwr, upr))^ 2)
}
limits <- expand.grid(lwr = x, upr = x)
limits <- limits[limits$lwr <= limits$upr,]
nrow(limits)
SSEvals <- mapply(SSE, limits$lwr, limits$upr)
id <- which(SSEvals == min(SSEvals))
optlims <- limits[id,]
meanouter <- mean(dat[x <= optlims$lwr | x > optlims$upr])
meaninner <- mean(dat[x > optlims$lwr & x <= optlims$upr])
bar <- function(x) {
y <- x
y[x <= optlims$lwr | x > optlims$upr] <- meanouter
y[x > optlims$lwr & x <= optlims$upr] <- meaninner
y
}
plot(dat/100)
curve(bar(x) / 100, add = TRUE)
I need little help. I try to do plot with ggplot package. When I want to make plot, depends of more than 1 factor (for example here: plot changes when średnia1 and odchylenie1 change):
alpha = 0.05
N = 100
sample_l = 10
srednia1 = seq(-7, 7, by = 1)
odchylenie1 = seq(1, 10, by = 1)
srednia2 = 2
odchylenie2 = 2
prob = 0.7
params = expand.grid(sample_l, srednia1, odchylenie1, srednia2, odchylenie2, prob)
str(params)
names(params) = c("dlugość", "średnia1", "odchylenie1", "średnia2", "odchyelnie2", "prawdopodobienstwo")
set.seed(100)
now <- Sys.time()
powers <- sapply(1:nrow(params), function(p){
l <- params[p, 1]
par_1 <- c(params[p, 2],params[p, 3])
par_2 <- c(params[p, 4], params[p, 5])
p <- params[p,6]
p_sim <-sapply(rep(l, N), function(x){
my_sample <- rmix(l,"norm", par_1, "norm", par_2, p)
shapiro.test(my_sample)$p.value
})
mean(p_sim < alpha)
})
Sys.time() - now
power_df <- bind_cols(params, power = powers)
power_df %>% ggplot(aes(x = średnia1,
y = power,
col = factor(odchylenie1))) +
geom_line()
it work perfect, but now, when I want to make plot only depends of 1 factor - prob something goes wrong. I have error : Error: Aesthetics must be either length 1 or the same as the data (150): x, y. Here is a code:
alpha = 0.05
N = 100
sample_l = 10
srednia1 = 2
odchylenie1 = 2
srednia2 = 1
odchylenie2 = 1
prob = seq(0.1,0.9,by=0.1)
set.seed(100)
now <- Sys.time()
powers <- sapply(1:nrow(params), function(p){
l <- params[p, 1]
par_1 <- c(params[p, 2],params[p, 3])
par_2 <- c(params[p, 4], params[p, 5])
p <- params[p,6]
p_sim <-sapply(rep(l, N), function(x){
my_sample <- rmix(l,"norm", par_1, "norm", par_2, p)
shapiro.test(my_sample)$p.value
})
mean(p_sim < alpha)
})
Sys.time() - now
power_df <- bind_cols(params, power = powers)
power_df %>% ggplot(aes(x = prob, y = power)) + geom_line()
PLEASE HELP ME :(
Here's the code I made so far:
z = vector()
for(i in 1:20){
Alkie = function(T=20, lambda=2.5, k=2, mu=3) {
t = 0
N = 0
i = 1
A.t = rexp(1, lambda)
D.t = Inf
while(t[i] < T) {
t[i+1] = min(A.t, D.t)
N[i+1] = N[i] + ifelse(A.t < D.t, 1, -1)
if(A.t < D.t) {
A.t = A.t + rexp(1,lambda)
if(N[i+1] == 1) D.t = t[i+1] + rgamma(1, k, mu)
if(N[i+1] == 6) D.t = t[i+1] + rgamma(1, 0, mu)
}
else
D.t = ifelse(N[i+1] == 0, Inf, t[i+1] + rgamma(1, k, mu))
i = i + 1
}
cbind(t=t, N=N)
}
x = Alkie(T=20, lambda=2.5, k=2, mu=3)
n = nrow(x)
plot(c(x[1,1], rep(x[-1,1], each=2), x[n,1]), rep(x[,2], each=2), type="l",
xlab="t(mins)", ylab="N(t)", col="blue")
How do I store the counts?