#!/usr/bin/perl

require "../pagelib.pl";
my(@cookies) = split /; /,$ENV{HTTP_COOKIE};
$time = time();
foreach my $cookie (@cookies) {
    if($cookie =~ /LPURE=(\d+)/) {
	$cookieid = $1;
    }
}
if(!$cookieid) {
    $cookieid = $$ . $time;
}
@newlt = localtime($time+(60*60*24*366));
$newlt[5]+=1900;
my $dayname = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")[$newlt[6]];
my $monname = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$newlt[4]];
my $cookie_expire = "$dayname, ".sprintf("%02d",$newlt[4]+1)."-$monname-$newlt[5] 23:00:00 GMT";
print "Set-Cookie: LPURE=$cookieid; path=/; expires=$cookie_expire;\n";

%ques = (
	 CLONE => { q => 'Clone Brands (Mega Bloks, Best Lock, etc)', },
	 FANCL => { q => 'Fan Clones (Brick Forge, Little Armory, etc)', },
	 MODLG => { q => 'Modifying your own Lego bricks (cutting, melting, etc official Lego elements)', },
	 MODCL => { q => 'Modifying your own Clone elements (cutting, melting, etc Lego clone elements)', },
	 FANMD => { q => 'Fan-Modified official Lego elements (etched BrickFest badges, etc)', },
	 SCULP => { q => 'Your own sculpted elements', },
	 STICK => { q => 'Using official Lego stickers', },
	 MODST => { q => 'Modifying Official Lego stickers', },
	 FANST => { q => 'Fan-created stickers (Your LUG\'s logo, for example)', },
	 OTHST => { q => 'Any stickers/decals at all (Train decals, stickers you made yourself, etc)', },
	 UNINT => { q => '"Unintentionally" official things (part of a Lego box, a Lego baggie, etc)', },
	 COLOR => { q => '"New" colors (bley, dark bley, new brown)', },
	 BIONC => { q => 'Bionicle', },
	 GALID => { q => 'Galidor', },
	 CLIKT => { q => 'Clikits', },
	 ZNAPE => { q => 'ZNAP', },
	 SCALA => { q => 'Scala', },
	 BELVL => { q => 'Belville', },
	 NNABS => { q => 'Non-ABS (but solid colored) elements (new non-ABS swords, Exo-Force hair pieces, etc)', },
	 BLEND => { q => 'Blended-color elements (multi-color BURPs, various Bionicle elements, etc)', },
	 POOPS => { q => 'Large elements buildable from smaller ones (1x2x5 bricks, 2x6x3 bricks, etc)', },
	 BASEP => { q => 'Raised Baseplates', },
	 PREFB => { q => 'Large Prefab Elements (BURPs, rope bridge, car chassis, etc)', },
	 COMMN => { q => 'Non-Lego common household stuff (string, rubber bands, Saran Wrap)', },
	 GLUED => { q => 'Glue', },
	 PAINT => { q => 'Painting your model or elements', },
	 VIRTL => { q => 'Building with virtual bricks', },
	 FLXTB => { q => 'Cutting Flex-Tubing to arbitrary sizes (not-specified-by-Lego-sizes)', },
	 DUPLO => { q => 'Duplo', },
	 PRIMO => { q => 'Primo', },
	 PITSC => { q => 'Non-Lego Pitsco products (toothpicks, straws, etc)', },
	 MODLX => { q => 'Modulex', },
	 );

header();
head();
$dataf = "/home/dave/lego/purism_data.txt";
my($DATAF);
if($params{check}) {
    if($ENV{REQUEST_METHOD} eq "POST") {
	#GRRR. Lousy people linking to their results!
	if(open($DATAF,">> $dataf")) {
	    print $DATAF "$ENV{REMOTE_ADDR}\t$cookieid\t$time\tPURITY:$params{pure_level}";
	    foreach my $q (keys %ques) {
		print $DATAF "\t$q:$params{$q}";
	    }
	    print $DATAF "\n";
	    close $DATAF;
	} else {
	    print "Error writing to data file!<br>\n";
	    exit(1);
	}
    }
}
if($params{cookieid}) { $cookieid = $params{cookieid}; } #for looking at people's ratings
elsif($params{rid}) { $cookieid = $params{rid}; } #for looking at people's ratings

