/*                                                      */   
    /*               How wrong is wrong?                    */   
    /*                                                      */   
    /*      By John Collett              September, 1994    */   
    /*                                                      */   
    
    signal on syntax ; signal on error
    if arg() ~= 0 then signal Finish
    lf = '0a'x ; ff = '0c'x ; eol = '9b'x || '1K'
    c0 = '' ; c1 = '' ; c2 = '' ; c3 = ''
    b0 = '' ; b1 = '' ; b2 = '' ; b3 = ''
    p = copies(' ',23) || 'Press Return  '
    op = open(co,'con:20/12/600/200/How Wrong is Wrong?')
    
    do forever
     st = copies('*',48) ; st2 = '*' || copies(' ',46) || '*'
     call wr(2,10,c3 st) ; call wr(3,10,c3 st2)
     call wr(3,14,c2 'An attempt at grading student text input')
     call wr(4,10,c3 st)
     call wr(6,16,c1 || '1   Demo of a graded set')
     call wr(8,16,'2   Three trials')
     call wr(10,16,'3   Free range')
     call wr(12,16,'4   Quit' lf lf)
     w = writech(co,copies(' ',14) c2 'Enter the number of your choice ' c1)
     s = readch(co) ; call wr(1,1,ff)
     select
      when s = 1 then call Graded()
      when s = 2 then call ThreeTrials()
      when s = 3 then call YourOwn()
      when s = 4 then signal 'Finish'
      otherwise
      end
    end
    
    Finish:    
    cl = close(co)
    exit
     syntax:
     error: say 'Error 'errortext(rc) rc '. Line 'sigl ; signal 'Finish'
   
    wr: procedure
     parse arg row, col, text ; outstring = row || ';' || col || H || text
     w = writeln(co,'9b'x || outstring)
     return
    
    store:
    b.1 = 'The quick brown fox jumped over the lazy dog.'
    b.2 = 'The quick brown fox jumped over the lasy dog.'
    b.3 = 'The quick brawn fox jumps over the laizy dog.'
    b.4 = 'The quick brown fox jumped over the dog.'
    b.5 = 'A quick brown fox jumped over a sleepy dog.'
    b.6 = 'The quick brown fox jumped through a wooden hoop.'
    b.7 = 'The quick brown fox jumps through a wooden hoop.'
    b.8 = 'The brave little fox jumped over a wooden hoop.'
    b.9 = 'A qwick braun focks jumpt ovah that log.'
    b.10 = 'The quaint brown bear jumped through a wooden hoop.'
    b.11 = 'A black and white cat leaped over my fence.'
    return
    
    low: procedure                  /* Remove punctuation and capitals */
      a = compress(arg(1),",.!?,;:'")
      a = translate(a,xrange('a','z'),xrange('A','Z'))
     return a

    Next:
     call wr(arg(1),13,'') ; w = writech(co,c2 p)
     r = readch(co) ; if arg(1) = 17 then r = readch(co)
     call wr(1,1,ff)
     return
 
    Assess:
     origb = b ; b = low(b)
     call Partners()
     call UnMatched()
     call Misplaced()
     call Unused()
     call ExtraOutput()
     call CheckLetters()
     call CheckUnused()
     if score < 0 then score = 0
     score = trunc(score / words(a),1)
    return
    
    Partners:                           /* Partner word found in input */
    str = '' ; wordcount = words(a)
    smatch. = 0 ; imatch. = 0 
    do i = 1 to wordcount
     smatch.i = (word(a,i) = word(b,i)) ; imatch.i = smatch.i
     if smatch.i then str = str '' word(a,i)
     score = score + 10*smatch.i
     end
    return

    Unmatched:                      /* Which source words are unmatched? */
    source. = '' ; input. = '' ; ns = 0 ; ni = 0
    do i = 1 to words(a)
     if ~smatch.i then do ; ns = ns + 1 ; source.ns = word(a,i) ; end
     end
    do i = 1 to words(b)
     if ~smatch.i then do ; ni = ni + 1 ; input.ni = word(b,i) ; end
     end
    return
 
   Misplaced:                 /* Which words are in a different place? */
    n1 = max(ns,ni) ; n2 = min(ns,ni) ; str = ''
    do i = 1 to ns
     do j = 1 to ni
      match = ((source.i) = (input.j))
      if match then do 
       f1 = find(a,source.i) ; smatch.f1 = 1 
       f2 = find(b,input.j) ; imatch.f2 = 1
       str = str '' word(a,f1) ; score = score + 10 - abs(f1-f2)
       end
      end
     end
    odds. = 0 ; oddi. = 0 ; ns = 0 ; ni = 0
    return
    
    Unused:                                   /* Unused source words */
    str = ''
    do i = 1 to words(a) 
     if ~smatch.i then do 
      ns = ns + 1 ; odds.ns = i ; str = str '' word(a,i) '' i 
      end
     end
    return
     
    ExtraOutput:                             /* Unexpected output words */
     str = ''    
     do i = 1 to words(b) 
      if ~imatch.i then do
       ni = ni + 1 ; oddi.ni = i ; str = str '' word(b,i) '' i ;
       end
      end
     m = max(ns,ni)
     return

    CheckLetters:                 /* How wrong are non-matching words? */
     str = ''         
     do i = 1 to words(a) 
      if smatch.i = 0 & imatch.i = 0 then do
        smatch.i = 1 ; imatch.i = 1 ; wa = word(a,i) ; wb = word(b,i)
        m = max(length(wa),length(wb)) ; t = 0
        do c = 1 to m ; t = t + (substr(wa,c,1) = substr(wb,c,1)) ; end
        score = score + (t / m) * 10
        end
       end
      return
      
    CheckUnused:                                  /* Anything missed? */
     do i = 1 to words(a) 
      if smatch.i = 0 then do ; score = score - 5 ; imatch.i = 1 ; end
     end
     do i = 1 to words(b) 
      if imatch.i = 0 then score = score - 5
     end
     return
    
    Trial:
     call wr(y,2,c2 ins c1 lf) ; w = writech(co,qu)
      trial = readch(co) ; b = readln(co)
     score = 0 ; orig = a ; a = low(a)
     call Assess()
     call wr(y+3,50,c2 'Graded :' score)
     call wr(y+4,13,'Expected : ' || c1 || orig)
     return

    Graded:
     a = 'The quick brown fox jumped over the lazy dog.'
     call wr(2,3,c2 || "Graded renderings of :")
     call wr(4,2,a c1 lf) ; a = low(a)  
     call Store() 
     do sen = 1 to 11
      score = 0 ; b = b.sen ; call Assess()
      call wr(sen+4,2,origb) ; call wr(sen+4,60,c2 score c1)
     end
     call Next(17)
    return
    
    ThreeTrials:
     call wr(2,49,ff b2 c1 " Three trials " b0) 
     ins = '1 Enter your version of the French for'
     qu = '   The pen of my aunt. ' ; a = 'la plume de ma tante' ; y = 3
     call Trial()
     ins = '2 Complete : '
     qu = '   To be or not to be, ' ; a = 'that is the question' ; y = 9
     call Trial()
     ins = '3 Write out in full : '
     qu = '   UNO :   ' ; a = 'United Nations Organisation' ; y = 15
     call Trial()
     call Next(21)
    return
    
    YourOwn:
     call wr(1,1,ff) ;  call wr(2,20,b2 c1 " Your own texts " b0)
     call wr(3,2,"Repeat as often as you like.   (Enter x to exit)")
     call wr(4,2,c2 "Enter the text which is to be matched :")   
     do forever
      do cl = 6 to 13 ; call wr(cl,1,eol) ; end
      call wr(5,2,'') ; w = writech(co,c1 '-> ')
      a = '' ; do until length(a) > 0 ; a = readln(co) ; end
      if upper(a) = 'X' then leave
      call wr(8,2,c2 "And now the text which attempts to match it :") 
      w = writech(co,c1 '-> ') ; b = readln(co)
      score = 0 ; origa = a ; a = low(a) ; origb = b ; b = low(b)
      call Assess()
      do cl = 15 to 18 ; call wr(cl,1,eol) ; end
      call wr(15,2,eol 'Expected : 'origa)
      call wr(16,2,eol 'Given    : ' || c1 || origb)
      call wr(18,30,c2 'Graded :' score)
      end
     call wr(1,1,ff)
     return