File:  [LON-CAPA] / loncom / homework / radiobuttonresponse.pm
Revision 1.153.6.4: download - view: text, annotated - select for diffs
Mon Jan 23 12:00:13 2012 UTC (12 years, 2 months ago) by foxr
Branches: BZ4492-feature_horizontal_radioresponse
Diff to branchpoint 1.153: preferred, colored
BZ 4492 More refactoring prior to implementing latex direction rendering
        selection.

# The LearningOnline Network with CAPA
# mutliple choice style responses
#
# $Id: radiobuttonresponse.pm,v 1.153.6.4 2012/01/23 12:00:13 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::radiobuttonresponse;
use strict;
use HTML::Entities();
use Apache::lonlocal;
use Apache::lonnet;
use Apache::response;

my $default_bubbles_per_line = 10;
my @alphabet      = ( 'A' .. 'Z' ); # Foil labels.



BEGIN {
    &Apache::lonxml::register( 'Apache::radiobuttonresponse',
        ('radiobuttonresponse') );
}

sub bubble_line_count {
    my ( $numfoils, $bubbles_per_line ) = @_;
    my $bubble_lines;
    $bubble_lines = int( $numfoils / $bubbles_per_line );
    if ( ( $numfoils % $bubbles_per_line ) != 0 ) {
        $bubble_lines++;
    }
    return $bubble_lines;

}

sub start_radiobuttonresponse {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;
    my $result;

    #when in a radiobutton response use these
    &Apache::lonxml::register( 'Apache::radiobuttonresponse',
        ( 'foilgroup', 'foil', 'conceptgroup' ) );
    push( @Apache::lonxml::namespace, 'radiobuttonresponse' );
    my $id = &Apache::response::start_response( $parstack, $safeeval );

    %Apache::hint::radiobutton = ();
    undef(%Apache::response::foilnames);
    if ( $target eq 'meta' ) {
        $result = &Apache::response::meta_package_write('radiobuttonresponse');
    }
    elsif ( $target eq 'edit' ) {
        $result .=
            &Apache::edit::start_table($token)
          . '<tr><td>'
          . &Apache::lonxml::description($token)
          . &Apache::loncommon::help_open_topic('Radio_Response_Problems')
          . '</td>'
          . '<td><span class="LC_nobreak">'
          . &mt('Delete?') . ' '
          . &Apache::edit::deletelist( $target, $token )
          . '</span></td>'
          . '<td>&nbsp;'
          . &Apache::edit::end_row()
          . &Apache::edit::start_spanning_row();
        $result .= &Apache::edit::text_arg( 'Max Number Of Shown Foils:',
            'max', $token, '4' )
          . '&nbsp;' x 3
          . &Apache::edit::select_arg( 'Randomize Foil Order:',
            'randomize', [ 'yes', 'no' ], $token )
          . '&nbsp;' x 3
          . &Apache::edit::select_arg(
            'Display Direction:', 'direction',
            [ 'vertical', 'horizontal' ], $token
          )
          . &Apache::edit::end_row()
          . &Apache::edit::start_spanning_row() . "\n";
    }
    elsif ( $target eq 'modified' ) {
        my $constructtag =
          &Apache::edit::get_new_args( $token, $parstack, $safeeval, 'max',
            'randomize', 'direction' );
        if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
    }
    elsif ( $target eq 'tex' ) {
        my $type =
          &Apache::lonxml::get_param( 'TeXtype', $parstack, $safeeval, undef,
            0 );
        if ( $type eq '1' ) {
            $result .= ' \renewcommand{\labelenumi}{\arabic{enumi}.}';
        }
        elsif ( $type eq 'A' ) {
            $result .= ' \renewcommand{\labelenumi}{\Alph{enumi}.}';
        }
        elsif ( $type eq 'a' ) {
            $result .= ' \renewcommand{\labelenumi}{\alph{enumi}.}';
        }
        elsif ( $type eq 'i' ) {
            $result .= ' \renewcommand{\labelenumi}{\roman{enumi}.}';
        }
        else {
            $result .= ' \renewcommand{\labelenumi}{\Alph{enumi}.}';
        }

    }
    elsif ( $target eq 'analyze' ) {
        my $part_id = "$Apache::inputtags::part.$id";
        $Apache::lonhomework::analyze{"$part_id.type"} = 'radiobuttonresponse';
        push( @{ $Apache::lonhomework::analyze{"parts"} }, $part_id );
    }
    return $result;
}

sub end_radiobuttonresponse {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;
    my $result;
    if ( $target eq 'edit' ) { $result = &Apache::edit::end_table(); }

    &Apache::response::end_response;
    pop @Apache::lonxml::namespace;
    &Apache::lonxml::deregister( 'Apache::radiobuttonresponse',
        ( 'foilgroup', 'foil', 'conceptgroup' ) );
    undef(%Apache::response::foilnames);
    return $result;
}

%Apache::response::foilgroup = ();

sub start_foilgroup {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;
    %Apache::response::foilgroup               = ();
    $Apache::radiobuttonresponse::conceptgroup = 0;
    &Apache::response::pushrandomnumber( undef, $target );
    return;
}

