reid@decwrl.dec.com (Brian Reid) (01/29/88)
I've been doing a lot of PostScript hacking for years. Just to show you the
outer limits of the genre, here is an exam scoring program written in
PostScript. This is real data from a midterm exam I gave at Stanford a couple
of years ago, but I have replaced all of the names with strings chosen at
random from /usr/dict/words, to protect the privacy of the individuals.
There's no documentation because I wrote it for my own use, but hard-core PS
hackers should be able to cope. This prints at the rate of about a minute a
page on a LaserWriter, and maybe 10 seconds per page on an LPS40. If you want
to try printing just a few pages, edit the "for" loop that is 0 1 n into
something like 0 1 10 or 10 1 20.
%!
/maxn 100 def
/nq 7 def
/maxscore 110 def
/qmaxscore [25 28 12 20 5 10 10] def
/Whatcourse (CS108B: Fundamentals of Computer Science) def
/Whatexam (Midterm Examination Results WQ 86) def
/Whatprof (Professor Brian K. Reid) def
% --------------------------------------
/scores maxn array def
/names maxn dict def
/rawscores maxn dict def
/n 0 def
/gtotal 0 def
/qscores [ 0 nq {dup} repeat pop ] def
/xx {/svec exch def /name exch def
names n name put
rawscores n svec put
/total 0 def /i 0 def
svec length nq ne {name print ( bad score vector\n) print} if
svec {
dup /total exch total add def
qscores i get add qscores exch i exch put
/i i 1 add def
} forall
scores n total put
/gtotal gtotal total add def
/n n 1 add def
} def
(Abelian, Babcock) [25 21 9 0 2 0 0] xx
(Albanian, MacDonald) [25 28 12 0 0 2 0] xx
(Alsatian, Machiavelli) [0 28 12 0 0 3 5] xx
(Annapolis, Jacobean) [25 28 12 11 5 0 0] xx
(Aristotelean, Hadamard) [25 28 12 4 5 10 0] xx
(Atropos, Daedalus) [25 26 12 6 1 7 3] xx
(Ballard, Lagrange) [23 21 9 0 0 7 0] xx
(Bavaria, Laidlaw) [22 28 9 0 5 0 5] xx
(Bennett, Haitian) [25 9 12 20 5 0 10] xx
(Bessemer, Malagasy) [25 26 12 4 0 7 0] xx
(Bohemia, Maldive) [25 26 9 4 5 3 5] xx
(Brandenburg, Salesian) [25 28 12 6 4 10 10] xx
(Brookline, Salisbury) [25 28 12 4 5 0 9] xx
(Burundi, Galloway) [25 28 12 16 5 7 10] xx
(Canaveral, Maltese) [23 28 9 4 5 5 0] xx
(Carroll, Calvinist) [25 9 12 18 0 8 6] xx
(Chambers, Cameroun) [25 28 12 14 2 10 5] xx
(Chinamen, Hampton) [25 28 9 4 5 7 8] xx
(Claremont, Manchester) [25 28 0 0 0 0 1] xx
(Columbus, Sanderson) [20 28 12 20 5 10 4] xx
(Cornelia, Bangladesh) [15 21 12 18 2 0 0] xx
(Cushman, Hanover) [25 21 9 4 0 0 1] xx
(Decatur, January) [23 27 12 17 5 7 10] xx
(Domesday, Capetown) [0 21 0 11 2 0 0] xx
(Dusenbury, Caracas) [23 28 9 0 0 0 0] xx
(Ellison, Barbara) [25 26 9 18 5 7 1] xx
(Ernestine, Harding) [16 16 6 0 0 3 3] xx
(Falstaff, Marilyn) [20 19 6 11 5 7 0] xx
(Flagstaff, Darlene) [25 28 12 9 0 0 0] xx
(Fredericks, Yarmouth) [20 28 12 4 0 0 0] xx
(Gannett, Carolyn) [15 19 6 0 5 3 2] xx
(Gifford, Harriman) [25 14 6 3 5 0 0] xx
(Goodrich, Marseilles) [25 21 12 20 2 7 3] xx
(Guggenheim, Martian) [25 13 9 13 0 0 0] xx
(Harcourt, Pasadena) [25 28 9 4 2 9 5] xx
(Henderson, Masonite) [25 21 9 4 5 0 0] xx
(Hildebrand, Hastings) [23 28 6 4 2 10 10] xx
(Hopkinsian, Lateran) [15 7 0 0 5 0 5] xx
(Indianapolis, Hathaway) [25 14 0 16 5 6 0] xx
(Jacobian, Lathrop) [25 28 9 16 5 0 10] xx
(Johansen, Patrick) [25 26 12 8 2 7 2] xx
(Katowice, Caucasian) [19 26 9 0 4 5 8] xx
(Knightsbridge, Bauhaus) [22 21 12 14 5 10 0] xx
(Langley, Maurice) [25 23 6 0 5 0 8] xx
(Leonardo, Havilland) [23 28 12 20 5 5 4] xx
(Lockhart, Hawthorne) [15 28 12 0 5 9 2] xx
(Macassar, Raymond) [21 26 12 0 0 0 0] xx
(Malraux, Abelson) [25 28 9 18 5 10 4] xx
(Martinique, McCarthy) [25 28 9 18 5 0 1] xx
(McCarty, McDaniel) [0 28 9 15 0 3 5] xx
(McKinley, McGowan) [22 28 12 4 0 0 0] xx
(Merrimack, McLaughlin) [25 28 12 20 5 10 10] xx
(Minneapolis, Oceania) [24 28 12 5 1 0 2] xx
(Missouri, Melissa) [25 26 9 20 2 3 10] xx
(Monongahela, Delmarva) [21 14 12 0 5 2 4] xx
(Simonson, Schmidt) [20 17 10 11 5 9 4] xx
(Spencer, Schumacher) [22 28 9 17 2 7 5] xx
(Stockholm, Scotsman) [24 28 9 0 0 4 5] xx
(Swenson, Scythia) [25 28 9 13 5 7 0] xx
(Theresa, Edmonton) [24 28 12 7 5 7 5] xx
(Triplett, Zealand) [25 28 9 11 2 10 5] xx
(Venezuela, Beaujolais) [25 27 9 4 2 0 4] xx
(Wallace, Nebraska) [25 21 6 4 5 0 9] xx
(Whatley, Bedford) [0 28 6 14 5 3 0] xx
(Wiedmann, Selectric) [25 21 9 14 5 10 5] xx
(Windsor, Jeffrey) [25 28 9 12 5 10 10] xx
(Yonkers, Segundo) [25 28 12 3 2 0 0] xx
(Zoroaster, Tektronix) [25 28 9 10 4 10 5] xx
/n names length def
/scores scores 0 n getinterval def
% scores setcounts
/setcounts {
/stcvec exch def
/counts localmax 1 add array def
0 1 localmax {counts exch 0 put} for
stcvec
{0.5 add
dup localmax gt {pop localmax} if
cvi dup counts exch get 1 add counts 3 1 roll put}
forall
/sigma /total 0 def
stcvec
{mean sub dup mul total add /total exch def}
forall total n div sqrt def
} def
% score counts pctile
/pctile {
/pcvec exch def /psc exch 0.5 sub cvi def
/cum 0 def
0 1 psc {pcvec exch get cum add /cum exch def} for
cum 100 mul n div 0.5 add cvi
} def
% counts hx hy score mean histo
/histo {
/label exch def
/xbar exch def /flag exch def /hy exch def /hx exch def /cvec exch def
/dx hx localmax 1 add div def
/dy dx 4 gt {4}{dx} ifelse def
gsave currentpoint translate
0 1 localmax {/i exch def
i dx mul dx 2 div add 0 moveto
i 10 mod 0 eq
{0 dy -2 mul rlineto 0.5 setlinewidth stroke}
{i 5 mod 0 eq
{0 dy -1.3 mul rlineto 0.4 setlinewidth stroke}
{0 dy neg rlineto 0.2 setlinewidth stroke} ifelse}
ifelse
} for
/di 10 def
dx 2 gt {/di 5 def} if
dx 5 gt {/di 2 def} if
dx 10 gt {/di 1 def} if
/fsize dx di mul dup cvi 10 gt {pop 10} if def
/Courier findfont fsize scalefont setfont
0 0 moveto gsave
90 rotate -8 dx neg 1 sub translate
0 di localmax {
dup 0 exch 0.5 sub dx neg mul moveto
zs cvs dup stringwidth pop neg fsize -4 div rmoveto show
} for
grestore
/maxcount 1 def
cvec {dup maxcount gt {/maxcount exch def}{pop} ifelse} forall
/cdy hy maxcount div def
/dmax maxcount 10 gt {10}{1} ifelse def
0 dmax maxcount {dup cdy mul hx exch moveto
gsave dy 0 rlineto
1 setlinewidth stroke grestore
zs cvs dy 2 add dy -1.7 div rmoveto show
} for
0 1 localmax {/i exch def
/j cvec i get cdy mul def
dx i mul 0 moveto
0 j rlineto dx 0 rlineto 0 j neg rlineto closepath
gsave 0.8 setgray fill grestore 0 setlinewidth stroke
} for
0 hy moveto 0 0 lineto hx 0 lineto hx hy lineto closepath
1 setlinewidth stroke
7 hy 10 sub moveto label
7 hy 20 sub moveto (Mean: ) show
mean zs cvs show
flag 0.5 add dx mul hy moveto
/Symbol findfont 12 scalefont setfont
(\337) dup stringwidth pop -2 div 0 rmoveto show
newpath xbar 0.5 add dx mul 0 moveto 0 hy rlineto
0 setlinewidth stroke
grestore
} def
/zs 20 string def
/localscores scores length array def
0 1 n {
/id exch def
/name names id get def
/svec rawscores id get def
/score scores id get def
/localmax maxscore def
/mean gtotal n div 100 mul cvi 100 div def
scores setcounts
/Helvetica-Bold findfont 11 scalefont setfont
60 756 moveto Whatcourse show
/xmarg currentpoint pop 20 add def
/Helvetica findfont 11 scalefont setfont
60 740 moveto Whatexam show
60 729 moveto Whatprof show
/Courier findfont 18 scalefont setfont
xmarg 756 moveto
name show
/Courier findfont 10 scalefont setfont
xmarg 740 moveto
(Raw score: ) show score zs cvs show
( T score: ) show score mean sub sigma div 100 mul cvi 100 div
zs cvs show
xmarg 730 moveto
(Percentile: ) show
score counts pctile zs cvs show
72 580 moveto counts 6.5 72 mul 120 score mean
{(Overall exam) show} histo
0 1 nq 1 sub {/j exch def
/jrow j 2 div 1 add cvi def
/localmax qmaxscore j get def
0 1 n 1 sub {/i exch def
localscores i
rawscores i get
j get
put
} for
/mean qscores j get n div 100 mul cvi 100 div def
localscores setcounts
/score svec j get def
/dpx 3.5 72 mul def
/dpy 510 nq 2 div 1 add cvi div def
72 j 2 mod cvi dpx mul add 530 jrow dpy 1 sub mul sub 30 add moveto
counts 3 72 mul dpy 40 sub score mean
/jquesno j 1 add def
{(Question ) show jquesno zs cvs show} histo
} for
showpage
} for