rares = c(
  "8217" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "38" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "7544" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "2605" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "313" = list(x=   quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "7599" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "2285" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "7848" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "6662" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "1382" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "4531" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "4975" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "2591" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "7880" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "7458" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "1893" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "7459" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "6288" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "2543" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "2313" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "1104" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "392" = list(x=   quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "7958" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "7252" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "8032" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "2787" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "1176" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "3073" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "9309" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "7535" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "7423" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "8356" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "3255" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "9228" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "1759" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "8994" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "469" = list(x=   quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "4182" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "2638" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "3403" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "1820" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "5139" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "6208" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "4849" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "8951" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "7168" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "6167" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "2096" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "9571" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "6417" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "7942" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "9727" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "4396" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "3159" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "5099" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "5420" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "8572" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "3513" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "1053" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "16" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "4502" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^4))),
  "2295" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^4))),
  "8634" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^4))),
  "3112" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^4))),
  "744" = list(x=   quote(runif(1, -1, 1) * x_i^2 - sin(y_i^4)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^4))),
  "6564" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "6593" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "985" = list(x=   quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "3605" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "7061" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "5753" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "6278" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "4745" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "6726" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "5013" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "5531" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "2513" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "8872" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "5594" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "9891" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "4158" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "5870" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "7910" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "2500" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "5711" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "1677" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "904" = list(x=   quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "3897" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "6660" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "2345" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "7087" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "345" = list(x=   quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "3900" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "6557" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "4358" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "8033" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "3856" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "396" = list(x=   quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "8482" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "5702" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "1516" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "8762" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "3576" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "6987" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "4397" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "5975" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "1042" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "5225" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "2794" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "2589" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "8392" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "8715" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "4401" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "1384" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "894" = list(x=   quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "5738" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "3951" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "5193" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^1 - cos(x_i^4))),
  "3257" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "7350" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "759" = list(x=   quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "6342" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^4))),
  "8926" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^3))),
  "3148" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^1))),
  "2913" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^1))),
  "998" = list(x=   quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "371" = list(x=   quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "3500" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "7312" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "2376" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "8324" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "2169" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "5834" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^0)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^0))),
  "6292" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^0)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^0))),
  "5984" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^0)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^0))),
  "2939" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^1))),
  "173" = list(x=   quote(runif(1, -1, 1) * x_i^3 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^1))),
  "3378" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^1))),
  "1505" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^3))),
  "9728" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^3)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^3))),
  "7116" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^5)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^5))),
  "1757" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - sin(x_i^2))),
  "9907" = list(x=  quote(runif(1, -1, 1) * x_i^4 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^4 - cos(x_i^2))),
  "7238" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "9484" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "2338" = list(x=  quote(runif(1, -1, 1) * x_i^3 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^3 - cos(x_i^2))),
  "2338" = list(x=  quote(runif(1, -1, 1) * x_i^1 - sin(y_i^1)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))),
  "2338" = list(x=  quote(runif(1, -1, 1) * x_i^2 - sin(y_i^2)), y = quote(runif(1, -1, 1) * y_i^2 - cos(x_i^2))))


library(tidyverse)
library(dslabs)
data(heights)

heights %>% ggplot(aes(height, fill = sex)) + geom_density(alpha = 0.5)


#  James Rekow

partition = function(n, numPartitions){

  #  ARGS: n - number to be partitioned
  #        numPartitions - number of pieces into which n is to be partitioned
  #
  #  RETURNS: partitionSizeVec - numeric vector of the unique set of numPartitions numbers with the
  #                              property that the sum of the numbers is n and any two numbers in
  #                              partitionSizeVec differ by at most 1

  #  if the number of partitions is greater than n, set it to n
  numPartitions = min(numPartitions, n)

  #  compute the size of the partitions, ignoring the remainder
  basePartitionSize = floor(n / numPartitions)

  #  compute the number of partition elements that will be one larger than the base partition size
  #  in order to account for the remainder
  remainder = n %% numPartitions

  #  create base partition, ignoring remainder
  partitionSizeVec = rep(basePartitionSize, numPartitions)

  #  increase the size of some elements of the partition by 1 to account for the remainder
  if(remainder > 0){
    partitionSizeVec[1:remainder] = sapply(partitionSizeVec[1:remainder], function(z) z + 1)
  } #  end if

  return(partitionSizeVec)

} #  end partition function


outputmeasures<-function(raim,truemaut){

modelRO1=raim[,1]
modelRO3=raim[,1]+raim[,2]+raim[,3]
modelRO5=raim[,1]+raim[,2]+raim[,3]+raim[,4]+raim[,5]

smodelRO1=sort(modelRO1,decreasing=TRUE,index.return=TRUE)
smodelRO3=sort(modelRO3,decreasing=TRUE,index.return=TRUE)
smodelRO5=sort(modelRO5,decreasing=TRUE,index.return=TRUE)

mautRO=sort(truemaut,decreasing=TRUE,index.return=TRUE)

# record min and max of MAUT utility (to get an idea of how close the best and worst alternatives are)
mautbest=mautRO$x[1]
mautworst=tail(mautRO$x,1)
output=c(mautbest,mautworst)

  for (l in 1:3){
     # assign relevant model rank order measure and calculate correlation between true and model rank orders
     if (l==1){
      modelRO=smodelRO1
      scor=cor(truemaut,modelRO1,method="spearman")
     }
     else if(l==2){
      modelRO=smodelRO3
      scor=cor(truemaut,modelRO3,method="spearman")
     }
     else if (l==3){
      modelRO=smodelRO5
      scor=cor(truemaut,modelRO5,method="spearman")
     }

    # utility loss
    sel=truemaut[modelRO$ix[1]]
    ul=(mautbest-sel)/(mautbest-mautworst)

    # rank of MAUT best in model rank order
    mro4mautbest=match(mautRO$ix[1],modelRO$ix)
    # is MAUT best in in top3 ranks of model rank order?
    if(mro4mautbest<4){mautbestintop3=1}
    else{mautbestintop3=0}
    # is MAUT best in in top5 ranks of model rank order?
    if(mro4mautbest<6){mautbestintop5=1}
    else{mautbestintop5=0}
    # rank of model's best in MAUT rank order
    mautro4modelbest=match(modelRO$ix[1],mautRO$ix)
    # is model best in in top3 ranks of MAUT rank order?
    if(mautro4modelbest<4){modelbestintop3=1}
    else{modelbestintop3=0}
    # is model best in in top5 ranks of MAUT rank order?
    if(mautro4modelbest<6){modelbestintop5=1}
    else{modelbestintop5=0}

    newoutput=c(scor,ul,mro4mautbest,mautbestintop3,mautbestintop5,mautro4modelbest,modelbestintop3,modelbestintop5)
    output=c(output,newoutput)
  }
  output
}


# Chart 1

#p_0 are 0.2, 0.8, 0.4, 0.6, 0.7
#p_0 <- c(1,2,3,4,5) # C(x,y) is a vector to store values. A List that we can iterate over.

# Matrix, values converted to characters
#naming <- c("a", "a", "a", "a", "a")
#cbind(p_0, naming)

#frequencia(geracoes) = (p_0 - p')(1-m)^geracoes

m <- 0.1

p_constant <- 0.5

p_0 <- c(0.1,0.3,0.5,0.7,0.9) # C(x,y) is a vector to store values. A List that we can iterate over.

t <- c(10,20,30,40,50)

#valores <- 1
#b <- c(b, 2)

for (geracao in t) {
	message("Inicio")
	message(t)
	for (i in p_0) {
		message("inner loop")
		message(i)
		resultado <- ( i - p_constant ) * (1 - m) ^ geracao
		valores <- c(valores, resultado)
	}
}
unlist(valores)


## Salidas de funciones

# En esta lección vamos a explorar las diferentes opciones de salida que podemos
# darle a una función, desde un valor sencillo sin ningún detalle hasta salidas
# listadas más complejas.

v <- 15:25  # Vamos a necesitar un objeto 'v' para los ejemplos.

# Salidas simples
# Si recordamos la lección anterior, los objetos definidos dentro del cuerpo de
# una función sólo existen en el instante que dura el ambiente creado durante la
# ejecución de la misma. En la medida en que nos interesa obtener una salida de
# la evaluación de una función, hay que definir qué objetos van a salir de este
# ambiente a la consola, y para ello debemos definir salidas en el cuerpo de la
# función.
# Por defecto, la salida de una función es el resultado de la última evaluación
# contenida en el cuerpo de la misma. Si tomamos como ejemplo la siguiente
# función

f <- function(v) {
  v <- v[!is.na(v)]
  p <- sum(v) / length(v)
  p
}
f(v)

# la salida va a ser el valor de 'p', en este caso el promedio de 'v'.
# El último comando no necesita ser la llamada a un objeto, puede ser una
# operación. Intentemos ver qué pasa si suprimimos la llamada a 'p', y nos que-
# damos sólo con la operación anterior pero sin asignar el resultado.

f <- function(v) {
  v <- v[!is.na(v)]
  sum(v) / length(v)
}
f(v)

# El resultado final es el mismo.
# Veamos ahora qué sucede si asignamos el objeto 'p', pero no lo llamamos al
# final del cuerpo de 'f'.

f <- function(v) {
  v <- v[!is.na(v)]
  p <- sum(v) / length(v)
}
f(v)

# En este caso no hay una salida visible a la consola. Esto no implica que no
# exista una salida, ya que si asignamos la evaluación de la función a un objeto
# en la consola, éste va a ser asignado con esta salida invisible.

a <- f(v)
a

# Una opción que podemos adoptar es interrumpir la ejecución de la función y
# definir con precisión una salida de la misma. Para ello podemos utilizar el
# comando 'return', utilizando como argumento el objeto que queremos en la
# salida.

f <- function(v) {
  v <- v[!is.na(v)]
  p <- sum(v) / length(v)
  if (p > 15) return(15)
  p
}
f(v + 20)

# En este caso, cuando el condicional 'if' es verdadero, la función devuelve el
# valor indicado en este comando, y todo lo que se encuentra posterior al mismo
# no es ejecutado. (El uso de condicionales lo veremos detalladamente en la
# unidad siguiente)

# Otro comando que se puede utilizar es 'invisible', que hace que la salida de
# nuestra función no sea impresa en la consola.

f <- function(v) {
  v <- v[!is.na(v)]
  p <- sum(v) / length(v)
  invisible(p)
}
f(v)

# Esto produce el mismo resultado que la situación en la que el resultado sólo
# era visible si asignábamos la evaluación de la función a un nuevo objeto.

a <- f(v)
a

## Salidas más elaboradas

# A veces las salidas que queremos no se limitan a un vector o matriz, sino que
# necesitamos obtener más de un resultado de nuestra función. La solución más
# sencilla y frecuente es usar listas.

f <- function(v) {
  v <- v[!is.na(v)]
  p <- sum(v) / length(v)
  m <- matrix(rnorm(9, mean = p), 3, 3)
  list(prom = p, matriz = m)
}
f(v)

# Si recordamos de unidades anteriores, en funciones como 'lm', 'summary', etc.,
# se utiliza exactamente este método.

# A modo de cierre y resumen de la presente lección, nos quedan 3 puntos:
# - Definir las salidas es necesario ya que los objetos del ambiente de
#   ejecución de una función no son accesibles desde los ambientes parentales
#   (i.e.: el área de trabajo).
# - En general la salida de una función es la última evaluación del cuerpo de
#   instrucciones, pero esto cambia al usar 'return'.
# - El uso de listas (generalmente nombradas) suele ser una solución útil para
#   obtener salidas elaboradas cuando no nos alcanza con un objeto sencillo.


 DGEESX Example Program Results

 Matrix A
          1       2       3       4
 1   0.3500  0.4500 -0.1400 -0.1700
 2   0.0900  0.0700 -0.5400  0.3500
 3  -0.4400 -0.3300 -0.0300  0.1700
 4   0.2500 -0.3200 -0.1300  0.1100

 Number of eigenvalues for which SELECT is true =    1
 (dimension of invariant subspace)

 Selected eigenvalues
  (  0.7995,  0.0000)


library(tidyquant)
library(tidyverse)
# library(quantmod)
library(scales)
library(readxl)
library(fuzzyjoin)
library(data.table)
library(ggrepel)
library(WDI)

