[LON-CAPA-cvs] cvs: modules /bisitz/scripts create_partialcredits_problems.pl

[bisitz]

bisitz		Fri Jul  3 11:50:17 2009 EDT

  Added files:                 
    /modules/bisitz/scripts	create_partialcredits_problems.pl 
  Log:
  Script to convert an input text file with problem text and gap text
  to a custom response problem with partial credits.
  First version, fully functional.
  
  Credits: Juliane Wenzel
  
  

Index: modules/bisitz/scripts/create_partialcredits_problems.pl
+++ modules/bisitz/scripts/create_partialcredits_problems.pl
# Create Partial Credits Problems
# $Id: create_partialcredits_problems.pl,v 1.1 2009/07/03 11:50:17 bisitz Exp $
#
# (C) Juliane Wenzel, 03.07.2009

use strict;
use warnings;


my $solution = 0;
my $solutiontext = "";
my $assignmenttext = "";
my $task = 'Fill in the gaps:';
my $size = 0;
my @solutionsarray;

### Subroutine die ###
### Daten in Datei schreibt ###

sub writedata{
        my $text=shift;
        open(DATEI,">out.problem");
        print DATEI "$text";
    close(DATEI);}


### Subroutine die ###
### .problem-Datei erzeugt ###

sub createproblem{
        my ($assignText, $solText)= @_;
        my $assignTextnew = "";
        my $solTextnew = "";
        $solTextnew = createsoluarray($assignText,$solText);
        $assignTextnew = createtextlines($assignText);
        $solText = createbold($assignText,$solText,@solutionsarray);
        writedata('<problem>
<startouttext />'.$task.'<endouttext />
<customresponse id="11">
<notsolved>
<startouttext />'.
$assignTextnew.'<endouttext />
</notsolved>
<solved>
<startouttext />'.
$solText.'<endouttext />
</solved>

    <answer type="loncapa/perl">@answer=('.$solTextnew.');
$correct=0;
for ($i=0;$i<=$#$submission;$i++) {
    $$submission[$i]=~s/\s//gs;
    if ($$submission[$i] eq $answer[$i]) { $correct++; }
}
if ($correct==$#answer+1) { return '."'EXACT_ANS'".'; }
if ($correct==0) { return '."'INCORRECT'".'; }
return('."'ASSIGNED_SCORE'".',$correct/($#answer+1));</answer>
</customresponse>
</problem>');
        
}

###Ersetzt die Unterstriche durch Textlines###
sub createtextlines{
        my ($assignText)= @_;
        $assignText =~ s/___+/\<textline readonly="no" size="$size" \/\>/g;

        return ($assignText);
}

###Erzeuge Loesungen aus dem Loesungstext###
sub createsoluarray{
        my ($assignText,$solText)=@_;
        #Zeilenumbrueche rausfiltern und mehrfach direkt hintereinander#
        #vorkommende Leerzeichen durch ein einzelndes ersetzen#
        $assignText =~ s/\n//g;
        $solText =~ s/\n//g;
        $assignText =~ s/ (\s+)/ /g;
        $solText =~ s/(\s+)/ /g;
        
        #Ersetze die Stellen aus $solText, die auch in $assignText vorkommen,#
        #durch *. Dadurch bleiben nur die Loesungsfragmente und * ueber#
        while($assignText =~ m/([^_]+)/gi){
        $solText =~ s/\Q$1\E/\*/;
    }
    #Trenne die Loesungsfragmente an den *#
        my @solutions = split(/\*/, $solText);
        shift @solutions;
        
        #Falls letztes Arrayelement leer ist diese entfernen#
        if(not($solutions[$#solutions] =~ m/.+/gi)){
                splice(@solutions,-1);
        }
        @solutionsarray=@solutions;
        $solText = "";
        $size = length($solutions[0]);
        #Erzeuge 'Array' als String und finde das laengste Loesungsfragment heraus#
        for(my $i = 0; $i <$#solutions+1; $i++){
                $solText = $solText."'".$solutions[$i]."'".','; 
                if($size<length($solutions[$i])){
                   $size = length($solutions[$i]);
                }       
        }
        #Textline size so setzen, dass sie 3 Zeichen#
        #laenger ist als das laengste Loesungswort#
        $size = $size + 3;
        $solText = substr($solText,0,length($solText)-1);
        
        return $solText;
}


###Makiere Loesungen mit 'Fett'###
sub createbold{
        my ($assignText, $solText,@solutions)=@_;
        my $count=0;
    while($assignText =~ m/([_]+)/gi){
         $assignText =~ s/\Q$1\E/\<b\>$solutions[$count]\<\/b\>/;
         $count++;
        }
        
        return $assignText;
}



### Aufgaben-Datei oeffnen und Zeilen einlesen ###
### und in Augaben- und Loesungstext trennen ###

open (DATEI_IN,"<in.txt") || die;

while (<DATEI_IN>){
my $line = $_;
        if(!$solution and not($line =~ /^#/)){
                $assignmenttext = $assignmenttext.$_;
        }
        if($solution){
                $solutiontext = $solutiontext.$_;
        }
        if($line =~ /^###/){
                $solution = 1;
        }
}

createproblem($assignmenttext,$solutiontext);

close DATEI_IN;