score <- function(input) {
    var1 <- ((((((26.85177874216177) + ((subroutine0(input)) * (-0.12034962779157432))) + ((subroutine1(input)) * (1.0))) + ((subroutine2(input)) * (-1.0))) + ((subroutine3(input)) * (-1.0))) + ((subroutine4(input)) * (-1.0))) + ((subroutine5(input)) * (0.6171875007313155))
    var2 <- (subroutine6(input)) * (-1.0)
    var0 <- (((((((((((((((((((((((((var1) + (var2)) + ((subroutine7(input)) * (1.0))) + ((subroutine8(input)) * (-1.0))) + ((subroutine9(input)) * (1.0))) + ((subroutine10(input)) * (0.3164062486215933))) + ((subroutine11(input)) * (-1.0))) + ((subroutine12(input)) * (1.0))) + ((subroutine13(input)) * (-1.0))) + ((subroutine14(input)) * (1.0))) + ((subroutine15(input)) * (-1.0))) + ((subroutine16(input)) * (1.0))) + ((subroutine17(input)) * (-1.0))) + ((subroutine18(input)) * (-1.0))) + ((subroutine19(input)) * (-0.3201043650830524))) + ((subroutine20(input)) * (-1.0))) + ((subroutine21(input)) * (-1.0))) + ((subroutine22(input)) * (1.0))) + ((subroutine23(input)) * (-0.7715023625371545))) + ((subroutine24(input)) * (-1.0))) + ((subroutine25(input)) * (1.0))) + ((subroutine26(input)) * (-1.0))) + ((subroutine27(input)) * (-0.006346611962003479))) + ((subroutine28(input)) * (1.0))) + ((subroutine29(input)) * (-1.0))) + ((subroutine30(input)) * (-1.0))
    var3 <- (subroutine31(input)) * (-0.17130203879318218)
    return((((((((((((((((((((((((((var0) + (var3)) + ((subroutine32(input)) * (1.0))) + ((subroutine33(input)) * (1.0))) + ((subroutine34(input)) * (1.0))) + ((subroutine35(input)) * (-0.32034025068626093))) + ((subroutine36(input)) * (-0.9199503780639393))) + ((subroutine37(input)) * (1.0))) + ((subroutine38(input)) * (-1.0))) + ((subroutine39(input)) * (1.0))) + ((subroutine40(input)) * (-0.12010436508304956))) + ((subroutine41(input)) * (1.0))) + ((subroutine42(input)) * (1.0))) + ((subroutine43(input)) * (1.0))) + ((subroutine44(input)) * (-1.0))) + ((subroutine45(input)) * (-1.0))) + ((subroutine46(input)) * (1.0))) + ((subroutine47(input)) * (1.0))) + ((subroutine48(input)) * (0.816406250647308))) + ((subroutine49(input)) * (1.0))) + ((subroutine50(input)) * (1.0))) + ((subroutine51(input)) * (1.0))) + ((subroutine52(input)) * (-1.0))) + ((subroutine53(input)) * (1.0))) + ((subroutine54(input)) * (-1.0))) + ((subroutine55(input)) * (-1.0)))
}
subroutine0 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((25.9406) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.679) - (input[5])) ^ (2))) + (((5.304) - (input[6])) ^ (2))) + (((89.1) - (input[7])) ^ (2))) + (((1.6475) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((127.36) - (input[12])) ^ (2))) + (((26.64) - (input[13])) ^ (2)))))
}
subroutine1 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((6.53876) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2))) + (((0.631) - (input[5])) ^ (2))) + (((7.016) - (input[6])) ^ (2))) + (((97.5) - (input[7])) ^ (2))) + (((1.2024) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((392.05) - (input[12])) ^ (2))) + (((2.96) - (input[13])) ^ (2)))))
}
subroutine2 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((22.5971) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.7) - (input[5])) ^ (2))) + (((5.0) - (input[6])) ^ (2))) + (((89.5) - (input[7])) ^ (2))) + (((1.5184) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((31.99) - (input[13])) ^ (2)))))
}
subroutine3 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((45.7461) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((4.519) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.6582) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((88.27) - (input[12])) ^ (2))) + (((36.98) - (input[13])) ^ (2)))))
}
subroutine4 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((11.8123) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.718) - (input[5])) ^ (2))) + (((6.824) - (input[6])) ^ (2))) + (((76.5) - (input[7])) ^ (2))) + (((1.794) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((48.45) - (input[12])) ^ (2))) + (((22.74) - (input[13])) ^ (2)))))
}
subroutine5 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.08187) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((2.89) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.445) - (input[5])) ^ (2))) + (((7.82) - (input[6])) ^ (2))) + (((36.9) - (input[7])) ^ (2))) + (((3.4952) - (input[8])) ^ (2))) + (((2.0) - (input[9])) ^ (2))) + (((276.0) - (input[10])) ^ (2))) + (((18.0) - (input[11])) ^ (2))) + (((393.53) - (input[12])) ^ (2))) + (((3.57) - (input[13])) ^ (2)))))
}
subroutine6 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((7.67202) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((5.747) - (input[6])) ^ (2))) + (((98.9) - (input[7])) ^ (2))) + (((1.6334) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((393.1) - (input[12])) ^ (2))) + (((19.92) - (input[13])) ^ (2)))))
}
subroutine7 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((1.46336) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((19.58) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.605) - (input[5])) ^ (2))) + (((7.489) - (input[6])) ^ (2))) + (((90.8) - (input[7])) ^ (2))) + (((1.9709) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((403.0) - (input[10])) ^ (2))) + (((14.7) - (input[11])) ^ (2))) + (((374.43) - (input[12])) ^ (2))) + (((1.73) - (input[13])) ^ (2)))))
}
subroutine8 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((20.0849) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.7) - (input[5])) ^ (2))) + (((4.368) - (input[6])) ^ (2))) + (((91.2) - (input[7])) ^ (2))) + (((1.4395) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((285.83) - (input[12])) ^ (2))) + (((30.63) - (input[13])) ^ (2)))))
}
subroutine9 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((1.83377) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((19.58) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2))) + (((0.605) - (input[5])) ^ (2))) + (((7.802) - (input[6])) ^ (2))) + (((98.2) - (input[7])) ^ (2))) + (((2.0407) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((403.0) - (input[10])) ^ (2))) + (((14.7) - (input[11])) ^ (2))) + (((389.61) - (input[12])) ^ (2))) + (((1.92) - (input[13])) ^ (2)))))
}
subroutine10 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.5405) - (input[1])) ^ (2)) + (((20.0) - (input[2])) ^ (2))) + (((3.97) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.575) - (input[5])) ^ (2))) + (((7.47) - (input[6])) ^ (2))) + (((52.6) - (input[7])) ^ (2))) + (((2.872) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((264.0) - (input[10])) ^ (2))) + (((13.0) - (input[11])) ^ (2))) + (((390.3) - (input[12])) ^ (2))) + (((3.16) - (input[13])) ^ (2)))))
}
subroutine11 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((73.5341) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.679) - (input[5])) ^ (2))) + (((5.957) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.8026) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((16.45) - (input[12])) ^ (2))) + (((20.62) - (input[13])) ^ (2)))))
}
subroutine12 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.33147) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((6.2) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.507) - (input[5])) ^ (2))) + (((8.247) - (input[6])) ^ (2))) + (((70.4) - (input[7])) ^ (2))) + (((3.6519) - (input[8])) ^ (2))) + (((8.0) - (input[9])) ^ (2))) + (((307.0) - (input[10])) ^ (2))) + (((17.4) - (input[11])) ^ (2))) + (((378.95) - (input[12])) ^ (2))) + (((3.95) - (input[13])) ^ (2)))))
}
subroutine13 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((25.0461) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((5.987) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.5888) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((26.77) - (input[13])) ^ (2)))))
}
subroutine14 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.57834) - (input[1])) ^ (2)) + (((20.0) - (input[2])) ^ (2))) + (((3.97) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.575) - (input[5])) ^ (2))) + (((8.297) - (input[6])) ^ (2))) + (((67.0) - (input[7])) ^ (2))) + (((2.4216) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((264.0) - (input[10])) ^ (2))) + (((13.0) - (input[11])) ^ (2))) + (((384.54) - (input[12])) ^ (2))) + (((7.44) - (input[13])) ^ (2)))))
}
subroutine15 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((16.8118) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.7) - (input[5])) ^ (2))) + (((5.277) - (input[6])) ^ (2))) + (((98.1) - (input[7])) ^ (2))) + (((1.4261) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((30.81) - (input[13])) ^ (2)))))
}
subroutine16 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.31533) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((6.2) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.504) - (input[5])) ^ (2))) + (((8.266) - (input[6])) ^ (2))) + (((78.3) - (input[7])) ^ (2))) + (((2.8944) - (input[8])) ^ (2))) + (((8.0) - (input[9])) ^ (2))) + (((307.0) - (input[10])) ^ (2))) + (((17.4) - (input[11])) ^ (2))) + (((385.05) - (input[12])) ^ (2))) + (((4.14) - (input[13])) ^ (2)))))
}
subroutine17 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((67.9208) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((5.683) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.4254) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((384.97) - (input[12])) ^ (2))) + (((22.98) - (input[13])) ^ (2)))))
}
subroutine18 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.18337) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((27.74) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.609) - (input[5])) ^ (2))) + (((5.414) - (input[6])) ^ (2))) + (((98.3) - (input[7])) ^ (2))) + (((1.7554) - (input[8])) ^ (2))) + (((4.0) - (input[9])) ^ (2))) + (((711.0) - (input[10])) ^ (2))) + (((20.1) - (input[11])) ^ (2))) + (((344.05) - (input[12])) ^ (2))) + (((23.97) - (input[13])) ^ (2)))))
}
subroutine19 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((14.3337) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.7) - (input[5])) ^ (2))) + (((4.88) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.5895) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((372.92) - (input[12])) ^ (2))) + (((30.62) - (input[13])) ^ (2)))))
}
subroutine20 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.20746) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((27.74) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.609) - (input[5])) ^ (2))) + (((5.093) - (input[6])) ^ (2))) + (((98.0) - (input[7])) ^ (2))) + (((1.8226) - (input[8])) ^ (2))) + (((4.0) - (input[9])) ^ (2))) + (((711.0) - (input[10])) ^ (2))) + (((20.1) - (input[11])) ^ (2))) + (((318.43) - (input[12])) ^ (2))) + (((29.68) - (input[13])) ^ (2)))))
}
subroutine21 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((41.5292) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((5.531) - (input[6])) ^ (2))) + (((85.4) - (input[7])) ^ (2))) + (((1.6074) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((329.46) - (input[12])) ^ (2))) + (((27.38) - (input[13])) ^ (2)))))
}
subroutine22 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((1.51902) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((19.58) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2))) + (((0.605) - (input[5])) ^ (2))) + (((8.375) - (input[6])) ^ (2))) + (((93.9) - (input[7])) ^ (2))) + (((2.162) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((403.0) - (input[10])) ^ (2))) + (((14.7) - (input[11])) ^ (2))) + (((388.45) - (input[12])) ^ (2))) + (((3.32) - (input[13])) ^ (2)))))
}
subroutine23 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((11.5779) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.7) - (input[5])) ^ (2))) + (((5.036) - (input[6])) ^ (2))) + (((97.0) - (input[7])) ^ (2))) + (((1.77) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((25.68) - (input[13])) ^ (2)))))
}
subroutine24 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((14.2362) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((6.343) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.5741) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((20.32) - (input[13])) ^ (2)))))
}
subroutine25 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((9.2323) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.631) - (input[5])) ^ (2))) + (((6.216) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.1691) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((366.15) - (input[12])) ^ (2))) + (((9.53) - (input[13])) ^ (2)))))
}
subroutine26 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((9.91655) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((5.852) - (input[6])) ^ (2))) + (((77.8) - (input[7])) ^ (2))) + (((1.5004) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((338.16) - (input[12])) ^ (2))) + (((29.97) - (input[13])) ^ (2)))))
}
subroutine27 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((22.0511) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.74) - (input[5])) ^ (2))) + (((5.818) - (input[6])) ^ (2))) + (((92.4) - (input[7])) ^ (2))) + (((1.8662) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((391.45) - (input[12])) ^ (2))) + (((22.11) - (input[13])) ^ (2)))))
}
subroutine28 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.61154) - (input[1])) ^ (2)) + (((20.0) - (input[2])) ^ (2))) + (((3.97) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.647) - (input[5])) ^ (2))) + (((8.704) - (input[6])) ^ (2))) + (((86.9) - (input[7])) ^ (2))) + (((1.801) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((264.0) - (input[10])) ^ (2))) + (((13.0) - (input[11])) ^ (2))) + (((389.7) - (input[12])) ^ (2))) + (((5.12) - (input[13])) ^ (2)))))
}
subroutine29 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((10.8342) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.679) - (input[5])) ^ (2))) + (((6.782) - (input[6])) ^ (2))) + (((90.8) - (input[7])) ^ (2))) + (((1.8195) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((21.57) - (input[12])) ^ (2))) + (((25.79) - (input[13])) ^ (2)))))
}
subroutine30 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((15.8603) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.679) - (input[5])) ^ (2))) + (((5.896) - (input[6])) ^ (2))) + (((95.4) - (input[7])) ^ (2))) + (((1.9096) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((7.68) - (input[12])) ^ (2))) + (((24.39) - (input[13])) ^ (2)))))
}
subroutine31 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((17.8667) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.671) - (input[5])) ^ (2))) + (((6.223) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.3861) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((393.74) - (input[12])) ^ (2))) + (((21.78) - (input[13])) ^ (2)))))
}
subroutine32 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((8.26725) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2))) + (((0.668) - (input[5])) ^ (2))) + (((5.875) - (input[6])) ^ (2))) + (((89.6) - (input[7])) ^ (2))) + (((1.1296) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((347.88) - (input[12])) ^ (2))) + (((8.88) - (input[13])) ^ (2)))))
}
subroutine33 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.52693) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((6.2) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.504) - (input[5])) ^ (2))) + (((8.725) - (input[6])) ^ (2))) + (((83.0) - (input[7])) ^ (2))) + (((2.8944) - (input[8])) ^ (2))) + (((8.0) - (input[9])) ^ (2))) + (((307.0) - (input[10])) ^ (2))) + (((17.4) - (input[11])) ^ (2))) + (((382.0) - (input[12])) ^ (2))) + (((4.63) - (input[13])) ^ (2)))))
}
subroutine34 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.0351) - (input[1])) ^ (2)) + (((95.0) - (input[2])) ^ (2))) + (((2.68) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.4161) - (input[5])) ^ (2))) + (((7.853) - (input[6])) ^ (2))) + (((33.2) - (input[7])) ^ (2))) + (((5.118) - (input[8])) ^ (2))) + (((4.0) - (input[9])) ^ (2))) + (((224.0) - (input[10])) ^ (2))) + (((14.7) - (input[11])) ^ (2))) + (((392.78) - (input[12])) ^ (2))) + (((3.81) - (input[13])) ^ (2)))))
}
subroutine35 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((12.2472) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.584) - (input[5])) ^ (2))) + (((5.837) - (input[6])) ^ (2))) + (((59.7) - (input[7])) ^ (2))) + (((1.9976) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((24.65) - (input[12])) ^ (2))) + (((15.69) - (input[13])) ^ (2)))))
}
subroutine36 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((14.4208) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.74) - (input[5])) ^ (2))) + (((6.461) - (input[6])) ^ (2))) + (((93.3) - (input[7])) ^ (2))) + (((2.0026) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((27.49) - (input[12])) ^ (2))) + (((18.05) - (input[13])) ^ (2)))))
}
subroutine37 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.29819) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((6.2) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.504) - (input[5])) ^ (2))) + (((7.686) - (input[6])) ^ (2))) + (((17.0) - (input[7])) ^ (2))) + (((3.3751) - (input[8])) ^ (2))) + (((8.0) - (input[9])) ^ (2))) + (((307.0) - (input[10])) ^ (2))) + (((17.4) - (input[11])) ^ (2))) + (((377.51) - (input[12])) ^ (2))) + (((3.92) - (input[13])) ^ (2)))))
}
subroutine38 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((38.3518) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((5.453) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.4896) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((30.59) - (input[13])) ^ (2)))))
}
subroutine39 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.06129) - (input[1])) ^ (2)) + (((20.0) - (input[2])) ^ (2))) + (((3.33) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2))) + (((0.4429) - (input[5])) ^ (2))) + (((7.645) - (input[6])) ^ (2))) + (((49.7) - (input[7])) ^ (2))) + (((5.2119) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((216.0) - (input[10])) ^ (2))) + (((14.9) - (input[11])) ^ (2))) + (((377.07) - (input[12])) ^ (2))) + (((3.01) - (input[13])) ^ (2)))))
}
subroutine40 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((88.9762) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.671) - (input[5])) ^ (2))) + (((6.968) - (input[6])) ^ (2))) + (((91.9) - (input[7])) ^ (2))) + (((1.4165) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((17.21) - (input[13])) ^ (2)))))
}
subroutine41 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.05602) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((2.46) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.488) - (input[5])) ^ (2))) + (((7.831) - (input[6])) ^ (2))) + (((53.6) - (input[7])) ^ (2))) + (((3.1992) - (input[8])) ^ (2))) + (((3.0) - (input[9])) ^ (2))) + (((193.0) - (input[10])) ^ (2))) + (((17.8) - (input[11])) ^ (2))) + (((392.63) - (input[12])) ^ (2))) + (((4.45) - (input[13])) ^ (2)))))
}
subroutine42 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.01501) - (input[1])) ^ (2)) + (((90.0) - (input[2])) ^ (2))) + (((1.21) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2))) + (((0.401) - (input[5])) ^ (2))) + (((7.923) - (input[6])) ^ (2))) + (((24.8) - (input[7])) ^ (2))) + (((5.885) - (input[8])) ^ (2))) + (((1.0) - (input[9])) ^ (2))) + (((198.0) - (input[10])) ^ (2))) + (((13.6) - (input[11])) ^ (2))) + (((395.52) - (input[12])) ^ (2))) + (((3.16) - (input[13])) ^ (2)))))
}
subroutine43 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.02009) - (input[1])) ^ (2)) + (((95.0) - (input[2])) ^ (2))) + (((2.68) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.4161) - (input[5])) ^ (2))) + (((8.034) - (input[6])) ^ (2))) + (((31.9) - (input[7])) ^ (2))) + (((5.118) - (input[8])) ^ (2))) + (((4.0) - (input[9])) ^ (2))) + (((224.0) - (input[10])) ^ (2))) + (((14.7) - (input[11])) ^ (2))) + (((390.55) - (input[12])) ^ (2))) + (((2.88) - (input[13])) ^ (2)))))
}
subroutine44 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((15.1772) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.74) - (input[5])) ^ (2))) + (((6.152) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.9142) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((9.32) - (input[12])) ^ (2))) + (((26.45) - (input[13])) ^ (2)))))
}
subroutine45 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((18.0846) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.679) - (input[5])) ^ (2))) + (((6.434) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.8347) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((27.25) - (input[12])) ^ (2))) + (((29.05) - (input[13])) ^ (2)))))
}
subroutine46 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.01381) - (input[1])) ^ (2)) + (((80.0) - (input[2])) ^ (2))) + (((0.46) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.422) - (input[5])) ^ (2))) + (((7.875) - (input[6])) ^ (2))) + (((32.0) - (input[7])) ^ (2))) + (((5.6484) - (input[8])) ^ (2))) + (((4.0) - (input[9])) ^ (2))) + (((255.0) - (input[10])) ^ (2))) + (((14.4) - (input[11])) ^ (2))) + (((394.23) - (input[12])) ^ (2))) + (((2.97) - (input[13])) ^ (2)))))
}
subroutine47 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((5.66998) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((1.0) - (input[4])) ^ (2))) + (((0.631) - (input[5])) ^ (2))) + (((6.683) - (input[6])) ^ (2))) + (((96.8) - (input[7])) ^ (2))) + (((1.3567) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((375.33) - (input[12])) ^ (2))) + (((3.73) - (input[13])) ^ (2)))))
}
subroutine48 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.01538) - (input[1])) ^ (2)) + (((90.0) - (input[2])) ^ (2))) + (((3.75) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.394) - (input[5])) ^ (2))) + (((7.454) - (input[6])) ^ (2))) + (((34.2) - (input[7])) ^ (2))) + (((6.3361) - (input[8])) ^ (2))) + (((3.0) - (input[9])) ^ (2))) + (((244.0) - (input[10])) ^ (2))) + (((15.9) - (input[11])) ^ (2))) + (((386.34) - (input[12])) ^ (2))) + (((3.11) - (input[13])) ^ (2)))))
}
subroutine49 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((4.89822) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.631) - (input[5])) ^ (2))) + (((4.97) - (input[6])) ^ (2))) + (((100.0) - (input[7])) ^ (2))) + (((1.3325) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((375.52) - (input[12])) ^ (2))) + (((3.26) - (input[13])) ^ (2)))))
}
subroutine50 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((2.01019) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((19.58) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.605) - (input[5])) ^ (2))) + (((7.929) - (input[6])) ^ (2))) + (((96.2) - (input[7])) ^ (2))) + (((2.0459) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((403.0) - (input[10])) ^ (2))) + (((14.7) - (input[11])) ^ (2))) + (((369.3) - (input[12])) ^ (2))) + (((3.7) - (input[13])) ^ (2)))))
}
subroutine51 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.52014) - (input[1])) ^ (2)) + (((20.0) - (input[2])) ^ (2))) + (((3.97) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.647) - (input[5])) ^ (2))) + (((8.398) - (input[6])) ^ (2))) + (((91.5) - (input[7])) ^ (2))) + (((2.2885) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((264.0) - (input[10])) ^ (2))) + (((13.0) - (input[11])) ^ (2))) + (((386.86) - (input[12])) ^ (2))) + (((5.91) - (input[13])) ^ (2)))))
}
subroutine52 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((9.33889) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.679) - (input[5])) ^ (2))) + (((6.38) - (input[6])) ^ (2))) + (((95.6) - (input[7])) ^ (2))) + (((1.9682) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((60.72) - (input[12])) ^ (2))) + (((24.08) - (input[13])) ^ (2)))))
}
subroutine53 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((0.03578) - (input[1])) ^ (2)) + (((20.0) - (input[2])) ^ (2))) + (((3.33) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.4429) - (input[5])) ^ (2))) + (((7.82) - (input[6])) ^ (2))) + (((64.5) - (input[7])) ^ (2))) + (((4.6947) - (input[8])) ^ (2))) + (((5.0) - (input[9])) ^ (2))) + (((216.0) - (input[10])) ^ (2))) + (((14.9) - (input[11])) ^ (2))) + (((387.31) - (input[12])) ^ (2))) + (((3.76) - (input[13])) ^ (2)))))
}
subroutine54 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((24.8017) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.693) - (input[5])) ^ (2))) + (((5.349) - (input[6])) ^ (2))) + (((96.0) - (input[7])) ^ (2))) + (((1.7028) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((396.9) - (input[12])) ^ (2))) + (((19.77) - (input[13])) ^ (2)))))
}
subroutine55 <- function(input) {
    var0 <- (0) - (0.07692307692307693)
    return(exp((var0) * (((((((((((((((13.6781) - (input[1])) ^ (2)) + (((0.0) - (input[2])) ^ (2))) + (((18.1) - (input[3])) ^ (2))) + (((0.0) - (input[4])) ^ (2))) + (((0.74) - (input[5])) ^ (2))) + (((5.935) - (input[6])) ^ (2))) + (((87.9) - (input[7])) ^ (2))) + (((1.8206) - (input[8])) ^ (2))) + (((24.0) - (input[9])) ^ (2))) + (((666.0) - (input[10])) ^ (2))) + (((20.2) - (input[11])) ^ (2))) + (((68.95) - (input[12])) ^ (2))) + (((34.02) - (input[13])) ^ (2)))))
}


