[LON-CAPA-cvs] cvs: modules /peter/PartialCredit PCC_1.pl PCC_2.pl

[riegler]

riegler		Thu Jul 30 15:58:16 2009 EDT

  Added files:                 
    /modules/peter/PartialCredit	PCC_1.pl PCC_2.pl 
  Log:
  perl scripts written by Juliane Wenzel to automatically convert "Schlageter-type" of fill in the blank problem raw texts into lc partial credit problems
  

Index: modules/peter/PartialCredit/PCC_1.pl
+++ modules/peter/PartialCredit/PCC_1.pl
use strict;
use warnings;


my $text = "";
my $task = 'Fill in the gaps:';
my $size = 0;
my $filenumber = 1;

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

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


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

sub createproblem{
	my ($Text_in)= @_;
    #Zeilenumbrueche rausfiltern und mehrfach direkt hintereinander#
	#vorkommende Leerzeichen durch ein einzelnes ersetzen#
	$Text_in =~ s/\n/ /g;
	$Text_in =~ s/ (\s+)/ /g;
	my $assignText = "";
	my $solText = "";
	my $solTextnew = "";
	$solTextnew = createsoluarray($Text_in);
	$assignText = createtextlines($Text_in);
	$solText = createbold($Text_in);
	
	

	writedata('<problem>
	
<startouttext />'.$task.'<endouttext />

<customresponse id="11">

<notsolved>
<startouttext />'."\n".
$assignText."\n".
'<endouttext />
</notsolved>

<solved>
<startouttext />'."\n".
$solText."\n".
'<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>');
	
}

###Erzeuge Textlines###
sub createtextlines{
	my ($assignText)= @_;
	
	$assignText =~ s/(\[[a-zA-Z]+\])/\<textline readonly="no" size="$size" \/\>/g;
	
	return ($assignText);
}

###Filtere Loesungen aus den umklammerten Fragementen###
sub createsoluarray{
	my ($Text) = @_;
	my $count = 0;
	my @sols;
	my $solText = "";

	
	#Ersetze die eckigen Klammern aus $Text durch *#
	$Text =~ s/\[/\*/g;
	$Text =~ s/\]/\*/g;
	   
    #Trenne die Loesungsfragmente an den *#
	my @solutions =	split(/\*/, $Text);
	
	for(my $i = 0; $i <$#solutions+1; $i++){
		if(not($i%2==0)){
		  #$i ungerade, jedes zweite Element is Loesungsteil
		  $sols[$count]=$solutions[$i];
		  $count++; 
		}
	
	}
    #Erzeuge 'Array' als String und finde das laengste Loesungsfragment heraus#
	for(my $j=0; $j <$#sols+1; $j++){
		$solText = $solText."'".$sols[$j]."'".',';
		if($size<length($sols[$j])){
		   $size = length($sols[$j]);
		   
		}	
	}
	$solText = substr($solText,0,length($solText)-1);
	#Textline size so setzen, dass sie 3 Zeichen#
    #laenger ist als das laengste Loesungswort#	
	$size = $size + 3;
	
	return $solText;
}


###Makiere Loesungen mit 'Fett'###
sub createbold{
	my ($solText)=@_;
	$solText =~s/\[/\<b\>/g;
	$solText =~s/\]/\<\/b\>/g;
 	return $solText;
}



### Aufgaben-Datei oeffnen (in.txt) und Zeilen einlesen ###
### und in Augaben- und Loesungstext trennen ###

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