rev_gdp = WDI(country = 'all', indicator = 'GC.REV.XGRT.GD.ZS') %>% filter(country == 'United States')
tax_rev_gdp = WDI(indicator = 'GC.TAX.TOTL.GD.ZS') %>% filter(country == 'United States')
exp_gdp = WDI(country = 'all', indicator = 'GC.XPN.TOTL.GD.ZS') %>% filter(country == 'United States')

combined_stats = left_join(tax_rev_gdp, exp_gdp) %>%
  mutate(
    deficit = GC.TAX.TOTL.GD.ZS - GC.XPN.TOTL.GD.ZS
  )
ggplot(combined_stats, aes(year, deficit)) +
  geom_bar(stat = 'identity')
ggplot(combined_stats, aes(year)) +
  geom_line(aes(y = GC.XPN.TOTL.GD.ZS), colour = 'blue') +
  geom_line(aes(y = GC.TAX.TOTL.GD.ZS), colour = 'black') +
  scale_y_continuous(limits =c(0, 18))

ggplot(combined_stats, aes(year)) +
  geom_line(aes(y = GC.XPN.TOTL.GD.ZS))

setwd('~\\Public_Policy\\Projects\\Taxes vs. Deficits\\data')

##### Get political data #####

  the_url = 'https://www.presidency.ucsb.edu/statistics/data/house-and-senate-concurrence-with-presidents'
  concurrence_table = html_table(GET(the_url) %>% content(), fill = TRUE)

# MIT data lab
house_elections = read.csv('1976-2018-house.csv') %>%
  mutate(candidate_votes = as.numeric(candidatevotes)) %>%
  filter(stage == 'gen') %>% data.table()

senate_elections = read.csv('1976-2018-senate.csv') %>% filter(stage == 'gen') %>% data.table()
presidential_elections = read.csv('1976-2016-president.csv') %>% data.table()

large_text_theme = theme(
  plot.title = element_text(size = 24),
  plot.subtitle = element_text(size = 18, face = 'italic'),
  plot.caption = element_text(size = 13, face = 'italic', hjust = 0),
  axis.text = element_text(size = 16),
  axis.title = element_text(size = 18)
)

setwd("~/Public_Policy/Projects/Presidential Approval/data")
the_sheets = excel_sheets("American Presidency Project - Approval Ratings for POTUS.xlsx")

president_start_dates = tibble(
  President = c('Franklin D. Roosevelt','Harry S. Truman','Dwight D. Eisenhower','John F. Kennedy',
  'Lyndon B. Johnson','Richard Nixon','Gerald R. Ford','Jimmy Carter','Ronald Reagan','George Bush',
  'William J. Clinton','George W. Bush','Barack Obama','Donald Trump'),
  Party = c('Democratic', 'Democratic', 'Republican', 'Democratic', 'Democratic', 'Republican', 'Republican',
            'Democratic', 'Republican', 'Republican', 'Democratic', 'Republican', 'Democratic', 'Republican'),
  start_date = c('1933-03-04', '1945-04-12', '1953-01-20', '1961-01-20',
           '1963-11-22', '1969-01-20', '1974-08-09', '1977-01-20',
           '1981-01-20', '1989-01-20', '1993-01-20', '2001-01-20',
           '2009-01-20', '2017-01-20') %>% as.Date(),
  end_date = lead(start_date, 1) %>% as.Date()
)

date_df = tribble(
  ~date, ~description,
  as.Date('1979-11-04'), 'Iran Hostage Crisis',
  as.Date('1986-11-01'), 'Iran Contra Affair',
  as.Date('1990-08-02'), 'First Gulf War',
  as.Date('2001-09-11'), 'September 11 Attacks',
  as.Date('2008-09-15'), 'Lehman Bankruptcy',
  as.Date('2010-03-23'), 'Obamacare Signed',
  as.Date('2013-01-15'), 'Debt Ceiling Crisis'
)

president_start_dates$end_date[is.na(president_start_dates$end_date)] = as.Date('2021-01-20')
president_start_dates = mutate(president_start_dates,
    n_terms = ifelse(year(end_date) - year(start_date) >= 6, 2, 1)
  )

stacked_presidential_approval = map(the_sheets, function(the_president){
  read_excel("American Presidency Project - Approval Ratings for POTUS.xlsx", the_president) %>%
    mutate(
      End_Date = as.Date(`End Date`),
      President = the_president,
      net_approve = Approving - Disapproving
      ) %>%
    left_join(president_start_dates) %>%
    rename(term_start = start_date, term_end = end_date) %>%
    arrange(End_Date) %>%
    mutate(
      first_term = End_Date <= term_start + years(4),
      delta_net_approve = c(NA, diff(net_approve, 1)),
      period_diff = as.numeric(End_Date - lag(End_Date, 1))
    )

}) %>%
  bind_rows() %>%
  arrange(End_Date) %>%
  mutate(
    year = year(End_Date),
    month = month(End_Date)
  ) %>%
  group_by(
    President, year, month, first_term
  ) %>%
  summarize(
    mean_monthly_approval = mean(Approving, na.rm = T)
  ) %>%
  ungroup() %>%
  mutate(
    month_date = paste(year, month, '01', sep = '-') %>% as.Date()
  ) %>%
  arrange(
    month_date
  )

president_stats = group_by(stacked_presidential_approval, President) %>%
  summarize(
    obs = n(),
    start_date = min(month_date, na.rm = T),
    end_date = max(month_date, na.rm = T),
    min_approval = min(mean_monthly_approval),
    mean_approve = mean(mean_monthly_approval),
    median_approve = median(mean_monthly_approval)
  ) %>%
  ungroup() %>%
  mutate(
    midpoint = as.numeric(end_date - start_date) / 2 + start_date,
    last_name = str_extract(President, '( [a-zA-Z]+)$') %>% str_trim()
  ) %>%
  arrange(
    start_date
  )

president_stats_by_term = group_by(stacked_presidential_approval, President, first_term) %>% summarize(
  obs = n(),
  first_poll_date = min(month_date, na.rm = T),
  last_poll_date = max(month_date, na.rm = T),
  mean_approve = mean(mean_monthly_approval),
  median_approve = median(mean_monthly_approval)
) %>%
  arrange(first_poll_date )

first_term_stats = president_stats_by_term %>% filter(first_term) %>% ungroup() %>% arrange(mean_approve) %>%
  mutate(pres_sorted = factor(President, levels = President))

setwd("~/Public_Policy/Projects/Presidential Approval/output")

ggplot(first_term_stats, aes(pres_sorted, mean_approve / 100)) +
  geom_bar(stat = 'identity', fill = 'steelblue') +
  geom_text(aes(label = percent(mean_approve/100, accuracy = 0.1)), hjust = 1, fontface = 'bold') +
  coord_flip() +
  theme_bw() +
  scale_y_continuous(labels = percent) +
  large_text_theme +
  labs(
    x = '', y = 'Average Monthly Approval Rating',
    title = 'U.S. Presidential Approval Ratings',
    subtitle = 'First Term',
    caption = 'Chart: Taylor G. White\nData: UCSB Presidency Project'
  )
ggsave('first_term_approval.png', height = 10, width = 10, units = 'in', dpi = 600)

stacked_presidential_approval$President = factor(stacked_presidential_approval$President, levels = president_stats$President)

large_text_theme = theme(
  plot.title = element_text(size = 28),
  plot.subtitle = element_text(size = 18, face = 'italic'),
  plot.caption = element_text(size = 13, face = 'italic', hjust = 0),
  axis.text = element_text(size = 16),
  axis.title = element_text(size = 18),
  legend.text = element_text(size = 16),
  legend.title = element_text(size = 18)
)

get_monthly_annual_index_fred = function(symbol) {

  the_dat = getSymbols(symbol, from = 1940, to = 2020, src = 'FRED', auto.assign = F)

  interest_rate_spread_df = tibble(
    date = index(the_dat),
    period_index = as.numeric(the_dat[,symbol])
  ) %>%
    mutate(
      year = year(date),
      month = month(date)
    ) %>%
    arrange(date) %>%
    group_by(year, month) %>%
    summarize(
      last_val = tail(period_index, 1)
    ) %>%
    ungroup()

}

ten_year_interest_rates_df = get_monthly_annual_index_fred('DGS10') %>% rename(ten_year_yield = last_val)
interest_rate_spread_df = get_monthly_annual_index_fred('T10Y2Y') %>% rename(ten_two_spread = last_val)
unemployment_rate_df = get_monthly_annual_index_fred('UNRATE') %>% rename(unemployment_rate = last_val)

# debt_gdp_ratio_df = get_monthly_annual_index_fred('GFDEGDQ188S') %>% rename(debt_to_gdp = last_val)
# annual_deficit_df = get_monthly_annual_index_fred('FYFSD') %>% rename(annual_deficit = last_val)
# annual_gdp_df = get_monthly_annual_index_fred('GDPA') %>% rename(annual_gdp = last_val)

get_quarterly_changes = function(symbol, use_diff = F) {
  # symbol = 'GDPC1'
  the_symbol = getSymbols(symbol, from = 1940, to = 2020, src = 'FRED', auto.assign = F)

  index(the_symbol) = index(the_symbol) - 1 # change the reporting dates to end of period

  the_df = tibble(
    date = index(the_symbol),
    quarterly_index = as.numeric(the_symbol[,symbol])
  ) %>%
    mutate(
      year = year(date),
      month = month(date),
      quarterly_diff = quarterly_index - lag(quarterly_index, 1),
      quarterly_difftime = as.numeric(date - lag(date, 1))
    )

  if (use_diff) {

    annual_diffs = group_by(the_df, year) %>%
      summarize(
        annual_index = quarterly_index[month == max(month, na.rm = T)],
        date = max(date)
      ) %>%
      mutate(
        annual_diff = annual_index - lag(annual_index, 1)
      )
    left_join(the_df, annual_diffs) %>% return()

  } else {
    changes = allReturns(the_symbol)
    bind_cols(the_df, as.data.frame(changes)) %>%
      rename(
        annual_val = yearly,
        quarterly_val = quarterly
      ) %>%
      return()
  }

}

gdp_df = get_quarterly_changes('GDPC1') %>% rename(annual_gdp = annual_val, quarterly_gdp = quarterly_val)
debt_gdp_ratio_df = get_quarterly_changes('GFDEGDQ188S', T) %>%
  rename(
    quarterly_debt_gdp = quarterly_index,
    annual_debt_gdp = annual_index
    )
deficit_gdp_df = get_quarterly_changes('FYFSGDA188S', T) %>%
  rename(
    annual_deficit_gdp = quarterly_index
  ) %>%
  mutate(
    change_annual_deficit = annual_deficit_gdp - lag(annual_deficit_gdp, 1)
  ) %>%
  select(
    date, year, month, annual_deficit_gdp, change_annual_deficit
  )

# annual_deficit_df = get_monthly_annual_index_fred('FYFSD') %>% rename(annual_deficit = last_val)

# gdp = getSymbols('GDPC1', from = 1940, to = 2020, src = 'FRED', auto.assign = F)

# index(gdp) = index(gdp) - 1 # change the reporting dates to end of period
# gdp_changes = allReturns(gdp) %>% as.data.frame()
# gdp_df = tibble(
#   date = index(gdp),
#   quarterly_value = as.numeric(gdp$GDPC1)
# ) %>%
#   bind_cols(
#     gdp_changes
#   ) %>%
#   rename(
#     annual_gdp = yearly,
#     quarterly_gdp = quarterly
#   ) %>%
#   mutate(
#     year = year(date),
#     month = month(date)
#   )

inflation = getSymbols('CPIAUCSL', from = 1940, to = 2020, src = 'FRED', auto.assign = F)

inflation_changes = allReturns(inflation) %>% as.data.frame()
inflation_df = tibble(
  date = index(inflation),
  monthly_index = as.numeric(inflation$CPIAUCSL)
) %>%
  bind_cols(
    inflation_changes
  ) %>%
  rename(
    annual_inflation = yearly,
    monthly_inflation = monthly
  ) %>%
  mutate(
    year = year(date),
    month = month(date)
  )

# annual_inflation = filter(inflation_df, !is.na(yearly)) %>% mutate(year = year(date))
#
# ggplot(annual_inflation, aes(year, yearly)) +
#   geom_bar(stat = 'identity')