if(($ENV{HTTP_COOKIE} =~ /LPURE=/ || $params{stats} || $params{check}) && !$params{update}) {
    show_data();
} else {
    pform();
}
foot();

sub show_data {
    my($data) = read_data();
    print "<table style=\"font-size: 10px; font-family: Verdana, Arial, Helvetica, sans-serif;\">\n";
    print "<tr><td>Here's how $data->{total_voters} people felt about various Lego building styles.";
    if($data->{i_voted}) {
	print "  Your responses are shown as the small arrow, while t";
    } else {
	print "  T";
    }
    print "he weighted average of people's responses is shown in the colored bar.";
    if($data->{i_voted}) {
	print "<br><br><A href=\"$ENV{SCRIPT_NAME}?update=1\">Adjust my choices</A><br>";
	print "<br><A href=\"$ENV{SCRIPT_NAME}?stats=1&rid=$cookieid\">Link to my results</A><br>";
	if($data->{my_data}{level}) {
	    if($data->{my_data}{level} < 0) {
		print "<br>You did not give yourself a rating for purity.<br>\n";
	    } else {
		print "<br>On a scale of 0-10, you rated yourself <b>$data->{my_data}{level}/10</b> in terms of purity.<br>\n";
	    }
	}
	my($avg_level) = $data->{stat_data}{totlevel} / $data->{stat_data}{levels};
	my($score,$score2,$score3,$score4) = (0,0,0,0);
	foreach my $f (sort {$data->{$b}{wavg} <=> $data->{$a}{wavg}} (keys %{$data})) {
	    next unless(exists($ques{$f}));
	    if($params{$f} =~ /^([12345])$/ || $data->{my_data}{$f} =~ /^([12345])$/) {
		my($rating) = $1;
		$score += ($data->{$f}{wavg}-$rating);
		$score2 += ($data->{$f}{avg}-$rating);
		$score3 += ($data->{$f}{wavg}-$rating)/$data->{$f}{std_dev};
		$score4 += ($data->{$f}{avg}-$rating)/$data->{$f}{std_dev};
	    }
	}
	$max = 30;
	if($score > $max) { $score = $max; } elsif($score < -1*$max) { $score = -1*$max; }
	if($score > 0)     { $rated_purity = $avg_level + ($score*(10-$avg_level)/$max); }
	elsif($score < 0)  { $rated_purity = $avg_level + ($score*($avg_level)/$max); }
	elsif($score == 0) { $rated_purity = $avg_level; }

	if($score2 > $max) { $score2 = $max; } elsif($score2 < -1*$max) { $score2 = -1*$max; }
	if($score2 > 0)     { $rated_purity2 = $avg_level + ($score2*(10-$avg_level)/$max); }
	elsif($score2 < 0)  { $rated_purity2 = $avg_level + ($score2*($avg_level)/$max); }
	elsif($score2 == 0) { $rated_purity2 = $avg_level; }

	if($score3 > $max) { $score3 = $max; } elsif($score3 < -1*$max) { $score3 = -1*$max; }
	if($score3 > 0)     { $rated_purity3 = $avg_level + ($score3*(10-$avg_level)/$max); }
	elsif($score3 < 0)  { $rated_purity3 = $avg_level + ($score3*($avg_level)/$max); }
	elsif($score3 == 0) { $rated_purity3 = $avg_level; }

	if($score4 > $max) { $score4 = $max; } elsif($score4 < -1*$max) { $score4 = -1*$max; }
	if($score4 > 0)     { $rated_purity4 = $avg_level + ($score4*(10-$avg_level)/$max); }
	elsif($score4 < 0)  { $rated_purity4 = $avg_level + ($score4*($avg_level)/$max); }
	elsif($score4 == 0) { $rated_purity4 = $avg_level; }

	#Let's pick a purity method that's closest to how you rated yourself! Sneaky!
	if($data->{my_data}{level} =~ /^\d+$/) {
	    @ratings = sort { abs($data->{my_data}{level} - $a) <=> abs($data->{my_data}{level} - $b)} ($rated_purity,$rated_purity2,$rated_purity3,$rated_purity4);
	} else {
	    $ratings[0] = ($rated_purity + $rated_purity2 + $rated_purity3 + $rated_purity4) / 4;
	}
	if($ENV{REMOTE_ADDR} eq "198.183.141.65") {
	    print "Average: $avg_level<br>\n";
	    print "Score: $score<br>\n";
	    print "Purity: $rated_purity<br>\n";
	    print "Score2: $score2<br>\n";
	    print "Purity2: $rated_purity2<br>\n";
	    print "Score3: $score3<br>\n";
	    print "Purity3: $rated_purity3<br>\n";
	    print "Score4: $score4<br>\n";
	    print "Purity4: $rated_purity4<br>\n";
	}

	print "<br>According to our data, on a purity scale from 0-10, you rate <b>".sprintf("%.2f",$ratings[0])."/10</b>.<br>\n";
	
    } else {
	print "<br><br><A href=\"$ENV{SCRIPT_NAME}?update=1\">Take the test!</A><br>\n";
    }
    print "</td>";
    print "<td>&nbsp;</td>\n";
    print "<td align=left valign=bottom>Pure</td>\n";
    print "<td align=right valign=bottom>Impure</td>\n";
    print "</tr>\n";
    foreach my $f (sort {$data->{$b}{wavg} <=> $data->{$a}{wavg}} (keys %{$data})) {
	next unless(exists($ques{$f}));
	my($red_width) = int((5-$data->{$f}{wavg})*25);
	my($blue_width) = 100 - $red_width;
	my($self_width,$self_right);
	if($params{$f} =~ /^([12345])$/ || $data->{my_data}{$f} =~ /^([12345])$/) {
	    $self_width = int((5-$1)*25);
	    $self_right = 100 - $self_width;
	}
	print "<tr><td colspan=4><hr></td></tr>\n";
	print "<tr><td>$ques{$f}{q}</td>\n";
	print "<td>$blue_width\%</td>\n";
	print "<td colspan=2>\n";
	if($params{$f} =~ /^[12345]$/ || $data->{my_data}{$f} =~ /^[12345]$/) {
	    print "<table cellspacing=0 cellpadding=0 style=\"cell-spacing: 0px; border-collapse: seperate;\"><tr>";
	    print "<td style=\"background-color: #FFFFFF; width: $self_width"."px; height: 1px;\"></td>";
	    print "<td><img src=\"/~dave/images/downarrow.gif\"></td>";
	    print "<td style=\"background-color: #FFFFFF; width: $self_right"."px; height: 1px;\"></td>";
	    print "</tr></table>\n";
	}
	print "<table cellspacing=0 cellpadding=0 style=\"cell-spacing: 0px; border-collapse: seperate;\"><tr>";
	print "<td style=\"background-color: #FF8080; width: $red_width"."px; height: 1px;\"></td>";
	print "<td><img src=\"/~dave/images/redbluedot.gif\"></td>";
	print "<td style=\"background-color: #8080FF; width: $blue_width"."px; height: 1px;\"></td>";
	print "</tr></table>\n";
	print "</td>\n";
	if($ENV{REMOTE_ADDR} eq "198.183.141.65") {
	    print "<td>".sprintf("%.2f",$data->{$f}{std_dev})."</td>\n";
	    print "<td>".sprintf("%.2f",$data->{$f}{avg})."</td>\n";
	    print "<td>".sprintf("%.2f",$data->{$f}{wavg})."</td>\n";
	}
	print "</tr>\n";
    }
    print "</table>\n";
}