sub storesurvey {
    my ($style) = @_;
    if ( !&Apache::response::submitted() ) { return ''; }
    my $response = $env{ 'form.HWVAL_' . $Apache::inputtags::response['-1'] };
    &Apache::lonxml::debug("Here I am!:$response:");
    if ( $response !~ /[0-9]+/ ) { return ''; }
    my $part       = $Apache::inputtags::part;
    my $id         = $Apache::inputtags::response['-1'];
    my @whichfoils = @{ $Apache::response::foilgroup{'names'} };
    my %responsehash;
    $responsehash{ $whichfoils[$response] } = $response;
    my $responsestr = &Apache::lonnet::hash2str(%responsehash);
    $Apache::lonhomework::results{"resource.$part.$id.submission"} =
      $responsestr;
    my %previous =
      &Apache::response::check_for_previous( $responsestr, $part, $id );
    my $ad;

    if ( $style eq 'anonsurvey' ) {
        $ad = $Apache::lonhomework::results{"resource.$part.$id.awarddetail"} =
          'ANONYMOUS';
    }
    elsif ( $style eq 'anonsurveycred' ) {
        $ad = $Apache::lonhomework::results{"resource.$part.$id.awarddetail"} =
          'ANONYMOUS_CREDIT';
    }
    elsif ( $style eq 'surveycred' ) {
        $ad = $Apache::lonhomework::results{"resource.$part.$id.awarddetail"} =
          'SUBMITTED_CREDIT';
    }
    else {
        $ad = $Apache::lonhomework::results{"resource.$part.$id.awarddetail"} =
          'SUBMITTED';
    }
    &Apache::response::handle_previous( \%previous, $ad );
    &Apache::lonxml::debug("submitted a $response<br />\n");
    return '';
}

sub grade_response {
    my ( $answer, $whichfoils, $bubbles_per_line ) = @_;

    if ( !&Apache::response::submitted() ) { return; }
    my $response;

    if ( $env{'form.submitted'} eq 'scantron' ) {
        $response =
          &Apache::response::getresponse( 1, undef,
            &bubble_line_count( scalar( @{$whichfoils} ), $bubbles_per_line ),
            $bubbles_per_line );

    }
    else {
        $response = $env{ 'form.HWVAL_' . $Apache::inputtags::response['-1'] };
    }

    if ( $response !~ /[0-9]+/ ) { return; }
    my $part = $Apache::inputtags::part;
    my $id   = $Apache::inputtags::response['-1'];
    my %responsehash;
    $responsehash{ $whichfoils->[$response] } = $response;
    my $responsestr = &Apache::lonnet::hash2str(%responsehash);
    my %previous =
      &Apache::response::check_for_previous( $responsestr, $part, $id );
    $Apache::lonhomework::results{"resource.$part.$id.submission"} =
      $responsestr;
    &Apache::lonxml::debug("submitted a $response<br />\n");
    my $ad;

    if ( $response == $answer ) {
        $ad = 'EXACT_ANS';
    }
    else {
        $ad = 'INCORRECT';
    }
    $Apache::lonhomework::results{"resource.$part.$id.awarddetail"} = $ad;
    &Apache::response::handle_previous( \%previous, $ad );
}

sub end_foilgroup {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;

    my $result;
    my $bubble_lines;
    my $answer_count;
    my $id               = $Apache::inputtags::response['-1'];
    my $part             = $Apache::inputtags::part;
    my $bubbles_per_line = &getbubblesnum( $part, $id );

    if (   $target eq 'grade'
        || $target eq 'web'
        || $target eq 'answer'
        || $target eq 'tex'
        || $target eq 'analyze' )
    {
        my $style = $Apache::lonhomework::type;
        my $direction =
          &Apache::lonxml::get_param( 'direction', $parstack, $safeeval, '-2' );
        if (
            (
                   ( $style eq 'survey' )
                || ( $style eq 'surveycred' )
                || ( $style eq 'anonsurvey' )
                || ( $style eq 'anonsurveycred' )
            )
            && ( $target ne 'analyze' )
          )
        {
            if ( $target eq 'web' || $target eq 'tex' ) {
                $result = &displayallfoils( $direction, $target );
            }
            elsif ( $target eq 'answer' ) {
                $result = &displayallanswers();
            }
            elsif ( $target eq 'grade' ) {
                $result = &storesurvey($style);
            }
            $answer_count =
              scalar( @{ $Apache::response::foilgroup{'names'} } );

        }
        else {

            my $name;
            my $max =
              &Apache::lonxml::get_param( 'max', $parstack, $safeeval, '-2' );
            my $randomize =
              &Apache::lonxml::get_param( 'randomize', $parstack, $safeeval,
                '-2' );
            my ( $answer, @shown ) = &whichfoils( $max, $randomize );
            $answer_count = scalar(@shown);

            if ( $target eq 'web' || $target eq 'tex' ) {
                $result =
                  &displayfoils( $target, $answer, \@shown, $direction,
                    $bubbles_per_line );
            }
            elsif ( $target eq 'answer' ) {
                $result =
                  &displayanswers( $answer, \@shown, $bubbles_per_line );
            }
            elsif ( $target eq 'grade' ) {
                &grade_response( $answer, \@shown, $bubbles_per_line );
            }
            elsif ( $target eq 'analyze' ) {
                my $bubble_lines =
                  &bubble_line_count( $answer_count, $bubbles_per_line );
                &Apache::response::analyze_store_foilgroup( \@shown,
                    [ 'text', 'value', 'location' ] );
                my $part_id = "$part.$id";
                push(
                    @{ $Apache::lonhomework::analyze{"$part_id.options"} },
                    ( 'true', 'false' )
                );

            }
        }
        $Apache::lonxml::post_evaluate = 0;
    }
    if ( $target eq 'web' ) {
        &Apache::response::setup_prior_tries_hash( \&format_prior_answer,
            [ \%Apache::response::foilgroup ] );
    }
    &Apache::response::poprandomnumber();
    $bubble_lines = &bubble_line_count( $answer_count, $bubbles_per_line );
    &Apache::lonxml::increment_counter( $bubble_lines, "$part.$id" );
    if ( $target eq 'analyze' ) {
        &Apache::lonhomework::set_bubble_lines();
    }
    return $result;
}

