| Title: | Multidimensional Top Scoring for Creativity Research |
|---|---|
| Description: | Implementation of Multidimensional Top Scoring method for creativity assessment proposed in Boris Forthmann, Maciej Karwowski, Roger E. Beaty (2023) <doi:10.1037/aca0000571>. |
| Authors: | Jakub Jędrusiak [aut, cre, cph] (ORCID: <https://orcid.org/0000-0002-6481-8210>, affiliation: University of Wrocław), Boris Forthmann [aut, rev] (ORCID: <https://orcid.org/0000-0001-9755-7304>, affiliation: University of Münster), Roger E. Beaty [aut] (ORCID: <https://orcid.org/0000-0001-6114-5973>, affiliation: Pennsylvania State University), Maciej Karwowski [aut] (ORCID: <https://orcid.org/0000-0001-6974-1673>, affiliation: University of Wrocław) |
| Maintainer: | Jakub Jędrusiak <[email protected]> |
| License: | MIT + file LICENSE |
| Version: | 2.0.0 |
| Built: | 2026-05-24 09:18:42 UTC |
| Source: | https://github.com/jakub-jedrusiak/mtscr |
Create MTS model for creativity analysis. Use with summary.mtscr() and predict.mtscr().
mtscr( df, id_column, score_column, item_column = NULL, top = 1, ties_method = c("random", "average"), normalise = TRUE, self_ranking = NULL )mtscr( df, id_column, score_column, item_column = NULL, top = 1, ties_method = c("random", "average"), normalise = TRUE, self_ranking = NULL )
df |
Data frame in long format. |
id_column |
Name of the column containing participants' id. |
score_column |
Name of the column containing divergent thinking scores (e.g. semantic distance). |
item_column |
Optional, name of the column containing distinct trials (e.g. names of items in AUT). |
top |
Integer or vector of integers (see examples), number of top answers to prepare indicators for. Default is 1, i.e. only the top answer. |
ties_method |
Character string specifying how ties are treated when
ordering. Can be |
normalise |
Logical, should the creativity score be normalised? Default is |
self_ranking |
Name of the column containing answers' self-ranking.
Provide if model should be based on top answers self-chosen by the participant.
Every item should have its own ranks. The top answers should have a value of 1,
and the other answers should have a value of 0. In that case, the |
The return value depends on length of the top argument. If top is a single
integer, a mtscr model is returned. If top is a vector of integers, a mtscr_list object
is returned, with names corresponding to the top values, e.g. top1, top2, etc.
summary.mtscr() for the fit measures of the model.
predict.mtscr() for getting the scores.
data("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore # single model for top 1 answer mtscr(mtscr_creativity, id, SemDis_MEAN, item) |> summary() # three models for top 1, 2, and 3 answers fit3 <- mtscr( mtscr_creativity, id, SemDis_MEAN, item, top = 1:3, ties_method = "average" ) # add the scores to the database predict(fit3) # get the socres only predict(fit3, minimal = TRUE)data("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore # single model for top 1 answer mtscr(mtscr_creativity, id, SemDis_MEAN, item) |> summary() # three models for top 1, 2, and 3 answers fit3 <- mtscr( mtscr_creativity, id, SemDis_MEAN, item, top = 1:3, ties_method = "average" ) # add the scores to the database predict(fit3) # get the socres only predict(fit3, minimal = TRUE)
Shiny app used as graphical interface for mtscr. Simply invoke mtscr_app() to run.
mtscr_app()mtscr_app()
To use the GUI you need to have the following packages installed:
DT, broom.mixed, datamods, writexl, shinyWidgets, bslib, rstatix.
First thing you see after running the app is datamods
window for importing your data. You can use the data already loaded in your environment
or any other option. Then you'll see four dropdown lists used to choose arguments for the functions.
Consult the documentation for more details (execute ?mtscr in the console).
When the parameters are chosen, click "Generate model" button. After a while
(up to a dozen or so seconds) models' parameters and are shown along with a scored dataframe.
You can download your data as a .csv or an .xlsx file using buttons in the sidebar. You can either download the scores only (i.e. the dataframe you see displayed) or your whole data with scores columns added.
For testing purposes, you may use mtscr_creativity dataframe. In the importing window change
"Global Environment" to "mtscr" and our dataframe should appear in the upper dropdown list.
Use id for the ID column, item for the item column and SemDis_MEAN for the score column.
Runs the app. No explicit return value.
mtscr() for more information on the arguments.
mtscr_creativity for more information about the example dataset.
Forthmann, B., Karwowski, M., & Beaty, R. E. (2023). Don’t throw the “bad” ideas away! Multidimensional top scoring increases reliability of divergent thinking tasks. Psychology of Aesthetics, Creativity, and the Arts. doi:10.1037/aca0000571
if(interactive()){ mtscr_app() }if(interactive()){ mtscr_app() }
A dataset from Forthmann, Karwowski & Beaty (2023) paper. It contains a set of responses in Alternative Uses Task for different items with their semantic distance assessment.
mtscr_creativitymtscr_creativity
mtscr_creativityA tibble with 4585 rows and 10 columns:
patricipant's unique identification number
response in AUT
item for which alternative uses were searched for
mean semantic distance
a tibble
An example dataset with best answers self-chosen by the participant. Use with self_ranking
argument in mtscr().
mtscr_self_rankmtscr_self_rank
mtscr_self_rankA tibble with 3225 rows and 4 columns:
patricipant's unique identification number
divergent thinking task number
average judges' raiting
indicator of self-chosen two best answers; 1 if chosen, 0 if not
Extract the scores from a model fitted with mtscr().
## S3 method for class 'mtscr' predict(object, ..., minimal = FALSE, id_col = TRUE) ## S3 method for class 'mtscr_list' predict(object, ..., minimal = FALSE, id_col = TRUE)## S3 method for class 'mtscr' predict(object, ..., minimal = FALSE, id_col = TRUE) ## S3 method for class 'mtscr_list' predict(object, ..., minimal = FALSE, id_col = TRUE)
object |
A model or a model list fitted with |
... |
Additional arguments. Currently not used. |
minimal |
If |
id_col |
If |
The return value is always a tibble but its content depends mainly on the minimal argument:
If minimal = FALSE (default), the original data frame is returned with the creativity scores columns added.
If minimal = TRUE, only the creativity scores are returned (i.e., one row per person).
predict(mtscr_list): Extract scores from a model list fitted with mtscr().
data("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore fit <- mtscr(mtscr_creativity, id, SemDis_MEAN, item, top = 1:3) # for a single model from a list predict(fit$top1) # for a whole list of models predict(fit) # person-level scores only predict(fit, minimal = TRUE) # you can also achieve more classic predict() behaviour mtscr_creativity$score <- predict(fit, id_col = FALSE) mtscr_creativity |> tidyr::unnest_wider(score, names_sep = "_") # Use to expand list-coldata("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore fit <- mtscr(mtscr_creativity, id, SemDis_MEAN, item, top = 1:3) # for a single model from a list predict(fit$top1) # for a whole list of models predict(fit) # person-level scores only predict(fit, minimal = TRUE) # you can also achieve more classic predict() behaviour mtscr_creativity$score <- predict(fit, id_col = FALSE) mtscr_creativity |> tidyr::unnest_wider(score, names_sep = "_") # Use to expand list-col
Summarise the overall fit of a single model fitted with mtscr().
## S3 method for class 'mtscr' summary(object, ...) ## S3 method for class 'mtscr_list' summary(object, ...)## S3 method for class 'mtscr' summary(object, ...) ## S3 method for class 'mtscr_list' summary(object, ...)
object |
mtscr model or a mtscr_list object. |
... |
Additional arguments. Currently not used. |
A tibble with the following columns:
The model number (only if a list of models is provided)
Number of observations
The square root of the estimated residual variance
The log-likelihood of the model
The Akaike information criterion
The Bayesian information criterion
The residual degrees of freedom
The empirical reliability
The first difference of the empirical reliability
summary(mtscr_list): Get fit measures for a list of models fitted with mtscr().
data("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore fit1 <- mtscr(mtscr_creativity, id, SemDis_MEAN, item, ties_method = "average") fit3 <- mtscr(mtscr_creativity, id, SemDis_MEAN, item, top = 1:3, ties_method = "average") summary(fit1) summary(fit3)data("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore fit1 <- mtscr(mtscr_creativity, id, SemDis_MEAN, item, ties_method = "average") fit3 <- mtscr(mtscr_creativity, id, SemDis_MEAN, item, top = 1:3, ties_method = "average") summary(fit1) summary(fit3)
Get creativity measures using simple top-scoring, i.e., calculate a single index based only on top-X best scores.
top_scoring( df, id_column, score_column, item_column = NULL, top = 1, by_item = FALSE, na_if_less = FALSE, append = FALSE, aggregate_function = mean, top_all = TRUE )top_scoring( df, id_column, score_column, item_column = NULL, top = 1, by_item = FALSE, na_if_less = FALSE, append = FALSE, aggregate_function = mean, top_all = TRUE )
df |
Data frame in long format. |
id_column |
Name of the column containing participant's unique id. |
score_column |
Name of the column containing idea-level scores. |
item_column |
Name of the column containing separate trials for the task (e.g., AUT items). Optional. Supplying this argument changes the way the scores are calculated. See Deatils. |
top |
A number or an integer vector specifying on how many best ideas the final score should be based. |
by_item |
Boolean specifying whether the return value should aggregate scores from different items. |
na_if_less |
Whether to return |
append |
Boolean specifying whether the return value should be a new data frame with
person-level scores ( |
aggregate_function |
The function that should be used to aggregate idea-level scores
into person-level scores. Should be a function, not a call
(e.g., |
top_all |
Whether to calculate the top score based on all ideas, not only the top-X. |
The way the top-X scores are calculated is based mainly on the aggregate_function and
on whether the item_column was supplied. If the item_column wasn't supplied, the
top-X scores are the participants' best ideas across all trials. For example, if top = 2,
then the score is based on the person's 2 best ideas, even if there were 3 different items
and both best ideas were uses for a brick.
Now if the item_column was supplied and by_item = FALSE (default), the score will be
based on X best ideas per item. For example, if top = 2 and there were 3 different items,
the final score will be the mean of 6 best scores – 2 per item. Set by_item = TRUE to
get separate scores for each item.
The return value is a dataframe. By default, it contains an id column and a series
of score columns named top1, top2 etc. for each element of the vector given in the top
argument. If by_item = TRUE, the return value also contains an item column with item indices.
A separate score for each item is calculated. If append = TRUE, the return value is the
original dataframe with the score columns appended.
data("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore # Get top1, top2, and top3 scores for each participant top_scoring(mtscr_creativity, id, SemDis_MEAN, item, top = 1:3) # Get top2 scores ignoring items top_scoring(mtscr_creativity, id, SemDis_MEAN, top = 2) # Get top2-top4 scores for each item separately top_scoring(mtscr_creativity, id, SemDis_MEAN, item, top = 2:4, by_item = TRUE) # Add the scores to the original data frame top_scoring(mtscr_creativity, id, SemDis_MEAN, item, top = 2:4, append = TRUE) # Get scores by the sum of 3 top scores (note no parentheses after the function) top_scoring( mtscr_creativity, id, SemDis_MEAN, item, top = 3, aggregate_function = sum ) # Create a custom aggregate function (here: scale by 100, round and then get the mean) top_scoring( mtscr_creativity, id, SemDis_MEAN, item, top = 1:3, aggregate_function = \(x) mean(round(x * 100)) )data("mtscr_creativity", package = "mtscr") mtscr_creativity <- mtscr_creativity |> dplyr::slice_sample(n = 500) # for performance, ignore # Get top1, top2, and top3 scores for each participant top_scoring(mtscr_creativity, id, SemDis_MEAN, item, top = 1:3) # Get top2 scores ignoring items top_scoring(mtscr_creativity, id, SemDis_MEAN, top = 2) # Get top2-top4 scores for each item separately top_scoring(mtscr_creativity, id, SemDis_MEAN, item, top = 2:4, by_item = TRUE) # Add the scores to the original data frame top_scoring(mtscr_creativity, id, SemDis_MEAN, item, top = 2:4, append = TRUE) # Get scores by the sum of 3 top scores (note no parentheses after the function) top_scoring( mtscr_creativity, id, SemDis_MEAN, item, top = 3, aggregate_function = sum ) # Create a custom aggregate function (here: scale by 100, round and then get the mean) top_scoring( mtscr_creativity, id, SemDis_MEAN, item, top = 1:3, aggregate_function = \(x) mean(round(x * 100)) )