while (<DATEI_IN>){
my $line = $_;
	if(not($line =~ /^#/)){
   		$text = $text.$_;
	}
	
	if($line =~ /^###/){
		createproblem($text);
	    $text="";
	    $filenumber++;
	}
}
createproblem($text);


close DATEI_IN;

Index: modules/peter/PartialCredit/PCC_2.pl
+++ modules/peter/PartialCredit/PCC_2.pl
### Skript, wenn Textluecken mit [ ] gekennzeichnet
use strict;
use warnings;


my $text = "";
my $task = 'Fill in the gaps:';
my $size = 0;
my $filenumber = 1;

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

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


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

sub createproblem
{
	my ($Text_in)= @_;
    #Zeilenumbrueche rausfiltern und mehrfach direkt hintereinander#
	#vorkommende Leerzeichen durch ein einzelnes ersetzen#
	$Text_in =~ s/\n/ /g;
	$Text_in =~ s/ \s+/ /g;
	my $assignText = "";
	my $solText = "";
	my $solTextnew = "";
	$solTextnew = createsoluarray($Text_in);
	$assignText = createtextlines($Text_in);
	$solText = createbold($Text_in);
	
	

	writedata('<problem>
	
<startouttext />'.$task.'<endouttext />

<customresponse id="11">

<notsolved>
<startouttext />'."\n".
$assignText."\n".
'<endouttext />
</notsolved>

<solved>
<startouttext />'."\n".
$solText."\n".
'<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>');
	
}

###Erzeuge Textlines und span setzen###
sub createtextlines
{
	my ($assignText)= @_;
	
	my $temp;
	my $temp2;
 	
 	#Anfang des Span durch ** makieren#
    while ($assignText =~ m/([a-zA-Z]*\[)/g)
    {
		$temp = $1;
		$temp2 = substr($temp,0,length($temp)-1);
		$assignText =~ s/\Q$temp\E/\*\*$temp2\#\#/;
	}

	$assignText =~ s/\#\#/\[/g;

	#Ende des Span durch ++ makieren#
 	while ($assignText =~ m/(\][^\s]*)/g)
 	{
		$temp = $1;
		$temp2 = $1;
		$temp2 =~ s/\]/\#\#/g;
		$assignText =~ s/\Q$temp\E/$temp2\+\+/;
    }
    
    $assignText =~ s/\#\#/\]/g;

	$assignText =~ s/\*\*/\<span style="white-space:nowrap"\>/g;
	$assignText =~ s/\+\+/\<\/span>/g;
	$assignText =~ s/\[[a-zA-Z]+\]/\<textline readonly="no" size="$size" \/\>/g;

    return $assignText;
}

###Filtere Loesungen aus den umklammerten Fragementen###
sub createsoluarray
{
	my ($Text) = @_;
	my $count = 0;
	my @sols;
	my $solText = "";

	
    #Trenne an eckigen Klammern#
    my @solutions =    split(/\[|\]/, $Text); 
    	
	for(my $i = 0; $i <$#solutions+1; $i++)
	{
		if($i%2==1)
		{
		  #$i ungerade, jedes zweite Element is Loesungsteil#
		  $sols[$count]=$solutions[$i];
		  $count++; 
		}
	
	}
    #Erzeuge 'Array' als String und finde das laengste Loesungsfragment heraus#
    foreach my $sol (@sols)
    {
          $solText.= "'$sol',";
             if($size<length($sol))
             {
             $size = length($sol);
       		 }   
    } 
	$solText = substr($solText,0,length($solText)-1);
	#Textline size so setzen, dass sie 3 Zeichen#
    #laenger ist als das laengste Loesungswort#	
	$size = $size + 3;
	
	return $solText;
}


###Makiere Loesungen mit bold###
sub createbold
{
	my ($solText)=@_;
	$solText =~s/\[/\<b\>/g;
	$solText =~s/\]/\<\/b\>/g;
 	return $solText;
}



### Aufgaben-Datei oeffnen (in.txt) und Zeilen einlesen ###
### und in Augaben- und Loesungstext trennen ###

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

while (<DATEI_IN>)
{
my $line = $_;
	if(not($line =~ /^#/))
	{
   		$text = $text.$_;
	}
	
	if($line =~ /^###/)
	{
		createproblem($text);
	    $text="";
	    $filenumber++;
	}
}
createproblem($text);


close DATEI_IN;