get_monthly_symbol_returns = function(symbol, src) {

  the_dat = getSymbols(symbol, auto.assign = F, from = 2000)

  returns = allReturns(the_dat) %>% as.data.frame()
  adjusted_col = names(the_dat)[str_detect(names(the_dat), 'Adjusted')]

  gold_df = tibble(
    date = index(the_dat),
    adjusted_close = as.numeric(the_dat[,adjusted_col])
  ) %>%
    bind_cols(
      returns
    ) %>%
    mutate(
      year = year(date),
      month = month(date)
    ) %>%
    arrange(year, month) %>%
    group_by(
      year, month
    ) %>%
    summarize(
      last_monthly_value = tail(monthly, 1),
      last_yearly_value = tail(yearly, 1),
      last_close_val = tail(adjusted_close, 1)
    )

}

sp500_df = get_monthly_symbol_returns('^GSPC')
gold_df = get_monthly_symbol_returns('IAU')

# get month end returns

financial_statistics_with_presidents = left_join(
  inflation_df %>% select(year, month, annual_inflation, monthly_inflation),
  gold_df %>% select(year, month, annual_gold = last_yearly_value, monthly_gold = last_monthly_value, gold_adjusted_close = last_close_val)
) %>%
  left_join(
    sp500_df %>% select(year, month, annual_sp500 = last_yearly_value, monthly_sp500 = last_monthly_value, sp500_adjusted_close = last_close_val)
  ) %>%
  left_join(gdp_df %>% select(year, month, annual_gdp, quarterly_gdp, quarterly_gdp_value = quarterly_index)) %>%
  left_join(debt_gdp_ratio_df %>% select(year, month, quarterly_debt_gdp, annual_debt_gdp)) %>%
  left_join(deficit_gdp_df %>% select(year, month, annual_deficit_gdp, change_annual_deficit)) %>%
  left_join(interest_rate_spread_df) %>%
  left_join(ten_year_interest_rates_df) %>%
  left_join(unemployment_rate_df) %>%
  filter(
    !is.na(monthly_inflation)
  ) %>%
  mutate(
    month_date = as.Date(paste(year, month, '01', sep = '-')),
    ten_two_spread = ten_two_spread  / 100,
    ten_year_yield = ten_year_yield  / 100
  )  %>%
  fuzzy_left_join(
    president_start_dates, by = c('month_date' = 'start_date', 'month_date' = 'end_date'),
    match_fun = list(`>=`, `<=`)
  ) %>%
  mutate(
    last_name = str_extract(President, '( [a-zA-Z]+)$') %>% str_trim(),
    years_into_presidency = as.numeric(month_date - start_date) / 365
  ) %>%
  arrange(month_date)

financial_statistics_with_presidents_dt = data.table(financial_statistics_with_presidents)
president_indexes = financial_statistics_with_presidents_dt[, {
  # obama_df = financial_statistics_with_presidents_dt[President == 'Barack Obama',]
  # attach(obama_df)
  filled_gdp = na.fill(quarterly_gdp_value, 'extend')
  filled_debt_gdp = na.fill(quarterly_debt_gdp, 'extend')

  list(
    month_date = month_date,
    last_val = month_date == max(month_date),
    month_index = 1:length(month_date) - 1,
    last_month_index = length(month_date) -1,
    gdp_index = filled_gdp / filled_gdp[1],
    debt_to_gdp_added = filled_debt_gdp - filled_debt_gdp[1],
    unemployment_index = unemployment_rate / unemployment_rate[1],
    sp500_index = sp500_adjusted_close / sp500_adjusted_close[1]
  )
  # detach(obama_df)
}, by = list(President, last_name)]

ggplot(financial_statistics_with_presidents_dt, aes(month_date, sp500_adjusted_close, colour = President)) + geom_point()

ggplot(president_indexes %>% filter(year(month_date) >= 1981), aes(month_index, gdp_index - 1, colour = President)) +
  geom_line(size = 1) +
  scale_y_continuous(labels = percent)

##### stock market by president #####
ggplot(president_indexes %>% filter(month_index <= 48, month_date >= as.Date('1981-01-20')), aes(month_index, sp500_index-1, colour = President)) +
  theme_bw() +
  geom_line(size = 1) +
  scale_y_continuous(labels = percent) +
  scale_x_continuous(breaks = seq(0, 50, by = 10)) +
  large_text_theme +
  scale_colour_hue(guide = F) +
  geom_label_repel(
    data = filter(president_indexes, ifelse(last_month_index < 48, last_month_index == month_index, month_index == 48),
                  month_date >= as.Date('1981-01-20')), aes(month_index + 6, label = paste(President, percent(sp500_index-1, accuracy = 1))), show.legend = F) +
  labs(
    x = 'Month of Presidency', y = 'S&P 500 Index Cumulative Return',
    title = 'Stock Market Returns by President',
    subtitle = 'First four years in office',
    caption = 'Chart: Taylor G. White\nData: Yahoo Finance'
  )
ggsave('stock_market_by_president.png', height = 9, width = 12, units = 'in', dpi = 600)

##### debt by president #####

annual_comparison = filter(financial_statistics_with_presidents, !is.na(annual_inflation), month == 12) %>%
  mutate(
    scaled_growth = scale(annual_gdp) %>% as.numeric(),
    scaled_sp500 = scale(annual_sp500) %>% as.numeric()
  )
head(annual_comparison)

library(xgboost)

names(annual_comparison)
the_dat = select(
  annual_comparison,
  change_annual_deficit,
  annual_gdp,
  annual_deficit_gdp,
  year,
  Party,
  years_into_presidency,
  ten_year_yield,
  # ten_two_spread,
  # annual_inflation,
  # annual_sp500
) %>%
  mutate(
    lag_1_annual_gdp = lag(annual_gdp, 1),
    lag_1_annual_deficit_gdp = lag(annual_deficit_gdp, 1)
  ) %>% na.omit()

dim(the_dat)

test_data_predictions = lapply(1:100, function(it){
  train_dat = sample_n(the_dat, 40)
  test_dat = filter(the_dat, !year %in% train_dat$year)

  model_mat = model.matrix(change_annual_deficit ~ annual_gdp + lag_1_annual_gdp +
                             lag_1_annual_deficit_gdp + ten_year_yield + Party + year + years_into_presidency, data = train_dat)

  model_mat_test = model.matrix(change_annual_deficit ~ annual_gdp + lag_1_annual_gdp +
                                  lag_1_annual_deficit_gdp + ten_year_yield  + Party + year + years_into_presidency, data = test_dat)

  boost_mod = xgboost(model_mat, label = train_dat$change_annual_deficit, nrounds = 20)
  test_dat$predictions = predict(boost_mod, newdata = model_mat_test)
  test_dat$it = it
  test_dat
}) %>%
  bind_rows()

combined_preds = group_by(test_data_predictions, year) %>%
  summarize(
    obs = n(),
    mean_pred = mean(predictions),
    actual_val = change_annual_deficit[1]
  )

ggplot(combined_preds, aes(mean_pred, actual_val)) +
  geom_point()

cor(combined_preds$actual_val, combined_preds$mean_pred)

ggplot(combined_preds %>% filter(between(year, 2006, 2020)), aes(year)) +
  geom_bar(aes(y = actual_val), stat = 'identity') +
  geom_point(aes(y = mean_pred), colour = 'red')

group_by(importance_dats, Feature) %>%
  summarize(
    mean_freq = mean(Frequency)
  ) %>%
  arrange(
    -mean_freq
  )

test_dat$predicted_boost = predict(boost_mod, newdata = model_mat_test)

ggplot(test_dat, aes(predicted_boost, change_annual_deficit)) + geom_point()

mod = lm(change_annual_deficit ~ annual_gdp + lag(annual_gdp, 1) + lag(annual_deficit_gdp, 1) + ten_year_yield + Party * years_into_presidency, data = annual_comparison)
summary(mod)

annual_comparison$ten_year_yield
ggplot(annual_comparison, aes(annual_gdp, change_annual_deficit)) +
  geom_point() +
  stat_smooth(method = 'lm')

filter(annual_comparison, !is.na(annual_deficit_gdp)) %>% select(year) %>% tail()

ggplot(annual_comparison, aes(year, annual_deficit_gdp, fill = Party)) +
  geom_bar(stat = 'identity')

ggplot(annual_comparison, aes(year, change_annual_deficit  )) +
  geom_bar(stat = 'identity')
View(annual_comparison %>% select(year, annual_debt_gdp, quarterly_debt_gdp, annual_deficit, quarterly_deficit))

monthly_comparison = filter(joined_inflation_gold_growth) %>%
  mutate(
    scaled_sp500 = scale(monthly_sp500) %>% as.numeric(),
    scaled_gold = scale(monthly_gold) %>% as.numeric(),
    scaled_gold_close = scale(gold_adjusted_close) %>% as.numeric(),
    scaled_ten_two_spread = scale(ten_two_spread) %>% as.numeric(),
    scaled_inflation = scale(monthly_inflation) %>% as.numeric()
  )

blank_df = data.frame(
  description = c('Presidential Approval', 'Real GDP Growth'),
  x = rep(as.Date('1947-01-01'), 2),
  y = 0
)

##### approval vs growth #####
ggplot(stacked_presidential_approval %>% filter(month_date >= as.Date('1947-01-01'))) +
  labs(
    y = 'Scaled Value', x = '', title = 'U.S. Presidential Approval Ratings vs. Economic Growth',
    caption = 'Chart: Taylor G. White\nData: UCSB Presidency Project, St. Louis Federal Reserve\nScaled values represent standard deviations from the mean for both presidential approval and economic growth.'
  ) +
  geom_bar(data = blank_df, aes(x, y, fill = description), stat = 'identity', alpha = 0) +
  guides(fill = guide_legend(override.aes = list(alpha = 1))) +
  scale_fill_manual(values = c('Presidential Approval' = 'steelblue', 'Real GDP Growth' = 'orange'), name = '') +
  theme_minimal() +
  theme(
    legend.position = 'bottom',
    panel.grid.minor = element_blank()
    ) +
  geom_rect(data = president_start_dates %>% filter(end_date   >= as.Date('1947-01-01')),
            aes(xmin = start_date, xmax = end_date, ymin = -3.5, ymax = 3.5), size = 0.5, alpha = 0.10, show.legend = F, colour = 'black') +
  geom_text(data = president_stats %>% filter(end_date >= as.Date('1947-01-01')), aes(x = midpoint, y = -2.75,
                                                                                label = paste0(last_name, '\n', sprintf('(%s)', percent(mean_approve /100, accuracy = 1)))), fontface = 'bold') +
  scale_colour_hue(guide = F) +
  scale_y_continuous(breaks = seq(-3, 3, by = 1)) +
  scale_x_date(date_breaks = '4 years', date_labels = '%Y') +
  geom_hline(aes(yintercept = 0)) +
  # geom_bar(data = annual_comparison %>% filter(month_date >= as.Date('1947-01-01'), year < 2020), aes(month_date, scaled_growth), stat = 'identity', fill = 'orange', alpha = 0.5, colour = 'black') +

  geom_point(aes( month_date, scale(mean_monthly_approval )), colour = 'steelblue') +
  geom_line(data = annual_comparison %>% filter(month_date >= as.Date('1947-01-01'), year < 2020), aes(month_date, scaled_growth), size = 0.75, colour = 'orange') +
  geom_point(data = annual_comparison %>% filter(month_date >= as.Date('1947-01-01'), year < 2020), aes(month_date, scaled_growth), size = 1, colour = 'orange') +
  # stat_smooth(aes(colour = NA), span = .1) +

  large_text_theme
  # geom_vline(data = date_df, aes(xintercept = date)) +
  # geom_text(data = date_df, aes(x = date, y = 2, label = description, angle = 90), vjust = 0, hjust = 0, fontface = 'bold')

ggsave('presidential_approval_timeline.png', height = 10, width = 20, units = 'in', dpi = 600)
getwd()

head(stacked_presidential_approval)
filter(stacked_presidential_approval, President == 'Jimmy Carter')

ggplot(monthly_comparison, aes(month_date, scaled_gold_close)) +
  theme_bw() +
  geom_line(colour = 'gold', size = 1) +
  geom_line(aes(y = scaled_ten_two_spread), colour = 'steelblue', size = 1)

ggplot(annual_comparison, aes(annual_inflation, annual_sp500)) +
  geom_point()

ggplot(annual_comparison, aes(annual_gdp, annual_sp500)) +
  geom_point() +
  stat_smooth(method = 'lm') +
  theme_bw() +
  scale_x_continuous(labels = percent, limits = c(-0.04, 0.065)) +
  scale_y_continuous(labels = percent, breaks = seq(-0.4, 0.3, by = 0.1)) +
  large_text_theme +
  labs(
    x = '\nReal Annual GDP Growth', y = 'Annual SP500 Market Return\n'
  )

