Skip to content

Commit

Permalink
another small bug
Browse files Browse the repository at this point in the history
  • Loading branch information
michellepistner committed Jan 12, 2024
1 parent b3ef13f commit 043f02d
Show file tree
Hide file tree
Showing 2 changed files with 30 additions and 29 deletions.
11 changes: 6 additions & 5 deletions R/fit_basset.R
Original file line number Diff line number Diff line change
Expand Up @@ -92,11 +92,6 @@ basset <- function(Y=NULL, X, upsilon=NULL, Theta=NULL, Gamma=NULL, Xi=NULL, lin
stop("Theta and Gamma must be of the same length.")
}

## setting newdata <- X if newdata is null
if(is.null(newdata)){
newdata <- X
}

## evaluating theta and gamma
## theta
theta_eval <- function(Theta, X, linear){
Expand Down Expand Up @@ -139,6 +134,7 @@ basset <- function(Y=NULL, X, upsilon=NULL, Theta=NULL, Gamma=NULL, Xi=NULL, lin
Gamma_comb <- Reduce('+', Gamma_trans)

## fitting the joint model
## newdata auto handled by pibble
collapse_samps <- pibble(Y, X=diag(ncol(X)), upsilon, Theta_comb, Gamma_comb, Xi, init, pars, newdata = newdata, ...)

## fitting uncollapse using the joint samples
Expand Down Expand Up @@ -176,6 +172,11 @@ basset <- function(Y=NULL, X, upsilon=NULL, Theta=NULL, Gamma=NULL, Xi=NULL, lin
}
}

## setting newdata <- X if newdata is null
if(is.null(newdata)){
newdata <- X
}

for(i in 1:num.comp){
## if num.comp == 1 --> return the samples from Lambda above
if(num.comp == 1){
Expand Down
48 changes: 24 additions & 24 deletions vignettes/non-linear-models.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -145,30 +145,30 @@ predicted <- predict(fit.clr, X_predict, jitter=1)
Now I am going to create a visual that shows the observed data in CLR coordinates
(to do that I will need to add a pseudo-count) along with the smoothed estimates.
```{r fig.height=5, fig.width=7}
# family_names <- as(mallard_family$tax_table$Family, "vector")
# Y_clr_tidy <- clr_array(Y+0.65, parts = 1) %>%
# gather_array(mean, coord, sample) %>%
# mutate(time = X[1,sample],
# coord = paste0("CLR(", family_names[coord],")"))
#
# predicted_tidy <- gather_array(predicted, val, coord, sample, iter) %>%
# mutate(time = X_predict[1,sample]) %>%
# filter(!is.na(val)) %>%
# group_by(time, coord) %>%
# summarise_posterior(val, na.rm=TRUE) %>%
# ungroup() %>%
# mutate(coord = paste0("CLR(", family_names[coord],")"))
#
# ggplot(predicted_tidy, aes(x = time, y=mean)) +
# geom_ribbon(aes(ymin=p2.5, ymax=p97.5), fill="darkgrey", alpha=0.5) +
# geom_ribbon(aes(ymin=p25, ymax=p75), fill="darkgrey", alpha=0.9)+
# geom_line(color="blue") +
# geom_point(data = Y_clr_tidy, alpha=0.5) +
# facet_wrap(~coord, scales="free_y") +
# theme_minimal()+
# theme(axis.title.y = element_blank(),
# axis.title.x = element_blank(),
# axis.text.x = element_text(angle=45))
family_names <- as(mallard_family$tax_table$Family, "vector")
Y_clr_tidy <- clr_array(Y+0.65, parts = 1) %>%
gather_array(mean, coord, sample) %>%
mutate(time = X[1,sample],
coord = paste0("CLR(", family_names[coord],")"))
predicted_tidy <- gather_array(predicted, val, coord, sample, iter) %>%
mutate(time = X_predict[1,sample]) %>%
filter(!is.na(val)) %>%
group_by(time, coord) %>%
summarise_posterior(val, na.rm=TRUE) %>%
ungroup() %>%
mutate(coord = paste0("CLR(", family_names[coord],")"))
ggplot(predicted_tidy, aes(x = time, y=mean)) +
geom_ribbon(aes(ymin=p2.5, ymax=p97.5), fill="darkgrey", alpha=0.5) +
geom_ribbon(aes(ymin=p25, ymax=p75), fill="darkgrey", alpha=0.9)+
geom_line(color="blue") +
geom_point(data = Y_clr_tidy, alpha=0.5) +
facet_wrap(~coord, scales="free_y") +
theme_minimal()+
theme(axis.title.y = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_text(angle=45))
```

Expand Down

0 comments on commit 043f02d

Please sign in to comment.