sub pform {
    my($data) = read_data();
    print "<form method=POST style=\"display: inline;\">\n";
    print "<input type=\"hidden\" name=\"check\" value=\"1\">\n";
    print "<table style=\"font-size: 10px; font-family: Verdana, Arial, Helvetica, sans-serif;\">\n";
    print "<tr><td colspan=6><br><br>On a scale from 0-10, how much of a Lego purist do you consider yourself? ";
    print "<select name=\"pure_level\" style=\"font-size: 10px; font-family: Verdana, Arial, Helvetica, sans-serif;\">";
    print "<option value=\"\">-- Select --</option>\n";
    print "<option value=\"10\"".(($data->{my_data}{level} == 10) ? " selected" : "").">10 Very Pure</option>\n";
    print "<option value=\"9\"".(($data->{my_data}{level} == 9) ? " selected" : "").">9</option>\n";
    print "<option value=\"8\"".(($data->{my_data}{level} == 8) ? " selected" : "").">8</option>\n";
    print "<option value=\"7\"".(($data->{my_data}{level} == 7) ? " selected" : "").">7</option>\n";
    print "<option value=\"6\"".(($data->{my_data}{level} == 6) ? " selected" : "").">6</option>\n";
    print "<option value=\"5\"".(($data->{my_data}{level} == 5) ? " selected" : "").">5 Neither Pure nor Impure</option>\n";
    print "<option value=\"4\"".(($data->{my_data}{level} == 4) ? " selected" : "").">4</option>\n";
    print "<option value=\"3\"".(($data->{my_data}{level} == 3) ? " selected" : "").">3</option>\n";
    print "<option value=\"2\"".(($data->{my_data}{level} == 2) ? " selected" : "").">2</option>\n";
    print "<option value=\"1\"".(($data->{my_data}{level} == 1) ? " selected" : "").">1</option>\n";
    print "<option value=\"0\"".(($data->{my_data}{level} eq "0") ? " selected" : "").">0 Very Impure</option>\n";
    print "</select><br><br></td></tr>\n";
    print "<tr>\n";
    print "<th>How do you feel about:</th>\n";
    print "<th>Of course!</th>\n";
    print "<th>I'm ok with that</th>\n";
    print "<th>Iffy.</th>\n";
    print "<th>Nah, too far.</th>\n";
    print "<th>Blasphemy!</th>\n";
    print "</tr>\n";
    print "<tr>\n";
    print "<td><img src=\"/~dave/images/spacer.gif\" width=\"50\" height=\"1\"></td>\n";
    print "<td><img src=\"/~dave/images/spacer.gif\" width=\"50\" height=\"1\"></td>\n";
    print "<td><img src=\"/~dave/images/spacer.gif\" width=\"50\" height=\"1\"></td>\n";
    print "<td><img src=\"/~dave/images/spacer.gif\" width=\"50\" height=\"1\"></td>\n";
    print "<td><img src=\"/~dave/images/spacer.gif\" width=\"50\" height=\"1\"></td>\n";
    print "<td><img src=\"/~dave/images/spacer.gif\" width=\"50\" height=\"1\"></td>\n";
    print "</tr>\n";
    foreach my $q (sort {$a cmp $b} (keys %ques)) {
	print "<tr><td colspan=6><hr></td></tr>\n";
	print "<tr><td>$ques{$q}{q}</td>";
	print "<td align=center><input type=\"radio\" name=\"$q\" value=\"5\"".(($data->{my_data}{$q} == 5) ? " checked" : "")."></td>\n";
	print "<td align=center><input type=\"radio\" name=\"$q\" value=\"4\"".(($data->{my_data}{$q} == 4) ? " checked" : "")."></td>\n";
	print "<td align=center><input type=\"radio\" name=\"$q\" value=\"3\"".(($data->{my_data}{$q} == 3) ? " checked" : "")."></td>\n";
	print "<td align=center><input type=\"radio\" name=\"$q\" value=\"2\"".(($data->{my_data}{$q} == 2) ? " checked" : "")."></td>\n";
	print "<td align=center><input type=\"radio\" name=\"$q\" value=\"1\"".(($data->{my_data}{$q} == 1) ? " checked" : "")."></td>\n";
	print "</tr>\n";
    }
    print "<tr><td colspan=6><hr></td></tr>\n";
    print "<tr><td colspan=6 align=center><input type=submit value=\"Submit\"></td></tr>\n";
    
    print "<tr><td colspan=6><a href=\"$ENV{SCRIPT_NAME}?stats=1\">View the Results</a></td></tr>\n";

    print "</table>\n";
    print "</form>\n";
}