sub getbubblesnum {
    my ( $part, $id ) = @_;
    my $bubbles_per_line;
    my $default_numbubbles = $default_bubbles_per_line;
    if (   ( $env{'form.bubbles_per_row'} =~ /^\d+$/ )
        && ( $env{'form.bubbles_per_row'} > 0 ) )
    {
        $default_numbubbles = $env{'form.bubbles_per_row'};
    }
    $bubbles_per_line = &Apache::response::get_response_param( $part . "_$id",
        'numbubbles', $default_numbubbles );
    return $bubbles_per_line;
}

sub getfoilcounts {
    my @names;
    my $truecnt  = 0;
    my $falsecnt = 0;
    my $name;
    if ( $Apache::response::foilgroup{'names'} ) {
        @names = @{ $Apache::response::foilgroup{'names'} };
    }
    foreach $name (@names) {
        if ( $Apache::response::foilgroup{ $name . '.value' } eq 'true' ) {
            $truecnt++;
        }
        elsif ( $Apache::response::foilgroup{ $name . '.value' } eq 'false' ) {
            $falsecnt++;
        }
    }
    return ( $truecnt, $falsecnt );
}

sub format_prior_answer {
    my ( $mode, $answer, $other_data ) = @_;
    my $foil_data = $other_data->[0];
    my %response  = &Apache::lonnet::str2hash($answer);
    my ($name)    = keys(%response);
    return
        '<span class="LC_prior_radiobutton">'
      . $foil_data->{ $name . '.text' }
      . '</span>';

}

##
sub displayallfoils {
    my ( $direction, $target ) = @_;
    my $result;
    &Apache::lonxml::debug("survey style display");
    my @names;
    if ( $Apache::response::foilgroup{'names'} ) {
        @names = @{ $Apache::response::foilgroup{'names'} };
    }

    my $temp = 0;
    my $i    = 0;
    my $id   = $Apache::inputtags::response['-1'];
    my $part = $Apache::inputtags::part;
    my ( $lastresponse, $newvariation, $showanswer );
    if (
        (
            (
                $Apache::lonhomework::history{"resource.$part.type"} eq
                'randomizetry'
            )
            || ( $Apache::lonhomework::type eq 'randomizetry' )
        )
        && ( $Apache::inputtags::status[-1] eq 'CAN_ANSWER' )
      )
    {
        if ( $env{ 'form.' . $part . '.rndseed' } ne
            $Apache::lonhomework::history{"resource.$part.rndseed"} )
        {
            $newvariation = 1;
        }
    }
    $showanswer = &Apache::response::show_answer();
    unless (
        (
            (
                $Apache::lonhomework::history{"resource.$part.type"} eq
                'anonsurvey'
            )
            || ( $Apache::lonhomework::history{"resource.$part.type"} eq
                'anonsurveycred' )
        )
        && ( defined( $env{'form.grade_symb'} ) )
        || ( $newvariation && !$showanswer )
      )
    {
        $lastresponse =
          $Apache::lonhomework::history{"resource.$part.$id.submission"};
    }
    if ( $direction eq 'horizontal' ) { $result .= '<table><tr>'; }
    my %lastresponse = &Apache::lonnet::str2hash($lastresponse);
    if ($showanswer) {
        foreach my $name (@names) {
            if ( $Apache::response::foilgroup{ $name . '.value' } ne 'unused' )
            {
                if ( ( $direction eq 'horizontal' ) && ( $target ne 'tex' ) ) {
                    $result .= "<td>";
                }
                else {
                    if ( $target eq 'tex' ) {
                        $result .= '\item \vskip -2mm ';
                    }
                    else {
                        $result .= "<br />";
                    }
                }
                if ( defined( $lastresponse{$name} ) ) {
                    if ( $target eq 'tex' ) {
                        $result .= '}';
                    }
                    else {
                        $result .= '<b>';
                    }
                }
                $result .= $Apache::response::foilgroup{ $name . '.text' };
                if ( defined( $lastresponse{$name} ) && ( $target ne 'tex' ) ) {
                    $result .= '</b>';
                }
                if ( ( $direction eq 'horizontal' ) && ( $target ne 'tex' ) ) {
                    $result .= "</td>";
                }
            }
        }
    }
    else {
        foreach my $name (@names) {
            if ( $Apache::response::foilgroup{ $name . '.value' } ne 'unused' )
            {
                if ( $direction eq 'horizontal' ) {
                    $result .= "<td>";
                }
                else {
                    if ( $target eq 'tex' ) {
                        if (   $env{'form.pdfFormFields'} eq 'yes'
                            && $Apache::inputtags::status[-1] eq 'CAN_ANSWER' )
                        {
                            my $fieldname =
                                $env{'request.symb'} 
                              . '&part_'
                              . $Apache::inputtags::part
                              . '&radiobuttonresponse'
                              . '&HWVAL_'
                              . $Apache::inputtags::response['-1'];
                            $result .= '\item[{'
                              . &Apache::lonxml::print_pdf_radiobutton(
                                $fieldname, $temp )
                              . '}]'
                              . $Apache::response::foilgroup{ $name . '.text' }
                              . "\n";
                        }
                        else {
                            $result .= '\item \vskip -2mm ';
                        }
                    }
                    else {
                        $result .= "<br />";
                    }
                }
                if ( $target eq 'tex' ) {
                    if (   $env{'form.pdfFormFields'} ne 'yes'
                        or $Apache::inputtags::status[-1] ne 'CAN_ANSWER' )
                    {
                        $result .=
                            '$\bigcirc$'
                          . $Apache::response::foilgroup{ $name . '.text' }
                          . '\\\\';    #' stupid emacs
                    }
                    $i++;
                }
                else {
                    $result .= '<label>';
                    $result .= "<input
                       onchange=\"javascript:setSubmittedPart('$part');\"
                       type=\"radio\"
                       name=\"HWVAL_$Apache::inputtags::response['-1']\"
                       value=\"$temp\"";

                    if ( defined( $lastresponse{$name} ) ) {
                        $result .= ' checked="checked"';
                    }
                    $result .= ' />'
                      . $Apache::response::foilgroup{ $name . '.text' }
                      . '</label>';
                }
                $temp++;
                if ( $target ne 'tex' ) {
                    if (   ( $direction eq 'horizontal' )
                        && ( $target ne 'tex' ) )
                    {
                        $result .= "</td>";
                    }
                }
                else {
                    $result .= '\vskip 0 mm ';
                }
            }
        }
    }

    if ( ( $direction eq 'horizontal' ) && ( $target ne 'tex' ) ) {
        $result .= '</tr></table>';
    }
    return $result;
}