ggsave('economic_growth_vs_stock_market.png', height = 10, width = 10, units = 'in', dpi = 400)

ggplot(monthly_comparison, aes(scaled_ten_two_spread, scaled_gold)) +
  geom_point()

ggplot(annual_comparison, aes(ten_year_yield, annual_gold)) +
  geom_point()

ggplot(annual_comparison, aes(annual_inflation, annual_gold)) +
  geom_point()

ggplot(annual_comparison, aes(annual_inflation, ten_year_yield)) +
  geom_point() +
  # stat_smooth() +
  stat_smooth(method = 'lm') +
  scale_y_continuous(labels = percent, breaks = seq(0, 0.15, by = 0.025)) +
  scale_x_continuous(labels = percent, breaks = seq(0, 0.13, by = 0.025)) +
  labs(
    x = '\nAnnual Inflation\nConsumer Price Index for All Urban Consumers',
    y = '10 Year Treasury Bond Yield\n',
    caption = 'Chart: Taylor G. White\nData: St. Louis Federal Reserve'
  ) +
  theme_bw() +
  large_text_theme +
  coord_cartesian(xlim = c(0, 0.13), ylim = c(0, 0.15))

ggsave('inflation_vs_10yr_yield.png', height = 10, width = 10, units = 'in', dpi = 450)


"Runs the hypothesis test for the dataset and computes the p-value, test statistic and plots the null-distribution.
Saves results into rds files for references in the final repoer.
Usage: src/hypothesis_test.r --processed_data_path=<processed_data_path> --results_dir_path=<results_path>

Options:
--processed_data_path=<processed_data_path>             Path to the processed data including the file name and extension to raw data
--results_dir_path=<results_dir_path>                   Path to where the results should be written.
" -> doc

library(tidyverse)
library(testthat)
library(infer)
library(knitr)
library(docopt)
opt <- docopt(doc)

test_input <- function(data_path) {
  #' tests whether the input file exists
  #'
  #' @param data_path path of the input data file
  #' @export
  #'
  #' @examples
  #' test_input("./data_file.csv")
  expect_true(
    file.exists(data_path),
    paste(data_path, "does not exist.")
  )
}

test_output <- function(dir_path) {
    #' tests whether all expected output files exist
    #' We expect p_value.rds, null_distribution.rds,
    #' ci_95.rds, and diff_medians.rds files.
    #'
    #' @param dir_path directory path where all the output files exist.
    #' @export
    #'
    #' @examples
    #' test_output("./data_folder")

  # ensure we have files to save our figures and variables for reference
  p_value_file <- paste(dir_path, "/p_value.rds", sep = "")
  expect_true(
    file.exists(p_value_file),
    paste(p_value_file, "does not exist.")
  )

  null_distribution_file <- paste(dir_path, "/null_distribution.rds", sep = "")
  expect_true(
    file.exists(null_distribution_file),
    paste(null_distribution_file, "does not exist.")
  )

  ci_95_file <- paste(dir_path, "/ci_95.rds", sep = "")
  expect_true(
    file.exists(ci_95_file),
    paste(ci_95_file, "does not exist.")
  )

  diff_means_file <- paste(dir_path, "/diff_medians.rds", sep = "")
  expect_true(
    file.exists(diff_means_file),
    paste(diff_means_file, "does not exist.")
  )
}

main <- function(processed_data_path, results_dir_path) {
  test_input(processed_data_path)

  # read data
  processed_offender <- read_csv(processed_data_path)[, 2:3]
  processed_offender <- processed_offender |>
    mutate(race_grouping = as.factor(race_grouping))

  # get difference in medians as the test statistic
  diff_medians <- processed_offender |>
    specify(formula = aggregate_sentence_length ~ race_grouping) |>
    calculate(stat = "diff in medians",
              order = c("Indigenous", "Non Indigenous"))

  # null distribution by permutation test
  # don't change the seed for reproducibility purposes
  set.seed(2021)
  null_distribution <- processed_offender |>
    specify(formula = aggregate_sentence_length ~ race_grouping) |>
    hypothesize(null = "independence") |>
    generate(reps = 5000, type = "permute") |>
    calculate(stat = "diff in medians",
              order = c("Indigenous", "Non Indigenous"))

  # 95% confidence interval of the null distribution
  ci_95 <- null_distribution |>
    get_confidence_interval(level = 0.95, type = "percentile")

  # plot of null distribution
  null_distribution_plot <- null_distribution |>
    visualize() +
    geom_vline(xintercept = diff_medians$stat, color = "red") +
    shade_confidence_interval(endpoints = ci_95, alpha = 0.2) +
    labs(
        x = "Difference in medians of indigenous vs. non indigenous offenders",
        y = "Count"
    ) + theme_bw() +
    annotate("text", x=-75, y=750, color="Red", label= "Observed difference in medians")

  p_value <- null_distribution |>
    get_pvalue(obs_stat = diff_medians, direction = "two_sided")

  # save created variables and figures for reference in the report file
  saveRDS(p_value, paste(results_dir_path, "/p_value.rds", sep = ""))
  saveRDS(null_distribution_plot, paste(results_dir_path, "/null_distribution.rds", sep = ""))
  saveRDS(ci_95, paste(results_dir_path, "/ci_95.rds", sep = ""))
  saveRDS(diff_medians, paste(results_dir_path, "/diff_medians.rds", sep = ""))
  test_output(results_dir_path)
}

main(opt[["--processed_data_path"]], opt[["--results_dir_path"]])


## From tormodb https://github.com/harrelfe/Hmisc/issues/61

require(Hmisc)
src <- example(summaryM, give.lines=TRUE)
eval(parse(text=src[1:34]))
# xless(f)    # see built-in cat. test

catTestchisq.sim_p <- function(tab) {
    st <- if (! is.matrix(tab) || nrow(tab) < 2 || ncol(tab) <  2)
        list(p.value = NA, statistic = NA, parameter = NA)
    else {
        rowcounts <- tab %*% rep(1, ncol(tab))
        tab <- tab[rowcounts > 0, ]
        if (! is.matrix(tab))
            list(p.value = NA, statistic = NA, parameter = NA)
        else chisq.test(tab, correct = FALSE, simulate.p.value = TRUE)
    }
    list(P            = st$p.value,
         stat         = st$statistic,
         df           = (nrow(tab) - 1) * (ncol(tab) - 1),   # st$parameter NA
         testname     = "Pearson",
         namefun      = 'chisq',     # must add this line for Hmisc_4.0
         statname     = "Chi-square",
         latexstat    = "\\chi^{2}_{df}",
         plotmathstat = "chi[df]^2")
}

f <- summaryM(age + sex + sbp + Symptoms ~ treatment, test=TRUE,
              catTest = catTestchisq.sim_p)
f


#' Mean difference test (t-test) for local random approach
#'
#' @param basemod baseline formula. `outcome ~ running variable`.
#' @param data data.frame which you want to use.
#' @param bootse numeric.
#'   Generate N averages of bootstrap samples and
#'   use the standard deviation as the standard error of the average.
#'   If missing, standard error of mean is calculated by
#'   sqrt(v / e) where v is unbiased variance of outcome,
#'   and e is effective sample size: e = sum(w) ^ 2 / sum(w ^ 2).
#'   If w is missing, we set w = 1, and obtain e = 1 / n.
#'   standard error of mean difference is obtained by
#'   sqrt((v1 / e1) + (v0 / e0))
#' @param bootp numeric.
#'   Perform a permutation test with N re-randomizations.
#'   The p-value is obtained at a rate
#'   where the absolute value of the mean difference
#'   due to rerandomization is greater than
#'   the absolute value of the observed mean difference.
#'   If missing, standard t-test is performed.
#'
#' @importFrom rlang f_lhs
#' @importFrom rlang eval_tidy
#' @importFrom stats var
#' @importFrom stats pt
#' @examples
#' \dontrun{
#' running <- sample(1:100, size = 1000, replace = TRUE)
#' cov1 <- rnorm(1000, sd = 2); cov2 <- rnorm(1000, mean = -1)
#' y0 <- running + cov1 + cov2 + rnorm(1000, sd = 10)
#' y1 <- 2 + 1.5 * running + cov1 + cov2 + rnorm(1000, sd = 10)
#' y <- ifelse(running <= 50, y1, y0)
#' bin <- ifelse(y > mean(y), 1, 0)
#' w <- sample(c(1, 0.5), size = 1000, replace = TRUE)
#' raw <- data.frame(y, bin, running, cov1, cov2, w)
#'
#' set_optDiscRD(discRD.cutoff = 50, discRD.assign = "smaller")
#' useit <- clean_rd_data(y ~ running, data = raw)
#' str(local_random_test_int(y ~ running, useit$data))
#' str(local_random_test_int(y ~ running, useit$data, bootse = 100))
#' str(local_random_test_int(y ~ running, useit$data, bootp = 100))
#' }
#'
local_random_test_int <- function(basemod,
                                  data,
                                  bootse,
                                  bootp) {
  # create weights if null
  if (is.null(data$"(weights)")) data$"(weights)" <- 1

  # treated and control data
  d1 <- data$d == 1
  n1 <- sum(d1)
  n0 <- sum(!d1)

  yvar <- rlang::f_lhs(basemod)
  y1 <- rlang::eval_tidy(yvar, data[d1, ])
  y0 <- rlang::eval_tidy(yvar, data[!d1, ])

  w1 <- data[d1, "(weights)"]
  w0 <- data[!d1, "(weights)"]

  # average and mean difference
  ymu1 <- mean(y1 * w1) / mean(w1)
  ymu0 <- mean(y0 * w0) / mean(w0)
  diff_mu <- ymu1 - ymu0

  # create output list
  out <- list()
  out$outcome <- as.character(yvar)
  out$observe$treat$N <- n1
  out$observe$treat$mean <- ymu1
  out$observe$control$N <- n0
  out$observe$control$mean <- ymu0
  out$local.ate$estimate <- diff_mu

  # standard errors
  if (missing(bootse)) {
    effective_size_1 <- sum(w1)^2 / sum(w1^2)
    effective_size_0 <- sum(w0)^2 / sum(w0^2)

    yse1 <- var(y1) / effective_size_1
    yse0 <- var(y0) / effective_size_0
    mean_se <- sqrt(yse1 + yse0)
  } else {
    yse1 <- bootstrap(y1, w1, bootse)$boot$se
    yse0 <- bootstrap(y0, w0, bootse)$boot$se
    mean_se <- sqrt(yse1 + yse0)
  }

  out$observe$treat$se <- yse1
  out$observe$control$se <- yse0
  out$local.ate$se <- mean_se

  # two-sided test or permutation test
  if (missing(bootp)) {
    dfval <- n1 + n0 - 2
    tval <- abs(diff_mu) / mean_se
    pval <- 2 * pt(tval, df = dfval, lower.tail = FALSE)

    out$local.ate$df <- dfval
    out$local.ate$t <- tval
    out$local.ate$p.value <- pval
    out$local.ate$method <- "Two-sided t-test"
  } else {
    y <- rlang::eval_tidy(yvar, data)
    d <- data$d
    w <- data$"(weights)"

    perm <- permutation(y, d, w, bootp)

    out$local.ate$p.value <- perm$ate$p.value
    out$local.ate$method <- perm$ate$method
  }

  out
}

