@@ -76,3 +76,123 @@ print.BayesMallowsSMC2 <- function(x, ...) {
7676
7777 invisible (x )
7878}
79+
80+ # ' Summary Method for BayesMallowsSMC2 Objects
81+ # '
82+ # ' Creates a summary of a BayesMallowsSMC2 object returned by
83+ # ' [compute_sequentially()].
84+ # '
85+ # ' @param object An object of class \code{BayesMallowsSMC2}.
86+ # ' @param ... Additional arguments (currently unused).
87+ # '
88+ # ' @return An object of class \code{summary.BayesMallowsSMC2}, which is a list
89+ # ' containing summary information about the model.
90+ # '
91+ # ' @details
92+ # ' The summary method creates a summary object that includes:
93+ # ' \itemize{
94+ # ' \item Number of particles
95+ # ' \item Number of timepoints
96+ # ' \item Number of items
97+ # ' \item Number of clusters
98+ # ' \item Log marginal likelihood
99+ # ' \item Final effective sample size (ESS)
100+ # ' \item Number of resampling events
101+ # ' \item Posterior mean of alpha for each cluster
102+ # ' \item Posterior standard deviation of alpha for each cluster
103+ # ' }
104+ # '
105+ # ' @export
106+ # '
107+ # ' @examples
108+ # ' # Fit a model with complete rankings
109+ # ' set.seed(123)
110+ # ' mod <- compute_sequentially(
111+ # ' complete_rankings,
112+ # ' hyperparameters = set_hyperparameters(n_items = 5),
113+ # ' smc_options = set_smc_options(n_particles = 100, n_particle_filters = 1)
114+ # ' )
115+ # '
116+ # ' # Create summary
117+ # ' summary(mod)
118+ # '
119+ summary.BayesMallowsSMC2 <- function (object , ... ) {
120+ # Basic validation
121+ if (! inherits(object , " BayesMallowsSMC2"
122+ stop(" object must be an object of class 'BayesMallowsSMC2'"
123+ }
124+
125+ required_fields <- c(" alpha" " rho" " ESS" " resampling" " log_marginal_likelihood"
126+ missing_fields <- setdiff(required_fields , names(object ))
127+ if (length(missing_fields ) > 0 ) {
128+ stop(" Object is missing required fields: " missing_fields , collapse = " , "
129+ }
130+
131+ # Extract dimensions
132+ n_particles <- ncol(object $ alpha )
133+ n_timepoints <- length(object $ ESS )
134+ n_items <- dim(object $ rho )[1 ]
135+ n_clusters <- nrow(object $ alpha )
136+
137+ # Count resampling events
138+ n_resampling_events <- sum(object $ resampling )
139+
140+ # Compute posterior mean and standard deviation of alpha
141+ # alpha is a matrix where rows are clusters and columns are particles
142+ alpha_mean <- rowMeans(object $ alpha )
143+ alpha_sd <- apply(object $ alpha , 1 , sd )
144+
145+ # Create summary object
146+ summary_obj <- list (
147+ n_particles = n_particles ,
148+ n_timepoints = n_timepoints ,
149+ n_items = n_items ,
150+ n_clusters = n_clusters ,
151+ log_marginal_likelihood = object $ log_marginal_likelihood ,
152+ final_ess = object $ ESS [n_timepoints ],
153+ n_resampling_events = n_resampling_events ,
154+ alpha_mean = alpha_mean ,
155+ alpha_sd = alpha_sd
156+ )
157+
158+ class(summary_obj ) <- " summary.BayesMallowsSMC2"
159+ summary_obj
160+ }
161+
162+ # ' Print Method for summary.BayesMallowsSMC2 Objects
163+ # '
164+ # ' Prints a summary of a BayesMallowsSMC2 model.
165+ # '
166+ # ' @param x An object of class \code{summary.BayesMallowsSMC2}.
167+ # ' @param ... Additional arguments (currently unused).
168+ # '
169+ # ' @return Invisibly returns the input object \code{x}.
170+ # '
171+ # ' @export
172+ # '
173+ print.summary.BayesMallowsSMC2 <- function (x , ... ) {
174+ # Create header
175+ cat(" BayesMallowsSMC2 Model Summary\n "
176+ cat(strrep(" =" " BayesMallowsSMC2 Model Summary" " \n\n " sep = " "
177+
178+ # Display basic information
179+ cat(sprintf(" %-25s %s\n " " Number of particles:" x $ n_particles ))
180+ cat(sprintf(" %-25s %s\n " " Number of timepoints:" x $ n_timepoints ))
181+ cat(sprintf(" %-25s %s\n " " Number of items:" x $ n_items ))
182+ cat(sprintf(" %-25s %s\n\n " " Number of clusters:" x $ n_clusters ))
183+
184+ # Display model fit information
185+ cat(sprintf(" %-25s %.2f\n " " Log marginal likelihood:" x $ log_marginal_likelihood ))
186+ cat(sprintf(" %-25s %.2f\n " " Final ESS:" x $ final_ess ))
187+ cat(sprintf(" %-25s %d/%d\n\n " " Resampling events:" x $ n_resampling_events , x $ n_timepoints ))
188+
189+ # Display posterior statistics for alpha
190+ cat(" Posterior Statistics for Alpha:\n "
191+ cat(strrep(" -" " Posterior Statistics for Alpha:" " \n " sep = " "
192+ for (i in seq_along(x $ alpha_mean )) {
193+ cat(sprintf(" Cluster %d: Mean = %.4f, SD = %.4f\n "
194+ i , x $ alpha_mean [i ], x $ alpha_sd [i ]))
195+ }
196+
197+ invisible (x )
198+ }
0 commit comments