sub whichfoils {
    my ( $max, $randomize ) = @_;

    my @truelist;
    my @falselist;
    my @whichfalse = ();
    my ( $truecnt, $falsecnt ) = &getfoilcounts();
    my $count = 0;

    # we will add in 1 of the true statements
    if ( $max > 0 && ( $falsecnt + 1 ) > $max ) { $count = $max }
    else { $count = $falsecnt + 1; $max = $count; }
    my $answer = int( &Math::Random::random_uniform() * ($count) );
    &Apache::lonxml::debug("Count is $count, $answer is $answer");
    my @names;
    if ( $Apache::response::foilgroup{'names'} ) {
        @names = @{ $Apache::response::foilgroup{'names'} };
    }
    if ( &Apache::response::showallfoils() ) {
        @whichfalse = @names;
    }
    elsif ( $randomize eq 'no' ) {
        &Apache::lonxml::debug("No randomization");
        my $havetrue = 0;
        foreach my $name (@names) {
            if ( $Apache::response::foilgroup{ $name . '.value' } eq 'true' ) {
                if ( !$havetrue ) {
                    push( @whichfalse, $name );
                    $havetrue++;
                    $answer = $#whichfalse;
                }
            }
            elsif (
                $Apache::response::foilgroup{ $name . '.value' } eq 'false' )
            {
                push( @whichfalse, $name );
            }
            elsif (
                $Apache::response::foilgroup{ $name . '.value' } eq 'unused' )
            {
            }
            else {
                &Apache::lonxml::error(
                    &HTML::Entities::encode(
"No valid value assigned ($Apache::response::foilgroup{$name.'.value'}) for foil $name in <foilgroup>",
                        '<>&"'
                    )
                );
            }
        }
        if (   ( !$havetrue )
            && ( $Apache::lonhomework::type ne 'survey' )
            && ( $Apache::lonhomework::type ne 'surveycred' )
            && ( $Apache::lonhomework::type ne 'anonsurvey' )
            && ( $Apache::lonhomework::type ne 'anonsurveycred' ) )
        {
            &Apache::lonxml::error(
                &mt('There are no true statements available.') . '<br />' );
        }
    }
    else {
        my $current = 0;
        &Apache::lonhomework::showhash(%Apache::response::foilgroup);
        my ( %top, %bottom );

        #first find out where everyone wants to be
        foreach my $name (@names) {
            $current++;
            if ( $Apache::response::foilgroup{ $name . '.value' } eq 'true' ) {
                push( @truelist, $name );
                if ( $Apache::response::foilgroup{ $name . '.location' } eq
                    'top' )
                {
                    $top{$name} = $current;
                }
                elsif ( $Apache::response::foilgroup{ $name . '.location' } eq
                    'bottom' )
                {
                    $bottom{$name} = $current;
                }
            }
            elsif (
                $Apache::response::foilgroup{ $name . '.value' } eq 'false' )
            {
                push( @falselist, $name );
                if ( $Apache::response::foilgroup{ $name . '.location' } eq
                    'top' )
                {
                    $top{$name} = $current;
                }
                elsif ( $Apache::response::foilgroup{ $name . '.location' } eq
                    'bottom' )
                {
                    $bottom{$name} = $current;
                }
            }
            elsif (
                $Apache::response::foilgroup{ $name . '.value' } eq 'unused' )
            {
            }
            else {
                &Apache::lonxml::error(
                    &HTML::Entities::encode(
"No valid value assigned ($Apache::response::foilgroup{$name.'.value'}) for foil $name in <foilgroup>",
                        '<>&"'
                    )
                );
            }
        }

        #pick a true statement
        my $notrue = 0;
        if ( scalar(@truelist) == 0 ) { $notrue = 1; }
        my $whichtrue =
          int( &Math::Random::random_uniform() * ( $#truelist + 1 ) );
        &Apache::lonxml::debug(
            "Max is $max, From $#truelist elms, picking $whichtrue");
        my ( @toplist, @bottomlist );
        my $topcount    = 0;
        my $bottomcount = 0;

        # assign everyone to either toplist/bottomlist or whichfalse
        # which false is randomized, toplist bottomlist are in order
        while (( ( $#whichfalse + $topcount + $bottomcount ) < $max - 2 )
            && ( $#falselist > -1 ) )
        {
            &Apache::lonxml::debug("Have $#whichfalse max is $max");
            my $afalse =
              int( &Math::Random::random_uniform() * ( $#falselist + 1 ) );
            &Apache::lonxml::debug("From $#falselist elms, picking $afalse");
            $afalse = splice( @falselist, $afalse, 1 );
            &Apache::lonxml::debug("Picked $afalse");
            &Apache::lonhomework::showhash( ( 'names' => \@names ) );
            &Apache::lonhomework::showhash(%top);
            if ( $top{$afalse} ) {
                $toplist[ $top{$afalse} ] = $afalse;
                $topcount++;
            }
            elsif ( $bottom{$afalse} ) {
                $bottomlist[ $bottom{$afalse} ] = $afalse;
                $bottomcount++;
            }
            else {
                push( @whichfalse, $afalse );
            }
        }
        &Apache::lonxml::debug("Answer wants $answer");
        my $truename = $truelist[$whichtrue];
        my $dosplice = 1;
        if (   ($notrue)
            && ( $Apache::lonhomework::type ne 'survey' )
            && ( $Apache::lonhomework::type ne 'surveycred' )
            && ( $Apache::lonhomework::type ne 'anonsurvey' )
            && ( $Apache::lonhomework::type ne 'anonsurveycred' ) )
        {
            $dosplice = 0;
            &Apache::lonxml::error(
                &mt('There are no true statements available.') . '<br />' );
        }

        #insert the true statement, keeping track of where it wants to be
        if (   $Apache::response::foilgroup{ $truename . '.location' } eq 'top'
            && $dosplice )
        {
            $toplist[ $top{$truename} ] = $truename;
            $answer = -1;
            foreach my $top ( reverse(@toplist) ) {
                if ($top) { $answer++; }
                if ( $top eq $truename ) { last; }
            }
            $dosplice = 0;
        }
        elsif (
            $Apache::response::foilgroup{ $truename . '.location' } eq 'bottom'
            && $dosplice )
        {
            $bottomlist[ $bottom{$truename} ] = $truename;
            $answer = -1;
            foreach my $bot (@bottomlist) {
                if ($bot) { $answer++; }
                if ( $bot eq $truename ) { last; }
            }
            $answer += $topcount + $#whichfalse + 1;
            $dosplice = 0;
        }
        else {
            if ( $topcount > 0 || $bottomcount > 0 ) {
                my $inc = 1;
                if (   ( $bottomcount > 0 )
                    && ( $Apache::lonhomework::type ne 'exam' ) )
                {
                    $inc = 2;
                }
                $answer = int(
                    &Math::Random::random_uniform() * ( $#whichfalse + $inc ) )
                  + $topcount;
            }
        }
        &Apache::lonxml::debug("Answer now wants $answer");

        #add the top items to the top, bottom items to the bottom
        for ( my $i = 0 ; $i <= $#toplist ; $i++ ) {
            if ( $toplist[$i] ) { unshift( @whichfalse, $toplist[$i] ) }
        }
        for ( my $i = 0 ; $i <= $#bottomlist ; $i++ ) {
            if ( $bottomlist[$i] ) { push( @whichfalse, $bottomlist[$i] ) }
        }

        #if the true statement is randomized insert it into the list
        if ($dosplice) {
            splice( @whichfalse, $answer, 0, $truelist[$whichtrue] );
        }
    }
    &Apache::lonxml::debug("Answer is $answer");
    return ( $answer, @whichfalse );
}
##
# Generate the HTML for a single html foil.
# @param $part           - The part for which the response is being generated.
# @param $fieldname      - The basename of the radiobutton field
# @param $name           - The foilname.
# @param $last_responses - Reference to a hash that holds the most recent
#                          responses.
# @param $value          - radiobutton value.
# 
# @return text
# @retval The generated html.
#
sub html_radiobutton {
    my ($part, $fieldname, $name, $last_responses, $value) = @_;

    my $result='<label>';
    
    $result .= '<input type="radio"
                onchange="javascript:setSubmittedPart(' . "'$part');\""
		. 'name="HWVAL_' . $fieldname . '"'
		. "value='$value'";

    if (defined($last_responses->{$name})) {
	$result .= '  checked="checked" ';
    }
    $result .= ' />';
    $result .= $Apache::response::foilgroup{$name . '.text'};
    $result .= '</label>';

    return $result;

}
##
# Return a reference to the last response hash. This hash has exactly
# one or zero entries.  The one entry is keyed by the foil 'name' of
# the prior response
#
# @param $part - Number of the problem part.
# 
# @return reference to a hash.
# @retval see above.
#
sub get_last_response {
    my ($part) = @_;

    my $id = $Apache::inputtags::response['-1'];
    my ( $lastresponse, $newvariation );
    
    if ((( $Apache::lonhomework::history{"resource.$part.type"} eq  'randomizetry')
	 || ( $Apache::lonhomework::type eq 'randomizetry' )
	)
	&& ( $Apache::inputtags::status[-1] eq 'CAN_ANSWER' )
	)
    {
	
	if ( $env{ 'form.' . $part . '.rndseed' } ne
	     $Apache::lonhomework::history{"resource.$part.rndseed"} )
	{
	    $newvariation = 1;
	}
    }
    unless ($newvariation) {
	$lastresponse =
	    $Apache::lonhomework::history{"resource.$part.$id.submission"};
    }
    my %lastresponse = &Apache::lonnet::str2hash($lastresponse);

    return \%lastresponse;
}

##
# Display foils in html rendition.:
#
# @param $whichfoils - Set of foils to display.
# @param $target     - Rendition target...there are several html targets.
# @param $direction  - 'horizontal' if layout is horizontal.
# @param $part       - Part of the problem that's being displayed.
# @param $solved     - Solution state of the problem.
# @param $show_answer- True if answers should be shown.
#
# @return string
# @retval generated html.
#
sub display_foils_html {
    my ($whichfoils, $target, $direction, $part, $solved, $show_answer) = @_;
    my $result;

    # if the answers get shown, we need to label each item as correct or
    # incorrect.

    if ($show_answer) {
	my $item_pretext     = '<br />'; # html prior to each item
	my $item_posttext    = '';	 # html after each item.
	my $finalclose       = '';	 # html to close off the whole shebang


	# Horizontal layout is a table with each foil in a cell

	if ($direction eq 'horizontal') {
	    $result        = '<table><tr>';
	    $item_pretext  = '<td>' . $item_pretext;
	    $item_posttext = '</td>';
	    $finalclose    = '</tr></table>';
	} 

	foreach my $name (@{$whichfoils}) {

	    # If the item gets further surrounded by tags, this 
	    # holds the closures for those tages.

	    my $item_closetag = '';

	    $result .= $item_pretext;

	    # Label each foil as correct or incorrect:

	    if ($Apache::response::foilgroup{$name . '.value'} eq 'true') {
		$result .= &mt('Correct:') . '<b>';
		$item_closetag .= '</b>';
		
	    } else {
		$result .= &mt('Incorrect');
	    }

	    # Web rendition encloses the 
	    # item text in a label tag as well:

	    if ($target eq 'web') {
		$result .= '<label>';
		$item_closetag = '</label>' . $item_closetag;
	    }
	    $result .= $Apache::response::foilgroup{$name . '.text'};
	    $result .= $item_closetag;
	    $result .= $item_posttext;
	    $result .= "\n";	# make the html a bit more readable.
	}

	$result .= $finalclose;

    } else {
	$result .= '<br />';	# end line prior to foilgroup:

	#  Not showing the answers, we need to generate the HTML appropriate
	#  to allowing the student to respond.
	
	my $item_pretext;
	my $item_posttext;
	my $lastresponse = &get_last_response($part);

	if ( $direction eq 'horizontal' ) {
	    $item_pretext  = '<td>';
	    $item_posttext = '</td>';
	}
	else {
	    $item_pretext = '<br/>';
	}
	my $item_no = 0;
	foreach my $name (@{$whichfoils}) {
	    $result .= $item_pretext;
	    $result .= &html_radiobutton(
		$part, $Apache::inputtags::response[-1],
		$name, $lastresponse, $item_no
		);
	    $result .= $item_posttext;
	    $item_no++;
	}

	if ($direction eq 'horizontal' ) {
            $result .= "</tr></table>";
        } else {
	     $result .= "<br />"; 
	}	
    }

    return $result;
}
##
#  Display foils in exam mode for latex
#
# @param $whichfoils - Reference to an array that contains the foil names to display
# @param $bubbles_per_line - Number of bubbles on a line.
#
# @return string
# @return the latex rendering of the exam problem.
#
# @note The direction is not honored for exams.   The lines reflect the number of
#       bubbles on an exam sheet.
#
sub display_latex_exam {
    my ($whichfoils, $bubbles_per_line) = @_;
    my $result;
    my $numlines;
    my $bubble_number = 0;
    my $line          = 0;
    my $i             = 0;

    # This section puts out the prefix that tells the user
    # (if necessary) to only choose one bubble in the next n lines
    # for problems with more than one line worth of bubbles in the grid sheet:

    my $numitems = scalar( @{$whichfoils} );
    $numlines = int( $numitems / $bubbles_per_line );
    if ( ( $numitems % $bubbles_per_line ) != 0 ) {
	$numlines++;
    }
    if ( $numlines < 1 ) {
	$numlines = 1;
    }
    if ( $numlines > 1 ) {
	my $linetext;
	for ( my $i = 0 ; $i < $numlines ; $i++ ) {
	    $linetext .= $Apache::lonxml::counter + $i . ', ';
	}
	$linetext =~ s/,\s$//;
	$result .=
	    '\item[\small {\textbf{'
	    . $linetext . '}}]'
	    . ' {\footnotesize '
	    . &mt( '(Bubble once in [_1] lines)', $numlines )
	    . '} \hspace*{\fill} \\\\';
    }
    else {
	$result .= '\item[\textbf{' . $Apache::lonxml::counter . '}.]';
    }

    # Now output the bubbles themselves:

    foreach my $name (@{$whichfoils}) {
	if ( $bubble_number >= $bubbles_per_line ) {
	    $line++;
	    $i             = 0;
	    $bubble_number = 0;
	}
	my $identifier;
	if ( $numlines > 1 ) {
	    $identifier = $Apache::lonxml::counter + $line;
	}
	$result .=
	    '{\small \textbf{'
	    . $identifier
	    . $alphabet[$i]
	    . '}}$\bigcirc$'
	    . $Apache::response::foilgroup{ $name . '.text' }
	. '\\\\';    #' stupid emacs -- it thinks it needs that apostrophe to close the quote

	$i++;
	$bubble_number++;
    }
    
    return $result;

}

##
#  Display latex when exam mode is not on.
#
#  @param $whichfoils - The foils to display
#  @param $direction  - Display direction ('horizontal' is what matters to us).
#  @param $vbegin     - Begin the vertical environment being used.
#  @param  $vend      - End the vertical environment being used.
#
#  @return string
#  @retval - The LaTeX rendering of the resource.'
#
sub display_latex {
    my ($whichfoils, $direction, $vbegin, $vend) = @_;
    my $result;

    $result .= $vbegin;
    foreach my $name (@{$whichfoils}) {
	$result .=  '\vspace*{-2 mm}\item '
	    . $Apache::response::foilgroup{ $name . '.text' };
    }

    $result .= $vend;
	
    return $result;
}


##

sub displayfoils {
    my ( $target, $answer, $whichfoils, $direction, $bubbles_per_line ) = @_;
    my $result;

    my $part   = $Apache::inputtags::part;
    my $solved = $Apache::lonhomework::history{"resource.$part.solved"};

    # Show answers html.

    if ( ( $target ne 'tex' )
        && &Apache::response::show_answer() )
    {

	$result = &display_foils_html(
	    $whichfoils, $target, $direction, $part, $solved, 1);
	
	# other html
    }  elsif ($target ne 'tex') {
	    $result = &display_foils_html($whichfoils, $target, $direction, $part,
					  0, 0);

       # LaTeX rendering:
    } else {

        my $i             = 0;
        my $bubble_number = 0;
        my $line          = 0;
        my $temp          = 0;
        my $id            = $Apache::inputtags::response['-1'];
        my $part          = $Apache::inputtags::part;

	
	
	my $numlines;
	
	# Decide how to bracket the list of foils:

	my $begin_environment;
	my $end_environment;

        if (   $env{'form.pdfFormFields'} eq 'yes'
            && $Apache::inputtags::status[-1] eq 'CAN_ANSWER' )
        {
            $begin_environment = '\begin{itemize}';
	    $end_environment   = '\end{itemize}';
        }
        else {
            $begin_environment = '\begin{enumerate}';
	    $end_environment   = '\end{enumerate}';
        }	
	
	# Rendering for latex exams.
	
	if ( ( $Apache::lonhomework::type eq 'exam' ) )
	{
	    $result .= $begin_environment;
	    $result .= &display_latex_exam($whichfoils, $bubbles_per_line);
	    $result .= $end_environment;
	    $result .= '\vskip 0mm ';
	    
	} else {	    

	    # Different rendering for PDF form than for a
	    # 'regular' answer direction is honored in both of those
	    #

	    if ( ($env{'form.pdfFormFields'} eq 'yes')
		    && ($Apache::inputtags::status[-1] eq 'CAN_ANSWER'))
	    {
		$result .= $begin_environment;
		foreach my $name ( @{$whichfoils} ) {
		    
		    my $fieldname =
			$env{'request.symb'} 
		        . '&part_'
			. $Apache::inputtags::part
			. '&radiobuttonresponse'
			. '&HWVAL_'
			. $Apache::inputtags::response['-1'];
		    $result .= '\item[{'
			. &Apache::lonxml::print_pdf_radiobutton( $fieldname,
								  $temp )
			. '}]'
			. $Apache::response::foilgroup{ $name . '.text' }
		    . "\n";
		    
		    $temp++;
		}
		$result .= $end_environment;
	    } else {
		$result .= &display_latex(
		     $whichfoils,  $direction, $begin_environment, $end_environment
		    );
	    }
	    $result .= '\vskip 0 mm '; 
       
	}


    }
    return $result;
}

sub displayallanswers {
    my @names;
    if ( $Apache::response::foilgroup{'names'} ) {
        @names = @{ $Apache::response::foilgroup{'names'} };
    }
    my $result = &Apache::response::answer_header('radiobuttonresponse');
    foreach my $name (@names) {
        $result .=
          &Apache::response::answer_part( 'radiobuttonresponse',
            $Apache::response::foilgroup{ $name . '.value' } );
    }
    $result .= &Apache::response::answer_footer('radiobuttonresponse');
    return $result;
}

sub displayanswers {
    my ( $answer, $whichopt, $bubbles_per_line ) = @_;
    my $result;

    if ( $Apache::lonhomework::type eq 'exam' ) {
        my $line    = int( $answer / $bubbles_per_line );
        my $correct = ( 'A' .. 'Z' )[ $answer % $bubbles_per_line ];
        $result .=
          &Apache::response::answer_header( 'radiobuttonresponse', $line );
        $result .=
          &Apache::response::answer_part( 'radiobuttonresponse', $correct );
    }
    else {
        $result .= &Apache::response::answer_header('radiobuttonresponse');
    }
    foreach my $name ( @{$whichopt} ) {
        $result .=
          &Apache::response::answer_part( 'radiobuttonresponse',
            $Apache::response::foilgroup{ $name . '.value' } );
    }
    $result .= &Apache::response::answer_footer('radiobuttonresponse');
    return $result;
}

sub start_conceptgroup {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;
    $Apache::radiobuttonresponse::conceptgroup = 1;
    %Apache::response::conceptgroup            = ();
    my $result;
    if ( $target eq 'edit' ) {
        $result .= &Apache::edit::tag_start( $target, $token );
        $result .=
            &Apache::edit::text_arg( 'Concept:', 'concept', $token, '50' )
          . &Apache::edit::end_row()
          . &Apache::edit::start_spanning_row();
    }
    elsif ( $target eq 'modified' ) {
        my $constructtag =
          &Apache::edit::get_new_args( $token, $parstack, $safeeval,
            'concept' );
        if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
    }
    return $result;
}

sub end_conceptgroup {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;
    $Apache::radiobuttonresponse::conceptgroup = 0;
    my $result;
    if (   $target eq 'web'
        || $target eq 'grade'
        || $target eq 'answer'
        || $target eq 'tex'
        || $target eq 'analyze' )
    {
        &Apache::response::pick_foil_for_concept( $target,
            [ 'value', 'text', 'location' ],
            \%Apache::hint::radiobutton, $parstack, $safeeval );
    }
    elsif ( $target eq 'edit' ) {
        $result = &Apache::edit::end_table();
    }
    return $result;
}

sub insert_conceptgroup {
    my $result =
        "\n\t\t<conceptgroup concept=\"\">"
      . &insert_foil()
      . "\n\t\t</conceptgroup>\n";
    return $result;
}

sub start_foil {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;
    my $result = '';
    if ( $target eq 'web' || $target eq 'tex' || $target eq 'analyze' ) {
        &Apache::lonxml::startredirection;
        if ( $target eq 'analyze' ) {
            &Apache::response::check_if_computed( $token, $parstack, $safeeval,
                'value' );
        }
    }
    elsif ( $target eq 'edit' ) {
        $result = &Apache::edit::tag_start( $target, $token );
        $result .= &Apache::edit::text_arg( 'Name:', 'name', $token );
        $result .= &Apache::edit::select_or_text_arg(
            'Correct Option:', 'value',
            [ 'unused', 'true', 'false' ], $token
        );
        my $randomize =
          &Apache::lonxml::get_param( 'randomize', $parstack, $safeeval, '-3' );
        if ( $randomize ne 'no' ) {
            $result .=
              &Apache::edit::select_arg( 'Location:', 'location',
                [ 'random', 'top', 'bottom' ], $token );
        }
        $result .=
          &Apache::edit::end_row() . &Apache::edit::start_spanning_row();
    }
    elsif ( $target eq 'modified' ) {
        my $constructtag =
          &Apache::edit::get_new_args( $token, $parstack, $safeeval, 'value',
            'name', 'location' );
        if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
    }
    return $result;
}

sub end_foil {
    my ( $target, $token, $tagstack, $parstack, $parser, $safeeval, $style ) =
      @_;
    my $text = '';
    if ( $target eq 'web' || $target eq 'tex' || $target eq 'analyze' ) {
        $text = &Apache::lonxml::endredirection;
    }
    if (   $target eq 'web'
        || $target eq 'grade'
        || $target eq 'answer'
        || $target eq 'tex'
        || $target eq 'analyze' )
    {
        my $value = &Apache::lonxml::get_param( 'value', $parstack, $safeeval );
        if ( $value ne 'unused' ) {
            my $name =
              &Apache::lonxml::get_param( 'name', $parstack, $safeeval );
            if ( $name eq "" ) {
                &Apache::lonxml::warning(
                    &mt(
'Foils without names exist. This can cause problems to malfunction.'
                    )
                );
                $name = $Apache::lonxml::curdepth;
            }
            if ( defined( $Apache::response::foilnames{$name} ) ) {
                &Apache::lonxml::error(
                    &mt(
'Foil name [_1] appears more than once. Foil names need to be unique.',
                        '<b><tt>' . $name . '</tt></b>'
                    )
                );
            }
            $Apache::response::foilnames{$name}++;
            my $location =
              &Apache::lonxml::get_param( 'location', $parstack, $safeeval );
            if ( $Apache::radiobuttonresponse::conceptgroup
                && !&Apache::response::showallfoils() )
            {
                push @{ $Apache::response::conceptgroup{'names'} }, $name;
                $Apache::response::conceptgroup{"$name.value"}    = $value;
                $Apache::response::conceptgroup{"$name.text"}     = $text;
                $Apache::response::conceptgroup{"$name.location"} = $location;
            }
            else {
                push @{ $Apache::response::foilgroup{'names'} }, $name;
                $Apache::response::foilgroup{"$name.value"}    = $value;
                $Apache::response::foilgroup{"$name.text"}     = $text;
                $Apache::response::foilgroup{"$name.location"} = $location;
            }
        }
    }
    return '';
}

sub insert_foil {
    return '
<foil name="" value="unused">
<startouttext />
<endouttext />
</foil>';
}

1;
__END__



=head1 NAME

Apache::radiobuttonresponse

=head1 SYNOPSIS

Handles multiple-choice style responses.

This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.

=head1 SUBROUTINES

=over

=item start_radiobuttonresponse()

=item bubble_line_count()

=item end_radiobuttonresponse()

=item start_foilgroup()

=item storesurvey()

=item grade_response()

=item end_foilgroup()

=item getfoilcounts()

=item format_prior_answer()

=item displayallfoils()

=item &whichfoils($max,$randomize)

Randomizes the list of foils.
Respects
  - each foils desire to be randomized
  - the existance of Concept groups of foils (select 1 foil from each)
  - and selects a single correct statement from all possilble true statments
  - and limits it to a toal of $max foils

WARNING: this routine uses the random number generator, it should only
be called once per target, otherwise it can cause randomness changes in
homework problems.

Arguments
  $max - maximum number of foils to select (including the true one)
         (so a max of 5 is: 1 true, 4 false)

  $randomize - whether to randomize the listing of foils, by default
               will randomize, only if randomize is 'no' will it not

Returns
  $answer - location in the array of the correct answer
  @foils  - array of foil names in to display order

=item displayfoils()

=item displayallanswers()

=item displayanswers()

=item start_conceptgroup()

=item end_conceptgroup()

=item insert_conceptgroup()

=item start_foil()

=item end_foil()

=item insert_foil()

=back

=cut
 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>