## Anatomía de las funciones

# En esta lección vamos a explorar las distintas partes que componen una función.

# Componentes de una función
# 1- Argumentos formales o parámetros formales (formals)
# 2- Cuerpo de la función
# 3- Ambiente de la función

# Para comprender mejor estos componentes, empecemos por definir una función 'f'
# bien sencilla:

f <- function(a, b = 5, ...) { # a partir de dos variables 'a' y 'b'
  x <- a * b + w               # se crea un objeto 'x' y
  x / 2                        # la función devuelve el valor de 'x' dividido
}                              # entre 2.
w <- 24  # Vamos a definir también un valor 'w', que vamos a usar más adelante.

# 1- Argumentos formales
# Los argumentos de una función son los valores que nosotros podemos manipular
# en la entrada al ejecutar la misma. Vamos a distinguir entre los argumentos
# formales y los argumentos reales (actual arguments). Los primeros son los que
# componen la función como nosotros la definimos. Indican qué valores vamos a
# tener que definir para ejecutar la misma y muchas veces van a tener valores
# por defecto. Veamos cuáles son estos argumentos formales en nuestra función:

formals(f)

# Este comando devuelve una lista de los argumentos formales de cualquier
# función. En nuestro caso, nos dice que los argumentos formales de la función
# f son a y b, indicando además que b tiene un valor por defecto de 5.
# Los argumentos reales, o actuales, son los valores que le vamos a dar a los
# argumentos formales al ejecutar la función. Intentemos correr nuestra función
# con a = 2 y b = 4.