#'
#' Perform Local Randomization Approach
#'
#' @description An analysis of the difference between
#'   the means of the two groups is performed
#'   under the assumption that
#'   the treatment assignments are random near the cutoff (local random).
#'   Statistical inference has a permutation test for small sample sizes
#'   in addition to the standard t-test.
#'
#' @param basemod baseline formula. `outcome ~ running variable`.
#' @param data data.frame which you want to use.
#' @param weights weight variable.
#' @param submod numeric vector.
#'   Which baseline model you want to use.
#' @param subset subset condition.
#' @param bw numeric vector of bandwidth.
#'   If specified, use data
#'   whose running variables are within this range will be used.
#'   If missing, use data from treatment and control groups
#'   where the running variable is closest to the cutoff
#' @param global logical (default is FALSE).
#'   Whether to use all observations.
#' @param bootse numeric.
#'   Generate N averages of bootstrap samples and
#'   use the standard deviation as the standard error of the average.
#'   If missing, standard error of mean is calculated by
#'   sqrt(v / e) where v is unbiased variance of outcome,
#'   and e is effective sample size: e = sum(w) ^ 2 / sum(w ^ 2).
#'   If w is missing, we set w = 1, and obtain e = 1 / n.
#'   standard error of mean difference is obtained by
#'   sqrt((v1 / e1) + (v0 / e0))
#' @param bootp numeric.
#'   Perform a permutation test with N re-randomization.
#'   The p-value is obtained at a rate
#'   where the absolute value of the mean difference
#'   due to re-randomization is greater than
#'   the absolute value of the observed mean difference.
#'   If missing, standard t-test is performed.
#' @param cutoff numeric of cutoff points
#'   If missing, try to find `getOption("discRD.cutoff")`.
#' @param assign assignment rule of treatment.
#'   If "greater",
#'   treated whose running variable is greater than or equal to cutoff.
#'   If "smaller",
#'   treated whose running variable is less than or equal to cutoff.
#'   If missing, try to find `getOption("discRD.assign")`.
#'
#' @export
#' @examples
#' running <- sample(1:100, size = 1000, replace = TRUE)
#' cov1 <- rnorm(1000, sd = 2); cov2 <- rnorm(1000, mean = -1)
#' y0 <- running + cov1 + cov2 + rnorm(1000, sd = 10)
#' y1 <- 2 + 1.5 * running + cov1 + cov2 + rnorm(1000, sd = 10)
#' y <- ifelse(running <= 50, y1, y0)
#' bin <- ifelse(y > mean(y), 1, 0)
#' w <- sample(c(1, 0.5), size = 1000, replace = TRUE)
#' raw <- data.frame(y, bin, running, cov1, cov2, w)
#'
#' set_optDiscRD(
#'   y + bin ~ running,
#'   discRD.cutoff = 50,
#'   discRD.assign = "smaller"
#' )
#'
#' est1 <- local_random_test(data = raw, weights = w, global = TRUE)
#' str(est1)
#' est2 <- local_random_test(data = raw, bootp = 1000, submod = 1)
#' str(est2)
#'
local_random_test <- function(basemod,
                              data,
                              weights,
                              submod,
                              subset,
                              bw,
                              global = FALSE,
                              bootse,
                              bootp,
                              cutoff,
                              assign) {
  # check basemod
  if (missing(basemod)) basemod <- getOption("discRD.basemod")
  if (!is.list(basemod)) basemod <- list(basemod)
  if (length(basemod) == 0) stop("Baseline model not found")
  if (missing(submod)) submod <- seq_len(length(basemod))
  usemod <- basemod[submod]

  # check arguments for cleaning data
  dtarg <- rlang::enquos(
    weights = weights,
    subset = subset
  )
  dtarg <- Filter(Negate(rlang::quo_is_missing), dtarg)
  dtarg$data <- data
  if (!missing(cutoff)) dtarg$cutoff <- cutoff
  if (!missing(assign)) dtarg$assign <- assign
  if (!missing(global)) dtarg$global <- global
  if (!missing(bw)) dtarg$bw <- bw

  # check arguments for test
  estarg <- list()
  if (!missing(bootse)) estarg$bootse <- bootse
  if (!missing(bootp)) estarg$bootp <- bootp

  # run test
  est <- lapply(usemod, function(m) {
    # cleaning data
    dtarg$basemod <- m
    clean <- do.call("clean_rd_data", dtarg)

    # temporal output
    temp <- list()
    temp$RD.info <- clean$RD.info
    temp$bandwidth <- clean$bw.subset

    # run t-test / permutation test
    estarg$basemod <- m
    estarg$data <- clean$data
    temp$estimate <- do.call("local_random_test_int", estarg)

    # output
    class(temp) <- "local_random"
    temp
  })

  # final output
  class(est) <- append("list_local_random", class(est))
  est
}


#  Plotting and computing Box Cox transformation

# using the judges data as an example
judges <- read.table('c:/philip/stat500/data/judges.txt',as.is=T,header=T)

# calculate the mean for each group
#  syntax for tapply is Y variable, grouping variable, function to apply to each group

jmean <- tapply(judges$percent,judges$judge,mean)

# repeat to get sd for each group
jsd <- tapply(judges$percent,judges$judge,sd)

# plot them, using a log scale for X and Y
plot(jmean,jsd,log='xy')

# calculate the regression slope
lm(log(jsd) ~ log(jmean))

RFrontEndSolution/Tests Repo/Rscripts All (163 files)/boxcox.r


# fill in median value into NA
fill.na <- function(df, n = 0) {
  dimm <- dim(df)
  for (i in 1:dimm[1]) {
    nun_na <- df[i, !is.na(df[i, ])]
    median_r <- median(as.numeric(nun_na[2:length(nun_na)]))
    df[i, is.na(df[i, ])] <- median_r
  }
  return(df)
}
fill.na2 <- function(df, n = 0) {
  dimm <- dim(df)
  for (i in 1:dimm[2]) {
    nun_na <- df[!is.na(df[, i]), i]
    median_r <- median(as.numeric(nun_na[2:length(nun_na)]))
    df[is.na(df[, i]), i] <- median_r
  }
  return(df)
}

# Z-score normalization
Zscore <- function(x) {
  y <- (x - mean(x)) / sd(x)
  return(y)
}

# delete NAs
del.na <- function(x) {
  y <- x[!is.na(x)]
  return(y)
}

# cut data into bins
cutbin <- function(x, nbins) {
  if (require(ggplot2)) {
    labs <- levels(cut_number(x, nbins))
    options(warn = -1) # turning off warning messages globally
    bins <- c(as.numeric(sub("\\((.+),.*", "\\1", labs)), as.numeric(sub("[^,]*,([^]]*)\\]", "\\1", labs)))
    bins <- unique(bins)
    bins[1] <- min(x)
    options(warn = 0) # turning on warning messages
    return(bins)
  }
}

# show color panel
showpanel <- function(col) {
  image(z = matrix(1:100, ncol = 1), col = col, xaxt = "n", yaxt = "n")
}

rename_Matrix <- function(x) {
  cols <- colnames(x)
  newnames <- c()
  for (i in cols) {
    y <- unlist(strsplit(i, "\\."))[1]
    newnames <- c(newnames, unlist(strsplit(y, "\\_"))[1])
  }
  colnames(x) <- newnames
  return(x)
}
showpanel <- function(col) {
  image(z = matrix(1:100, ncol = 1), col = col, xaxt = "n", yaxt = "n")
}

# boxplot with jitters:
BoxJetter <- function(vec1, vec2, lable_vec1, label_vec2, my.bg) {
  y <- c(rep(lable_vec1, length(vec1)), rep(label_vec2, length(vec2)))
  y <- ordered(y, c(lable_vec1, label_vec2))
  x <- c(vec1, vec2)
  boxplot(x ~ y, border = 4, col = "light grey", boxwex = 0.5)
  points(jitter(c(rep(1, length(vec1)), rep(2, length(vec2))), 0.7),
    c(vec1, vec2),
    col = my.bg, cex = 2, pch = 19
  )
  p.value <- wilcox.test(vec1, vec2)
  return(p.value)
}


rm(list=ls())

# load the library
library(AppliedPredictiveModeling) # Abalone data set
library(caret) # Machine Learning library
library(mlbench) # Soybean data set

# Data Wrangling in R
setwd('...')

# The dataset we will be using today... abalone
data(abalone)
dim(abalone)
head(abalone)

# Set to data
data <- abalone
str(data)
# One Hot Encoding
dummy <- dummyVars("~.", data = data)
newdata <- data.frame(predict(dummy, newdata = data))
View(newdata)
str(newdata)

# Let's check out the apply family.
# Maybe I want everything to be an integer? How would I go about doing this?
# apply(X, MARGIN, FUN, ...)
str(data) # (Going back to the original dataset)
d <- data[,2:dim(data)[2]] # Remove the first column
str(d)

?apply
# Returns an array of attributes.
apply(d, MARGIN = 2, FUN = sum) # Switch to MARGIN = 1 compare the sums of rows;

?lapply
# Returns a list (dataframe)
lapply(d, MARGIN = 2, FUN = sum)

?sapply
# A wrapper function of lapply -- only difference is that sapply tries tries
# to simplify the elements to its most basic structure. If simplify = FALSE,
# you get the same output as lapply.
sapply(d, MARGIN = 2, FUN = sum, simplify = TRUE)

?mapply
# This is a multivariate version of sapply
# mapply(FUN, data, # of times you call function on the data)
mapply(rep,1:4, 3)

# Add, Remove and place features in to a dataset
library(dplyr)
str(data) # Let's work with this dataset.
# %>% this is a pipe operator. You are running a function on an object.
# This return a resulting object. You can therefore stack many operators on
# eachother.

# For instance, let's select 1 column.
data %>%
  select(Type)

# 2 columns? Run a head function?
data %>%
  select(Type, LongestShell) %>%
  head()

# Let's attempt to subset data. Let's get all the rows that have only 'M' in Type.
data %>%
  filter(Type == "M")

# Maybe you'd want to start plotting?
data %>%
  select(LongestShell, Diameter) %>%
  plot()

# How but if we only want the type whose Diameter > 0.3? Similar concept.
# How but less than 10 rings? Use the | and & operator
data %>%
  filter(Type == "M" & Diameter > 0.3 & Rings < 10)
# How but if I want part of a key word? (or parts of a number?)
# Let's use Soybean dataset.
data("Soybean")
str(Soybean)
Soybean$Class

Soybean %>%
  filter(grepl("frog", Class))
# How but if I don't want 'frog' inside of my rows?

Soybean %>%
  filter(!grepl("frog", Class))

# Let's go back to the original 'data'.. How would I sort by a feature?
str(data)
data %>%
  arrange(Rings)

# Let's start creating variables.
library(lubridate)
str(data)
data %>%
  mutate(Rings_Times_Height = Rings * Diameter) %>%
  head()
# Create more than 1 column? No problem.

data %>%
  mutate(Rings_Times_Height = Rings * Diameter,
         round_whole_height = round(WholeWeight)) %>%
  head()

# Maybe you'd want to create a column that has very specific conditions based on
# other columns? No worries. We can have an ifelse statement in one line.
data %>%
  mutate(Old = ifelse(Rings > 10, "Old", "Young")) # True, False

# Maybe you are doing some data analyst work and you want to generate some quick
# statistics. This can be done real easy via the pipes operator.

data %>%
  group_by(Type) %>%
  summarise(average_rings_by_type = mean(Rings, na.rm = TRUE),
            sum_rings_by_type = sum(Rings, na.rm=TRUE)) # If there is any NA? You can ignore.


rm(list = ls()) #cleaning up
library(utils)
library(tidyverse)

gender_data <- as.tibble(read.csv("olken.csv"))

ggplot(gender_data, aes(x=head_edu, color=factor(treat_invite))) +
  geom_density()

ggplot(gender_data, aes(x=mosques, color=factor(treat_invite))) +
  geom_density()

ggplot(gender_data, aes(x=pct_poor, color=factor(treat_invite))) +
  geom_density()

ggplot(gender_data, aes(x=total_budget, color=factor(treat_invite))) +
  geom_density()

###########
ggplot(gender_data, aes(x=pct_missing, color=factor(treat_invite))) +
  geom_density()

#sample means
tmean_missing <- mean(gender_data$pct_missing[gender_data$treat_invite==1])
cmean_missing <- mean(gender_data$pct_missing[gender_data$treat_invite==0])

avg_treatment_effect <- tmean_missing - cmean_missing

#######
tsize = length(gender_data$pct_missing[gender_data$treat_invite==1])
csize = length(gender_data$pct_missing[gender_data$treat_invite==0])
#sample variances
tvar_missing = var(gender_data$pct_missing[gender_data$treat_invite==1])
cvar_missing = var(gender_data$pct_missing[gender_data$treat_invite==0])

std_err_neyman = sqrt( tvar_missing/tsize + cvar_missing/csize )

##### t-statistic ######
t = avg_treatment_effect / std_err_neyman

###### p-value #########
p_value = 2 * pnorm(abs(t), lower.tail = FALSE)


#!/usr/bin/env Rscript

# FLYCOP
# Author: Beatriz García-Jiménez
# April 2018

suppressMessages(library(car))
suppressMessages(library(ellipse))
suppressMessages(library(RColorBrewer))

args = commandArgs(trailingOnly=TRUE)
if (length(args)<3) {
  stop("At least 3 arguments must be supplied: <domainName (string)> <experimentID (number)> <fitnessID (string)>", call.=FALSE)
} else {
  domainName=args[1]
  id=args[2]
  fitnessID=args[3]
}

# cleaning
suffix=paste("Scenario",id,sep="")
setwd(paste(domainName,'_scenario',id,'_FLYCOPdataAnalysis',sep=""))

my_colors <- brewer.pal(11, "RdYlBu")
my_colors=colorRampPalette(my_colors)(25)
data=read.csv('tableParamWithFitness.csv',sep='\t',header=TRUE)
formula=formula(paste("~",paste(colnames(data),collapse="+"),sep=""))

header=paste(suffix,", Fitness=",fitnessID,sep="")
# correlation ellipse plot
corrMatrix<-cor(data)
pdf(paste('correlationEllipsePlot_',suffix,".pdf",sep=""),title=header)
plotcorr(corrMatrix, col=my_colors[corrMatrix*15+15], type="lower", mar=c(1,1,1,1), main=paste("Correlation plot.",suffix))
invisible(dev.off())
write.table(corrMatrix,paste('corrMatrix_',suffix,".txt",sep=""),quote=FALSE,sep="\t")

# Scatterplot, with lower diagonal with correlations:
panel.cor <- function(x, y, digits = 3, prefix = "", cex.cor=1, ...) # from help(pairs) # Only correlation, with modifications from below code
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  # correlation coefficient
  r <- cor(x,y)
  txt <- format(c(r, 0.123456789), digits = digits)[1]
  txt <- paste("r= ", txt, sep = "")
  text(0.5, 0.6, txt, cex=1)
}
pdf(paste('scatterplotMatrix_',suffix,"_withCorr.pdf",sep=""),title=header)
scatterplotMatrix(formula, data=data, smooth=list(smoother=""),lower.panel=panel.cor,main=header)
invisible(dev.off())

# Removing not stable configurations
# To retrieve standard deviation values:
tableSd=read.table('avgfitnessAndStdev.txt',sep=",",header=FALSE,row.names=NULL)
colnames(tableSd)=c('mean','sd')
pdf(paste('fitnessVsSd_',suffix,'.pdf',sep=""))
plot(tableSd,main=paste("Correlation plot.",suffix))
invisible(dev.off())
pdf(paste('fitnessVsSd_',suffix,'sdLt0.1.pdf',sep=""))
plot(tableSd[tableSd$sd<0.1,],main=paste("Correlation plot",suffix,'sd<0.1',sep=", "))
invisible(dev.off())
data$sd=tableSd$sd
data <- subset(data,select=c(1:(length(data)-2),sd,fitness))
dataSorted <- data [with(data, order(-fitness)), ]
write.table(dataSorted,paste('dataTable_',suffix,".txt",sep=""),quote=FALSE,sep="\t",row.names=TRUE, col.names=TRUE)
data_sdLt0.1=data[data$sd<0.1,]
pdf(paste('scatterplotMatrix_',suffix,'sdLt0.1.pdf',sep=""),title=paste(header,'sd<0.1',sep=', '))
scatterplotMatrix(formula,data=data_sdLt0.1, smooth=list(smoother=""),main=paste(header,'sd<0.1',sep=', '))
invisible(dev.off())

corrMatrix<-cor(data_sdLt0.1)
pdf(paste('correlationEllipsePlot_',suffix,'sdLt0.1.pdf',sep=""),title=paste(header,'sd<0.1',sep=', '))
plotcorr(corrMatrix, col=my_colors[corrMatrix*15+15], type="lower", mar=c(1,1,1,1), main=paste(header,'sd<0.1',sep=', '))
invisible(dev.off())

sink(paste('corrMatrices_',suffix,'.txt',sep=''))
print('All configurations:')
print(dim(data)[1])
cor(data)
print('Sd<0.1:')
print(dim(data_sdLt0.1)[1])
cor(data_sdLt0.1)
sink()


#Script to run Metropolis-Hastings sampling for various problem sizes and numbers of cores

#Load the parallel package
library(parallel)

#problem size (number of points)
n.pts <- 1e7
#cluster size (number of cores)
ncores <- 16

tm.tot.st = Sys.time()

n.pts.cl <- ceiling(n.pts / ncores)  # Strong scaling
cat('running parallel version with n.pts = ',n.pts,' and ncores = ',ncores,' (',n.pts.cl,' pts per core) \n')

tm.comp.st = Sys.time()

#Load the function to calculate pi
source('mcpi.r')

#call mcpi in parallel
n.pts.cl = rep(n.pts.cl,ncores) #array of inputs to mcpi
pi.approx = mean( unlist( mclapply(n.pts.cl, mcpi, mc.cores=ncores) ) )

tm.comp = as.numeric(Sys.time() - tm.comp.st, units="secs")

cat('     pi estimate = ',pi.approx,'\n')

pi.err = abs(pi - pi.approx)/pi
cat('  relative error = ',pi.err,'\n')

tm.tot = as.numeric(Sys.time() - tm.tot.st, units="secs")
cat('  computational time = ',tm.comp,'\n')
cat('          total time = ',tm.tot,'\n')


# .hlpr_get_stats ----
.hlpr_get_stats <- function(input) {
  out <- c(
    class(input),
    length(input),
    sd(input),
    min(input),
    quantile(input, 0.25),
    mean(input),
    median(input),
    quantile(input, 0.75),
    max(input)
  )
  return(out)
}


#loading libraries
library (ISLR )
library(caret)
library(dplyr)

#reading the file
df <- read.csv("/Users/rajivranjan/Desktop/slump.csv", header=TRUE)
df<-select(df, Cement,Slag,Fly.ash,Water,SP,Coarse.Aggr.,Fine.Aggr.,FLOW.cm.)

#randomly selecting 85 values
smp_size <- floor(0.83 * nrow(df))
set.seed(123)
train_ind <- sample(seq_len(nrow(df)), size = smp_size)

#selecting test and train values
train <- df[train_ind, ]
test <- df[-train_ind, ]

#creating a model of  degree 1
Control1<-trainControl(method = "repeatedcv",repeats = 5)
LmFit<-train(FLOW.cm. ~ ., data = train, method = "lm",trControl = Control1, metric="Rsquared")
PredictedTest<-predict(LmFit,test)
ModelTest<-data.frame(obs = test$FLOW.cm., pred=PredictedTest)
defaultSummary(ModelTest)
plot(test$FLOW.cm.,PredictedTest,xlab="actual",ylab="predicted",col = "red")

#creating a model of plynomial degree 2
LmFit2<- lm(FLOW.cm. ~ poly(Cement, degree=2, raw=TRUE) +
     poly(Slag, degree=2, raw=TRUE) +
     poly(Fly.ash, degree=2, raw=TRUE) +
     poly(Water, degree=2, raw=TRUE) +
     poly(SP, degree=2, raw=TRUE) +
     poly(Coarse.Aggr., degree=2, raw=TRUE) +
     poly(Fine.Aggr., degree=2, raw=TRUE) ,data=train)
PredictedTest2<-predict(LmFit2,test)
ModelTest2<-data.frame(obs = test$FLOW.cm., pred=PredictedTest2)
defaultSummary(ModelTest2)
plot(test$FLOW.cm.,PredictedTest2,xlab="actual",ylab="predicted",col = "red")

#creating a model of plynomial degree 3
LmFit3<- lm(FLOW.cm. ~ poly(Cement, degree=3, raw=TRUE) +
              poly(Slag, degree=3, raw=TRUE) +
              poly(Fly.ash, degree=3, raw=TRUE) +
              poly(Water, degree=3, raw=TRUE) +
              poly(SP, degree=3, raw=TRUE) +
              poly(Coarse.Aggr., degree=3, raw=TRUE) +
              poly(Fine.Aggr., degree=3, raw=TRUE) ,data=train)
PredictedTest3<-predict(LmFit3,test)
ModelTest3<-data.frame(obs = test$FLOW.cm., pred=PredictedTest3)
defaultSummary(ModelTest3)
plot(test$FLOW.cm.,PredictedTest3,xlab="actual",ylab="predicted",col = "red")

#creating a model of plynomial degree 4
LmFit4<- lm(FLOW.cm. ~ poly(Cement, degree=4, raw=TRUE) +
              poly(Slag, degree=4, raw=TRUE) +
              poly(Fly.ash, degree=4, raw=TRUE) +
              poly(Water, degree=4, raw=TRUE) +
              poly(SP, degree=4, raw=TRUE) +
              poly(Coarse.Aggr., degree=4, raw=TRUE) +
              poly(Fine.Aggr., degree=4, raw=TRUE) ,data=train)
PredictedTest4<-predict(LmFit4,test)
ModelTest4<-data.frame(obs = test$FLOW.cm., pred=PredictedTest4)
defaultSummary(ModelTest4)
plot(test$FLOW.cm.,PredictedTest4,xlab="actual",ylab="predicted",col = "red")

#creating a model of plynomial degree 5
LmFit5<- lm(FLOW.cm. ~ poly(Cement, degree=5, raw=TRUE) +
              poly(Slag, degree=5, raw=TRUE) +
              poly(Fly.ash, degree=5, raw=TRUE) +
              poly(Water, degree=5, raw=TRUE) +
              poly(SP, degree=5, raw=TRUE) +
              poly(Coarse.Aggr., degree=5, raw=TRUE) +
              poly(Fine.Aggr., degree=5, raw=TRUE) ,data=train)
PredictedTest5<-predict(LmFit5,test)
ModelTest5<-data.frame(obs = test$FLOW.cm., pred=PredictedTest5)
defaultSummary(ModelTest5)
plot(test$FLOW.cm.,PredictedTest5,xlab="actual",ylab="predicted",col = "red")


 DGEEV Example Program Results

 Eigenvalue( 1) =  7.9948E-01

 Eigenvector( 1)
 -6.5509E-01
 -5.2363E-01
  5.3622E-01
 -9.5607E-02

 Eigenvalue( 2) = (-9.9412E-02, 4.0079E-01)

 Eigenvector( 2)
 (-1.9330E-01, 2.5463E-01)
 ( 2.5186E-01,-5.2240E-01)
 ( 9.7182E-02,-3.0838E-01)
 ( 6.7595E-01, 0.0000E+00)

 Eigenvalue( 3) = (-9.9412E-02,-4.0079E-01)

 Eigenvector( 3)
 (-1.9330E-01,-2.5463E-01)
 ( 2.5186E-01, 5.2240E-01)
 ( 9.7182E-02, 3.0838E-01)
 ( 6.7595E-01,-0.0000E+00)

 Eigenvalue( 4) = -1.0066E-01

 Eigenvector( 4)
  1.2533E-01
  3.3202E-01
  5.9384E-01
  7.2209E-01


options(repr.plot.width = 7, repr.plot.height = 6)
options(jupyter.plot_mimetypes = c('application/pdf', 'image/png'))

library(destiny)
data(guo_norm)

sigmas <- find_sigmas(guo_norm, verbose = FALSE)
optimal_sigma(sigmas)

par(pch = 20, mfrow = c(2, 2), mar = c(3,2,2,2))
palette(cube_helix(6))

for (sigma in list('local', 5, round(optimal_sigma(sigmas), 2), 100))
    plot(DiffusionMap(guo_norm, sigma), 1:2,
         main = substitute(sigma == s, list(s = sigma)),
         col_by = 'num_cells', draw_legend = FALSE)


# ......................................................................................
# .............. Cvičení 10. Úvod do testování hypotéz, jednovýběrové testy.............
# ......................... Michal Béreš, Martina Litschmannová.........................
# ......................................................................................

# Nezobrazuje-li se vám text korektně, nastavte File \ Reopen with Encoding... na UTF-8
# Pro zobrazení obsahu skriptu použijte CTRL+SHIFT+O
# Pro spouštění příkazů v jednotlivých řádcích použijte CTRL+ENTER

#  Od intervalových odhadů k testům hypotéz ####
# * Co je to statistický test hypotéz? ####
# Mějme následující:
# - náhodná veličina X (například výška mužů)
# - výběr z náhodné veličiny (měření výšky 30 mužů)
#
# Statistické testování hypotéz rozhoduje na základě získaných dat z náhodného výběru o
# platnosti:
# - $H_0$ - nulové hypotézy
# - $H_A$ - alternativní hypotézy
#
# Například:
# $H_0$: $\mu_X = 175$
# $H_A$: $\mu_X > 175$
# Jelikož se jedná o statistické rozhodnutí, vždy bude vázáno k nějaké hladnině
# významnosti $\alpha$. Vždy můžeme dospět pouze k 2 různým rozhodnutím:
# - Zamítám $H_0$ ve prospěch $H_A$
#     - to znamená, že tvrdím, že $H_0$ neplatí
#     - toto rozhodnutí je s maximální chybou $\alpha$ (hladina významnosti, chyba I.
# druhu) - to znamená, že velikost této chyby jsme schopni ovlivnit
# - Nezamítám $H_0$
#     - to znamená, že tvrdím, že vzhledem k získaným datům (výběr) nelze vyvrátit $H_0$
#     - toto rozhodnutí je s chybou $\beta$ (chyba II. druhu), tato chyba není přímo
# ovlivnitelná a záleží na typu použitého testu
#
# Jak testy hypotéz souvisí s intervalovými odhady a jak do nich vstupuje hladina
# významnosti si ukážeme v další části.

# * Intervalový odhad a hladina významnosti ####

data = readxl::read_excel("D:/_VSB/S8/PS/Beres/GitPS/CV10/data/uvod.xlsx")
head(data)

options(repr.plot.width = 12) # šířka grafů v Jupyteru
par(mfrow = c(1, 2))          # matice grafů 1x2

boxplot(data$data)
hist(data$data)

moments::skewness(data$data)       # šikmost
moments::kurtosis(data$data) - 3   # špičatost

shapiro.test(data$data)$p.value    # test normality

length(data$data)
mean(data$data)
sd(data$data)

# Vyrobíme 95% intervalový odhad střední hodnoty pomocí t-testu:

t.test(data$data, alternative = "two.sided", conf.level = 0.95)$conf.int

# Představme si nyní, že chceme testovat hypotézu:
# $H_0$: $\mu = 100$
# $H_A$: $\mu \neq 100$
# Jaké by bylo rozhodnutí vzhledem k spočtenému IO a tedy hladině významnosti $\alpha =
# 0.05$?

# Představme si dále, že chceme testovat hypotézu:
# $H_0$: $\mu = 105$
# $H_A$: $\mu \neq 105$
# Jaké by bylo rozhodnutí vzhledem k spočtenému IO a tedy hladině významnosti $\alpha =
# 0.05$?

# **To co jsme právě udělali se nazývá klasický test.**
# Ukážeme si ještě klasické testy pro jednostranné alternativy.
# $H_0$: $\mu = 105$
# $H_A$: $\mu > 105$

t.test(data$data, alternative = "greater", conf.level = 0.95)$conf.int

# $H_0$: $\mu = 105$
# $H_A$: $\mu < 105$

t.test(data$data, alternative = "less", conf.level = 0.95)$conf.int

# Všimněte si, že první z těchto jednostranných alternativ vedla k "nezamítnutí" $H_0$.
# Je to z důvodu porovnávání nepravděpodobné $H_0$ s ještě méně pravděpodobnou $H_A$.
# *** Čistý test významnosti a souvislost s IO ####
# Alternativou ke klasickému testu (kde vytváříme IO - v terminologii klasických testů
# tzv. obor přijetí a jeho doplněk do R kritický obor) je tzv. čistý test významnosti:

# H_0: mu = 105
# H_A: mu <> 105
t.test(data$data, mu = 105, alternative = "two.sided")

t.test(data$data, mu = 105, alternative = "two.sided")$p.value

# Výsledkem čistého testu významnosti je p-hodnota. Na jejím základě rozhodujeme o
# zamítnutí či nezamítnutí $H_0$.
# p-hodnota se dá chápat jako nejvyšší možná hladina váznamnosti, taková aby naše
# rozhodnutí bylo - nezamítám. Tedy IO/obor přijetí by obsahoval zkoumanou hodnotu:

# H_0: mu = 105
# H_A: mu <> 105

p.hod = t.test(data$data, mu = 105, alternative = "two.sided")$p.value
p.hod

t.test(data$data, alternative = "two.sided", conf.level = 1 - p.hod)$conf.int

# H_0: mu = 105
# H_A: mu > 105

p.hod = t.test(data$data, mu = 105, alternative = "greater")$p.value
p.hod

t.test(data$data, alternative = "greater", conf.level = 1 - p.hod)$conf.int

# H_0: mu = 105
# H_A: mu < 105

p.hod = t.test(data$data, mu = 105, alternative = "less")$p.value
p.hod

t.test(data$data, alternative = "less", conf.level = 1 - p.hod)$conf.int

# * Přehled testů ####
# ** Míry polohy ####
# Mírami polohy rozumíme údaj určující polohu dat, nehledě na tom jak jsou rozptýlená.
# Pro data z normálního rozdělení můžeme odhadovat střední hodnotu, pro ostatní medián.
# *** a) studentův t-test ####
# - testujeme střední hodnotu
# - data musejí pocházet z normálního rozdělení
#     - exploračně: šikmost a špičatost leží v (-2,2)
#     - exploračně: QQ graf má body přibližně na čáře
#     - exaktně: pomocí statistického testu, např. Shapiro-Wilk test
# (shapiro.test(data))

# H_0: mu = 100
# H_A: mu <> 100
t.test(data$data, mu = 100, alternative = 'two.sided')$p.value

# H_0: mu = 100
# H_A: mu > 100
t.test(data$data, mu = 100, alternative = 'greater')$p.value

# H_0: mu = 100
# H_A: mu < 100
t.test(data$data, mu = 100, alternative = 'less')$p.value

# *** b) Wilcoxnův test ####
# - testujeme medián
# - data musejí pocházet ze symetrického rozdělení
#     - exploračně: šikmost leží v (-2,2)
#     - exploračně: histogram vypadá přibližně symetricky
#     - exaktně: pomocí statistického testu, např. balíček "lawstat", funkce
# "symmetry.test(data,boot=FALSE)"

# H_0: X_0.5 = 100
# H_A: X_0.5 <> 100
wilcox.test(data$data, mu = 100, alternative = 'two.sided')$p.value

# H_0: X_0.5 = 100
# H_A: X_0.5 > 100
wilcox.test(data$data, mu = 100, alternative = 'greater')$p.value

# H_0: X_0.5 = 100
# H_A: X_0.5 < 100
wilcox.test(data$data, mu = 100, alternative = 'less')$p.value

# *** c) znaménkový test test ####
# - testujeme medián
# - výběr většího rozsahu (>10)
# - vyžaduje knihovnu "BSDA"
# - jakožto nejrobustnější test, se dá použít i na nespojitá data - např. pořadí v
# nějakém seznamu

# H_0: X_0.5 = 100
# H_A: X_0.5 <> 100
BSDA::SIGN.test(data$data, md = 100, alternative = 'two.sided')$p.value

# H_0: X_0.5 = 100
# H_A: X_0.5 > 100
BSDA::SIGN.test(data$data, md = 100, alternative = 'greater')$p.value

# H_0: X_0.5 = 100
# H_A: X_0.5 < 100
BSDA::SIGN.test(data$data, md = 100, alternative = 'less')$p.value

# ** Míry variability ####
# Mírami variability rozumíme údaj určující rozptýlenost/variabilitu dat, nehledě na
# celkových hodnotách. Pro data z normálního rozdělení můžeme odhadovat směrodatnou
# odchylku.
# *** test směrodatné odchylky ####
# - testujeme směrodatnou odchylku
# - data musejí pocházet z normálního rozdělení
#     - exploračně: šikmost a špičatost leží v (-2,2)
#     - exploračně: QQ graf má body přibližně na čáře
#     - exaktně: pomocí statistického testu, např. Shapiro-Wilk test
# (shapiro.test(data))
# - vyžaduje balíček "EnvStats"
# - funkce v Rku, porovnává rozptyl!!!

# H_0: sigma = 10
# H_A: sigma <> 10
EnvStats::varTest(data$data, sigma.squared = 10*10,
                  alternative = 'two.sided')$p.value

# H_0: sigma = 10
# H_A: sigma > 10
EnvStats::varTest(data$data, sigma.squared = 10*10,
                  alternative = 'greater')$p.value

# H_0: sigma = 10
# H_A: sigma < 10
EnvStats::varTest(data$data, sigma.squared = 10*10,
                  alternative = 'less')$p.value

# * Pravděpodobnost výskytu u jednoho výběru ####
# *** IO pravděpodobnosti ####
# - testujeme pravděpodobnost
# - vyžadujeme dostatečný počet dat: $n>\frac{9}{p(1-p)}$
# - Clopperův - Pearsonův odhad (binom.test)
#     - jako parametr nebere data, ale počet úspěchů a počet pozorování

pi = 0.3
data_bin = runif(n = 100, min = 0, max = 1) < pi

n = length(data_bin)
x = sum(data_bin)
n
x

# H_0: pi = 0.2
# H_A: pi <> 0.2
binom.test(x = x, n = n, p = 0.2, alternative = 'two.sided')$p.value

# H_0: pi = 0.2
# H_A: pi > 0.2
binom.test(x = x, n = n, p = 0.2, alternative = 'greater')$p.value

# H_0: pi = 0.2
# H_A: pi < 0.2
binom.test(x = x, n = n, p = 0.2, alternative = 'less')$p.value

#  Příklady ####
# * Příklad 1. ####
# Máme výběr 216 pacientů a změřili jsme jejich bílkovinné sérum (soubor
# testy_jednovyberove.xlsx list bilk_serum). Ověřte, zda se průměrné bílkovinné sérum
# (Albumin) všech pacientů tohoto typu (populační průměr µ) statisticky významně liší od
# hodnoty 35 g/l.

# Načtení dat z xlsx souboru (pomoci balíčku readxl)
albumin = readxl::read_excel("D:/_VSB/S8/PS/Beres/GitPS/CV10/data/testy_jednovyberove.xlsx",
                             sheet = "bilk_serum")
head(albumin)

colnames(albumin)="hodnoty"

# Explorační analýza
boxplot(albumin$hodnoty)
summary(albumin$hodnoty)

length(albumin$hodnoty) # sd zaokrouhlujeme na 3 platné cifry
sd(albumin$hodnoty)     # sd a míry polohy zaokrouhlujeme na tisíciny

# **Test na míru polohy**

# Ověření normality - exploračně
moments::skewness(albumin$hodnoty)    # šikmost
moments::kurtosis(albumin$hodnoty)-3  # špičatost

options(repr.plot.width = 12) # šířka grafů v Jupyteru
par(mfrow = c(1, 2))          # matice grafů 1x2

qqnorm(albumin$hodnoty)
qqline(albumin$hodnoty)
hist(albumin$hodnoty)

# Pro konečné rozhodnutí o normalitě dat použijeme test normality.

# Předpoklad normality ověříme Shapirovovým - Wilkovovým testem.
# H0: Data jsou výběrem z normálního rozdělení.
# Ha: Data nejsou výběrem z normálního rozdělení.
shapiro.test(albumin$hodnoty)
# p-value > 0.05 -> Na hl. významnosti 0,05 nelze předpoklad normality zamít.

# normalita OK -> t.test

# H0: mu = 35 g/l
# Ha: mu <> 35 g/l

t.test(albumin$hodnoty, mu=35, alternative = "two.sided")

# p-value < 0.05 -> Na hl. významnosti 0,05 zamítáme nulovou hypotézu
# ve prospěch hypotézy alternativní
# Střední hodnota albuminu se statisticky významně liší od 35 g/l.

# * Příklad 2. ####
# V souboru testy_jednovyberove.xlsx list preziti jsou uvedeny doby přežití pro 100
# pacientů s rakovinou plic léčených novým lékem. Z předchozích studií je známo, že
# průměrné přežití takových pacientů bez podávání nového léku je 22,2 měsíce. Lze na
# základě těchto dat usoudit, že nový lék prodlužuje přežití?

# Načtení dat z xlsx souboru (pomoci balíčku readxl)
preziti = readxl::read_excel("D:/_VSB/S8/PS/Beres/GitPS/CV10/data/testy_jednovyberove.xlsx",
                             sheet = "preziti")
head(preziti)

colnames(preziti)="hodnoty"

## Explorační analýza
par(mfrow = c(1, 2))          # matice grafů 1x2

boxplot(preziti$hodnoty)
hist(preziti$hodnoty)

# **Data obsahují OP -> můžeme je odstranit. Nebo si také všimnout, že se pravděpdobně
# jedná o exponenciální rozdělení a OP tam ve skutečnosti nejsou (rozdělení se tak
# prostě chová).**

