/ Each function is in APPLICATION-SPECIFIC. / TRICKY POINTS: elimcards changes cardindex. If it is called several / times as the result of a single web request (which happened before / I started using the lastinput, lastoutput pair) / thne the index got messed up. / To do: determine <, > , =. Fraction multiply. / September 6, 2002: fault tolerance in testpresent. logogif: "\"minisp.gif\"" basicwidth: 60 basicwidth: 45 / basicwidth: 15 tilewidth: basicwidth tileheight: 50 / point size to fit tile 38 according to Justin tileheight: 35 / point size to fit tile 38 according to Justin / tileheight: 15 / point size to fit tile 38 according to Justin args: _i / BASICS /finds intersection of two lists / fastest of all intersect: {[x;y] x,: () y,: () if[(#x) < (#y) i: x ?/: y j: & i < #x :x[?i[j]] ] i: y ?/: x j: & i < #y :y[?i[j]] } /finds intersection of two lists / fastest of all hasintersect: {[x;y] x,: () y,: () if[0 = (#x) & (#y); :0] i: x ?/: y : (&/i) < #x } / x is a proper subset of y propersubset:{[x;y] x,: () y,: () if[~ (#x) < (#y); :0] / must be smaller :(#x) = (#intersect[x;y]) } subset:{[x;y] (#x) = (#intersect[x;y])} subset:{[x;y] j: y ?/: x / if any js are as big as #y, then there is a member of x not in y :0 = |/ j = #y } / proportion of x that y covers approxsubset:{[x;y] j: y ?/: x / any equal to #y are in x but not in y :(# & j < (#y)) % (#x) } / finds indexes in x and y that intersect / If x and y are both sets, then the results will be of the same length / fastest of all intersectindexes: {[x;y] i: x ?/: y / where each y hits j: & i < #x / those ys that hit :(i[j];j) } /finds indexes in x that intersect with y intersectleftindexes: {[x;y] i: x ?/: y / where each y hits j: & i < #x / those ys that hit :i[j] } / if there are duplicates in the left intersectleftindexesdup:{[x;y] i: y ?/: x j: & i < #y :j } /finds intersection of two lists / and returns index pairs of matches. Assumes no duplicates / in either list intersectbothindexes: {[x;y] x,: () y,: () i: x ?/: y pairs: (i ,' (!#y)) k: & pairs[;0] < #x :pairs[k] } / this is a set intersection so we remove duplicates multiintersect:{[lists] size: #lists if[2 > size; :lists] first: lists[0],() jj: first ?/: (,/ ?:' lists[1+ !(size-1)]) / find indexes in first x: @[(1+#first) # 0; jj; + ; 1] x: (-1) _ x / delete missing entry kk: & x = size - 1 :first[kk] } / A faster difference differ:{[x;y] x,: () y,: () i: y ?/: x j: & i = #y :?x[j] } / Count the difference differcount:{[x;y] i: y ?/: x :# & i = #y } avg:{(+/ x) % # x} var:{avg[_sqr x] - _sqr avg[x]} std:{_sqrt var[x]} cov:{avg[x * y] - avg[x] * avg[y]} corr:{ (cov[x;y])%((std[x]) * (std[y]))} / delay based search / END OF BASICS / GENERATE HTML / Generate the html / The vals array has a name in upper left hand corner and then / it has column headers / Row headers are below name. / Values are inside. / Does the actual work printtable:{[tabletype; vals; tablecolor] out: ,printheader[vals[0]] rem: 1 _ vals if[tabletype ~ "Division" x0: rem[;0] y: round''1 _' rem rem: x0,'y ] count: #rem[0] show: count # 0 show[0]: 1 / eventually others will be shown too jj: !#rem numrows:: (#rem) / global needed to determine who wins numcols:: (#rem[0]) - 1 out,: printrow[show; tabletype; rem; tablecolor]'jj :out } / first line printheader:{[vals] / width: 650 / width: _ (((#vals))%((#vals)-1)) * 450 / lastwidth: width - 450 superplywidth: (((#vals) - 1) * basicwidth) | (9*basicwidth) width: ((#vals) * basicwidth) | _ (((#vals))%((#vals)-1)) * superplywidth lastwidth: width - superplywidth colspan: (#vals) - 1 / out: "" out: "
"
 out,: " tablewidth.html"
 out,: ""
 out,: " "
 / change table width to change everything
 out,: ("
" out,: "" out,: (" " out,: (" " out,: "\" alt=\"\" width=\"" out,: "37" out,: "\" height=\"33\"> " j: 0 while[j < #vals / out,: "") j+: 1 ] out,: "" :out } / Does the actual work for multi-row header printtablemulti:{[tabletype; vals; tablecolor] out: ,printheadermulti[vals[0]] rem: 1 _ vals jj: !#rem show: (#rem[0]) # 0 show[0]: 1 numrows:: (#rem) numcols:: (#rem[0]) - 1 out,: printrow[show; tabletype; rem; tablecolor]'jj : out } / first line printheadermulti:{[vals] / width: 650 / width: 50*((#vals)+1) / width: 650 / width: _ (((#vals))%((#vals)-1)) * 450 / lastwidth: width - 450 superplywidth: (((#vals) - 1) * basicwidth) | (9*basicwidth) width: ((#vals) * basicwidth) | _ (((#vals))%((#vals)-1)) * superplywidth lastwidth: width - superplywidth colspan: (#vals) - 1 / out: "
\"\"
" / out,: " " out,: " " out,: ($vals[j]), ("
" out: "
"
 out,: " tablewidth.html"
 out,: ""
 out,: " "
 / change TABLE WIDTH to change everything
 out,: ("
" out,: "" out,: (" " out,: (" " out,: "\" alt=\"\" width=\"" out,: "37" out,: "\" height=\"33\"> " j: 0 / I don't know about height and width. I think I don't / want it because it is already big enough. / I'm not sure: width=\"38\" height=\"38\" while[j < #vals out,: "") j+: 1 ] out,: "" :out } / spit out a table of values / starting with a second line. printrow:{[show; tabletype; vals;tablecolor; i] even: (_ i % 2) = (i % 2) val: vals[i], () j: 0 out: "" while[j < #val x: even + j flag: (_ x % 2) = (x % 2) flag&: ~ (i;j) _in bluepairstaken flag&: ~ (i;j) _in redpairstaken / out,: "") j+: 1 ] out,: "" if[i = ((#vals) - 1) / last one out,: "
\"\"
" / out,: " " out,: ($vals[j]), ("
0) & flag); out,: (" BGCOLOR=\"#"), tablecolor, ("\"")] if[(i;j) _in bluepairstaken if[~ (i;j) _in turnpairs out,: (" BGCOLOR=\"#"), bluecolor, ("\"") ] if[(i;j) _in turnpairs out,: (" BGCOLOR=\"#"), bluecolornow, ("\"") ] show[j]: 1 ] if[(i;j) _in redpairstaken if[~ (i;j) _in turnpairs out,: (" BGCOLOR=\"#"), redcolor, ("\"") ] if[(i;j) _in turnpairs out,: (" BGCOLOR=\"#"), redcolornow, ("\"") ] show[j]: 1 ] out,: " NOWRAP>" if[show[j]; v: $val[j]] if[~show[j] remflag: tabletype _in ("FractionAdd"; "Intersection") if[remflag remainingvalues,: ,val[j] ] if[~ remflag remainingvalues,: val[j] ] v: ,/(" " " ?? ") v: ,/(" " ($webaddress) "/.m.h[click " ($tabletype), ("|"), ($i), ("|"), ($j), ("|"),(convert[$val[j]]) ("|"),($turnnum),("|"),($mytimestamp) "]\"> ?? ") ] out,: ,/(" " v "
" ] :out } printrowold:{[vals;tablecolor; i] even: (_ i % 2) = (i % 2) val: vals[i], () j: 0 out: "" while[j < #val x: even + j flag: (_ x % 2) = (x % 2) / out,: " 0) & flag); out,: (" BGCOLOR=\"#"), tablecolor, ("\"")] out,: " NOWRAP>" v: val[j] out,: ,/(" " $v "") j+: 1 ] out,: "" if[i = ((#vals) - 1) / last one out,: "" ] :out } / Does the actual work printcardsold:{[vals] / out: ,"
"
  out: ,"  hint cards "
  out,: ,"  "    
  jj: !#vals
  out,: printcardrow[vals]'jj
  / out,: ,"
" out,: ," " name: "card.html" web,: ,("http://cs.nyu.edu/cs/faculty/shasha/papers/data.d/"),name } / decide how to wrap a line to make it fit / no line should be bigger than about 25 wrapline:{[line] if[23 > #line; :line] if[line _sm "*src*"; :line] blanks: & line = " " blanks,: #line out: line[!*blanks] lastclear: 0 i: 1 while[i < #blanks flag: 23 < blanks[i] - lastclear if[flag lastclear: blanks[i-1] x: blanks[i-1] + 1 out,: ("
"), line[x + !(blanks[i] - x)] ] if[~ flag out,: line[blanks[i-1] + !(blanks[i] - blanks[i-1])] ] i+: 1 ] :out } printcardrowold:{[vals;i] / out: " " out,: " " out,: wrapline[vals[i]] out,: " " / out,: " " :out } / Does the actual work printcards:{[file; vals; valscolors] / out: ,"
"
  out: ,"  hint cards "
  out,: ,"  "    
  by3:{[i] (_ i % 3) = (i % 3)}
  if[~ by3[#vals]
	vals,: ,*|vals
	valscolors,: ,*|valscolors
  	if[~ by3[#vals]
		vals,: ,*|vals
		valscolors,: ,*|valscolors
	]
  ]
  i: 0
  while[(i) < #vals
    out,: ,printcardrow[vals;i;i+1; i+2; valscolors]
    i+: 3
  ]
  / out,: ,"
" out,: ," " web,: ,("http://cs.nyu.edu/cs/faculty/shasha/papers/data.d/"),name :out } printcardrow:{[vals;i; j; k; valscolors] / out: " " out,: "" out,: " " out,: wrapline[vals[i]] out,: " " out,: "" out,: " " out,: wrapline[vals[j]] out,: " " out,: "" out,: " " out,: wrapline[vals[k]] out,: " " out,: " " / out,: " " :out } / END OF GENERATE HTML / CONVERT/DECONVERT globalvalue spitglob:{[list] (-1) _ ,/ ($list) ,\: ";"} / this puts out a global value convert: {[string] spitglob _ic string} getfieldsglob:{[line] i: line = ";" j1: &i j2: &~i line @:j2 size: #j1 :(0,(j1 - !size)) _ line } deconvert:{[string] _ci 0 $ getfieldsglob string} / x: convert["dennis is here 12 3 or not"] / deconvert[x] / APPLICATION-SPECIFIC / print out a set printset:{[vec] if[0 = #vec; :("{}")] x: -2 _ ,/ ($vec) ,\: (", ") :("{"), x, ("}") } / GENERATE INTERIOR VALUES FOR ADDITION / generate the values given rows and columns / for 2-ply genvalsplus:{[title; rows; cols] vals: ,(,title), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvals: row+cols / function is here allrow: row, newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ?calcvals) } / GENERATE INTERIOR VALUES FOR MULTIPLICATION / generate the values given rows and columns / for 2-ply genvalsmult:{[title; rows; cols] vals: ,(,title), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvals: row*cols / function is here allrow: row, newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("Multiplication: The product is "),/: ($?calcvals),\:(".")) } / GENERATE INTERIOR VALUES FOR DIVISION / generate the values given rows and columns / for 2-ply oldgenvalsdiv:{[title; rows; cols] vals: ,(,title), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] x: _:' cols % row y: cols - (_:' row * x) newvals: ` $ ($x) ,' (" R"),/: ($y) allrow: row, newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("Division: The quotient is "),/: ($?calcvals),\:(".")) } / No longer tries to do remainder stuff genvalsdiv:{[title; rows; cols] vals: ,(,title), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvals: cols % row allrow: row, newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("Division: The quotient is "),/: ($?calcvals),\:(".")) } / GENERATE INTERIOR VALUES FOR INTERSECTION / algorithm for intersection is simply to find the intersection of two / sets / first evaluate, for each member, the product of the other members. / then generate for that member all multiples up to that product. / Take the intersection of those multiples and find the minimum value. / generate the values given rows and columns / for 2-ply genvalsintersect:{[rows; cols] vals: ,(,"Intersection"), printset'cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvals: printset'intersect[row]'cols / function is here allrow: (,printset[row]), newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("Sets: The intersection is "),/: ($?calcvals),\:(".")) } / GENERATE INTERIOR VALUES FOR LEAST COMMON MULTIPLE (LCM) / algorithm for lcm is given a vector / first evaluate, for each member, the product of the other members. / then generate for that member all multiples up to that product. / Take the intersection of those multiples and find the minimum value. lcm:{[vec] m: genmemberslcm[vec]'vec x: multiintersect[m] :&/x } genmemberslcm:{[vec; mem] i: vec ? mem newvec: vec _di i x: */newvec y: 1 + !x :mem * y } / generate the values given rows and columns / for 2-ply genvalslcm:{[rows; cols] vals: ,(,"LeastComMult"), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvec: row,/: cols / create a vector for lcm newvals: lcm'newvec / function is here allrow: row, newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ?calcvals) } / GENERATE INTERIOR VALUES FOR GREATEST COMMON DIVISOR (GCD) / algorithm for gcd is given a vector / first evaluate, for each member, the product of the other members. / then generate for that member all multiples up to that product. / Take the intersection of those multiples and find the minimum value. gcd:{[vec] m: genmembersgcd'vec x: multiintersect[m] :|/x } / we find the divisors of num genmembersgcd:{[num] x: 1 + !num i: & isdivisor[num]'x :x[i] } isdivisor:{[num;x] y: num % x : y = _ y } / generate the values given rows and columns / for 2-ply genvalsgcd:{[rows; cols] vals: ,(,"GreatestCommonDivisor"), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvec: row,/: cols / create a vector for gcd newvals: gcd'newvec / function is here allrow: row, newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("The greatest common factor is "),/: ($?calcvals),\:(".")) } / GENERATE PICTORIAL FRACTIONS genfracpict:{[title; rows; cols] vals: ,(,title), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvals: genfrac[row]'cols allrow: row, newvals vals,: ,allrow calcvals,: printfracsup'convertto12ths'(row ,/: cols) i+: 1 ] :(vals; ("Fraction expressed in 12ths: "),/: ($?calcvals),\:(".")) } convertto12ths:{[pair] num: pair[0] denom: pair[1] x: _ 12 % denom denom: 12 num*: x :(num;denom) } / generate a pictorial fraction table for this num out of this many / denoms, e.g. 7/12 would be 7 reds among 12 lines. genfrac:{[num; denom] x: _ 12 % denom denom: 12 num*: x out: () / out,: "" / out,: " littletable" / out,: " " / out,: " " out,: " " i: 0 while[i < denom - num out,: " " i+: 1 ] while[i < denom out,: " " i+: 1 ] out,: "
" out,: "
" / out,: " " :out } / GENERATE INTERIOR VALUES FOR FRACTION ADD / reduce a pair to its lowest terms / but leave as improper reducelowest:{[pair] num: pair[0] den: pair[1] y: gcd[num,den] num: _ num % y den: _ den % y :(num;den) } / add two fractions addfrac:{[pair1; pair2] num1: pair1[0] den1: pair1[1] num2: pair2[0] den2: pair2[1] x: lcm[den1,den2] mult1: _ x % den1 mult2: _ x % den2 new: ( (num1*mult1) + (num2*mult2); x) / add is here :reducelowest[new] / num: new[0] / den: new[1] / y: gcd[num,den] / num: _ num % y / den: _ den % y / :(num;den) } / 123/128 / print out a fraction printfracsup:{[pair] if[pair[0] = pair[1]; :"1"] out: () if[pair[0] > pair[1] out,: ("1 ") pair[0]-: pair[1] ] :out,(""),($pair[0]),("/"),($pair[1]),("") } / print out a fraction using a table printfracnew:{[pair] if[pair[0] = pair[1]; :"1"] out: "" if[pair[0] > pair[1] x: _ pair[0] % pair[1] out,: ($x), (" ") pair[0]-: pair[1] ] / :out,(""),($pair[0]),("/"),($pair[1]),("") y: (" ") y,: (out), ("") y,: "" y,: ("
") y,: ($pair[0]), ("
") / y,: (out), (" —
") y,: ($pair[1]), ("
") / :out, y : y } / print out a fraction using a table / this is too long so we are going to use a sup/sub approach printfracold:{[pair] xval: (pair[0])%(pair[1]) / if[pair[0] = pair[1]; :"1"] out: "" if[~ pair[0] < pair[1] x: _ pair[0] % pair[1] out,: ($x), (" ") pair[0]-: x*pair[1] ] / :out,(""),($pair[0]),("/"),($pair[1]),("") y: (" ") y,: "" y,: "" y,: "" y,: "" y,: "" y,: "
" y,: out y,: "" if[0 < pair[0] / beginning of fraction y,: (" ") y,: ("
") y,: ($pair[0]), ("
") y,: (" ---
") y,: ($pair[1]), ("
") / end of fraction ] / y,: ("
") y,: "" y,: " " y,: "" y,: (" ") y,: " " y,: " " y,: " " y,: "" y,: "" / :out, y : y } / print out a fraction using a table and slash printfracworks:{[pair] xval: (pair[0])%(pair[1]) / if[pair[0] = pair[1]; :"1"] out: "" if[~ pair[0] < pair[1] x: _ pair[0] % pair[1] out,: ($x), (" ") pair[0]-: x*pair[1] ] y: (" ") y,: "" y,: "" y,: "" y,: "" y,: "" y,: "
" y,: out y,: "" if[0 < pair[0] y,:(""),($pair[0]),("/"),($pair[1]),("") ] / y,: ("
") y,: "" y,: " " y,: "" y,: (" ") y,: " " y,: " " y,: " " y,: "" y,: "" / :out, y : y } / print out a fraction using a table and slash printfrac:{[pair] xval: (pair[0])%(pair[1]) / if[pair[0] = pair[1]; :"1"] out: "" if[~ pair[0] < pair[1] x: _ pair[0] % pair[1] out,: ($x), (" ") pair[0]-: x*pair[1] ] y: (" ") y,: "
" y,: out if[0 < pair[0] y,:(""),($pair[0]),("/"),($pair[1]),("") ] / y,: ("
") y,: "" y,: "" y,: "" / :out, y : y } / print out a fraction using a table / reducelowest[pair] printfrac2:{[pair] if[1 = #pair; :pair] if[(pair ~ reducelowest[pair]) & (pair[0] < pair[1]); :printfrac[pair]] y: (" ") y,: " " y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" / pair: reducelowest[pair] out: "" if[~ pair[0] < pair[1] x: _ pair[0] % pair[1] out,: ($x), (" ") pair[0]-: x*pair[1] ] if[0 < pair[0] pair: reducelowest[pair] ] / :out,(""),($pair[0]),("/"),($pair[1]),("") y,: "" y,: "" y,: "" y,: (" ") y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" y,: "" y,: "
" / beginning of fraction y,: (" ") y,: ("
") y,: ($pair[0]), ("
") y,: (" _
") y,: ($pair[1]), ("
") y,: "		 = " y,: out y,: "" if[0 < pair[0] / beginning of fraction y,: (" ") y,: ("
") y,: ($pair[0]), ("
") y,: (" _
") y,: ($pair[1]), ("
") / end of fraction ] y,: "
" / :out, y : y } / UNUSED printfractext:{[pair] if[pair[0] = pair[1]; :"1"] out: () if[pair[0] > pair[1] out,: ("1 ") pair[0]-: pair[1] ] :out,($pair[0]),("/"),($pair[1]) } / generate the values given rows and columns / for 2-ply / rows and columns are vectors of pairs genvalsfracadd:{[rows; cols] vals: ,(,"+"), printfrac'cols / operation name is here / vals: ,(,"+"), printfracsup'cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvec: addfrac[row]'cols / create a vector for fractions newvals: newvec allrow: (,row), newvals vals,: ,printfrac'allrow / vals,: ,printfracsup'allrow calcvals,: printfracsup'newvals i+: 1 ] :(vals; ("Fractions: The sum is "),/: ($?calcvals),\:(".")) } genvalsfracpie:{[rows; cols] vals: ,(,"FractionPie"), cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] / newvec: (row ,/: cols) newvec: (cols ,\: row) newvals: newvec allrow: (,row), newvals vals,: ,printfrac2'allrow calcvals,: printfracsup'newvals i+: 1 ] :(vals; ("Fractions: The sum is "),/: ($?calcvals),\:(".")) } / GENERATE INTERIOR VALUES FOR EVALUATION / These are globals x: 0 y: 0 z: 0 printvar:{[vec] vec,: () if[1 = #vec; :("x = "),($vec[0])] if[2 = #vec; :("x = "),($vec[0]), ("
y = "),($vec[1])] if[3 = #vec :("x = "),($vec[0]), ("
y = "),($vec[1]),("
z = "),($vec[2]) ] } printexp:{[exp] i: & ~ exp _in\: "*()" :exp[i] } eval:{[exp; vec] if[0 < #vec; . ("x:: "),($vec[0])] if[1 < #vec; . ("y:: "),($vec[1])] if[2 < #vec; . ("z:: "),($vec[2])] : . exp } / generate the values given rows and columns / for 2-ply / rows and columns are vectors of pairs genvalseval:{[rows; cols] vals: ,(,"Evaluate"), printvar'cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvec: eval[row]'cols / create a vector for fractions newvals: newvec allrow: (,printexp[row]), newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("Evaluation: The expression is "),/: ($?calcvals),\:(".")) } / GENERATE INTERIOR VALUES FOR ONE VARIABLE SOLVING / So we have something like (3*x) + 2 which is represented by (3 2) / or 4*x - 2 (4 -2) / print one side of the equation printside:{[pair] if[0 > pair[1] yy: _abs pair[1] :[1 = pair[0] :("x - "),($yy) :($pair[0]),("x - "),($yy)] ] if[~ 0 > pair[1] :[1 = pair[0] :("x + "),($pair[1]) :($pair[0]),("x + "),($pair[1])] ] } / one variable expression solver / 3x + 2 = 4x + 15 / (3-4)x = 15 - 2 solveone:{[pair1; pair2] newcoef1: pair1[0] - pair2[0] / coefficient of x on left side after / subtracting the right side. newconst2: pair2[1] - pair1[1] / coefficient of x^0 on right side x: (newconst2 % newcoef1) :(` $ ("x = "), ($x)) } / generate the values given rows and columns / for 2-ply / rows and columns are vectors of pairs gensolveone:{[rows; cols] vals: ,(,"Find_x"), printside'cols / operation name is here calcvals: () i: 0 while[i < #rows row: rows[i] newvec: solveone[row]'cols / create a vector for fractions newvals: newvec allrow: (,printside[row]), newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("Find_x: "),/: ($?calcvals),\:(".")) } / GENERATE INTERIOR VALUES FOR LEVERS torqueL:{[dist; pos; weight] (pos - (-dist)) * weight} torqueR:{[dist; pos; weight] (pos - (dist)) * weight} / stable if net effect on R is negative torque / and net effect on L is positive torque stable:{[posvec; weightvec] dist: 1 / of fulcrums from center boardweight: 1 / weight of board netL: +/ torqueL[dist]'[posvec;weightvec] netL+: torqueL[dist;0; boardweight] netR: +/ torqueR[dist]'[posvec;weightvec] netR+: torqueR[dist;0; boardweight] flag: :[(netL < 0) ; `"Tips left" (netR > 0); `"Tips right" `"Does not tip"] :flag } / 123/128 / print out a fraction printlever:{[pair] :("Position: "), ($pair[0]), ("
Weight: "), ($pair[1]) } / generate the values given rows and columns / for 2-ply / rows and columns are vectors of pairs / posvec: 2 -2 / weightvec: 5 2 / stable[posvec; weightvec] genvalslever:{[rows; cols] vals: ,(,"Lever"), printlever'cols / operation name is here calcvals: () otherpos: cols[;0] otherweight: cols[;1] i: 0 while[i < #rows row: rows[i] rowpos: row[0] rowweight: row[1] allposvec: rowpos ,/: otherpos allweightvec: rowweight ,/: otherweight newvec: stable'[allposvec; allweightvec] / vector of stability newvals: newvec allrow: (,printlever[row]), newvals vals,: ,allrow calcvals,: newvals i+: 1 ] :(vals; ("Lever: "),/: ($?calcvals),\:(".")) } / GENERATE INTERIOR VALUES FOR OLDER THAN / algorithm for lcm is given a vector / first evaluate, for each member, the product of the other members. / then generate for that member all multiples up to that product. / Take the intersection of those multiples and find the minimum value. older:{[vec] m: genmemberslcm[vec]'vec x: multiintersect[m] :&/x } genmembersolder:{[vec; mem] i: vec ? mem newvec: vec _di i x: */newvec y: 1 + !x :mem * y } / return a pair the first element of which are the people in the / cols[index] and the second is the number of other people each of them / is older than. fillcol:{[cols;index] mycol: cols[index] / all pairs people: ?,/mycol nums: howmany[mycol]'people :(people;nums) } / given a set of pairs and a person, how many people is that / person older than howmany:{[pairs;person] out: person,() realnew: out lefts: pairs[;0] rights: pairs[;1] flag: 1 while[flag i: & lefts _in\: realnew new: rights[i] realnew: differ[new;out] flag: 0 < #realnew out,: realnew ] :#?out _dv person } / generate the values given rows and columns / for 2-ply / cols are of the form of a set of pairs e.g. (`Tom `Judy; `Judy `Linda;...) / rows are a single assertion, e.g. (`Joe `Tom) / We want to count the number of people the person in the left of the / row assertion is surely older than. genvalsolder:{[rows; cols] vals: ,(,"JoeOlder"), convertcolsolder[cols] / operation name is here / col.id: ,/(#:' cols) #' (!#cols) / first fill in for each column how many people each person is older than col.id: !#cols col.people: (#cols) # ,() col.numbers: (#cols) # ,() i: 0 while[i < #cols pair: fillcol[cols; i] col.people[i]: pair[0] col.numbers[i]: pair[1] i+: 1 ] calcvals: () i: 0 while[i < #rows pair: rows[i] / e.g. `Joe `Henry younger: pair[1] / younger person in the pair newvec: () j: 0 while[j < #cols x: col.people[j] ? younger newvec,: :[x = #col.people[j]; 1;1+col.numbers[j][x]] j+: 1 ] allrow: (,($pair[0]), (" older than "), ($pair[1])), newvec vals,: ,allrow calcvals,: newvec i+: 1 ] name: ($rows[0;0]) / name of older person :(vals; (("Age Logic: "), (name), (" is surely older than ")) ,/: ($?calcvals) ,\:(".")) } / convert header for cols into a string convertcolsolder:{[cols] i: 0 out: () while[i< #cols out,: ,convertline[cols[i]] / out,: "|" i+: 1 ] / :(-1) _ out :out } / each col is a a set of pairs e.g. (`Tom `Judy; `Judy `Linda;...) convertline:{[pairs] i: 0 out: () while[i < #pairs out,: ($pairs[i;0]), (" older than "),($pairs[i;1]),("
") i+: 1 ] :(-4) _ out } / INPUT FROM A TEXT LINE USING VERTICAL BARS / parses a field based on vertical bars getfields:{[line] i: line = "|" j1: &i j2: &~i line @:j2 size: #j1 :(0,(j1 - !size)) _ line } / get rid of blanks at either end of the string delendblanks:{[string] if[0 = #string; :""] if[string ~ ,"" ; :""] i: & ~ string = " " if[(#string) = (#i); :string] if[0 = (#i); :""] string: (- ((#string) - (1 + *|i))) _ string :(*i) _ string } / Handles one line of input at a time according to table schema above. / A little more space efficient than the previous version. processline:{[line] :delendblanks'getfields[line] } / DATA round:{[x] y: _ 0.5 + (10 * x); y % 10} / round to one decimal place has:{[num;value] subset[($num); ($value)]} isodd:{[value] ~ (value % 2) = (_ (value % 2))} iseven:{[value] (value % 2) = (_ (value % 2))} isbetween:{[low;high;val] (~ val < low) & (~val > high)} isless:{[ref;val] (val < ref)} isgreater:{[ref;val] (val > ref)} getdecimal:{[num] num - _ num} getwhole:{[num] _ num} islessdecimal:{[ref;num] isless[getdecimal ref; getdecimal num]} isgreaterdecimal:{[ref;num] isgreater[getdecimal ref; getdecimal num]} islesswhole:{[ref;num] isless[getwhole ref; getwhole num]} isgreaterwhole:{[ref;num] isgreater[getwhole ref; getwhole num]} getquot:{[string] i: string ? " " : string[!i] } isprime:{[num] num: _abs num if[0 < getdecimal num; :0] num: _ num If[num = 1; :0] poss: 2 + _ _sqrt[num] poss&: num - 1 i: 2 while[i < poss x: (num % i) if[x = _ x; :0] i+: 1 ] :1 } / string of form "{A, C}"; get out `A `C (must be single letters) convertform:{[y] ii: & ~ y _in\: "{} ," y@: ii :` $'y } subsetformula:{[x;y] y: convertform[$y] :subset[x;y,()] } hasintersectformula:{[x;y] y: convertform[$y] :hasintersect[x;y] } isnull:{[y] 0 = # convertform[$y]} / string of form "{A, C}{B}{A}{A, B, C}{C, D, A}{D}{A}{A, C, D}{C, D}{B, D}" parseset:{[string] out: () cur: "" i: 0 while[i < #string cur,: string[i] if[("}") = string[i] out,: ,cur cur: "" ] i+: 1 ] :out } / we have arranged it so that there is a field myvalue=number / find that and return it findmyvalue:{[string] i: * string _ss "myvalue=" string: (i+8) _ string i: string ? ">" string@: !i : 0.0 $ string } fracless:{[num; string] myval: findmyvalue[$string] :(getdecimal myval) < num } fracgreater:{[num; string] myval: findmyvalue[$string] :(getdecimal myval) > num } fracwholeless:{[num; string] myval: findmyvalue[$string] :(getwhole myval) < num } fracwholegreater:{[num; string] myval: findmyvalue[$string] :(getwhole myval) > num } squeeze:{[string] string@: & ~ string = " "; string} advsum: ("The sum is odd." "The sum contains a 2." "The sum contains a 5." "The sum contains a 1." "The sum contains a 4." "The sum contains a 3." "The sum contains a 6." "The sum contains a 7." "The sum contains a 9." "The sum contains a 8." "The sum contains a 0.") advsumformulas:( ("isodd[") ("has[2;") ("has[5;") ("has[1;") ("has[4;") ("has[3;") ("has[6;") ("has[7;") ("has[9;") ("has[8;") ("has[0;")) genericlogic: ("Contains a C." "Contains both A and B." "Contains a D." "Contains nothing (empty set)." "Contains both C and B." "Contains an E." "Contains either an A or C." "Contains a B." "Contains an A.") genericlogicformulas:( ("subsetformula[,`C;") ("subsetformula[`A `B;") ("subsetformula[,`D;") ("isnull[") ("subsetformula[`C `B;") ("subsetformula[,`E;") ("hasintersectformula[`A `C;") ("subsetformula[,`B;") ("subsetformula[,`A;")) generic: ("The result is odd." "The result is between 0 and 10, inclusive." "The result is even." "The result contains a 5." "The result is strictly positive." "The result contains a 4." "The result contains a 3." "The result contains a 6." "The result is less than 7." "The result contains a 9." "The result contains a 8." "The result contains a 0." "The result is between -5 and 5, inclusive." "The result is less than 30.") genericformulas:( ("isodd[") ("isbetween[0;10;") ("iseven[") ("has[5;") ("isgreater[0;") ("has[4;") ("has[3;") ("has[6;") ("isless[7;") ("has[9;") ("has[8;") ("has[0;") ("isbetween[-5;5;") ("isless[30;")) genericpos: ("The result is odd." "The result is between 0 and 10, inclusive." "The result is even." "The result contains a 5." "The result is greater than 6." "The result contains a 4." "The result contains a 3." "The result contains a 6." "The result is less than 7." "The result contains a 9." "The result contains a 8." "The result contains a 0." "The result is between 3 and 7, inclusive." "The result is less than 30.") genericformulaspos:( ("isodd[") ("isbetween[0;10;") ("iseven[") ("has[5;") ("isgreater[6;") ("has[4;") ("has[3;") ("has[6;") ("isless[7;") ("has[9;") ("has[8;") ("has[0;") ("isbetween[3;7;") ("isless[30;")) genericabs: ("The result is odd." "The result is between 0 and 10, inclusive." "The result is between -20 and -50, inclusive." "The result is even." "The result contains a 5." "The result is strictly positive." "The result contains a 4." "The result contains a 3." "The result is strictly negative." "The result contains a 6." "The result is less than 7." "The result contains a 9." "The result contains a 8." "The result is greater than -15." "The result is between -10 and 10, inclusive." "The result contains a 0." "The result is between -5 and 5, inclusive." "The result is less than 30.") genericabsformulas:( ("isodd[") ("isbetween[0;10;") ("isbetween[-50;-20;") ("iseven[") ("has[5;") ("isgreater[0;") ("has[4;") ("has[3;") ("isless[0;") ("has[6;") ("isless[7;") ("has[9;") ("has[8;") ("isgreater[-15;") ("isbetween[-10;10;") ("has[0;") ("isbetween[-5;5;") ("isless[30;")) advmult: ("The product is odd." "The product is between 40 and 50, inclusive." "The product contains a 2." "The product contains a 5." "The product contains a 1." "The product contains a 4." "The product contains a 3." "The product contains a 6." "The product contains a 7." "The product contains a 9." "The product contains a 8." "The product contains a 0." "The product is less than 30.") advmultformulas:( ("isodd[") ("isbetween[40;50;") ("has[2;") ("has[5;") ("has[1;") ("has[4;") ("has[3;") ("has[6;") ("has[7;") ("has[9;") ("has[8;") ("has[0;") ("isless[30;")) advfrac: ("The fractional part < 1/2." "The fractional part < 7/10." "The fractional part > 1/3." "The fractional part < 2/3." "The fractional part > 3/4." "The whole part > 1.") advfracformulas:(("fracless[0.5;squeeze ") ("fracless[0.7;squeeze ") ("fracgreater[0.334;squeeze ") ("fracless[0.666;squeeze ") ("fracgreater[0.75;squeeze ") ("fracwholegreater[1;squeeze ")) decimal: ("Decimal Part < 0.7" "Decimal Part > 0.3" "Decimal Part > 0.6" "Decimal Part < 0.4." "Whole Number Part < 2" "Whole Number Part > 1") decimalformulas:( ("islessdecimal[0.7;") ("isgreaterdecimal[0.3;") ("isgreaterdecimal[0.6;") ("islessdecimal[0.4;") ("islesswhole[2;") ("isgreaterwhole[1;")) quotient: ("The quotient < 10" "The quotient > 100" "The quotient < 80" "The quotient is between 15 and 60 inclusive" "The quotient is between 50 and 120 inclusive") quotientformulasold:( ("isless[10; getquot $ ") ("isgreater[100; getquot $") ("isless[80; getquot $") ("isbetween[15;60; getquot $") ("isbetween[50;120; getquot $")) quotientformulas:( ("isless[10; ") ("isgreater[100; ") ("isless[80; ") ("isbetween[15;60; ") ("isbetween[50;120; ")) / EXECUTION web: () / initial randomization x: _gtime _t x: x[1] ! 101 x: (1+x) _draw 100 / cardcolors: () / card backgrounds / GLOBALS ??? -- must be reset; need different processes for different players mytimestamp: "" / to be used to identify the process bluepairstaken: () / locations taken by blue redpairstaken: () / locations taken by blue turn: `blue bluewin: 0 redwin: 0 cards: () / card content cardformulas: () / functions corresponding to the cards cardindex: -1 currentcards: () currentcardformulas: () currentcardindex: () numrows: -1 numcols: -1 turnnum: 0 / advance steadily alreadyseen: () / a record of what we've seen so we don't do an operation twice remainingvalues: () / values remaining after a selection. Eliminate / impossible formulas / globals for multiple move turns startturn: 1 / have just started a turn for a color turnpairs: () / pairs in the turn / end of globals for multiple move turns globaldeletecount: 0 / how many have been deleted at this point globaldeleted: () / GLOBALS BUT NOT PART OF PERMANENT STATE BECAUSE RECOMPUTED ON A CALL globalval: "" / value used to pass back lastinput: "" lastoutput: "" bluecolor: "00FFFF" redcolor: "FF0000" bluecolornow: "33FFFF" redcolornow: "FF3300" numberleft: 0 multiplemoveflag: 0 / if 0 then single move per turn / if 1 then blue gets continuation on anything next to anything in / current turn / if 2 then blue gets continuation on anything next to red / if 3 then blue gets continuation on anything next to blue / if 4 then blue gets continuation on anything next to blue or red if[(0 < #args) xflag: (|/("123456789") _in\: args[0]) if[xflag & ( ("+") _in args[0]) multiplemoveflag: - 0 $ (1 _ args[0]) numberleft: (- multiplemoveflag) ] if[xflag & (~ ("+") _in args[0]) multiplemoveflag: 0 $ args[0] ] if[~ xflag x: , "If no command line arguments, then each turn is one move each" x,: ,"If command line argument is 1 then blue gets continuation" x,: ," on anything next to a previous move in the same turn." x,: ,"If command line argument is 2 then blue gets continuation" x,: ," on anything next to any red." x,: ,"If command line argument is 3 then blue gets continuation" x,: ," on anything next to any blue." x,: ,"If command line argument is 4 then blue gets continuation" x,: ," on anything next to any blue or red." x,: ,"If command line argument is +n then blue gets continuation" x,: ," for n moves regardless of proximity." ` 0: x . "\\\\" ] ] verybeginning: 1 / END OF GLOBALS initializestate:{[] mytimestamp:: "" / to be used to identify the process bluepairstaken:: () / locations taken by blue redpairstaken:: () / locations taken by blue turn:: `blue bluewin:: 0 redwin:: 0 cards:: () / card content cardformulas:: () / functions corresponding to the cards cardindex:: 0 currentcards:: () currentcardformulas:: () currentcardindex:: () numrows:: -1 numcols:: -1 turnnum:: 0 alreadyseen:: () remainingvalues:: () startturn:: 1 / have just started a turn for a color turnpairs:: () / pairs in the turn globaldeletecount:: 0 globaldeleted:: () verybeginning:: 1 } savestate:{[time] savefile: ("state."),time a: (mytimestamp; bluepairstaken; redpairstaken; turn; bluewin; redwin cards; cardformulas; cardindex; currentcards; currentcardformulas currentcardindex; numrows; numcols; turnnum; alreadyseen remainingvalues; startturn; turnpairs; globaldeletecount; globaldeleted) savefile 1: a } read1:{[file] :1: file } testpresent:{[file] x: @[read1; file; :] :1-x[0] } recoverstate:{[time] recoverfile: ("state."), time presentflag: testpresent[recoverfile] if[0 = presentflag / this file is not present :1 ] a: 1: recoverfile mytimestamp:: a[0] bluepairstaken:: a[1] redpairstaken:: a[2] turn:: a[3] bluewin:: a[4] redwin:: a[5] cards:: a[6] cardformulas:: a[7] cardindex:: a[8] currentcards:: a[9] currentcardformulas:: a[10] currentcardindex:: a[11] numrows:: a[12] numcols:: a[13] turnnum:: a[14] alreadyseen:: a[15] remainingvalues:: a[16] startturn:: a[17] turnpairs:: a[18] globaldeletecount:: a[19] globaldeleted:: a[20] :0 } / GAME EVALUATION / determines whether a globalval accords with the hint isgood:{[myturn; myfields] globalval:: deconvert[myfields[3]] flag: myfields[0] _sm "*FractionAdd*" if[flag = 0 val: :[myfields[0] _sm "*Solve*" . currentcardformulas[cardindex], (4 _ globalval), ("]") . currentcardformulas[cardindex], (globalval), ("]") ] ] if[flag = 1 val: . currentcardformulas[cardindex], ("\""), (globalval), ("\"]") ] forlog,: ,currentcards[cardindex] :val } / determines whether this move accords with hint and whether it / is a good continuation. / Good continuation has to be next to something else in this turn. isgoodmove:{[myturn; myfields] if[(0 = multiplemoveflag) | (myturn = `red) startturn:: 1 turnpairs:: () :isgood[myturn; myfields] ] / we are in multiple move mode i1: 0 $ myfields[1] i2: 0 $ myfields[2] startflag: startturn if[startflag / first move of this turn x: isgood[myturn;myfields] if[~x startturn:: 1 numberleft:: (- multiplemoveflag) turnpairs:: () :x ] if[x startturn:: 0 turnpairs,: ,(i1;i2) :x ] ] if[~ startflag newpair: (i1;i2) / if 1 then blue gets continuation on anything next to anything in / current turn / if 2 then blue gets continuation on anything next to red / if 3 then blue gets continuation on anything next to blue / if 4 then blue gets continuation on anything next to blue or red if[multiplemoveflag = 1 x: |/ testneighbor[newpair]'turnpairs ] if[multiplemoveflag = 2 x: |/ testneighbor[newpair]'redpairstaken ] if[multiplemoveflag = 3 x: |/ testneighbor[newpair]'bluepairstaken ] if[multiplemoveflag = 4 x: |/ testneighbor[newpair]'redpairstaken,bluepairstaken ] if[0 > multiplemoveflag / have we gone down to zero moves left x: numberleft > 0 ] if[~x startturn:: 1 numberleft:: (- multiplemoveflag) turnpairs:: () :x ] x: isgood[myturn;myfields] if[x startturn:: 0 numberleft-: 1 if[0 > multiplemoveflag / have we gone down to zero moves left if[numberleft = 0 startturn:: 1 ] ] turnpairs,: ,(i1;i2) :x ] if[~x startturn:: 1 numberleft:: (- multiplemoveflag) turnpairs:: () :x ] ] } / if blue, then determine if there is a path from the left side / to the right side / if red, then from the top to the bottom / We do this by finding connected components of the color. haswon:{[color] all: :[color = `blue connectedcomponents[bluepairstaken] connectedcomponents[redpairstaken]] counts: #:' all all@: & (1+counts) > (numrows & numcols) / if too small, can't reach i: 0 while[i < #all mycomp: all[i] if[color = `blue x: (1 _in mycomp[;1]) & ((numcols) _in mycomp[;1]) if[x = 1; :1] ] if[color = `red x: (0 _in mycomp[;0]) & ((numrows-1) _in mycomp[;0]) if[x = 1; :1] ] i+: 1 ] :0 } areneighbors:{[pairs; indexpair] x1: pairs[indexpair[0]] x2: pairs[indexpair[1]] if[x1[0] > x2[0] + 1; :0] if[x1[0] < x2[0] - 1; :0] if[x1[1] > x2[1] + 1; :0] if[x1[1] < x2[1] - 1; :0] :1 } / x1 and x2 are each neighbors. See if they are ok testneighbor:{[x1;x2] if[x1[0] > x2[0] + 1; :0] if[x1[0] < x2[0] - 1; :0] if[x1[1] > x2[1] + 1; :0] if[x1[1] < x2[1] - 1; :0] :1 } / given a set of pairs (coordinates in a grid), / create a set of connected components connectedcomponents:{[pairs] indexes: !#pairs potentialneighbors: ,/ indexes ,/:\: indexes potentialneighbors@: & potentialneighbors[;0] < potentialneighbors[;1] potentialneighbors@: & areneighbors[pairs]'potentialneighbors indexes: ? ,/potentialneighbors indexes@: < indexes / these are the indexes to pairs; potentialneighbors refer to these comps: ,:'indexes flag: 1 & (0 < #potentialneighbors) while[flag compindexes: !#comps / some indexes may not be available comppairs: ,/ compindexes ,/:\: compindexes if[0 < #comppairs comppairs@: & comppairs[;0] < comppairs[;1] ] flag2: 1 j: 0 while[(j < #comppairs) & flag2 xpair: comppairs[j] mycomp1: comps[xpair[0]] mycomp2: comps[xpair[1]] x1: intersectleftindexesdup[potentialneighbors[;0];mycomp1] x2: intersectleftindexesdup[potentialneighbors[;1];mycomp2] flag3: hasintersect[x1;x2] if[~ flag3 x1: intersectleftindexesdup[potentialneighbors[;1];mycomp1] x2: intersectleftindexesdup[potentialneighbors[;0];mycomp2] flag3: hasintersect[x1;x2] ] if[flag3 / they go together flag2: 0 / that's all for now comps[xpair[0]],: mycomp2 comps[xpair[1]]: () if[xpair[0] > 0 k: 0 while[k < xpair[0] if[(#comps[k]) < (numrows & numcols) comps[k]: () ] k+: 1 ] ] counts: #:' comps comps@: & counts > 0 ] j+: 1 ] if[flag2; flag: 0] / no change ] :pairs[comps] } / eliminate formulas that are impossible because they are not in / remainingvalues / .:' cardformulas[0],/: remainingvalues ,\: "]" / if there are bugs set daring to 0. This might help??? / by eliminating any card eliminations elimcards:{[myfields] daring: 1 i: 0 / globaldeleted:: () while[(i < #cardformulas) & daring flag: myfields[0] _sm "*FractionAdd*" if[flag = 0 val: :[myfields[0] _sm "*Solve*" |/ .:' cardformulas[i],/: (4 _' remainingvalues) ,\: "]" |/ .:' cardformulas[i],/: remainingvalues ,\: "]"] ] if[flag = 1 val: |/ .:' (cardformulas[i], ("\"")) ,/: remainingvalues ,\: "\"]" ] if[0 = val globaldeleted,: i ] i+: 1 ] currentcardformulas:: cardformulas _di globaldeleted currentcards:: cards _di globaldeleted if[verybeginning | (globaldeletecount < #globaldeleted) / otherwise, don't change count cardindex:: * 1 _draw #currentcards globaldeletecount:: #globaldeleted ] } / to see the structure, set border = 1. / is a row. SuperPly. " " " "
" " " "" intro,: extrahint ] if[(bluewin = 1) intro,: (" BLUE HAS WON! ") ] if[(redwin = 1) intro,: (" RED HAS WON! ") ] intro,: ,/(" " if[turn = `blue intro,: ,/("" " " " ") ] if[turn = `red intro,: ,/ (" " " " "" " ") ] finale,: ,/(" " " " "
" "" " Goal
" " ") if[(bluewin = 0) & (redwin = 0) if[turn = `red intro,: (" Make a path between the two suns (between top and bottom). ") ] if[turn = `blue intro,: (" Make a path between the two icebergs (from side to side). ") ] intro,: (" Click on a square that satisfies the hint: ") extrahint: currentcards[cardindex] extrahint,: " 		") if[turn = `blue intro,: " \"win-blue\"
" "\"iceburg\"") finale: ,/(" " "" "
") finale: ,/("
" " \"sun\"
") finale,: superplyback finale,: ,/(" \"back\"
" ) x:intro, body, finale :x } gentablebasic:{[xweb] out: () x: 6 _ xweb fields: delendblanks'getfields[x] if[xweb _sm "*start*" y: _gtime _t temptimestamp: ($y[1]) if[0 < #mytimestamp / something else going on savestate[mytimestamp] initializestate[] ] mytimestamp:: temptimestamp ] if[xweb _sm "*click*" temptimestamp: fields[5] if[~ temptimestamp ~ mytimestamp savestate[mytimestamp] mytimestamp:: temptimestamp reinitialize: recoverstate[mytimestamp] if[reinitialize myxweb: xweb i: myxweb ? " " myxweb: (i+1) _ myxweb i: myxweb ? "|" myxweb@: !i myxweb: ("start "),myxweb :gentable[myxweb] ] ] i1: 0 $ fields[1] i2: 0 $ fields[2] nextturn: turn flag: ~ (i1;i2;0 $ fields[4]) _in alreadyseen / We need this alreadyseen stuff because / each .m.h seems to call in several times flag&: ~ (i1;i2) _in bluepairstaken,redpairstaken if[flag & (turn = `blue) flaggood: isgoodmove[turn; fields] alreadyseen,: ,(i1; i2; 0 $ fields[4]) if[flaggood bluepairstaken,: ,(i1;i2) if[haswon[`blue]; bluewin:: 1] ] if[startturn nextturn: `red ] cardindex+: 1 if[cardindex = #currentcardformulas cardindex:: 0 ] ] if[flag & (turn = `red) flaggood: isgoodmove[turn; fields] alreadyseen,: ,(i1; i2; 0 $ fields[4]) if[flaggood redpairstaken,: ,(i1;i2) if[haswon[`red]; redwin:: 1] ] if[startturn / time to switch nextturn: `blue numberleft:: (- multiplemoveflag) ] cardindex+: 1 if[cardindex = #currentcardformulas cardindex:: 0 ] ] if[flag turn:: nextturn turnnum+: 1 x: elimcards[fields] ] ] if[xweb _sm "* Plus*" / addition rows: !10 cols: !10 title: "Plus" pair: genvalsplus["+"; rows; cols] tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["Plus";pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues / pair[1] / these are to generate hint cards cards:: advsum cardformulas:: advsumformulas ] if[xweb _sm "*AdvancedPlus*" / fourth grade addition rows: 47 63 19 54 78 39 42 cols: 6 3 9 8 7 4 pair: genvalsplus["+"; rows; cols] tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["AdvancedPlus"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues cards:: advsum cardformulas:: advsumformulas ] if[xweb _sm "*DecimalAdd*" / decimal addition rows: .05, .1, .12, .34, .5, .63, .925, 1.2 ,5 cols: .05, .1, .12, .37, .6, .78, .925, 1.8, .5 pair: genvalsplus["+"; rows; cols] title: "DecimalAdd" tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable[title; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues / pair[1] / these are to generate hint cards cards:: decimal cardformulas:: decimalformulas ] if[xweb _sm "* Times*" / multiplication rows: 1+!9 cols: 1 + !9 rows: 2 + !8 cols: 2 + !8 pair: genvalsmult["X"; rows; cols] title: "Times" tablecolor: "FF9900" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable[title; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues / cards:: pair[1] / these are to generate hint cards cards:: advmult cardformulas:: advmultformulas ] if[xweb _sm "*DecimalMult*" / multiplication rows: .3, .03, 3, .4, 4, .04, .2, .02, 1 cols: .2, .02, 2, .04, .4, 4, .05, .5, 5 pair: genvalsmult["x"; rows; cols] title: "DecimalMult" tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable[title; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues / cards:: pair[1] / these are to generate hint cards cards:: decimal cardformulas:: decimalformulas ] if[xweb _sm "*SignedMult*" rows: -4, -7, 8, -6, 9, 1, -2, 3, -5 cols: -3, 4, 7, -8, 0, 1, -5, 2, -9 pair: genvalsmult["x"; rows; cols] title: "SignedMult" tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable[title; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues cards:: genericabs / these are to generate hint cards cardformulas:: genericabsformulas / these are to generate hint cards ] if[xweb _sm "*Multby10*" rows: 6, 60, .6, .06, 600, .006 cols: 1, 10, 100, 1000, 10000, 100000 pair: genvalsmult["x"; rows; cols] title: "Multby10" tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable[title; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues cards:: decimal cardformulas:: decimalformulas ] if[xweb _sm "* Division*" cols: 426 5629 872 7871 353 3213 rows: 21 121 57 82 165 pair: genvalsdiv["/"; rows; cols] / We are now doing this without remainders, but we could include / remainders if we put something like insertR and deleteR / in isgood and elimcards. It would work a lot like FractionAdd title: "Division" tablecolor: "0000FF" tablecolor: "999999" insertR:{[origstring] type: 4: origstring if[~ type = 4; :origstring] string: ($origstring),() i: string ? " " if[i < #string string: string[!i], (" R "), (i _ string) ] :` $ string } remainingvalues:: () / filled by printtable / out,: printtable[title; insertR''pair[0]; tablecolor] out,: printtable[title; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues removeR:{[string] string[& ~ string = "R"]} / remainingvalues:: removeR'$ remainingvalues / cards:: pair[1] / these are to generate hint cards cards:: quotient cardformulas:: quotientformulas ] if[xweb _sm "*LeastCommonMult*" / least common multiples rows: 2, 3, 4, 5, 6, 8, 9, 10, 12 cols: 1,2,3,4,6,8,9,10,12 pair: genvalslcm[rows;cols] tablecolor: "00FFFF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["LeastCommonMult"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues xx: ("Least Common Multiple is even." "Least Common Multiple is odd." "Least Common Multiple is 6." "Least Common Multiple is 8." "Least Common Multiple is 12." "Least Common Multiple is 20." "Least Common Multiple is 24." "Least Common Multiple < 11." "Least Common Multiple > 10." "Least Common Multiple > 8." "Least Common Multiple < 18.") / cardcolors,: (#xx) # ,"hintcardaqua.gif" cards:: genericpos cardformulas:: genericformulaspos ] if[xweb _sm "*GreatestCommonDivisor*" / greatest common divisors rows: 4, 6, 9, 12, 15, 18, 20, 30, 60 cols: 2, 4, 7, 8, 9, 10, 12, 15, 24 pair: genvalsgcd[rows;cols] tablecolor: "FF00FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["GreatestCommonDivisor"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues / cards:: pair[1] xx: ("Greatest Common Factor is even." "Greatest Common Factor is odd." "Greatest Common Factor < 5." "Greatest Common Factor < 4." "Greatest Common Factor > 8." "Greatest Common Factor > 6." "Greatest Common Factor > 10." "Greatest Common Factor < 15." "Greatest Common Factor > 3.") / xx: ("Greatest Common Factor Hint: "),/: xx / cards:: xx xx: xx, xx, xx / cardcolors,: (#xx) # ,"hintcardpink.gif" cards:: genericpos cardformulas:: genericformulaspos ] if[xweb _sm "*Evaluate*" / Evaluate rows: ("(3*x) + 2*y" "x + z + 5" "y - (5*z)" "x - (2*y) + (3*z)" "y+(2*z)+y") cols:((1 2 3) (4 5 6) (2 1 8) (-3 4 7) (6 4 5)) pair: genvalseval[rows; cols] tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtablemulti["Evaluate"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues cards:: pair[1] cards:: generic cardformulas:: genericformulas ] / Solve a one variable problem if[xweb _sm "*Solve*" rows: ((3 2) (2 1) (-4 3)) cols: ((1 3) (4 5) (-2 -5)) pair: gensolveone[rows; cols] tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtablemulti["Solve"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues / cards:: pair[1] advalg: ("x < -1." "x < 2." "x > -1." "x > 0." "x > -2." "x > 1.") advalg: ("Algebra Hint: "),/: advalg cards:: advalg / cardcolors,: (#advalg) # ,"hintcardblue.gif" cards:: genericabs cardformulas:: genericabsformulas ] if[xweb _sm "*Intersection*" / intersection rows: (`A `B `C `C `D `A `B `E `B `C `D `A `C `E `A `B `E) cols: (`A `C `D `B `D `E `A `A `D `E `A `B `C `D `C `E) pair: genvalsintersect[rows;cols] tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["Intersection"; pair[0]; tablecolor] remainingvalues?: / remainingvalues:: parseset[remainingvalues] cards:: genericlogic cardformulas:: genericlogicformulas ] if[xweb _sm "*FractionAdd*" / fraction add rows: ((1 6) (1 4) (1 3) (1 2) (2 3) (3 4)) cols: rows pair: genvalsfracadd[rows; cols] tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["FractionAdd"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues / cards:: pair[1] cards:: advfrac cardformulas:: advfracformulas ] / This one doesn't work yet ??? if[xweb _sm "*FractionPie*" / fraction pie rows: 1+!8 cols: 1+!4 pair: genvalsfracpie[rows; cols] tablecolor: "FF0022" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["FractionPie"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues cards:: pair[1] ] / This one doesn't work yet ??? if[xweb _sm "*Expressin12ths*" / fraction display rows: 1 2 3 cols: 12 3 4 6 pair: genfracpict["Expressin12ths"; rows; cols] tablecolor: "0000FF" tablecolor: "999999" remainingvalues:: () / filled by printtable out,: printtable["Expressin12ths"; pair[0]; tablecolor] remainingvalues?: remainingvalues:: $ remainingvalues cards:: pair[1] ] / final output of cards / printcards["cards.html"; cards; cardcolors] / cards: ("") / cardcolors: (#xx) # ,"-" / y: printcards["cardspies.html"; cards; cardcolors] / Need to set currentcards and currentcardformulas if[xweb _sm "*start*" x: elimcards[fields] ] savestate[mytimestamp] :out } / . "\\runcopy"