f(2, 4)

# Como dijimos antes, el argumento formal b tiene un valor por defecto por lo
# que, si no nos interesa darle un valor particular, podemos dejarlo sin asignar
# y la función va a utilizar ese valor.

f(2)

# 2- Cuerpo de la función
# El cuerpo de una función es el conjunto de las instrucciones que se van a eje-
# cutar al llamar a la función. En nuestra función, podemos ver el cuerpo de la
# misma, mediante el comando 'body'.

body(f)

# 3- Ambiente de la función
# Este es el componente de las funciones que requiere más explicación, ya que es
# el componente más abstracto de las mismas.
# El primer componente del ambiente de una función es el marco (frame) de la
# misma, y está compuesto por el conjunto de objetos presentes en R en el
# momento que la función es creada. El marco del ambiente de nuestra función
# está compuesto por los objetos presentes en el área de trabajo y los objetos
# de los paquetes cargados. A los primeros podemos consultarlos mediante 'ls'
# y a los segundos mediante 'search'

ls()      # Que nos devuelve los objetos que tenemos asignados
search()  # Que nos devuelve '.GlobalEnv' y cada paquete actualmente cargado

# '.GlobalEnv' es el ambiente correspondiente al interpretador de R, a la línea
# de comando. La función 'environment', aplicada a una función, nos dice en qué
# ambiente fue creada la misma.

environment(f)

# Nuestra función fue creada directamente en el nivel superior, R_GlobalEnv,
# que corresponde a la línea de comando de R, pero veamos que ocurre con alguna
# función, por ejemplo 'mean'.

environment(mean)

# Esta función fue creada dentro del ambiente correspondiente al paquete 'base'.
# Los ambientes están organizados en forma jerárquica dentro de R, de modo que
# el funcionamiento de cualquier función depende de que los objetos a los que
# refiere se encuentren en el ambiente en que fue definida o en uno superior,
# hasta R_GlobalEnv, que es el ambiente parental a todos. Esta pertenencia
# jerárquica entre ambientes es lo que se denomina el enclosure, y es el segundo
# componente del ambiente. Si una función depende de un objeto externo para su
# funcionamiento, éste deberá estar en el ambiente en que fue definida o en
# ambientes parentales a éste. Como ejemplo, veamos qué sucede con nuestra
# función si eliminamos el objeto 'w' que habíamos creado al principio.

rm (w)
f(2, 4)

# El objeto 'w', al que se hace referencia en el cuerpo de 'f', fue removido del
# ambiente de ésta (del marco, concretamente), por lo que ahora no puede correr.
# Volvamos a definirlo para seguir adelante.

w <- 24

# Además, cuando se corre una función se crea un ambiente dentro de la misma,
# que es transitorio y sólo existe mientras la función esté corriendo. En este
# ambiente se van a ejecutar las instrucciones del cuerpo de la función y no es
# accesible desde el workspace, sino que corre en paralelo. El objetivo de esta
# separación, es evitar siempre que sea posible que una función modifique alguna
# variable de la propia sesión. Es decir, pase lo que pase dentro de la función,
# no se van a afectar los objetos que se encuentran en nuestra área de trabajo.
# Si recordamos, en el cuerpo de nuestra función una de las instrucciones crea
# un objeto 'x'. Veamos qué sucede al correr esta función si tenemos un objeto
# llamado 'x' en el área de trabajo.

x <- 1:5
f(3, 4)
x

# El objeto 'x' de nuestra área de trabajo no fue modificado.
# Este territorio puede parecer confuso, por lo que sugiero que experimenten
# hasta entenderlo bien. A modo de guía, veamos la lista de objetos visibles
# para una función de R.
# - objetos definidos en los argumentos
# - objetos creados en el cuerpo de la función (hasta acá son los
#   pertenecientes al ambiente de la propia función).
# - objetos existentes en ambientes "parentales" (todos los "antepasados").

# Para entender un poco mejor esto, nótese que el objeto 'w', definido en para-
# lelo a nuestra función 'f', no es parte de los argumentos, y no está definido
# en el cuerpo de 'f'. El 'w' es usado dentro de la función para calcular 'x'
# (el 'x' del cuerpo de 'f', no el que definimos en el workspace). De hecho, si
# cambio a 'w' el resultado de evaluar 'f' será distinto.

f(3, 4)
w <- 1:5
f(3, 4)

# Esperando que esta lección complemente en buena forma lo visto en el video, la
# próxima lección será acerca de la salida de las funciones.


## File downloaded from 'http://www.sthda.com/upload/rquery_cormat.r'
## Date: 14/11/2016
## All Credit to Original Authors for this Script

#+++++++++++++++++++++++++
# Computing of correlation matrix
#+++++++++++++++++++++++++
# Required package : corrplot

# x : matrix
# type: possible values are "lower" (default), "upper", "full" or "flatten";
  #display lower or upper triangular of the matrix, full  or flatten matrix.
# graph : if TRUE, a correlogram or heatmap is plotted
# graphType : possible values are "correlogram" or "heatmap"
# col: colors to use for the correlogram
# ... : Further arguments to be passed to cor or cor.test function

# Result is a list including the following components :
  # r : correlation matrix, p :  p-values
  # sym : Symbolic number coding of the correlation matrix
rquery.cormat<-function(x, type=c('lower', 'upper', 'full', 'flatten'),
                        graph=TRUE, graphType=c("correlogram", "heatmap"),
                        col=NULL, ...)
{
  library(corrplot)
  # Helper functions
  #+++++++++++++++++
  # Compute the matrix of correlation p-values
  cor.pmat <- function(x, ...) {
    mat <- as.matrix(x)
    n <- ncol(mat)
    p.mat<- matrix(NA, n, n)
    diag(p.mat) <- 0
    for (i in 1:(n - 1)) {
      for (j in (i + 1):n) {
        tmp <- cor.test(mat[, i], mat[, j], ...)
        p.mat[i, j] <- p.mat[j, i] <- tmp$p.value
      }
    }
    colnames(p.mat) <- rownames(p.mat) <- colnames(mat)
    p.mat
  }
  # Get lower triangle of the matrix
  getLower.tri<-function(mat){
    upper<-mat
    upper[upper.tri(mat)]<-""
    mat<-as.data.frame(upper)
    mat
  }
  # Get upper triangle of the matrix
  getUpper.tri<-function(mat){
    lt<-mat
    lt[lower.tri(mat)]<-""
    mat<-as.data.frame(lt)
    mat
  }
  # Get flatten matrix
  flattenCorrMatrix <- function(cormat, pmat) {
    ut <- upper.tri(cormat)
    data.frame(
      row = rownames(cormat)[row(cormat)[ut]],
      column = rownames(cormat)[col(cormat)[ut]],
      cor  =(cormat)[ut],
      p = pmat[ut]
    )
  }
  # Define color
  if (is.null(col)) {
    col <- colorRampPalette(c("#67001F", "#B2182B", "#D6604D",
                              "#F4A582", "#FDDBC7", "#FFFFFF", "#D1E5F0", "#92C5DE",
                              "#4393C3", "#2166AC", "#053061"))(200)
    col<-rev(col)
  }

  # Correlation matrix
  cormat<-signif(cor(x, use = "complete.obs", ...),2)
  pmat<-signif(cor.pmat(x, ...),2)
  # Reorder correlation matrix
  ord<-corrMatOrder(cormat, order="hclust")
  cormat<-cormat[ord, ord]
  pmat<-pmat[ord, ord]
  # Replace correlation coeff by symbols
  sym<-symnum(cormat, abbr.colnames=FALSE)
  # Correlogram
  if(graph & graphType[1]=="correlogram"){
    corrplot(cormat, type=ifelse(type[1]=="flatten", "lower", type[1]),
             tl.col="black", tl.srt=45,col=col,...)
  }
  else if(graphType[1]=="heatmap")
    heatmap(cormat, col=col, symm=TRUE)
  # Get lower/upper triangle
  if(type[1]=="lower"){
    cormat<-getLower.tri(cormat)
    pmat<-getLower.tri(pmat)
  }
  else if(type[1]=="upper"){
    cormat<-getUpper.tri(cormat)
    pmat<-getUpper.tri(pmat)
    sym=t(sym)
  }
  else if(type[1]=="flatten"){
    cormat<-flattenCorrMatrix(cormat, pmat)
    pmat=NULL
    sym=NULL
  }
  list(r=cormat, p=pmat, sym=sym)
}


# Experimental and Statistical Methods in Biological Sciences I
# Demo 2: Descriptive statistics and plotting the data

# Heini Saarimäki 25.9.2014

# -----

# 1. Load in data

setwd('Z:/Desktop/Demo2')
ageweight <- read.csv("http://becs.aalto.fi/~heikkih3/age_weight2.csv")

# Examine your data

head(ageweight)
summary(ageweight)

# Save the original data into a new dataframe

ageweight.orig <- ageweight

# Change MALE into a factor

ageweight$MALE <- factor(ageweight$MALE)

# Change weird (< 0 ) WEIGHT values to NA

which(ageweight$WEIGHT <= 0)
ageweight[which(ageweight$WEIGHT <= 0), "WEIGHT"] <- NA

summary(ageweight)

# Attach the ageweight data

attach(ageweight)

# -----

# 2. Basics in plotting

# --

# 2.1 Basic structure of plotting functions

# Using plot function...

# For a numeric variable: scatterplot
plot(WEIGHT)

# For a factor (i.e., categorical variable): bar chart
plot(MALE)

# For 2 numeric variables: scatterplot
plot(AGE, WEIGHT)
plot(WEIGHT~AGE)		# equivalents!

# For a factor and a numeric variable: box plot
plot(MALE, WEIGHT)

# For 2 factors: bar chart
plot(MALE, SMOKE1)

# Other plotting functions..

# Histograms:
hist(WEIGHT)

# Box plots:
boxplot(WEIGHT)

# --

# 2.2 Modifying your plots

# Build up a nice scatterplot by adding named arguments:

plot(WEIGHT~AGE, main="Weight by Age",		# add main title
	xlab="Age (yrs)", ylab="Weight (kg)",	# add axis labels
	pch=16, col="blue",				# modify points
	xlim=c(0,70), ylim=c(0,140))			# scale axes

abline(lm(WEIGHT~AGE),					# draw regression line
	lty="dashed",					# modify line
	lwd=2,
	col="red")

# Make a nice histogram:

hist(WEIGHT, main="Weight", xlab="Weight", ylab="")

# Set total area size of histogram to 1:

hist(WEIGHT, main="Weight", xlab="Weight", ylab="", freq=F)

# Change the bin size

hist(WEIGHT)			# automatic binning

hist(WEIGHT, breaks=15)		# suggest the number of bins

bins=seq(20,140,by=20)		# suggest the size of a bin
hist(WEIGHT, breaks=bins)

# Advanced graphics:

# Sometimes you want to add a normal curve approximation to the plot.

# First, create the histogram object:
h <- hist(WEIGHT, freq=F, main="Distribution of Weights",
	xlab="Weight (kg)", ylab="")

# Second, find highest and lowest values and create a sequence of them:
x <- min(h$breaks):max(h$breaks)

# Third, create vector y from normal distribution with same mean and sd as WEIGHT:
y <- dnorm(x,
	mean=mean(WEIGHT, na.rm=T),
	sd=sd(WEIGHT, na.rm=T))

# Finally, add the normal curve:
lines(x,y,col="red", lty="dashed", lwd=3)

# --

# 2.3 Opening several plots in the same display

# E.g., put 4 plots in the same display:

layout(matrix(c(1,2,3,4),2,2))
hist(WEIGHT, main="Weight")
hist(HEIGHT, main="Height")
plot(SMOKE1, main="Smoking at time point 1")
plot(SMOKE2, main="Smoking at time point 2")

# --

# 2.4 Saving your plots

# First, open a device, then draw your plot, then close the device:

pdf(file="hist_weight.pdf")
hist(WEIGHT, main="Weight", xlab="Weight (kg)", ylab="")
dev.off()

# --

# 2.5 Exercises

# Question 1:

hist(WEIGHT,
	xlim=c(0,150), 			# scales x axis
	breaks=6, 				# sets number of bins
	col="red", 				# sets bar colour
	xlab="Weight (kg)", 		# sets x label
	bg="grey")				# OUGHT TO set background colour?

# Note: bg looks like it should set the background colour,
# BUT it does not actually work this way (see the arguments 'hist' approves of by
# checking ?hist.
# If you want to do it, you should use this instead:

par(bg="grey")
hist(WEIGHT, xlim=c(0,150), breaks=6, col="red", xlab="Weight (kg)")

# Here, we define the parameter background with function 'par'
# The background will stay grey until we change it, so run this next:
par(bg="white")

# NOTE: If you want to change the 'par' arguments, the defaults are somewhat tricky
# to restore. If you are using 'par' arguments, it is good to save the defaults first
# in an object:
opar <- par()   # stores whatever parameters you have currently
#  Now, you can change what ever you want:
par(bg="green")
plot(WEIGHT, AGE)  # see what changed
# And restore the default values this way:
par(opar)

# -

# Question 2:

hist(WEIGHT,
	xlim=c(0,150),
	breaks=6,
	col="red",
	xlab="Weight (kg)",
	main="")				# sets title to none

# -

# Question 3:

# Hmm.. Maybe weight increases with age?

plot(AGE, WEIGHT)

# So it seems.

# -

# Question 4:

plot(AGE, WEIGHT,
	pch=10,				# set plot character type
	col="green")			# set plot character colour

abline(lm(WEIGHT~AGE))			# add regression line

# -

# Question 5:

plot(MALE, WEIGHT)

# Weight seems to depend on gender too.

# -

# Question 6:

# In question 3 both variables are numeric, so a scatterplot is produced.
# In question 5 there is one factor and one numeric variable, so a boxplot is produced.
# Output of plot function depends on input!

# -

# Question 7:

# An example plot:
plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)")

# Changing font size larger for main title:

plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)",
	cex.main=2)

# Changing font style to bold-italic for axes labels:

plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)",
	font.lab=4)

# Changing font type for the whole graph:

plot(AGE, WEIGHT, pch=20,
	main="Weight by Age", xlab="Age (yrs)", ylab="Weight (kg)",
	family="mono")

# -----

# 3. Descriptive statistics & plotting of categorical variables

# -

# 3.1 Contingency tables

# One categorical variable (same information as with summary...)

table(MALE)

# Two categorical variables:

table(MALE, SMOKE1)

# Or even more...

table(MALE, SMOKE1, SMOKE2)

# Express frequencies as percentages:

round(prop.table(table(MALE, SMOKE1), margin=1)*100, 1)

# -

# 3.2 Plotting

# A simple bar chart:

plot(MALE)

# A boosted bar chart:

plot(MALE, col=c("red", "blue"), xlab="Gender")

# A simple bar chart for displaying two categorical variables:

plot(MALE, SMOKE1)

# Again then same one boosted:

plot(SMOKE1, MALE, col=c("red", "blue"),
	xlab="Smoking", ylab="Gender")

# -

# 3.3 Exercises

# Question 8:

table(SMOKE1, SMOKE2)

# 26 people quit smoking (smoked at time 1 but not at time 2)

# -

# Question 9

plot(SMOKE1, SMOKE2,
	main="Smoking",
	xlab="Smoking, time 1", ylab="Smoking, time 2",
	col=c("green", "red"))

# Example: how to add frequency values to the plot:

smoke.table <- table(SMOKE1,SMOKE2)		# save contingency table

text(0.25,0.2,smoke.table[1,1], cex=2)
text(0.25,0.8,smoke.table[1,2], cex=2)
text(0.77,0.2,smoke.table[2,1], cex=2)
text(0.77,0.8,smoke.table[2,2], cex=2)

# -----

# 4. Descriptive statistics & plotting of continuous variables

# --

# 4.1 Descriptive statistics

# Summary:

summary(ageweight)

# Use describe function from 'psych' package:

install.packages('psych')		# install if necessary
library('psych')				# load for the use of this session
describe(ageweight)

# You can also take each descriptive statistic separately:

mean(WEIGHT, na.rm=T)			# na.rm=T removes missing values
var(WEIGHT, na.rm=T)

# Take average weight for men and women separately:

tapply(WEIGHT, MALE, mean, na.rm=T)

# Take average weight for female and male non-smokers and smokers separately:

tapply(WEIGHT, list(MALE, SMOKE1), mean, na.rm=T)

# Save your table in .csv format:

my.table <- tapply(WEIGHT, list(MALE, SMOKE1), mean, na.rm=T)
write.csv(my.table, "my_table.csv")

# --

# 4.2 Plotting

# Box plot of a numeric variable:

boxplot(WEIGHT)		# remember to modify boxplots too! (add labels etc.)

# Use box plot

layout(matrix(c(1,2)))
boxplot(ageweight$WEIGHT, main="Missing values removed")
boxplot(ageweight.orig$WEIGHT, main="Original data")

# Box plots can be taken for categories separately:

plot(MALE, WEIGHT, main="Weight by Gender", ylab="Weight (kg)")

# Histogram shows the shape of the distribution efficiently:

hist(WEIGHT)
hist(WEIGHT, breaks=20)		# adjust e.g. number of bins

# --

# 4.3 Exercises

# Question 10

mean(HEIGHT)
sd(HEIGHT)

#

# -

# Question 11

height_mean <- tapply(HEIGHT, MALE, mean, na.rm=T)	# save table of means
height_sd <- tapply(HEIGHT, MALE, sd, na.rm=T)		# save table of sd's

height_table <- rbind(height_mean, height_sd)		# combine tables
height_table

# (a) women: mean height 1.66 (sd 0.07)
# (b) men: mean height 1.80 (sd 0.07)

# Save final table:

write.csv(height_table, "Height_by_gender.csv")

# -

# Question 12

hist(HEIGHT)

# -

# Question 13