# Data obsahují odlehlá pozorování. Pomoci f-ce boxplot je umíme vypsat.
pom=boxplot(preziti$hodnoty, plot = FALSE)
pom$out
# rozhodli-li jsme se pro odstranění odlehlých hodnot, pak
preziti$hodnoty.bez=preziti$hodnoty # doporučujeme nepřepisovat původní data
preziti$hodnoty.bez[preziti$hodnoty %in% pom$out]=NA

## Explorační analýza pro data bez odlehlých pozorování
boxplot(preziti$hodnoty.bez)
summary(preziti$hodnoty.bez,na.rm=TRUE)

length(na.omit(preziti$hodnoty.bez))   # sd zaokrouhlujeme na 3 platné cifry
sd(preziti$hodnoty.bez,na.rm=TRUE)     # sd a míry polohy zaokr. na desetiny

# **Test o míře polohy (střední hodnotě / mediánu)**

# Ověření normality - exploračně
moments::skewness(preziti$hodnoty.bez,na.rm=TRUE)
moments::kurtosis(preziti$hodnoty.bez,na.rm=TRUE)-3

par(mfrow = c(1, 2))          # matice grafů 1x2

qqnorm(preziti$hodnoty.bez)
qqline(preziti$hodnoty.bez)
hist(preziti$hodnoty.bez)

# QQ - graf i hist. ukazují, že výběr pravd. není výběrem z norm. rozdělení.
# Šikmost i špičatost odpovídá norm. rozdělení.
# použijeme test normality.

# Předpoklad normality ověříme Shapirovovým . Wilkovovým testem.
shapiro.test(preziti$hodnoty.bez)
# p-value < 0.05 -> Na hl. významnosti 0.05 zamítáme předpoklad normality

# explorační posouzení symetrie - výše hist. a šikmost

# Předpoklad symetrie - ověření testem
# H0: data pocházejí ze symetrického rozdělení
# HA: ~H0

lawstat::symmetry.test(preziti$hodnoty.bez,boot=FALSE)
# p-value < 0.05 -> Na hl. významnosti 0.05 zamítáme předpoklad symetrie

# normalita zamítnuta -> symetrie zamítnuta -> Sign. test
# H0: median = 22,2 měsíců
# Ha: median > 22,2 měsíců

BSDA::SIGN.test(preziti$hodnoty.bez, md=22.2,
                alternative="greater", conf.level=0.95)

# p-value > 0.05 -> Na hl. významnosti 0,05 nelze zamítnout nulovou hypotézu
# Medián doby přežití není statisticky významně větší než 22,2 měsíců.

median(preziti$hodnoty.bez, na.rm = TRUE)

# H0: median = 22,2 měsíců
# Ha: median < 22,2 měsíců

BSDA::SIGN.test(preziti$hodnoty.bez, md=22.2,
                alternative="less", conf.level=0.95)

# * Příklad 3. ####
# Automat vyrábí pístové kroužky o daném průměru. Výrobce udává, že směrodatná odchylka
# průměru kroužku je 0,05 mm. K ověření této informace bylo náhodně vybráno 80 kroužků a
# vypočtena směrodatná odchylka jejich průměru 0,04 mm. Lze tento rozdíl považovat za
# statisticky významný ve smyslu zlepšení kvality produkce? Ověřte čistým testem
# významnosti. Předpokládejte, že průměr pístových kroužků má normální rozdělení.

# Test o směrodatné odchylce

# Předpokládáme normalitu dat (dle zadání)
n = 80   # rozsah souboru
s = 0.04 # mm .... výběrová směrodatná odchylka (bodový odhad sm. odchylky)

# H0: sigma = 0.05 mm
# Ha: sigma < 0.05 mm

x.obs = (n-1)*s^2/0.05^2
x.obs

p.hodnota = pchisq(x.obs,n-1)
p.hodnota

# p.hodnota < 0.05 -> Na hladině významnosti 0,05 zamítáme nulovou hypotézu
# ve prospěch alternativní hypotézy
# Směr. odchylka průměru kroužku je statisticky významně menší než 0,05 mm.

# * Příklad 4. ####
# Automat vyrábí pístové kroužky o daném průměru. Výrobce udává, že směrodatná odchylka
# průměru kroužku je 0,05 mm. K ověření této informace bylo náhodně vybráno 80 kroužků a
# byl změřen jejich průměr (soubor testy_jednovyberove.xlsx list krouzky). Lze zjištěné
# výsledky považovat za statisticky významné ve smyslu zlepšení kvality produkce? Ověřte
# čistým testem významnosti.

# Načtení dat z xlsx souboru (pomoci balíčku readxl)
krouzky = readxl::read_excel("D:/_VSB/S8/PS/Beres/GitPS/CV10/data/testy_jednovyberove.xlsx",
                             sheet = "krouzky")
head(krouzky)

colnames(krouzky)="hodnoty"

## Explorační analýza
boxplot(krouzky$hodnoty)

# Data obsahují odlehlá pozorování. Pomoci f-ce boxplot je umíme vypsat.
pom = boxplot(krouzky$hodnoty, plot = FALSE)
pom$out
# rozhodli-li jsme se pro odstranění odlehlých hodnot, pak
krouzky$hodnoty.bez = krouzky$hodnoty
krouzky$hodnoty.bez[krouzky$hodnoty %in% pom$out] = NA

# Explorační analýza pro data bez odlehlých pozorování
summary(krouzky$hodnoty.bez,na.rm=TRUE)
boxplot(krouzky$hodnoty.bez)

length(na.omit(krouzky$hodnoty.bez))# sd zaokrouhlujeme na 3 platné cifry
sd(krouzky$hodnoty.bez,na.rm=TRUE)  # sd a míry polohy zaokr. na tisíciny

# Ověření normality - exploračně
moments::skewness(krouzky$hodnoty.bez,na.rm=TRUE)
moments::kurtosis(krouzky$hodnoty.bez,na.rm=TRUE)-3

par(mfrow = c(1, 2))          # matice grafů 1x2

qqnorm(krouzky$hodnoty.bez)
qqline(krouzky$hodnoty.bez)
hist(krouzky$hodnoty.bez)
# Šikmost i špičatost odpovídá norm. rozdělení.
# Pro konečné rozhodnutí o normalitě dat použijeme

# test normality.
# Předpoklad normality ověříme Shapirovovým . Wilkovovým testem.
shapiro.test(krouzky$hodnoty.bez)
# p-value > 0.05 -> Na hl. významnosti 0,05 nelze předpoklad norm. zamítnout

# test na míru variability -> test o rozptylu

# H0: sigma = 0,05 mm
# Ha: sigma < 0,05 mm
EnvStats::varTest(krouzky$hodnoty.bez, sigma.squared = 0.05^2,
                  alternative = "less")

# p-value < 0.05 -> Na hladině významnosti 0,05 zamítáme H0 ve prospěch Ha

# Jak najít 95% intervalový odhad směrodatné odchylky?
pom = EnvStats::varTest(krouzky$hodnoty.bez, sigma.squared = 0.05^2,
                        alternative = "less", conf.level=0.95)

sqrt(pom$conf.int)

# * Příklad 5. ####
# Firma TT udává, že 1% jejich rezistorů nesplňuje požadovaná kritéria. V testované
# dodávce 1000 ks bylo nalezeno 15 nevyhovujících rezistorů. Potvrzuje tento výsledek
# tvrzení TT? Ověřte čistým testem významnosti.

n = 1000   # rozsah výběru
x = 15     # počet "úspěchů"
p = x/n    # relativní četnost (bodový odhad pravděpodobnosti)
p

# Ověření předpokladů
9/(p*(1-p))
# Dále předpokládáme  n/N < 0.05, tj. že daná populace (rezistorů) má rozsah
# alespoň 1000/0.05 = 1000*20 = 20 000 rezistorů

## Clopperův - Pearsonův (exaktní) test
## H0: pi = 0.01
## Ha: pi <> 0.01

binom.test(x = x, n= n, p = 0.01, alternative="two.sided")

## Clopperův - Pearsonův (exaktní) test
## H0: pi = 0.01
## Ha: pi > 0.01

binom.test(x = x, n= n, p = 0.01, alternative="greater")

# Na hladině významnosti 0,05 nezamítáme H0
# Nelze očekávat, že podíl vadných rezistorů ve výrobě statisticky významně
# převyšuje 1 %.


#' Calculated the VWAP for a specified interval
#'
#' @param price the product's tranaction price.
#' @param size the number of products transacted.
#' @param date_time the date-times for the tranactions
#' @param on the interval to find the average over.
#' @param k along every k elements.
#' @return an xts object with the volume-weighted average price for the
#'         specified interval of time.
#' @examples
#' data(aapl_fix)
#' aapl_fix$dt_string = paste(aapl_fix$sys_date, aapl_fix$sys_time)
#' aapl_fix$dt = strptime(aapl_fix$dt_string, "%Y-%m-%d %H:%M:%OS")
#' # Minute-aggregated vwap prices.
#' minute_prices = vwap(aapl_fix$td_price, aapl_fix$td_size, aapl_fix$dt)
#' @export
vwap = function(price, size, date_time, on="minutes", k=1) {
  tx = xts(cbind(price, size), order.by=date_time, unique=FALSE)
  ep = endpoints(date_time, on=on, k=k)
  vwap=period.apply(tx, ep,
    function(x) sum(x$price*x$size, na.rm=TRUE)/sum(x$size, na.rm=TRUE))
}

#' @export
log_rate_return = function(prices) {
  log(as.vector(prices[2:length(prices)])) /
    log(as.vector(prices[1:(length(prices)-1)]))
}

#' Get the log-rate-returns of a time-series
#'
#' @param prices the values to calculated the log-rate returns from.
#' @examples
# Get the cointegration information for the log-rate returns.
#' data(aapl_fix)
#' data(a_fix)
#' aapl_cons = consolidate_prices(aapl_fix$sys_date, aapl_fix$sys_time,
#'  aapl_fix$td_price, aapl_fix$td_size)
#' a_cons = consolidate_prices(a_fix$sys_date, a_fix$sys_time,
#'  a_fix$td_price, a_fix$td_size)
#' trades = merge(aapl_cons$price, a_cons$price)
#' trades = carry_prices_forward(trades)
#' trade_llr = log_rate_returns(trades)
#' names(trades_lrr) = c("aapl", "a")
#' cointegration_p_matrix(trades_lrr)
#' @export
log_rate_returns = function(x, na.omit=TRUE) {
  if (is.null(getDoParName())) registerDoSEQ()
  ret = foreach(1:ncol(x), .combine=cbind) %dopar%  log_rate_return(x[,j])
  if (na.omit) ret = na.omit(ret)
  ret
}

#' Carry price forward
#'
#' @param x an xts object that may have NA's
#' @return an xts object where NA's are replace by the last valid value. Note
#'         that if NA's appear in the beginning of the series they will appear
#'         in the result.
carry_price_forward = function(x) {
  vec=as.vector(x)
  is_na = is.na(vec)
  fgi = min(which(!is_na))
  if (!is.finite(fgi)) {
    warning("All values are NA.")
    return(x)
  }
  na_inds = which(is_na)
  na_inds = na_inds[na_inds > fgi]
  for (ind in na_inds) {
    vec[ind] = vec[ind-1]
  }
  xts(vec, order.by=time(x))
}

#' Carry prices forward
#'
#' @param x an xtx object that may have mulitple columns and NA's
#' @param na.rm should the rows with NA's be omitted after carrying forward?
#' @return an xts object where NA's are replace by the last valid value. Note
#'         that if NA's appear in the beginning of the series they will appear
#'         in the result.
#' @examples
#' data(aapl_fix)
#' data(a_fix)
#' aapl_cons = consolidate_prices(aapl_fix$sys_date, aapl_fix$sys_time,
#'  aapl_fix$td_price, aapl_fix$td_size)
#' a_cons = consolidate_prices(a_fix$sys_date, a_fix$sys_time,
#'  a_fix$td_price, a_fix$td_size)
#' trades = merge(aapl_cons$price, a_cons$price)
#' trades = carry_prices_forward(trades)
#' names(trades) = c("aapl", "a")
#' cointegration_p_matrix(trades)
#' @export
carry_prices_forward = function(x, na.rm=TRUE) {
  if (is.null(getDoParName())) registerDoSEQ()
  ret = foreach(j=1:ncol(x), .combine=cbind) %dopar%  carry_price_forward(x[,j])
  if (na.rm) ret = na.omit(ret)
  colnames(ret) = colnames(x)
  ret
}