# The LearningOnline Network
# Custom Edit Course Routines for Assembly of Valid Concept Tests from
# Geoscience Concept Inventory.
#
# $Id: londocsgci.pm,v 1.17 2010/12/05 17:48:54 gci 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::londocsgci;
use strict;
use Apache::lonnet;
use Apache::loncommon;
use LONCAPA::map();
use Apache::lonindexer;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
{ #scope variables
my $path;
my $version;
my $reqnum;
my @mandcats;
my @bincats;
my @categories;
my @allprobs;
my %probcat;
my %prereqs;
my %revreqs;
my @defchosen;
my @chosen;
my @mandprobs;
my @bins;
my @optional;
my %mandatory;
my @development;
sub setdefaults {
my ($cdom) = @_;
if ($cdom eq 'gcitest') {
$path='/res/gci/gci';
$version='GCIv2-1-1';
$reqnum=15;
@allprobs=('01','02','37','2004_73','03','04','05','06','07',
'08','10',
'09',
'11','12','13','14','15','16','17',
'18','69',
'19','20',
'21','22','23','24','25','26','27','28','29','30',
'31','32','33','34','35','36','38',
'39A','39B',
'40',
'41','42','43','44','45','46','47','48','49','50',
'51',
'52','57',
'53','54','55','56','58',
'60',
'61','62','63','64','65','66','67','68','70',
'71');
@bins = ( ['03','04','06'],
['07','08','09'],
['10','12','13','14','15','16','17'],
['18','19','20','21','22','23','24','25'],
['26','27','28','30'],
['32','33','34','35','36'],
['38','39A','39B','40','41','42','43','44','45','46'],
['47','48','49','50','51','52','53'],
['54','55','56','57','58','60','61','62'],
['63','64','65'],
['66','67','68','69','70','71']);
@optional = ('05','11','29','31');
@mandcats = ('M1','M2','M3','M4');
@bincats = ('A','B','C','D','E','F','G','H','I','J','K');
@categories=(@mandcats,@bincats);
%probcat =('01' => 'M1' ,'02' => 'M2' ,'37' => 'M3' ,'2004_73' => 'M4' ,
'03' => 'A' ,'04' => 'A','05' => '' ,'06' => 'A' ,'07' => 'B' ,
'08' => 'B' ,'09' => 'B' ,'10' => 'C' ,'11' => '' ,'12' => 'C' ,
'13' => 'C' ,'14' => 'C' ,'15' => 'C' ,'16' => 'C' ,'17' => 'C' ,'18' => 'D' ,'19' => 'D' ,'20' => 'D' ,
'21' => 'D' ,'22' => 'D' ,'23' => 'D' ,'24' => 'D' ,'25' => 'D' ,'26' => 'E' ,'27' => 'E' ,'28' => 'E' ,'29' => '' ,'30' => 'E' ,
'31' => '' ,'32' => 'F' ,'33' => 'F' ,'34' => 'F' ,'35' => 'F' ,'36' => 'F' ,'38' => 'G' ,
'39A'=> 'G' ,'39B'=> 'G' ,
'40' => 'G' ,
'41' => 'G' ,'42' => 'G' ,'43' => 'G' ,'44' => 'G' ,'45' => 'G' ,'46' => 'G' ,'47' => 'H' ,'48' => 'H' ,'49' => 'H' ,'50' => 'H' ,
'51' => 'H' ,'52' => 'H' ,'53' => 'H' ,'54' => 'I' ,'55' => 'I' ,'56' => 'I' ,'57' => 'I' ,'58' => 'I' ,
'60' => 'I' ,
'61' => 'I' ,'62' => 'I' ,'63' => 'J' ,'64' => 'J' ,'65' => 'J' ,'66' => 'K' ,'67' => 'K' ,'68' => 'K' ,'69' => 'K' ,'70' => 'K' ,
'71' => 'K');
%mandatory=('01' => 1 ,'02' => 1,'37' => 1, '2004_73' => 1);
@mandprobs = ('01','02','37','2004_73');
%prereqs=('10' => '08', '57' => '52', '69' => '18');
foreach my $item (keys(%prereqs)) {
$revreqs{$prereqs{$item}} = $item;
}
@defchosen=('01','02','03','07','12','18','26','32','37','38','47','54','63','66','2004_73');
@development = ('001','002','003','004','005','006','007','008','009','010','011','012','013','014','015','016','017','018','019','020','021','022','023','024','025','026','027');
}
}
sub checkvalid {
my ($cdom) = @_;
my %covered=();
my %chosenproblems=();
my @errors=();
my $num=$#chosen+1;
if ($num<$reqnum) {
push(@errors,&mt('Test requires at least [_1] items, but has only [_2].',$reqnum,$num));
}
foreach my $item (@chosen) {
$chosenproblems{$item}=1;
$covered{$probcat{$item}}=1;
}
foreach my $cat (@categories) {
unless ($covered{$cat}) {
push(@errors,&mt('Bin [_1] not covered.',$cat));
}
}
foreach my $item (@chosen) {
if ($prereqs{$item}) {
unless ($chosenproblems{$prereqs{$item}}) {
my $url = &fullurl($item,$cdom);
my $title = &Apache::lonnet::metadata($url,'title');
my $prerequrl = &fullurl($prereqs{$item},$cdom);
my $prereqtitle = &Apache::lonnet::metadata($prerequrl,'title');
push(@errors,&mt('[_1] requires [_2].',"'$title'","'$prereqtitle'"));
}
}
}
return @errors;
}
sub fullurl {
my ($item,$cdom,$catname)=@_;
if ($cdom eq 'gcitest') {
unless ($item=~/\_/) { $item='_'.$item; }
if ($catname eq 'development') {
return $path.'/pilot/pilot'.$item.'.problem';
}
return $path.'/'.$version.'/GCI'.$item.'.problem';
}
}
sub item_from_url {
my ($url)=@_;
if ($url =~ m{\Q$path\E/\Q$version\E/GCI_?([^.]+)\.problem$}) {
return $1;
}
}
sub validcheck {
my ($r,$cdom)=@_;
my @errors=&checkvalid($cdom);
if ($#errors>-1) {
$r->print(''.&mt('Your test is not yet valid.').'
'.&mt('The following issues must be addressed before you can use the test:').'
');
foreach my $message (@errors) {
$r->print('
'.$message.'
');
}
$r->print('
');
return 0;
}
return 1;
}
sub listresources {
my ($r,$context,$cdom,$cnum)=@_;
my $numchosen = scalar(@chosen);
my $multipart = 0;
my $composites;
if ($numchosen > 0) {
foreach my $key (keys(%prereqs)) {
if (grep(/^\Q$key\E/,@chosen)) {
$multipart ++;
$numchosen --;
}
}
if ($multipart) {
$composites = &mt(' (of which [quant,_1,is a combination question,are combination questions] in which students select both an answer, and the reasoning used).',$multipart).' ';
} else {
$composites = '. ';
}
}
unless ($numchosen > 0) {
$r->print('
'.&mt('Create a Concept Test').'
'.
'
'.&mt('Choose how the test should be built:').' '.
'
');
$r->print(&mt('Select test items from the numbered bins below and then press [_1]"Store Problem Selection"[_2] at the bottom of the page.','','').' ');
if ($cdom eq 'gcitest') {
$r->print('
'.
'
'.&mt('Tests will contain a minimum of [_1] questions from the GCI 2 Inventory.',"$reqnum").'
'.
'
'.&mt('Tests must contain [_1]four[_2] mandatory questions and at least one item from each of [_1]eleven[_2] other bins.','','').'
'.
'
'.&mt('All tests conclude with [_1]two[_2] questions selected by the system (at random) from a pool of development questions being piloted by the GCI team.','','').'
'.
'
');
}
my $mandleg = &mt('Mandatory Questions');
$r->print(&display_questions(\@mandprobs,'mandatory',$mandleg,\%chosenitems,$cdom));
for (my $i=0; $i<@bins; $i++) {
my $num = $i+1;
my $legend = &mt('Bin [_1]',$num);
my $catname = 'bin'.$i;
$r->print(&display_questions($bins[$i],$catname,$legend,\%chosenitems,$cdom));
}
my $optleg = &mt('Optional Questions');
$r->print(&display_questions(\@optional,'optional',$optleg,\%chosenitems,$cdom));
my $devleg = &mt('Development Questions');
$r->print(&display_questions(\@devitems,'development',$devleg,\%chosenitems,$cdom));
$r->print(''.
''.
''.
''.
'
');
&Apache::lonnet::delenv('request.gcicontext');
}
sub display_questions {
my ($questions,$catname,$catlegend,$chosenitems,$cdom) = @_;
return unless((ref($questions) eq 'ARRAY') && (ref($chosenitems) eq 'HASH'));
my $total = 0;
foreach my $item (@{$questions}) {
if ($chosenitems->{$item}) {
$total ++;
}
}
my $fieldid = 'GCI_'.$catname.'_q';
my $titleid = 'GCI_'.$catname.'_t';
my $countid = 'GCI_'.$catname.'_count';
my $output = '