R中的循环密度曲线

Question

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.

Answer 1

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