From d295d4e8e399127340a3707913d4f6dc0884e8ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Paul-Christian=20B=C3=BCrkner?= <paul.buerkner@gmail.com>
Date: Tue, 13 Aug 2024 11:19:54 +0200
Subject: [PATCH] fix issue #1633

---
 DESCRIPTION                     |  2 +-
 R/stan-likelihood.R             |  7 ++++---
 inst/chunks/fun_von_mises.stan  | 34 ---------------------------------
 tests/testthat/tests.stancode.R |  5 -----
 4 files changed, 5 insertions(+), 43 deletions(-)
 delete mode 100644 inst/chunks/fun_von_mises.stan

diff --git a/DESCRIPTION b/DESCRIPTION
index 7ee510496..e304a7d06 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -101,4 +101,4 @@ Additional_repositories:
 VignetteBuilder:
     knitr,
     R.rsp
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
diff --git a/R/stan-likelihood.R b/R/stan-likelihood.R
index 458918bf6..adeeb2da0 100644
--- a/R/stan-likelihood.R
+++ b/R/stan-likelihood.R
@@ -714,6 +714,8 @@ stan_log_lik_wiener <- function(bterms, resp = "", mix = "", threads = NULL,
 }
 
 stan_log_lik_beta <- function(bterms, resp = "", mix = "", ...) {
+  # TODO: check if we still require n when phi is predicted 
+  # and check the same for other families too
   reqn <- stan_log_lik_adj(bterms) || nzchar(mix) ||
     paste0("phi", mix) %in% names(bterms$dpars)
   p <- stan_log_lik_dpars(bterms, reqn, resp, mix)
@@ -724,10 +726,9 @@ stan_log_lik_beta <- function(bterms, resp = "", mix = "", ...) {
 }
 
 stan_log_lik_von_mises <- function(bterms, resp = "", mix = "", ...) {
-  reqn <- stan_log_lik_adj(bterms) || nzchar(mix) ||
-    "kappa" %in% names(bterms$dpars)
+  reqn <- stan_log_lik_adj(bterms) || nzchar(mix) 
   p <- stan_log_lik_dpars(bterms, reqn, resp, mix)
-  sdist("von_mises2", p$mu, p$kappa)
+  sdist("von_mises", p$mu, p$kappa)
 }
 
 stan_log_lik_cox <- function(bterms, resp = "", mix = "", threads = NULL,
diff --git a/inst/chunks/fun_von_mises.stan b/inst/chunks/fun_von_mises.stan
deleted file mode 100644
index 2bdd080fd..000000000
--- a/inst/chunks/fun_von_mises.stan
+++ /dev/null
@@ -1,34 +0,0 @@
-  /* von Mises log-PDF of a single response
-   * for kappa > 100 the normal approximation is used
-   * for reasons of numerial stability
-   * Args:
-   *   y: the response vector between -pi and pi
-   *   mu: location parameter vector
-   *   kappa: precision parameter
-   * Returns:
-   *   a scalar to be added to the log posterior
-   */
-   real von_mises2_lpdf(real y, real mu, real kappa) {
-     if (kappa < 100) {
-       return von_mises_lpdf(y | mu, kappa);
-     } else {
-       return normal_lpdf(y | mu, sqrt(1 / kappa));
-     }
-   }
-  /* von Mises log-PDF of a response vector
-   * for kappa > 100 the normal approximation is used
-   * for reasons of numerial stability
-   * Args:
-   *   y: the response vector between -pi and pi
-   *   mu: location parameter vector
-   *   kappa: precision parameter
-   * Returns:
-   *   a scalar to be added to the log posterior
-   */
-   real von_mises2_lpdf(vector y, vector mu, real kappa) {
-     if (kappa < 100) {
-       return von_mises_lpdf(y | mu, kappa);
-     } else {
-       return normal_lpdf(y | mu, sqrt(1 / kappa));
-     }
-   }
diff --git a/tests/testthat/tests.stancode.R b/tests/testthat/tests.stancode.R
index d4e1e0539..274c81238 100644
--- a/tests/testthat/tests.stancode.R
+++ b/tests/testthat/tests.stancode.R
@@ -484,11 +484,6 @@ test_that("self-defined functions appear in the Stan code", {
   expect_match2(scode, "real inv_gaussian_lccdf(real y")
   expect_match2(scode, "real inv_gaussian_lpdf(vector y")
 
-  # von Mises models
-  scode <- stancode(time ~ age, data = kidney, family = von_mises)
-  expect_match2(scode, "real von_mises2_lpdf(real y")
-  expect_match2(scode, "real von_mises2_lpdf(vector y")
-
   # zero-inflated and hurdle models
   expect_match2(stancode(count ~ Trt, data = epilepsy,
                               family = "zero_inflated_poisson"),