sub read_data {
    my(%fields,$DATAF);
    my($total_voters) = 0;
    if(open($DATAF,$dataf)) {
	my(%idata);
	while(<$DATAF>) {
	    chomp;
	    my($ip,$cookie,$time,$leveltxt,@ratings) = split /\t/,$_;
	    $idata{$cookie}{leveltxt} = $leveltxt;
	    $idata{$cookie}{ratings} = \@ratings;
	}
	close $DATAF;
	foreach my $cookie (keys %idata) {
	    $total_voters++;
	    my($leveltxt) = $idata{$cookie}{leveltxt};
	    my(@ratings) = @{$idata{$cookie}{ratings}};
	    my($flag,$level);
	    if($leveltxt =~ /\w+:(\d+)/) {
		$level = $1;
		$fields{stat_data}{totlevel}+=$level;
		$fields{stat_data}{levels}++;
		$flag = 0;
	    } else {
		$flag = 1;
	    }
	    if($cookie eq $cookieid) {
		$fields{my_data}{level} = ($flag) ? -1 : $level;
		$fields{i_voted} = 1;
	    }
	    foreach my $rating (@ratings) {
		next unless($rating =~ /^([A-Z]+):([12345])$/);
		my($field,$purity) = ($1,$2);

		if($cookie eq $cookieid) {
		    $fields{my_data}{$field} = $purity;
		}

		#Standard Deviation calculation
		$fields{$field}{raw}{$purity}++;

		#here's the fun part.
		#We make a weighting based on their reported purity level. Then,
		#their votes count for between 1-2 votes, depending on how pure
		#they are versus what they answered. A purist voting something as
		#pure is probably right (2 votes) whereas a purist voting something
		#as impure is more iffy (1 vote). And visa versa for impurists.
		
		my($weight);
		if($flag) {
		    #if you didn't answer how purist you were, you don't get extra votes!
		    $weight = 1;
		} else {
		    $weight = (($level-5)*$purity)/25 + (105-6*$level)/50;
		}
		$fields{$field}{wtotal} += $weight*$purity;
		$fields{$field}{wvotes} += $weight;
		$fields{$field}{total} += $purity;
		$fields{$field}{votes}++;
	    }
	}
    }
    foreach my $f (keys %fields) {
	next unless(exists($ques{$f}));
	$fields{$f}{wavg} = $fields{$f}{wtotal} / $fields{$f}{wvotes};
	$fields{$f}{avg} = $fields{$f}{total} / $fields{$f}{votes};
    }
    #Standard Deviations
    foreach my $f (keys %fields) {
	next unless(exists($ques{$f}));
	my($sum) = 0;
	foreach my $value (keys %{$fields{$f}{raw}}) {
	    $sum += $fields{$f}{raw}{$value} * ($value - $fields{$f}{avg}) * ($value - $fields{$f}{avg});
	}
	$sum /= $fields{$f}{votes};
	$fields{$f}{std_dev} = sqrt($sum);
    }
    $fields{total_voters} = $total_voters;
    return \%fields;
}