h <- hist(HEIGHT, freq=F)
x <- seq(min(h$breaks),max(h$breaks), by=0.025)
y <- dnorm(x, mean=mean(HEIGHT, na.rm=T), sd=sd(HEIGHT, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)

# -

# Question 14

h <- hist(HEIGHT, freq=F,
	ylim=c(0,5), 					# change y axis
	main="Distribution of Height", 		# add main title
	xlab="Height (m)", ylab="",			# add axis labels
	col="grey")						# change colour
x <- seq(min(h$breaks),max(h$breaks), by=0.025)
y <- dnorm(x, mean=mean(HEIGHT, na.rm=T), sd=sd(HEIGHT, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)

# -

# Question 15

pdf(file="Height_distribution.pdf")
h <- hist(HEIGHT, freq=F,
	ylim=c(0,5),
	main="Distribution of Height",
	xlab="Height (m)", ylab="",
	col="grey")
x <- seq(min(h$breaks),max(h$breaks), by=0.025)
y <- dnorm(x, mean=mean(HEIGHT, na.rm=T), sd=sd(HEIGHT, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)
dev.off()

# -

# Question 16

boxplot(HEIGHT)

# (a) median is a bit over 1.7 m
# (b) distribution looks quite normal, maybe a bit more higher values than lower

# -

# Question 17

boxplot(HEIGHT~MALE, main="Height by Gender", ylab="Height (m)", xlab="Gender")

# men seem to be taller than women

# -

# Question 18

layout(matrix(c(1,2)))
boxplot(WEIGHT, main="Box plot of Weight", ylab="Weight (kg)", col="grey")
hist(WEIGHT, main="Histogram of Weight", xlab="Weight (kg)", ylab="", col="grey")

# -----

# 5. Exercises

# Load in naming data

naming <- read.csv("http://becs.aalto.fi/~heikkih3/naming_new.csv")

# Check for missing values and that factors are factors

summary(naming)

# Everything looks ok!
# We have 2 factors (word.type, sex) already coded as factors
# ... and 3 numeric variables (iq, hrs, ms)
# Missing values in iq already coded as NA's
# Other values look fine too.

# Detach ageweight and attach naming:
detach(ageweight)
attach(naming)

# -

# Question 20

plot(word.type,ms)

# Reading times for regular words seem to be faster than for exceptional words.

layout(matrix(c(1,2)))
plot(word.type, ms, data=naming[which(sex=="female"),],
	main="Female")
plot(word.type, ms, data=naming[which(sex=="male"),],
	main="Male")

# Effect of word type on reading types seems similar in men and women.
# I.e., no gender effects on differences in reading times between different word types.

# -

# Question 21

# Take a subset of the data:

naming_subset <- naming[1:1000, c("iq", "hrs", "sex")]

# Check this new subset:

head(naming_subset)
summary(naming_subset)

# Detach whole data and attach just the subset:

detach(naming)
attach(naming_subset)

# -

# Question 22

# Create factor reading group:

naming_subset$reading.group <- 'low'
naming_subset$reading.group[which(hrs>3.5)] <- 'medium'
naming_subset$reading.group[which(hrs>4.5)] <- 'high'
naming_subset$reading.group <- factor(naming_subset$reading.group)

# Check out the data now:

head(naming_subset)
summary(naming_subset)

# Need to attach the data again (cause we added a variable!)
# Previously added variables will be masked automatically

attach(naming_subset)

# -

# Question 23

table(sex,reading.group)		# contingency table
plot(table(sex,reading.group))	# bar charts

# No differences between men and women in how many participants are in which reading group.

# -

# Question 24

# Plot reading hours by gender:

boxplot(hrs~sex, main="Reading hours by gender", ylab="Reading hours")

# Shows similar lack of differences as question 23.

# -

# Question 25

# Plot intelligence by gender:

boxplot(iq~sex, main="Intelligence by gender", ylab="IQ")

# No differences in intelligence between men and women.

# -

# Question 26

# Plot histogram of intelligence with a normal curve approximation:

h <- hist(iq, freq=F, main="Distribution of IQ", xlab="IQ", ylab="", col="grey")
x <- min(h$breaks):max(h$breaks)
y <- dnorm(x, mean=mean(iq, na.rm=T), sd=sd(iq, na.rm=T))
lines(x,y,col="red", lty="dashed", lwd=2)

# Other ways to check for normality (see Section 6):
qqnorm(iq)					# QQ-plot
qqline(iq, col="red", lwd=2)
shapiro.test(iq)

# Both histogram, qq-plot and Shapiro-Wilk test for normality suggest the same:
# intelligence in this data set follows normal distribution.

# -

# Question 27

# Descriptive statistics for experimental manipulation (reading times by word type):

mean <- tapply(naming$ms, naming$word.type, mean, na.rm=T)
sd <- tapply(naming$ms, naming$word.type, sd, na.rm=T)

reading_times <- rbind(mean, sd)
reading_times

write.csv(reading_times, "reading_times.csv")

# Descriptive statistics for background variables:

bg_variables <- describe(naming_subset)
bg_variables

write.csv(bg_variables, "background_variables.csv")

# -----

# 6. Basic tools for testing for normality

# 6.1 Histogram

# Resets the seed for randomization:

set.seed(111)

# Take a sample of 20 from normal distribution:

data_normal <- rnorm(20)

# And a sample of 20 from exponential distribution:

data_exp <- rexp(20)

# Look at the histograms:

layout(matrix(c(1,2), nrow=1))
hist(data_normal)
hist(data_exp)

# -

# 6.2 Q-Q plot

?qqnorm
layout(matrix(c(1,2), nrow=1))
qqnorm(data_normal)
qqline(data_normal)
qqnorm(data_exp)
qqline(data_exp)

# data_normal is relatively normally distributed,
# but data_exp is clearly not

# -

# 6.3 Statistical tests for normality

# Shapiro-Wilk test:

shapiro.test(data_normal)
shapiro.test(data_exp)

# Kolmogorov-Smirnov test:
ks.test(data_normal, "pnorm", mean=mean(data_normal), sd=sd(data_normal))
ks.test(data_exp, "pnorm", mean=mean(data_exp), sd=sd(data_exp))

# Normality tests confirm the observation from the Q-Q plots:
# data_normal is normally distributed, data_exp is not.

# ------


# Code to generate plots for manuscript
library(rstan)
library(plyr)
library(magrittr)
library(lubridate)
library(ggplot2)
library(gridExtra)
library(patchwork)
library(reshape2)

# Loading and processing mosquito and case data
tseries <- read.csv("Data/Vitoria.data.csv")

post <- ddply(tseries, .(tot.week), summarise,
              qobs = sum(Mosquitoes, na.rm = T),
              yobs = sum(Cases, na.rm = T),
              tau = sum(Trap, na.rm = T),
              week = unique(Week),
              year = unique(Year),
              epiweek = 0,
              epiyear = 0)

# Generating epidemic weeks/years that count from peak to peak (week 16)
post$epiweek[16:243] <- c(1:52)
post$epiyear <- cumsum(post$epiweek == 1)

# Population size
pop <- 327801

# Loading and processing the weather data
weather <- read.csv("Data/Vitoria.weather.csv") %>%
  mutate(date = ymd(BRST), year = year(date), week = week(date))

weather <- subset(weather, date < date[1] + weeks(243))
weather$control <- rep(c(1:243), each = 7)

temp <- ddply(weather, .(control), summarise, temp = mean(Mean.TemperatureC, na.rm = T),
              humid = mean(Mean.Humidity, na.rm = T))

post$temp <- temp$temp
post$rov <- 7 * exp(0.21 * temp$temp - 7.9)

# Loading MCMC results
sim <- readRDS("Results/chain.rds")

# Effect of control in the number of cases in the following year
moving <- readRDS("Results/moving_control.rds")

# Figure 1: Observed and estimated time series =================================

# Case reports
yhat <- rstan::extract(sim, c("y_meas"), permute = T)[[1]] %>%
  reshape2::melt(varnames = c("rep", "week"), value.name = "yhat") %>%
  ddply(.(week), summarise,
        ymed = median(yhat),
        ymin = quantile(yhat, 0.1),
        ymax = quantile(yhat, 0.9))

# Trapped mosquitoes
qhat <- rstan::extract(sim, c("q_meas"), permute = T)[[1]] %>%
  reshape2::melt(varnames = c("rep", "week"), value.name = "qhat") %>%
  ddply(.(week), summarise,
        qmed = median(qhat),
        qmin = quantile(qhat, 0.1),
        qmax = quantile(qhat, 0.9))

# Mosquito mortality rate
system <- rstan::extract(sim, "state", permute = T)[[1]]

dvmu <- data.frame(rep = 1:dim(system)[1],
                   dvmu = 1.47 * rstan::extract(sim, "dvmu_c", permute = T)[[1]])

dv <- system[, 2:244, 12] %>%
  reshape2::melt(varnames = c("rep", "control"), value.name = "dv") %>%
  mutate(dvnat = exp(dv)) %>%
  join(dvmu) %>%
  mutate(dvnat = dvnat * dvmu) %>%
  join(temp)

# Plotting
yhat %>%
  ggplot(aes(week, ymin = ymin, ymax = ymax)) +
  geom_ribbon(fill = "grey70") +
  geom_line(aes(week, ymed)) +
  geom_point(aes(tot.week, yobs), data = post, inherit.aes = FALSE, size = 0.5) +
  theme_classic() +
  scale_y_continuous(expand = c(0, 0)) +
  scale_x_continuous(expand = c(0, 1), breaks = c(1, 54, 106, 158, 210), labels = c(2008, 2009, 2010, 2011, 2012)) +
  ylab("case reports") +
  xlab("year") +
  ggtitle("A") -> fig1a

qhat %>%
  ggplot(aes(week, ymin = qmin, ymax = qmax)) +
  geom_ribbon(fill = "grey70") +
  geom_line(aes(week, qmed)) +
  geom_point(aes(tot.week, qobs), data = post, inherit.aes = FALSE, size = 0.5) +
  theme_classic() +
  scale_y_continuous(expand = c(0, 0)) +
  scale_x_continuous(expand = c(0, 1), breaks = c(1, 54, 106, 158, 210), labels = c(2008, 2009, 2010, 2011, 2012)) +
  ylab("mosquitoes trapped") +
  xlab("year") +
  ggtitle("B") -> fig1b

post %>%
  ggplot(aes(tot.week, 1 / rov)) +
  geom_line() +
  theme_classic() +
  scale_y_continuous(expand = c(0.05, 0)) +
  scale_x_continuous(expand = c(0, 1), breaks = c(1, 54, 106, 158, 210), labels = c(2008, 2009, 2010, 2011, 2012)) +
  ylab("EIP (weeks)") +
  xlab("year") +
  ggtitle("C") -> fig1c

dv %>%
  ggplot(aes(control, dvnat)) +
  stat_summary(fun.ymin = function(x) quantile(x, 0.05),
               fun.ymax = function(x) quantile(x, 0.95),
               geom = "ribbon", fill = "gray70") +
  stat_summary(fun.y = "median", geom = "line") +
  theme_classic() +
  scale_y_continuous(expand = c(0.05, 0)) +
  scale_x_continuous(expand = c(0, 1), breaks = c(1, 54, 106, 158, 210), labels = c(2008, 2009, 2010, 2011, 2012)) +
  ylab("mosquito mortality rate") +
  xlab("year") +
  ggtitle("D") -> fig1d

postscript("Manuscript/figures/fig1.eps",
     width = 5, height = 7, paper = "special", horizontal = FALSE,
     family = "ArialMT")

fig1a + fig1b + fig1c + fig1d + plot_layout(ncol = 1)

dev.off()

# Figure 2: Estimates of latent mosquito mortality rate ========================

postscript("Manuscript/figures/fig2.eps",
           width = 4, height = 3, paper = "special", horizontal = FALSE,
           family = "ArialMT")

dv %>%
  ddply(.(control), summarise,
        dvnat = median(dvnat),
        temp = median(temp)) %>%
  ggplot(aes(temp, dvnat)) +
  geom_point() +
  theme_classic() +
  scale_y_continuous(expand = c(0.05, 0)) +
  scale_x_continuous(expand = c(0, 1)) +
  ylab("mosquito mortality rate") +
  xlab("weekly mean temperature")

dev.off()

# Figure 3: Effect of adult control implemented in different weeks ===================

# Adding week and year to moving window control results
moving <- moving %>%
  dplyr::rename("dv0" = "dvmu") %>%
  mutate(week = week(ymd("2008-01-01") + weeks(control - 1)),
         year = year(ymd("2008-01-01") + weeks(control - 1))) %>%
  join(dv)

# Computing the overall effect of control over 2008-2010
overall <- moving %>%
  subset(year < 2011) %>%
  ddply(.(rep, week), summarise,
        tcases = sum(tcases),
        tcases0 = sum(tcases0),
        ratio = tcases / tcases0,
        diff = tcases0 - tcases,
        dv0 = mean(dv0),
        dvmu = mean(dvmu),
        delta = mean(delta),
        phi = mean(phi))

overall <- dplyr::bind_rows(overall, moving) %>%
  mutate(year = factor(year, exclude = NULL, labels = c("2008","2009", "2010", "2011", "2012", "overall")))

# Computing the median overall best week for control
overall %>%
  ddply(.(rep, year), summarise,
        argmin = week[which.min(ratio)]) %>%
  ddply(.(year), summarise,
        argmin = median(argmin))

# Plotting

postscript("Manuscript/figures/fig3.eps",
           width = 4, height = 5, paper = "special", horizontal = FALSE,
           family = "ArialMT")

overall %>%
  subset(year %in% c("2008", "2009", "2010", "overall") & week < 53) %>%
  ggplot(aes(week, ratio)) +
  stat_summary(fun.ymin = function(x) quantile(x, 0.1),
               fun.ymax = function(x) quantile(x, 0.9),
               geom = "ribbon", fill = "gray70") +
  stat_summary(fun.y = "median", geom = "line") +
  facet_grid(year ~.) +
  geom_hline(yintercept = 1.0, color = "gray50", linetype = 2) +
  theme_classic() +
  theme(strip.background = element_blank()) +
  scale_x_continuous(expand = c(0, 0)) +
  xlab("week of control") +
  ylab("case ratio over following year")

dev.off()

# Figure 4: effect of phi on effectiveness of control ==========================

overall%>%
  subset(week == 34 & year == "overall") %>%
  ggplot(aes(dvmu, ratio)) +
  geom_point(size = 0.5) +
  theme_classic() +
  theme(strip.background = element_blank()) +
  labs(x = "mosquito mortality rate", y = "case ratio") -> fig4a

overall%>%
  subset(week == 34 & year == "overall") %>%
  ggplot(aes(phi, ratio)) +
  geom_point(size = 0.5) +
  theme_classic() +
  theme(strip.background = element_blank()) +
  labs(x = "case reporting probability", y = "case ratio") -> fig4b

postscript("Manuscript/figures/fig4.eps",
           width = 6, height = 3, paper = "special", horizontal = FALSE,
           family = "ArialMT")

fig4a + fig4b

dev.off()

# State var and control correlations ===========================================

# Cases
cases <- system[, , 11] %>%
  aaply(1, diff) %>%
  multiply_by(pop) %>%
  reshape2::melt(varnames = c("rep", "control"), value.name = "cases")

# Mosquitoes
mosq <- system[, 2:244, 9] %>%
  reshape2::melt(varnames = c("rep", "control"), value.name = "mosq")

# Probability of surviving EIP
infmosq <- system[, , 17] %>%
  aaply(1, diff) %>%
  melt(varnames = c("rep", "control"), value.name = "inf")

deadmosq <- system[, , 16] %>%
  aaply(1, diff) %>%
  reshape2::melt(varnames = c("rep", "control"), value.name = "dead")

surv <- join(infmosq, deadmosq) %>%
  mutate(total_exits = dead + inf,
         psurv = inf / total_exits)

# Joining everything
moving <- join(moving, cases) %>%
  join(mosq) %>%
  join(surv)

postcorr <- moving %>%
  subset(control < 191) %>%
  ddply(.(rep), summarise,
        dv = cor(ratio, dvnat),
        mosq = cor(ratio, mosq),
        cases = cor(ratio, cases),
        psurv = cor(ratio, psurv),
        temp = cor(ratio, temp))

colwise(median)(postcorr)

#===============================================================================
# Supplemental figures
#===============================================================================

# Figure S1: epsilons ==========================================================

eps_dv <- rstan::extract(sim, "eps_dv", permute = T)[[1]] %>%
  adply(2, quantile, c(0.1, 0.5, 0.9)) %>%
  mutate(week = as.numeric(X1))
names(eps_dv) <- c("X1", "min", "med", "max", "week")

eps_rv <- rstan::extract(sim, "eps_rv", permute = T)[[1]] %>%
  adply(2, quantile, c(0.1, 0.5, 0.9)) %>%
  mutate(week = as.numeric(X1))
names(eps_rv) <- c("X1", "min", "med", "max", "week")

postscript("Manuscript/figures/figS1.eps",
           width = 5.2, height = 3,
           family = "ArialMT")

ggplot(eps_dv, aes(week, med)) +
  geom_ribbon(aes(ymin = min, ymax = max), fill = "grey70") +
  geom_line() +
  geom_hline(yintercept = 0, linetype = 2) +
  theme_classic() +
  scale_x_continuous(expand = c(0, 1)) +
  ylab(expression(epsilon[nu])) +
  ggtitle("A") -> figs1.a

ggplot(eps_rv, aes(week, med)) +
  geom_ribbon(aes(ymin = min, ymax = max), fill = "grey70") +
  geom_line() +
  theme_classic() +
  scale_x_continuous(expand = c(0, 1)) +
  ylab(expression(epsilon[r])) +
  ggtitle("B") -> figs2.b

grid.arrange(figs1.a, figs2.b, nrow = 1)

dev.off()

# Figure S2: sigmas ============================================================

postscript("Manuscript/figures/figS2.eps",
           width = 6, height = 4,
           family = "ArialMT")

par(mfrow = c(1, 2))
rstan::extract(sim, "sigmadv", permute = T)[[1]] %>% hist(main = "A", xlab = expression(sigma[d]), freq = F)
rstan::extract(sim, "sigmarv", permute = T)[[1]] %>% hist(main = "B", xlab = expression(sigma[r]), freq = F)

dev.off()

# Figure S3: epidemiological parameters ===================================================

epiparams <- rstan::extract(sim, c("ro_c", "gamma_c", "delta_c", "dvmu_c"), permute = T)

postscript("Manuscript/figures/figS3.eps",
           width = 6, height = 6,
           family = "ArialMT")

par(mfrow = c(2, 2))

hist(epiparams[[1]], main = "A", xlab = "scaled latent period", freq = F, breaks = 30, ylim = c(0, 1.2))
curve(dgamma(x, 8.3, 8.3), add = T, lwd = 2)

hist(epiparams[[2]], main = "B", xlab = "scaled rate of infectious decay", freq = F, breaks = 30)
curve(dgamma(x, 100, 100), add = T, lwd = 2)

hist(epiparams[[3]], main = "C", xlab = "scaled period of cross-immunity", freq = F, breaks = 30, ylim = c(0, 1.3))
curve(dgamma(x, 10, 10), add = T, lwd = 2)

hist(epiparams[[4]], main = "D", xlab = "scaled mosquito mortality rate", freq = F, breaks = 30)
curve(dgamma(x, 100, 10), add = T, lwd = 2)

dev.off()

# Figure S4: initial conditions ===========================================================

ics <- rstan::extract(sim, c("S0", "E0","I0", "logNv", "dv0", "rv0"), permute = T)

postscript("Manuscript/figures/figS4.eps",
           width = 6, height = 5,
           family = "ArialMT")

par(mfrow = c(2, 3))

hist(ics$S0, freq = F, main = "A", xlab = expression(S[0]))
curve(dbeta(x, 4, 6), add = T, lwd = 2)

hist(ics$E0, freq = F, main = "B", xlab = expression(E[0]), ylim = c(0, 0.015))
curve(dgamma(x, 10, 0.1), add = T, lwd = 2)

hist(ics$I0, freq = F, main = "C", xlab = expression(I[0]), ylim = c(0, 0.02))
curve(dgamma(x, 6, 0.1), add = T, lwd = 2)

hist(ics$logNv, freq = F, main = "D", xlab = expression(log(V[N0])))
curve(dnorm(x, 0.7, 0.3), add = T, lwd = 2)

hist(ics$dv0, freq = F, main = "E", xlab = expression(nu[0]))
curve(dnorm(x, 0, 0.5), add = T, lwd = 2)

hist(ics$rv0, freq = F, main = "F", xlab = expression(r[0]))
curve(dnorm(x, 0, 0.5), add = T, lwd = 2)

dev.off()

# Figure S5: Measurement parameters ============================================

library(truncnorm)

meas <- rstan::extract(sim, c("log_phi_q", "phi_y", "eta_inv_q", "eta_inv_y"), permute = T)

postscript("Manuscript/figures/figS5.eps",
           width = 6, height = 6,
           family = "ArialMT")

par(mfrow = c(2, 2))

hist(meas$log_phi_q, freq = F, main = "A", xlab = expression(log(phi[q])))
curve(dnorm(x, -13, 0.5), add = T, lwd = 2)

hist(meas$phi_y, freq = F, main = "B", xlab = expression(phi[y]))
curve(dbeta(x, 7, 77), add = T, lwd = 2)

hist(meas$eta_inv_q, freq = F, main = "C", xlab = expression(eta[q]))
curve(dtruncnorm(x, a = 0, b = Inf, mean = 0, sd = 5), add = T)

hist(meas$eta_inv_y, freq = F, main = "D", xlab = expression(eta[y]))
curve(dtruncnorm(x, a = 0, b = Inf, mean = 0, sd = 5), add = T)

dev.off()

# Model checking ===============================================================

yrep <- rstan::extract(sim, "y_meas", permute = T)[[1]]
qrep <- rstan::extract(sim, "q_meas", permute = T)[[1]]

# Figure S6: ACF plots =========================================================

# Calculating the observed autocorrelation function
yacf <- acf(post$yobs, lag.max = 55, plot = F)$acf
qacf <- acf(post$qobs, lag.max = 55, plot = F)$acf

# Summarizing the posterior acf
yacfrange <- apply(yrep, 1, function(x){acf(x, lag.max = 55, plot = F)$acf}) %>%
  apply(1, quantile, probs = c(0.1,0.5, 0.9))

qacfrange <- apply(qrep, 1, function(x){acf(x, lag.max = 55, plot = F)$acf}) %>%
  apply(1, quantile, probs = c(0.1,0.5, 0.9))

# Assembling data frame for ggplot
acfdf <- data.frame("lag" = c(0:55),
                    "yobs" = yacf,
                    "qobs" = qacf,
                    "ymed" = yacfrange[2, ],
                    "ymin" = yacfrange[1, ],
                    "ymax" = yacfrange[3, ],
                    "qmed" = qacfrange[2, ],
                    "qmin" = qacfrange[1, ],
                    "qmax" = qacfrange[3, ]
                    )

# Plots
ggplot(acfdf, aes(lag, yobs)) +
  geom_hline(yintercept = 0, color = "gray50") +
  geom_linerange(aes(lag, ymin = ymin, ymax = ymax)) +
  geom_point() +
  theme_classic() +
  xlab("lag (weeks)") +
  ylab("case autocorrelation") +
  scale_x_continuous(expand = c(0, 0.1)) +
  ggtitle("A") -> figs5.a

ggplot(acfdf, aes(lag, qobs)) +
  geom_hline(yintercept = 0, color = "gray50") +
  geom_linerange(aes(lag, ymin = qmin, ymax = qmax)) +
  geom_point() +
  theme_classic() +
  xlab("lag (weeks)") +
  ylab("mosquito autocorrelation") +
  scale_x_continuous(expand = c(0, 0.1)) +
  ggtitle("B") -> figs5.b

postscript("Manuscript/figures/figS6.eps",
           width = 5.2, height = 3,
           family = "ArialMT")

grid.arrange(figs5.a, figs5.b, nrow = 1)

dev.off()

# Figure S7: Totals ============================================================

postscript("Manuscript/figures/figS7.eps",
           width = 6, height = 4,
           family = "ArialMT")

par(mfrow = c(1, 2))

hist(rowSums(yrep), main = "A", xlab = "total cases", freq = F, breaks = 20)
abline(v = sum(post$yobs), lwd = 2)

hist(rowSums(qrep), main = "B", xlab = "total captured mosquitoes", freq = F, breaks = 20)
abline(v = sum(post$qobs), lwd = 2)

dev.off()

# Figure S8: Min and max ===========================================================

postscript("Manuscript/figures/figS8.eps",
           width = 6, height = 6,
           family = "ArialMT")

par(mfrow = c(2, 2))

hist(apply(yrep, 1, max), main = "A", xlab = "maximum weekly cases", freq = F)
abline(v = max(post$yobs), lwd = 2)

hist(apply(qrep, 1, max), main = "B", xlab = "maximum weekly trap count", freq = F)
abline(v = max(post$qobs), lwd = 2)

hist(apply(yrep, 1, min), main = "C", xlab = "minimum weekly cases", freq = F)
abline(v = min(post$yobs), lwd = 2)

hist(apply(qrep, 1, min), main = "D", xlab = "minimum weekly trap count", freq = F)
abline(v = min(post$qobs), lwd = 2)

dev.off()

# Figure S9: Probability of surviving EIP ======================================

postscript("Manuscript/figures/figS9.eps",
           width = 6, height = 5,
           family = "ArialMT")

moving %>%
  ggplot(aes(control, psurv)) +
  stat_summary(fun.ymin = function(x) quantile(x, 0.1),
               fun.ymax = function(x) quantile(x, 0.9),
               geom = "ribbon", fill = "gray70") +
  stat_summary(fun.y = "median", geom = "line") +
  theme_classic() +
  scale_x_continuous(expand = c(0, 1), breaks = c(1, 54, 106, 158, 210), labels = c(2008, 2009, 2010, 2011, 2012)) +
  xlab("year") +
  ylab("probability of surviving EIP") -> figS9a

fig1d + ggtitle("") + figS9a + plot_layout(ncol = 1)

dev.off()


#### continuous_rqa_parameters-DCC.r: Part of `dual-conversation-constraints.Rmd` ####
#
# This script explores the parameters for the continuous cross-recurrence analysis
# that we'll run over the movement data. Because this is a lengthy process,
# we create a series of files along the way that can be re-run in pieces if needed.
# This allows us to keep this file commented by default.
#
# Written by: A. Paxton (University of California, Berkeley)
# Date last modified: 15 May 2017
#####################################################################################

#### 1. Preliminaries ####

# read in libraries and functions
source('./supplementary-code/libraries_and_functions-DCC.r')

# prep workspace and libraries
invisible(lapply(c('tseriesChaos',
                   'nonlinearTseries',
                   'crqa',
                   'quantmod',
                   'beepr'),
                 require,
                 character.only = TRUE))

# read in coords dataset
coords = read.table('./data/DCC-trimmed-data.csv', sep=',', header = TRUE)

#### 2. Determine delay with average mutual information (AMI) ####

# set maximum AMI
ami.lag.max = 100

# get AMI (lag and value) for both participants in each dyad
amis = coords %>% ungroup() %>%
  group_by(dyad,conv.type) %>%
  mutate(ami.val0 = min(as.numeric(mutual(euclid0, lag.max = ami.lag.max, plot = FALSE)),na.rm=TRUE)) %>%
  mutate(ami.val1 = min(as.numeric(mutual(euclid1, lag.max = ami.lag.max, plot = FALSE)),na.rm=TRUE)) %>%
  mutate(ami.loc0 = which.min(as.numeric(mutual(euclid0, lag.max = ami.lag.max, plot = FALSE)))-1) %>%
  mutate(ami.loc1 = which.min(as.numeric(mutual(euclid1, lag.max = ami.lag.max, plot = FALSE)))-1) %>%
  group_by(dyad,conv.num,conv.type,ami.val0,ami.val1,ami.loc0,ami.loc1) %>%
  distinct() %>%
  mutate(ami.selected = min(ami.loc1,ami.loc0))

# write AMI information to file
write.table(amis,'./data/crqa_parameters/ami_calculations-DCC.csv', sep=',',row.names=FALSE,col.names=TRUE)

# if we've already run it, load it in
amis = read.table('./data/crqa_parameters/ami_calculations-DCC.csv', sep=',',header=TRUE)

# join the AMI information to our whole dataframe
coords = join(coords,amis,by=c("dyad",'conv.type','conv.num'))

#### 3. Determing embedding dimension with FNN ####

# set maximum percentage of false nearest neighbors
fnnpercent = 10

# create empty dataframe
fnns = data.frame(dyad = numeric(),
                  partic = numeric(),
                  conv.type = numeric(),
                  head.embed = numeric(),
                  tail.embed = numeric())

# cycle through both conversations for each dyad
convo.dfs = split(coords,list(coords$dyad,coords$conv.type))
for (conv.code in names(convo.dfs)){

  # cycle through participants
  for (partic in 0:1){

    # print update
    print(paste("Beginning FNN calculations for P",partic," of Conversation ",conv.code,sep=""))

    # grab next participant's data
    p.data = select(convo.dfs[[conv.code]],matches(paste("euclid",partic,sep="")))[,1]
    p.ami = unique(convo.dfs[[conv.code]]$ami.selected)

    # only proceed if we have the dyad's data
    if (length(p.data) > 0) {

      # calculate false nearest neighbors
      fnn = false.nearest(p.data,
                          m = fnnpercent,
                          d = p.ami,
                          t = 0,
                          rt = 10,
                          eps = sd(p.data)/10)
      fnn = fnn[1,][complete.cases(fnn[1,])]
      threshold = fnn[1]/fnnpercent

      # identify the largest dimension after a large drop
      embed.dim.index = as.numeric(which(diff(fnn) < -threshold)) + 1
      head.embed = head(embed.dim.index,1)
      tail.embed = tail(embed.dim.index,1)
      if (length(embed.dim.index) == 0){
        head.embed = 1
        tail.embed = 1
      }

      # identify conversation type and dyad number from information
      conv.info = unlist(strsplit(conv.code,'[.]'))
      dyad = as.integer(conv.info[1])
      conv.type = as.integer(conv.info[2])

      # bind everything to data frame
      fnns = rbind.data.frame(fnns,
                              cbind.data.frame(dyad,
                                               partic,
                                               conv.type,
                                               head.embed,
                                               tail.embed))

    }}}

# change table configuration so that we get participants' embedding dimensions as columns, not rows
fnn.partic = split(fnns,fnns$partic)
fnn.partic.0 = plyr::rename(as.data.frame(fnn.partic[["0"]]),c('head.embed' = 'embed.0')) %>%
  select(dyad,conv.type,embed.0)
fnn.partic.1 = plyr::rename(as.data.frame(fnn.partic[["1"]]),c('head.embed' = 'embed.1')) %>%
  select(dyad,conv.type,embed.1)
fnn.merged = join(fnn.partic.0,fnn.partic.1,by=c("dyad","conv.type"))

# choose the largest embedding dimension
fnn.merged = fnn.merged %>% ungroup() %>%
  group_by(dyad,conv.type) %>%
  mutate(embed.selected = max(c(embed.0,embed.1)))

# save false nearest neighbor calculations to file
write.table(fnn.merged,'./data/crqa_parameters/fnn_calculations-DCC.csv', sep=',',row.names=FALSE,col.names=TRUE)

# if we've already run it, load it in
fnn.merged = read.table('./data/crqa_parameters/fnn_calculations-DCC.csv', sep=',',header=TRUE)

# merge with coords dataset
coords = join(coords, fnn.merged, by = c("dyad","conv.type"))

#### 4. Determine optimal radius ####

# rescale by mean distance
coords_crqa = coords %>% ungroup() %>%
  dplyr::select(dyad,conv.num,conv.type,euclid0,euclid1,conv.num,ami.selected,embed.selected) %>%
  group_by(dyad,conv.num) %>%
  mutate(rescale.euclid0 = euclid0/mean(euclid0)) %>%
  mutate(rescale.euclid1 = euclid1/mean(euclid1))

# create an empty dataframe to hold the parameter information
radius_selection = data.frame(dyad = numeric(),
                              conv.num = numeric(),
                              chosen.delay = numeric(),
                              chosen.embed = numeric(),
                              chosen.radius = numeric(),
                              rr = numeric())

# identify radius for calculations
radius.list = seq(.04,.26,by=.02)

# cycle through all conversations of all dyads
crqa.data = split(coords_crqa,
                  list(coords$dyad,
                       coords$conv.type))
for (next.conv in crqa.data){

  # make sure we only proceed if we have data for the conversation
  if (dim(next.conv)[1] != 0){

    # reset `target` variables for new radius (above what RR can be)
    from.target = 101
    last.from.target = 102

    # cycle through radii
    for (chosen.radius in radius.list){

      # if we're still improving, keep going
      if (from.target < last.from.target){

        # keep the previous iteration's performance
        last.from.target = from.target

        # print update
        print(paste("Dyad ", unique(next.conv$dyad),
                    ", conversation ",unique(next.conv$conv.num),
                    ": radius ",chosen.radius,sep=""))

        # identify parameters
        chosen.delay = unique(next.conv$ami.selected)
        chosen.embed = unique(next.conv$embed.selected)

        # run CRQA and grab recurrence rate (RR)
        rec_analysis = crqa(next.conv$rescale.euclid0,
                            next.conv$rescale.euclid1,
                            delay = chosen.delay,
                            embed = chosen.embed,
                            r = chosen.radius,
                            normalize = 0,
                            rescale = 0,
                            mindiagline = 2,
                            minvertline = 2,
                            tw = 0,
                            whiteline = FALSE,
                            recpt=FALSE)
        rr = rec_analysis$RR

        # clear it so we don't take up too much memory (optional)
        rm(rec_analysis)

        # identify how far off the RR is from our target (5%)
        from.target = abs(rr - 5)

        # save individual radius calculations
        dyad = unique(next.conv$dyad)
        conv.num = unique(next.conv$conv.num)
        write.table(cbind.data.frame(dyad,
                                     conv.num,
                                     chosen.delay,
                                     chosen.embed,
                                     chosen.radius,
                                     rr,
                                     from.target),
                    paste('./data/crqa_parameters/radius_calculations-mean_scaled-r',chosen.radius,'-',dyad,'_',conv.num,'-DCC.csv', sep=''),
                    sep=',',row.names=FALSE,col.names=TRUE)

        # append to dataframe
        radius_selection = rbind.data.frame(radius_selection,
                                            cbind.data.frame(dyad,
                                                             conv.num,
                                                             chosen.delay,
                                                             chosen.embed,
                                                             chosen.radius,
                                                             rr,
                                                             from.target))
      } else {

        # if we're no longer improving, break
        break

      }}}}

# save the radius explorations to file
write.table(radius_selection,'./data/crqa_parameters/radius_calculations-mean_scaled-DCC.csv', sep=',',row.names=FALSE,col.names=TRUE)

# let us know when it's finished
beepr::beep("fanfare")

# if we've already run it, load it in
radius_selection = read.table('./data/crqa_parameters/radius_calculations-mean_scaled-DCC.csv', sep=',',header=TRUE)

#### 5. Expand radius where necessary ####

# load back in the data
radius_selection = read.table('./data/crqa_parameters/radius_calculations-mean_scaled-DCC.csv', sep=',',header=TRUE)
radius_stats = radius_selection %>% ungroup() %>%
  group_by(dyad,conv.num) %>%
  dplyr::filter(from.target==min(from.target)) %>%
  dplyr::arrange(dyad,conv.num)

# check whether some conversations are further than 1% from our target recurrence rate
recheck_radii = radius_stats %>% ungroup() %>%
  dplyr::filter(from.target > 1) %>%
  dplyr::select(dyad,conv.num)

# link conversation numbers to types
checking_numbers = coords_crqa %>%
  ungroup() %>%
  dplyr::select(dyad,conv.type,conv.num) %>%
  distinct()
recheck_radii = recheck_radii %>%
  dplyr::left_join(x=.,
                   y=checking_numbers,
                   by=c("dyad"="dyad","conv.num"="conv.num")) %>%
  mutate(recheck.conv = paste(dyad,conv.type,sep='.'))

# create an empty dataframe to hold the parameter information
recheck_radius_selection = data.frame(dyad = numeric(),
                                      conv.num = numeric(),
                                      chosen.delay = numeric(),
                                      chosen.embed = numeric(),
                                      chosen.radius = numeric(),
                                      rr = numeric())

# cycle through the conversations
recheck_radii = crqa.data[recheck_radii$recheck.conv]
recheck_radius_list = seq(.28,1.4,by=.02)
for (next.conv in recheck_radii){

  # make sure we only proceed if we have data for the conversation
  if (dim(next.conv)[1] != 0){

    # reset `target` variables for new radius (above what RR can be)
    from.target = 101
    last.from.target = 102

    # cycle through radii
    for (chosen.radius in recheck_radius_list){

      # if we're still improving, keep going
      if (from.target < last.from.target){

        # keep the previous iteration's performance
        last.from.target = from.target

        # print update
        print(paste("Dyad ", unique(next.conv$dyad),
                    ", conversation ",unique(next.conv$conv.num),
                    ": radius ",chosen.radius,sep=""))

        # identify parameters
        chosen.delay = unique(next.conv$ami.selected)
        chosen.embed = unique(next.conv$embed.selected)

        # run CRQA and grab recurrence rate (RR)
        rec_analysis = crqa(next.conv$rescale.euclid0,
                            next.conv$rescale.euclid1,
                            delay = chosen.delay,
                            embed = chosen.embed,
                            r = chosen.radius,
                            normalize = 0,
                            rescale = 0,
                            mindiagline = 2,
                            minvertline = 2,
                            tw = 0,
                            whiteline = FALSE,
                            recpt=FALSE)
        rr = rec_analysis$RR

        # clear it so we don't take up too much memory (optional)
        rm(rec_analysis)

        # identify how far off the RR is from our target (5%)
        from.target = abs(rr - 5)

        # save individual radius calculations
        dyad = unique(next.conv$dyad)
        conv.num = unique(next.conv$conv.num)
        write.table(cbind.data.frame(dyad,
                                     conv.num,
                                     chosen.delay,
                                     chosen.embed,
                                     chosen.radius,
                                     rr,
                                     from.target),
                    paste('./data/crqa_parameters/radius_calculations-mean_scaled-r',chosen.radius,'-',dyad,'_',conv.num,'-DCC.csv', sep=''),
                    sep=',',row.names=FALSE,col.names=TRUE)

        # append to dataframe
        recheck_radius_selection = rbind.data.frame(recheck_radius_selection,
                                                    cbind.data.frame(dyad,
                                                                     conv.num,
                                                                     chosen.delay,
                                                                     chosen.embed,
                                                                     chosen.radius,
                                                                     rr,
                                                                     from.target))
      } else {

        # if we're no longer improving, break
        break

      }}}}

# save the radius explorations to file
write.table(recheck_radius_selection,'./data/crqa_parameters/radius_recheck_calculations-mean_scaled-DCC.csv', sep=',',row.names=FALSE,col.names=TRUE)

# let us know when it's finished
beepr::beep("fanfare")

# if we've already run it, load it in
recheck_radius_selection = read.table('./data/crqa_parameters/radius_recheck_calculations-mean_scaled-DCC.csv', sep=',',header=TRUE)

#### 6. Export chosen radii for all conversations ####

# load in files
radius_files = list.files('./data/crqa_parameters',
                          pattern='radius_calculations-mean_scaled*',
                          full.names = TRUE)

# identify the target radii
radius_stats = rbind.data.frame(rbindlist(lapply(radius_files, fread, sep=","))) %>%
  ungroup() %>%
  group_by(dyad,conv.num) %>%
  dplyr::filter(from.target==min(from.target)) %>%
  dplyr::arrange(dyad,conv.num) %>%
  ungroup() %>%
  distinct()

# rename our rescaled variables here
coords_crqa = coords_crqa %>% ungroup() %>%
  select(dyad,conv.num,rescale.euclid0,rescale.euclid1)

# join the dataframes
coords_crqa = plyr::join(x=coords_crqa,
                         y=radius_stats, by=c("dyad"="dyad","conv.num"="conv.num"))

# save to file
write.table(coords_crqa,'./data/crqa_data_and_parameters-DCC.csv', sep=',',row.names=FALSE,col.names=TRUE)


#' Predict probability from DMBC model
#'
#' @description
#' Based on a set of optimized features from training set, this function predicts the posterior probability for two class labels.
#'
#' @param data Validation dataset with rows are samples, columns are features. The first column should be the sample ID, second column group variable (Disease type, the label you want to classify on).
#' @param testset Lable unknown testset without sample IDs.
#' @param auc_out Output object of Cal_AUC() from a validation set.
#' @param col_start An index indicating at which column is the beginning of bacteria (features) data in the validation set. The default is the 3rd column.
#' @param type_col An index indicating at which column is group/type variable in the validation set. The default is the 2nd column.
#' @param Prior1 Prevalence of label1 according to literature or experience. Default is 0.5.
#' @param Prior2 Prevalence of label2 according to literature or experience. Default is 0.5.
#'
#' @return
#'
#' @examples
#' #load the DMBC library
#' library(DMBC)
#'
#' #load training dataset
#' data(training)
#'
#' #load test dataset
#' data(test)
#'
#'## calculate AUC based on training set using 10-fold cv ##
#' auc_out <- Cal_AUC(tfcv(training))
#'
#'## calculate AUC based on training set using leave-one-out cv ##
#' auc_out <- Cal_AUC(loocv(training))
#'
#' #predict unknown test set using training set and auc results.
#' dmbc_predict(data=training,testset=test,auc_out=auc_out)
#' @export

dmbc_predict <- function(data=data,testset = testset,auc_out=auc_out,col_start =3,type_col=2,Prior1=0.5,Prior2=1-Prior1){
  namelist <- auc_out$Features[which.max(auc_out$AUC_Area)]
  NameList <- as.vector(unlist(strsplit(as.character(namelist),";")))

  Disease <- levels(data[,type_col])

  NewDF <- as.data.frame(data[,colnames(data) %in% NameList])
  colnames(NewDF) <- colnames(data)[colnames(data) %in% NameList]

  NewDF2 <- data[,!colnames(data)%in% NameList]

  col_end2 = dim(NewDF2)[2]
  NewDF2$Others = rowSums(NewDF2[, col_start:col_end2])
  NewDFTotal = data.frame(NewDF2[, 1:(col_start-1)],NewDF, NewDF2$Others)

  rep2_Type1 = NewDFTotal[NewDFTotal[,type_col] == Disease[1],]
  rep2_Type2 = NewDFTotal[NewDFTotal[,type_col] == Disease[2],]

  for (taxa in NameList){
    if(nrow(rep2_Type1) == sum(rep2_Type1[,taxa]<1)) {
      rep2_Type1[,taxa][1] =1
    }
    if(nrow(rep2_Type2) == sum(rep2_Type2[,taxa]<1)) {
      rep2_Type2[,taxa][1] =1
    }
  }

  ####fit3 <- dirmult(rep2_Type1[,-(1:(col_start-1))],epsilon=10^(-4),trace=FALSE)
  ####fit4 <- dirmult(rep2_Type2[,-(1:(col_start-1))],epsilon=10^(-4),trace=FALSE)
  ####alpha_Type1 = fit3$gamma
  ####alpha_Type2 = fit4$gamma
  tol=0.0001
  max.iter=1000

  Xc = as.matrix(rep(1, dim(rep2_Type1)[1]))
  Xa = Xc
  Xb = Xc
  c0 = as.matrix(rep(1, dim(rep2_Type1)[2]-1))
  alpha0 = c0
  beta0 = c0
  p_Type1 <- ZIGDM_prob(rep2_Type1[,-(1:(col_start-1))], Xc, Xa, Xb, c0, alpha0, beta0, tol=0.0001, max.iter=1000)

  Xc = as.matrix(rep(1, dim(rep2_Type1)[1]))
  Xa = Xc
  Xb = Xc
  c0 = as.matrix(rep(1, dim(rep2_Type1)[2]-1))
  alpha0 = c0
  beta0 = c0
  p_Type2 <- ZIGDM_prob(rep2_Type2[,-(1:(col_start-1))], Xc, Xa, Xb, c0, alpha0, beta0, tol=0.0001, max.iter=1000)
  ###### predict test set #####

  for (t in NameList){
    if (! (t %in% colnames(testset)) ){
      testset <- data.frame(testset,rep(0,nrow(testset)))
      colnames(testset)[ncol(testset)] <- t
    }
  }

  NewTestSignature = testset[, colnames(testset)%in% NameList]
  NewTestNonSignature = testset[, !colnames(testset)%in% NameList]
  NewTestNonSignature$Others = rowSums(NewTestNonSignature)
  NewTestTotal = data.frame(NewTestSignature, NewTestNonSignature$Others)

  test_res <- list()
  for (r in 1:nrow(testset)){
    ##### Calculate log of Dirichlet multinomial probability mass function P(x|Type1)
    #pdfln_Type1 <- ddirmn(NewTestTotal[r,], t(as.matrix(alpha_Type1)))
    #lh_Type1=exp(pdfln_Type1)
    #lhP_Type1 = lh_Type1*Prior1

    probability_Type1 = apply(NewTestTotal[r,],1,dmultinom, prob = p_Type1)
    lhP_Type1 = probability_Type1*Prior1

    ##### Calculate log of Dirichlet multinomial probability mass function P(x|Type2)
    #pdfln_Type2 <- ddirmn(NewTestTotal[r,], t(as.matrix(alpha_Type2)))
    #lh_Type2=exp(pdfln_Type2)
    #lhP_Type2 = lh_Type2*Prior2
    probability_Type2 = apply(NewTestTotal[r,],1,dmultinom, prob = p_Type2)
    lhP_Type12 = probability_Type2*Prior2

    #Pos_Type1 = lh_Type1/(lh_Type1+lh_Type2)
    #Pos_Type2 = lh_Type2/(lh_Type1+lh_Type2)

    PosP_Type1 = lhP_Type1/(lhP_Type1+lhP_Type2)
    PosP_Type2 = lhP_Type2/(lhP_Type1+lhP_Type2)

    test_res[[r]] <- as.matrix(t(c(rownames(testset)[r],Disease[1], PosP_Type1, Disease[2], PosP_Type2,paste(NameList,collapse=";"))))

  }

  out <- data.frame(t(sapply(test_res,function(x) x)))
  colnames(out) <- c("test_idx","Group1","Group1_prb","Group2","Group2_prb","Features")

  return(out)
}


##############################################################################
# dci_calc_fx.r

# Edited by: G Oldford
    # Last modified: August, 2020
    # Inputs:
    #   sum_table
    #   lengths
    #   all_sections (t/f)
    #
    # Output:
    #   DCI
    #
    # Output example:
    #   DCIp     DCId
    #   30.03119 44.29823
    #
    # Notes:
    #
    #
    # to-do:

    #
    # Notes from previous coding work:

dci_calc_fx<-function(sum_table,
                      lengths,
                      all_sections=F){

    # Old Notes
    #sum.table is a variable that is used in the dci.calc.r function,
    #where we describe sum.table as sum.table.all or sum.table.nat
    #where: sum.table.nat<-read.csv("summary table natural.csv") and
    #sum.table.all<-read.csv("summary table all.csv") - from the
    #graph.and.data.setup.for.DCI.r function

    #WHAT THIS FUNCTION DOES: it calculates the DCIp and DCId
    #values for the riverscape (includes both natural and
    #artificial barriers)

    #this contains the length of each section

    #use this number for the DCIp calculation - i
    # interested in movements in all directions from all segments
    p_nrows<-dim(sum_table)[1]

    d_nrows<-subset(sum_table,
                    start=="sink")
    #for diadromous fish we are only interested in the movement
    # from the segment which is closest to the ocean
    d_sum_table<-d_nrows

    DCIp<-0
    DCId<-0

    #DCIp calculation
    for (k in 1:p_nrows){
        # Old notes:
        #to get the riverscape connectivity index for potadromous fish,
        #use the given formula: DCIp= Cij*(li/L)*(lj/L)
        #Cij = passability for pathway (product of all barrier passabilities
        #in the pathway), li & lj = length of start and finish sections,
        #L = total length of all sections

        lj<-sum_table$start_section_length[k]/sum(lengths$Shape_Length)
        lk<-sum_table$finish_section_length[k]/sum(lengths$Shape_Length)
        pass<-sum_table$pathway_pass[k]
        DCIp<-DCIp+lj*lk*pass*100

        #add DCIp at the beginning to keep a running total of DCIp values
    }

    #DCId calculation
    for (a in 1:dim(d_nrows)[1]){
        # Old notes:
        #to get the DCI for diadromous fish, use the following formula:
        # DCId= li/L*Cj (where j= the product of the passability in the pathway)

        la<-d_sum_table$finish_section_length[a]/sum(lengths$Shape_Length)
        pass_d<-d_sum_table$pathway_pass[a]
        DCId<-DCId+la*pass_d*100
    }

    DCI<-t(c(DCIp,DCId))
    DCI<-as.data.frame(DCI)

    names(DCI)<-c("DCIp","DCId")

    # Old notes
    #########  ALL SECTION ANLAYSIS  ######
    ## if desired, one can calculate the DCI_d starting with every sections.  This
    ## gives a "section-level" DCI score for each section in the watershed
    if(all_sections==T){
        sections<-as.vector(unique(sum_table$start))
        # store the all section results in DCI.as
        DCI_as<-NULL

        for(s in 1:length(sections)){
            DCI_s<-0
            # Old notes:
            # select out only the data that corresponds to pathways from one sectino
            # to all other sections
            d_nrows<-subset(sum_table, start==sections[s])
            d_sum_table<-d_nrows

            for (a in 1:dim(d_nrows)[1]){
                # Old note:
                #to get the DCI for diadromous fish, use the following formula:
                # DCId= li/L*Cj (where j= the product of the passability in the pathway)
                la<-d_sum_table$finish_section_length[a]/sum(lengths$Shape_Length)
                pass_d<-d_sum_table$pathway_pass[a]
                DCI_s<-round(DCI_s+la*pass_d*100, digits=2)
            } # end loop over sections for dci calc

            DCI_as[s]<-DCI_s
        } # end loop over "first" sections

        # STORE RESULTS IN .CSV file
        res<-data.frame(sections,DCI_as)
        write.table(x=res,
                file="DCI_all_sections.csv",
                sep=",",
                row.names=F)

    } # end if statement over all.sections

    print(DCI)

    #write.table(DCI,"DCI.csv", row.names=F, sep=",")

    return(DCI)
    # Old note:
    #returns the results (but you can't do anything after this, so "return"
    # must always be at the end of a function)

}