简体   繁体   中英

loop density curve in R

nummonty<- c(09,10,11,12)
monty <- c('Sep','Oct','Nov','Dec')
daa <- c(rlnorm(1000), rlnorm(1000), rlnorm(1000),rlnorm(1000))
dat <- data.frame(nummonty,monty,daa)

dfun <- function(x, a, b) 1/(sqrt(2*pi*b(x-1)))*exp(-0.5*((log(x-a)/b)^2))

#Fit the density curves for each "month"
#dens <- density(dat$daa, n = nrow(daa))
#df_dens <- data.frame(x = dens$x, y = dens$y)

#Fit the data for all months 
fit <- nls(y ~ dfun(x, a, b), data = df_dens, start = list(a = mean(dat$daa[i]), b = sd(dat$daa[i])))

How do I include for each montyg type the density curve and extract the fitted data including the nls coeff a and b in a separate csv file? For a single case, the solution is here but I'd like to loop it. Any help is appreciated.

What you want is possible using patchwork and avoiding the use of loop with a function. You can split your data in a list by month and the fit the models. Then, you can arrange the plots as desired. Just few thoughts in your code. You literally took the function from the other post and changed from normal to lognormal. Be careful about that because setting logs in dfun() without knowing what will happen is not a good practice. In most of cases, NA will be produced and you will get errors in stat_function() . For that reason and to show you how to do, I will use the same function as in the cited post. After that you can adjust to your real data:

library(tidyverse)
library(patchwork)
#Data
nummonty<- c(09,10,11,12)
monty <- c('Sep','Oct','Nov','Dec')
daa <- c(rnorm(1000), rnorm(1000), rnorm(1000),rnorm(1000))
dat <- data.frame(nummonty,monty,daa)
gdat <- data.frame(montyg=unique(dat$monty),nummontyg=unique(dat$nummonty))
#Function
dfun <- function(x, a, b) 1/(sqrt(2*pi)*b)*exp(-0.5*((x-a)^2/(2*b^2))) 
#Create a data list
List <- split(dat,dat$monty)
#Function
myfun <- function(x)
{
  #Fit the density curves for each "month"
  dens <- density(x$daa, n = nrow(x))
  df_dens <- data.frame(x = dens$x, y = dens$y)
  #Fit the model
  fit <- nls(y ~ dfun(x, a, b),data = df_dens,start = list(a = mean(x$daa), b = sd(x$daa)))
  #Plot
  G1 <- ggplot(x, aes(x = daa)) + 
    geom_histogram(aes(y = ..density..), binwidth = 0.5)+
    stat_function(fun = dfun,
                  args = list(a = coef(fit)[1], b = coef(fit)[2]))+
    ggtitle(unique(x$monty))
  return(G1)
}
#Apply
List2 <- lapply(List,myfun)
#Wrap plots
G <- wrap_plots(List2,ncol = 2)

Output:

在此处输入图片说明

Update: To extract coefs try this:

#Function
myfun2 <- function(x)
{
  #Fit the density curves for each "month"
  dens <- density(x$daa, n = nrow(x))
  df_dens <- data.frame(x = dens$x, y = dens$y)
  #Fit the model
  fit <- nls(y ~ dfun(x, a, b),data = df_dens,start = list(a = mean(x$daa), b = sd(x$daa)))
  #Plot
  C1 <- coef(fit)
  return(C1)
}
#Apply
List2 <- lapply(List,myfun2)

Output:

List2
$Dec
        a         b 
0.0426051 0.9513849 

$Nov
         a          b 
0.02477635 0.96920246 

$Oct
         a          b 
0.08146357 0.98437906 

$Sep
          a           b 
-0.02620755  0.93557576 

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM