[LON-CAPA-cvs] cvs: modules /gerd/discussions studeval.pl
www
lon-capa-cvs@mail.lon-capa.org
Sun, 10 Apr 2005 23:01:25 -0000
www Sun Apr 10 19:01:25 2005 EDT
Added files:
/modules/gerd/discussions studeval.pl
Log:
Analyze discussions by student
Index: modules/gerd/discussions/studeval.pl
+++ modules/gerd/discussions/studeval.pl
use strict;
#
# Discussions:
# 1: emotional pos
# 2: emotional neg
# 3: surface ques
# 4: surface answ
# 5: proc ques
# 6: proc answ
# 7: concept ques
# 8: concept answ
# a: unrel
# b: solution
# c: math
# d: physics
#
my @q=();
# index into the array
my $course=0;
my $grade=1;
my $gender=2;
my %disc=();
for (my $i=1; $i<=8; $i++) {
$disc{$i.'a'}=2+$i;
$disc{$i.'b'}=10+$i;
$disc{$i.'c'}=18+$i;
$disc{$i.'d'}=26+$i;
}
my $sumall=35;
#
# Read Files
#
foreach my $class ('LBS271byperson') {
print "\nReading $class";
open(IN,'raw/'.$class.'.csv');
my $num=0;
my $numdisc=0;
while (my $line=<IN>) {
my $thisnumdisc=0;
$line=~s/\s+$//;
my @entries=split(/\,/,$line);
if ($entries[1]!~/^[mf]$/) { next; }
if ($entries[2]) {
unless ($entries[2]=~/^(\d[a-d])+$/) {
print "\nError $class: $entries[2]\n";
}
}
$num++;
my @newentry=($class,$entries[0],$entries[1]);
for (my $i=3;$i<=34;$i++) { $newentry[$i]=0; }
for (my $i=0;$i<length($entries[2]);$i+=2) {
my $qtype=substr($entries[2],$i,2);
$newentry[$disc{$qtype}]++;
$numdisc++;
$thisnumdisc++;
}
$newentry[$sumall]=$thisnumdisc;
push @q,join(',',@newentry);
}
close(IN);
print "\n$class: $num students, $numdisc discussion items\n";
}
print "\nReading done.\n";
#
# Analysis
#
my %statmean=();
my %staterr=();
my %statsum=();
my %statn=();
my %statsumsquare=();
#
# Compute means and errors
#
foreach my $error (0,1) {
foreach (@q) {
my @entries=split(/\,/,$_);
}
}
#
# Output
#
print "\n";
# ======== End analysis, subroutines
sub callsums {
my ($which,$error,@entries)=@_;
unless ($error) {
&meansum($which,@entries);
} else {
&meansumsquared($which,@entries);
}
}
sub meansum {
my ($which,@entries)=@_;
unless ($entries[$sumall]) { return; }
$statn{$which}++;
my ($routine,$cat)=split(/\&/,$which);
no strict 'refs';
my $num=&$routine(@entries);
use strict 'refs';
$statsum{$which}+=$num/$entries[$sumall];
if ($entries[$sumall]-&chat(@entries)) {
$statn{$which.'&nochat'}++;
$statsum{$which.'&nochat'}+=$num/($entries[$sumall]-&chat(@entries));
}
}
sub meansumsquared {
my ($which,@entries)=@_;
unless ($entries[$sumall]) { return; }
unless ($statn{$which}) { return; }
my ($routine,$cat)=split(/\&/,$which);
no strict 'refs';
my $num=&$routine(@entries);
use strict 'refs';
$statsumsquare{$which}+=($num/$entries[$sumall]-$statsum{$which}/$statn{$which})**2;
if ($entries[$sumall]-&chat(@entries)) {
$statsumsquare{$which.'&nochat'}+=($num/($entries[$sumall]-&chat(@entries))-$statsum{$which.'&nochat'}/$statn{$which.'&nochat'})**2;
}
}
sub reportout {
my $which=shift;
return &reportoutinner($which).','.&reportoutinner($which.'&nochat');
}
sub reportoutinner {
my $which=shift;
my $value='';
if ($statn{$which}>0) {
$value=&percent($statsum{$which}/$statn{$which});
}
my $error='';
if ($statn{$which}>1) {
$error=&percent(sqrt($statsumsquare{$which}/($statn{$which}*($statn{$which}-1))));
}
return &padded($value).','.&padded($error);
}
sub texreportout {
my $which=shift;
return &texreportoutinner($which).' ('.&texreportoutinner($which.'&nochat').')';
}
sub texreportoutinner {
my $which=shift;
my $value='';
if ($statn{$which}>0) {
$value=&texpercent($statsum{$which}/$statn{$which});
}
my $error='';
if ($statn{$which}>1) {
$error=&texpercent(sqrt($statsumsquare{$which}/($statn{$which}*($statn{$which}-1))));
}
return $value.'$\pm$'.$error;
}
sub padded {
return substr(' '.shift,-5,5);
}
sub percent {
my $val=shift;
return int($val*1000+0.5)/10;
}
sub texpercent {
my $val=shift;
return int($val*100+0.5);
}
sub allcount {
my @entries=@_;
my $sum=0;
for (my $i=3;$i<=34;$i++) {
$sum+=$entries[$i];
}
return $sum;
}
sub solution {
my @entries=@_;
return &solution_question(@entries)
+&solution_answer(@entries);
}
sub solution_question {
my @entries=@_;
return $entries[$disc{'3b'}]
+$entries[$disc{'5b'}]
+$entries[$disc{'7b'}];
}
sub solution_answer {
my @entries=@_;
return $entries[$disc{'4b'}]
+$entries[$disc{'6b'}]
+$entries[$disc{'8b'}];
}
sub procedural {
my @entries=@_;
return &procedural_question(@entries)
+&procedural_answer(@entries);
}
sub procedural_question {
my @entries=@_;
return $entries[$disc{'5b'}]
+$entries[$disc{'5c'}]
+$entries[$disc{'5d'}];
}
sub procedural_answer {
my @entries=@_;
return $entries[$disc{'6b'}]
+$entries[$disc{'6c'}]
+$entries[$disc{'6d'}];
}
sub conceptual {
my @entries=@_;
return &conceptual_question(@entries)
+&conceptual_answer(@entries);
}
sub conceptual_question {
my @entries=@_;
return $entries[$disc{'7b'}]
+$entries[$disc{'7c'}]
+$entries[$disc{'7d'}];
}
sub conceptual_answer {
my @entries=@_;
return $entries[$disc{'8b'}]
+$entries[$disc{'8c'}]
+$entries[$disc{'8d'}];
}
sub physics {
my @entries=@_;
return &physics_question(@entries)
+&physics_answer(@entries);
}
sub physics_question {
my @entries=@_;
return $entries[$disc{'3d'}]
+$entries[$disc{'5d'}]
+$entries[$disc{'7d'}];
}
sub physics_answer {
my @entries=@_;
return $entries[$disc{'4d'}]
+$entries[$disc{'6d'}]
+$entries[$disc{'8d'}];
}
sub math {
my @entries=@_;
return &math_question(@entries)
+&math_answer(@entries);
}
sub math_question {
my @entries=@_;
return $entries[$disc{'3c'}]
+$entries[$disc{'5c'}]
+$entries[$disc{'7c'}];
}
sub math_answer {
my @entries=@_;
return $entries[$disc{'4c'}]
+$entries[$disc{'6c'}]
+$entries[$disc{'8c'}];
}
sub emotion {
my @entries=@_;
return $entries[$disc{'1b'}]
+$entries[$disc{'1c'}]
+$entries[$disc{'1d'}]
-$entries[$disc{'2b'}]
-$entries[$disc{'2c'}]
-$entries[$disc{'2d'}];
}
sub chat {
my @entries=@_;
return $entries[$disc{'1a'}]
+$entries[$disc{'2a'}]
+$entries[$disc{'3a'}]
+$entries[$disc{'4a'}]
+$entries[$disc{'5a'}]
+$entries[$disc{'6a'}]
+$entries[$disc{'7a'}]
+$entries[$disc{'8a'}]
+$entries[$disc{'1b'}]
+$entries[$disc{'2b'}]
+$entries[$disc{'1c'}]
+$entries[$disc{'2c'}]
+$entries[$disc{'1d'}]
+$entries[$disc{'2d'}];
}