## DESCRIPTION
## Match each of the following stages of meiosis prophase I with their corresponding partial descriptions.
## ENDDESCRIPTION
## KEYWORDS('stages of meiosis prophase I','partial descriptions')
## DBsubject('Genetics')
## DBchapter('')
## DBsection('')
## Date('2026-07-12')
## Author('Neil R. Voss')
## Institution('Roosevelt University')

DOCUMENT();

loadMacros(
    'PGstandard.pl',
    'PGML.pl',
    'PGchoicemacros.pl',
    'parserPopUp.pl',
    'parserUtils.pl',
    'PGgraders.pl',
    'PGcourse.pl'
);
our @ALPHABET = ('A' .. 'Z');

# ================================
# Full matching data
# ================================
%match_data = (
  'Leptotene' => [
    'chromosomes begin to condense',
    'thread-like chromomeres become visible along the chromosomes',
    'chromosomes first become visible as thin thread-like structures',
    'chromosomes first appear as fine discrete threads',
    'chromomeres appear as bead-like thickenings along the chromosomes',
    'condensation begins and chromosomes become visible as thin threads',
  ],
  'Zygotene' => [
    'synapsis begins',
    'the pairing of homologous chromosomes begins',
    'the synapsis process forms numerous points of contact between homologs',
    'stage where homologous chromosomes become paired',
    'homologous chromosomes align and pair',
    'synapsis of homologous chromosomes occurs',
    'strands of homologous chromosomes line up and become pairs',
  ],
  'Pachytene, early or late' => [
    'synapsis is complete',
    'the pairing of homologous chromosomes is complete',
    'crossing over occurs between non-sister chromatids',
    'crossing over occurs between homologous chromosomes',
    'exchange of segments between non-sister chromatids may occur',
    'exchange of segments between homologous chromosomes may occur',
    'chromosomes continue to shorten and thicken',
  ],
  'Diplotene or Diakinesis, combined' => [
    'the paired chromosomes begin to separate',
    'chiasmata are visible between homologous chromosomes',
    'homologous chromosomes begin to migrate apart',
    'homologous chromosome pairs begin to separate and chiasmata become visible',
    'homologous chromosomes separate and chiasmata become visible',
    'homologous chromosomes are held together only by the chiasmata',
    'chromosomes become further condensed',
    'chromosomes reach near-maximal condensation in late prophase I',
    'nucleolus and nuclear envelope disappear while spindle fibers form',
  ],
);

# -------------------------------
# Select N random keys
# -------------------------------
my $n = 4;
@all_keys = PGsort(sub { $_[0] lt $_[1] }, keys %match_data);
my $local_seed = (defined($problemSeed) && $problemSeed ne '') ? $problemSeed : 1;
my $local_random = new PGrandom($local_seed);

my @indices = (0 .. $#all_keys);
my @shuffled = ();
while (@indices) {
  my $pick = $local_random->random(0, $#indices, 1);
  push @shuffled, splice(@indices, $pick, 1);
}
my @selected_keys = @all_keys[@shuffled[0..$n-1]];

# -------------------------------
# Build question/answer pairs
# -------------------------------
# Each entry: [prompt, choice]
@q_and_a = ();
foreach my $key (@selected_keys) {
  my $values_ref = $match_data{$key};
  my $i = $local_random->random(0, $#$values_ref, 1);
  my $value = $values_ref->[$i];
  push @q_and_a, [ $value, $key ];
}

# -------------------------------
# Randomize the questions
# -------------------------------
my @q_indices = (0 .. $#q_and_a);
my @q_shuffled = ();
while (@q_indices) {
  my $pick = $local_random->random(0, $#q_indices, 1);
  push @q_shuffled, $q_and_a[splice(@q_indices, $pick, 1)];
}
@q_and_a = @q_shuffled;

# -------------------------------
# Sort the choices alphabetically
# -------------------------------
@answers = ();
push(@answers, (map { $_->[1] } @q_and_a));
@answers_sorted = PGsort(sub { $_[0] lt $_[1] }, @answers);

# -------------------------------
# HTML-safe answer labels
# -------------------------------
%answer_html = (
  'Leptotene' => '<span style="color: #b74300; font-weight:700;">Leptotene</span>',
  'Zygotene' => '<span style="color: #00775f; font-weight:700;">Zygotene</span>',
  'Pachytene, early or late' => '<span style="color: #0067cc; font-weight:700;">Pachytene, early or late</span>',
  'Diplotene or Diakinesis, combined' => '<span style="color: #cc0066; font-weight:700;">Diplotene or Diakinesis, combined</span>',
);

@answers_sorted_html = map { $answer_html{$_} || $_ } @answers_sorted;

# -------------------------------
# Create answer index lookup
# -------------------------------
our %answer_index;
for (my $i = 0; $i <= $#answers_sorted; $i++) {
  $answer_index{$answers_sorted[$i]} = $i;
}

# -------------------------------
# PopUp/DropDown compatibility
# -------------------------------
sub make_popup {
  return defined &DropDown ? DropDown(@_) : PopUp(@_);
}

# -------------------------------
# Create popup objects (blank default)
# -------------------------------
my @answer_letters = @ALPHABET[0 .. $#answers_sorted];
my @answer_letters_with_blank = ('', @answer_letters);
@answer_dropdowns =
  map { make_popup([ @answer_letters_with_blank ], $answer_index{$q_and_a[$_][1]} + 1 ) }
  0 .. $#q_and_a;

# -------------------------------
# Render the question
# -------------------------------
HEADER_TEXT(<<END_STYLE);
<style>
.pgml-bold { font-weight: 700; }
.two-column {
    display: flex;
	flex-wrap: wrap;
	gap: 2rem;
	align-items: center;
	justify-content: space-evenly;
}
</style>
END_STYLE

$question_text = 'Match each of the following stages of meiosis prophase I with their corresponding partial descriptions.';
$note_text = 'Note: Each choice will be used exactly once.';

BEGIN_PGML
[$question_text]*
[$note_text]*

[@ MODES(HTML => '<div class="two-column"><div>') @]*
[@ join(
    "\n\n",
    map {
        '[_]{$answer_dropdowns[' . $_ . ']} '
            . '*' . ($_ + 1) . '.* '
            . '[$q_and_a[' . $_ . '][0]]*'
    } 0 .. $#q_and_a
) @]**
[@ MODES(HTML => '</div><div class="right-col">') @]*
[@ join(
    "\n\n",
    map {
        chr(65 + $_) . '\\.' . ' ' . '[$answers_sorted_html[' . $_ . ']]*'
    } 0 .. $#answers_sorted
) @]**
[@ MODES(HTML => '</div></div>') @]*
END_PGML

# -------------------------------
# Dynamic Partial Credit Based on $n
# -------------------------------
$showPartialCorrectAnswers = 0;
my @thresholds;
my @scores;
for (my $i = 1; $i <= $n; $i++) {
  push @thresholds, $i;
  push @scores, sprintf("%.2f", $i / $n);
}

install_problem_grader(~~&custom_problem_grader_fluid);
$ENV{grader_numright} = [@thresholds];
$ENV{grader_scores}   = [@scores];
$ENV{grader_message} = 'You can earn partial credit.';

# -------------------------------
# Solution
# -------------------------------
$answer_list = join(', ', map { ($_ + 1) . '-' . $ALPHABET[$answer_index{$q_and_a[$_][1]}] } 0 .. $#q_and_a);
BEGIN_PGML_SOLUTION
The correct answers are: [$answer_list].
END_PGML_SOLUTION

ENDDOCUMENT();

