score <- function(input) {
    return((subroutine0(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.0351) - (input[1])) ^ (2.0)) + (((95.0) - (input[2])) ^ (2.0))) + (((2.68) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.4161) - (input[5])) ^ (2.0))) + (((7.853) - (input[6])) ^ (2.0))) + (((33.2) - (input[7])) ^ (2.0))) + (((5.118) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((224.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((392.78) - (input[12])) ^ (2.0))) + (((3.81) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine0 <- function(input) {
    return((subroutine1(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((18.0846) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.679) - (input[5])) ^ (2.0))) + (((6.434) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.8347) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((27.25) - (input[12])) ^ (2.0))) + (((29.05) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine1 <- function(input) {
    return((subroutine2(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.98843) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((5.813) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((4.0952) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((394.54) - (input[12])) ^ (2.0))) + (((19.88) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine2 <- function(input) {
    return((subroutine3(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((10.8342) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.679) - (input[5])) ^ (2.0))) + (((6.782) - (input[6])) ^ (2.0))) + (((90.8) - (input[7])) ^ (2.0))) + (((1.8195) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((21.57) - (input[12])) ^ (2.0))) + (((25.79) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine3 <- function(input) {
    return((subroutine4(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.22358) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((19.58) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.605) - (input[5])) ^ (2.0))) + (((6.943) - (input[6])) ^ (2.0))) + (((97.4) - (input[7])) ^ (2.0))) + (((1.8773) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((403.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((363.43) - (input[12])) ^ (2.0))) + (((4.59) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine4 <- function(input) {
    return((subroutine5(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((6.53876) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.631) - (input[5])) ^ (2.0))) + (((7.016) - (input[6])) ^ (2.0))) + (((97.5) - (input[7])) ^ (2.0))) + (((1.2024) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((392.05) - (input[12])) ^ (2.0))) + (((2.96) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine5 <- function(input) {
    return((subroutine6(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.18337) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((27.74) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.609) - (input[5])) ^ (2.0))) + (((5.414) - (input[6])) ^ (2.0))) + (((98.3) - (input[7])) ^ (2.0))) + (((1.7554) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((711.0) - (input[10])) ^ (2.0))) + (((20.1) - (input[11])) ^ (2.0))) + (((344.05) - (input[12])) ^ (2.0))) + (((23.97) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine6 <- function(input) {
    return((subroutine7(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.03578) - (input[1])) ^ (2.0)) + (((20.0) - (input[2])) ^ (2.0))) + (((3.33) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.4429) - (input[5])) ^ (2.0))) + (((7.82) - (input[6])) ^ (2.0))) + (((64.5) - (input[7])) ^ (2.0))) + (((4.6947) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((216.0) - (input[10])) ^ (2.0))) + (((14.9) - (input[11])) ^ (2.0))) + (((387.31) - (input[12])) ^ (2.0))) + (((3.76) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine7 <- function(input) {
    return((subroutine8(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((45.7461) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((4.519) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.6582) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((88.27) - (input[12])) ^ (2.0))) + (((36.98) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine8 <- function(input) {
    return((subroutine9(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((2.01019) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((19.58) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.605) - (input[5])) ^ (2.0))) + (((7.929) - (input[6])) ^ (2.0))) + (((96.2) - (input[7])) ^ (2.0))) + (((2.0459) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((403.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((369.3) - (input[12])) ^ (2.0))) + (((3.7) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine9 <- function(input) {
    return((subroutine10(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((7.67202) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((5.747) - (input[6])) ^ (2.0))) + (((98.9) - (input[7])) ^ (2.0))) + (((1.6334) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((393.1) - (input[12])) ^ (2.0))) + (((19.92) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine10 <- function(input) {
    return((subroutine11(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.46336) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((19.58) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.605) - (input[5])) ^ (2.0))) + (((7.489) - (input[6])) ^ (2.0))) + (((90.8) - (input[7])) ^ (2.0))) + (((1.9709) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((403.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((374.43) - (input[12])) ^ (2.0))) + (((1.73) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine11 <- function(input) {
    return((subroutine12(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.61282) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((6.096) - (input[6])) ^ (2.0))) + (((96.9) - (input[7])) ^ (2.0))) + (((3.7598) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((248.31) - (input[12])) ^ (2.0))) + (((20.34) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine12 <- function(input) {
    return((subroutine13(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((67.9208) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((5.683) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.4254) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((384.97) - (input[12])) ^ (2.0))) + (((22.98) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine13 <- function(input) {
    return((subroutine14(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((22.5971) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.7) - (input[5])) ^ (2.0))) + (((5.0) - (input[6])) ^ (2.0))) + (((89.5) - (input[7])) ^ (2.0))) + (((1.5184) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((31.99) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine14 <- function(input) {
    return((subroutine15(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((14.2362) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((6.343) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.5741) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((20.32) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine15 <- function(input) {
    return((subroutine16(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.25387) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((6.91) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.448) - (input[5])) ^ (2.0))) + (((5.399) - (input[6])) ^ (2.0))) + (((95.3) - (input[7])) ^ (2.0))) + (((5.87) - (input[8])) ^ (2.0))) + (((3.0) - (input[9])) ^ (2.0))) + (((233.0) - (input[10])) ^ (2.0))) + (((17.9) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((30.81) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine16 <- function(input) {
    return((subroutine17(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.01501) - (input[1])) ^ (2.0)) + (((90.0) - (input[2])) ^ (2.0))) + (((1.21) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.401) - (input[5])) ^ (2.0))) + (((7.923) - (input[6])) ^ (2.0))) + (((24.8) - (input[7])) ^ (2.0))) + (((5.885) - (input[8])) ^ (2.0))) + (((1.0) - (input[9])) ^ (2.0))) + (((198.0) - (input[10])) ^ (2.0))) + (((13.6) - (input[11])) ^ (2.0))) + (((395.52) - (input[12])) ^ (2.0))) + (((3.16) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine17 <- function(input) {
    return((subroutine18(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((9.91655) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((5.852) - (input[6])) ^ (2.0))) + (((77.8) - (input[7])) ^ (2.0))) + (((1.5004) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((338.16) - (input[12])) ^ (2.0))) + (((29.97) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine18 <- function(input) {
    return((subroutine19(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.31533) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((6.2) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.504) - (input[5])) ^ (2.0))) + (((8.266) - (input[6])) ^ (2.0))) + (((78.3) - (input[7])) ^ (2.0))) + (((2.8944) - (input[8])) ^ (2.0))) + (((8.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((17.4) - (input[11])) ^ (2.0))) + (((385.05) - (input[12])) ^ (2.0))) + (((4.14) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine19 <- function(input) {
    return((subroutine20(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.83377) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((19.58) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.605) - (input[5])) ^ (2.0))) + (((7.802) - (input[6])) ^ (2.0))) + (((98.2) - (input[7])) ^ (2.0))) + (((2.0407) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((403.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((389.61) - (input[12])) ^ (2.0))) + (((1.92) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine20 <- function(input) {
    return((subroutine21(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.38799) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((5.95) - (input[6])) ^ (2.0))) + (((82.0) - (input[7])) ^ (2.0))) + (((3.99) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((232.6) - (input[12])) ^ (2.0))) + (((27.71) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine21 <- function(input) {
    return((subroutine22(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.01538) - (input[1])) ^ (2.0)) + (((90.0) - (input[2])) ^ (2.0))) + (((3.75) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.394) - (input[5])) ^ (2.0))) + (((7.454) - (input[6])) ^ (2.0))) + (((34.2) - (input[7])) ^ (2.0))) + (((6.3361) - (input[8])) ^ (2.0))) + (((3.0) - (input[9])) ^ (2.0))) + (((244.0) - (input[10])) ^ (2.0))) + (((15.9) - (input[11])) ^ (2.0))) + (((386.34) - (input[12])) ^ (2.0))) + (((3.11) - (input[13])) ^ (2.0))))) * (0.7500000000002167)))
}
subroutine22 <- function(input) {
    return((subroutine23(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.01381) - (input[1])) ^ (2.0)) + (((80.0) - (input[2])) ^ (2.0))) + (((0.46) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.422) - (input[5])) ^ (2.0))) + (((7.875) - (input[6])) ^ (2.0))) + (((32.0) - (input[7])) ^ (2.0))) + (((5.6484) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((255.0) - (input[10])) ^ (2.0))) + (((14.4) - (input[11])) ^ (2.0))) + (((394.23) - (input[12])) ^ (2.0))) + (((2.97) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine23 <- function(input) {
    return((subroutine24(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((2.77974) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((19.58) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.871) - (input[5])) ^ (2.0))) + (((4.903) - (input[6])) ^ (2.0))) + (((97.8) - (input[7])) ^ (2.0))) + (((1.3459) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((403.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((29.29) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine24 <- function(input) {
    return((subroutine25(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((9.2323) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.631) - (input[5])) ^ (2.0))) + (((6.216) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.1691) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((366.15) - (input[12])) ^ (2.0))) + (((9.53) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine25 <- function(input) {
    return((subroutine26(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.06129) - (input[1])) ^ (2.0)) + (((20.0) - (input[2])) ^ (2.0))) + (((3.33) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.4429) - (input[5])) ^ (2.0))) + (((7.645) - (input[6])) ^ (2.0))) + (((49.7) - (input[7])) ^ (2.0))) + (((5.2119) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((216.0) - (input[10])) ^ (2.0))) + (((14.9) - (input[11])) ^ (2.0))) + (((377.07) - (input[12])) ^ (2.0))) + (((3.01) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine26 <- function(input) {
    return((subroutine27(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.25179) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((5.57) - (input[6])) ^ (2.0))) + (((98.1) - (input[7])) ^ (2.0))) + (((3.7979) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((376.57) - (input[12])) ^ (2.0))) + (((21.02) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine27 <- function(input) {
    return((subroutine28(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((4.89822) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.631) - (input[5])) ^ (2.0))) + (((4.97) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.3325) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((375.52) - (input[12])) ^ (2.0))) + (((3.26) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine28 <- function(input) {
    return((subroutine29(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.13081) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((5.713) - (input[6])) ^ (2.0))) + (((94.1) - (input[7])) ^ (2.0))) + (((4.233) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((360.17) - (input[12])) ^ (2.0))) + (((22.6) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine29 <- function(input) {
    return((subroutine30(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.33147) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((6.2) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.507) - (input[5])) ^ (2.0))) + (((8.247) - (input[6])) ^ (2.0))) + (((70.4) - (input[7])) ^ (2.0))) + (((3.6519) - (input[8])) ^ (2.0))) + (((8.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((17.4) - (input[11])) ^ (2.0))) + (((378.95) - (input[12])) ^ (2.0))) + (((3.95) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine30 <- function(input) {
    return((subroutine31(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.52693) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((6.2) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.504) - (input[5])) ^ (2.0))) + (((8.725) - (input[6])) ^ (2.0))) + (((83.0) - (input[7])) ^ (2.0))) + (((2.8944) - (input[8])) ^ (2.0))) + (((8.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((17.4) - (input[11])) ^ (2.0))) + (((382.0) - (input[12])) ^ (2.0))) + (((4.63) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine31 <- function(input) {
    return((subroutine32(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.35472) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((6.072) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((4.175) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((376.73) - (input[12])) ^ (2.0))) + (((13.04) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine32 <- function(input) {
    return((subroutine33(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.57834) - (input[1])) ^ (2.0)) + (((20.0) - (input[2])) ^ (2.0))) + (((3.97) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.575) - (input[5])) ^ (2.0))) + (((8.297) - (input[6])) ^ (2.0))) + (((67.0) - (input[7])) ^ (2.0))) + (((2.4216) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((264.0) - (input[10])) ^ (2.0))) + (((13.0) - (input[11])) ^ (2.0))) + (((384.54) - (input[12])) ^ (2.0))) + (((7.44) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine33 <- function(input) {
    return((subroutine34(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.08187) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((2.89) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.445) - (input[5])) ^ (2.0))) + (((7.82) - (input[6])) ^ (2.0))) + (((36.9) - (input[7])) ^ (2.0))) + (((3.4952) - (input[8])) ^ (2.0))) + (((2.0) - (input[9])) ^ (2.0))) + (((276.0) - (input[10])) ^ (2.0))) + (((18.0) - (input[11])) ^ (2.0))) + (((393.53) - (input[12])) ^ (2.0))) + (((3.57) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine34 <- function(input) {
    return((subroutine35(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.02009) - (input[1])) ^ (2.0)) + (((95.0) - (input[2])) ^ (2.0))) + (((2.68) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.4161) - (input[5])) ^ (2.0))) + (((8.034) - (input[6])) ^ (2.0))) + (((31.9) - (input[7])) ^ (2.0))) + (((5.118) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((224.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((390.55) - (input[12])) ^ (2.0))) + (((2.88) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine35 <- function(input) {
    return((subroutine36(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.61154) - (input[1])) ^ (2.0)) + (((20.0) - (input[2])) ^ (2.0))) + (((3.97) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.647) - (input[5])) ^ (2.0))) + (((8.704) - (input[6])) ^ (2.0))) + (((86.9) - (input[7])) ^ (2.0))) + (((1.801) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((264.0) - (input[10])) ^ (2.0))) + (((13.0) - (input[11])) ^ (2.0))) + (((389.7) - (input[12])) ^ (2.0))) + (((5.12) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine36 <- function(input) {
    return((subroutine37(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((3.32105) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((19.58) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.871) - (input[5])) ^ (2.0))) + (((5.403) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.3216) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((403.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((26.82) - (input[13])) ^ (2.0))))) * (-0.400989603367655)))
}
subroutine37 <- function(input) {
    return((subroutine38(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.29819) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((6.2) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.504) - (input[5])) ^ (2.0))) + (((7.686) - (input[6])) ^ (2.0))) + (((17.0) - (input[7])) ^ (2.0))) + (((3.3751) - (input[8])) ^ (2.0))) + (((8.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((17.4) - (input[11])) ^ (2.0))) + (((377.51) - (input[12])) ^ (2.0))) + (((3.92) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine38 <- function(input) {
    return((subroutine39(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.51902) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((19.58) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.605) - (input[5])) ^ (2.0))) + (((8.375) - (input[6])) ^ (2.0))) + (((93.9) - (input[7])) ^ (2.0))) + (((2.162) - (input[8])) ^ (2.0))) + (((5.0) - (input[9])) ^ (2.0))) + (((403.0) - (input[10])) ^ (2.0))) + (((14.7) - (input[11])) ^ (2.0))) + (((388.45) - (input[12])) ^ (2.0))) + (((3.32) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine39 <- function(input) {
    return((subroutine40(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((5.66998) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.631) - (input[5])) ^ (2.0))) + (((6.683) - (input[6])) ^ (2.0))) + (((96.8) - (input[7])) ^ (2.0))) + (((1.3567) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((375.33) - (input[12])) ^ (2.0))) + (((3.73) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine40 <- function(input) {
    return((subroutine41(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((8.26725) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((1.0) - (input[4])) ^ (2.0))) + (((0.668) - (input[5])) ^ (2.0))) + (((5.875) - (input[6])) ^ (2.0))) + (((89.6) - (input[7])) ^ (2.0))) + (((1.1296) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((347.88) - (input[12])) ^ (2.0))) + (((8.88) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine41 <- function(input) {
    return((subroutine42(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((25.0461) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((5.987) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.5888) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((26.77) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine42 <- function(input) {
    return((subroutine43(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.05602) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((2.46) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.488) - (input[5])) ^ (2.0))) + (((7.831) - (input[6])) ^ (2.0))) + (((53.6) - (input[7])) ^ (2.0))) + (((3.1992) - (input[8])) ^ (2.0))) + (((3.0) - (input[9])) ^ (2.0))) + (((193.0) - (input[10])) ^ (2.0))) + (((17.8) - (input[11])) ^ (2.0))) + (((392.63) - (input[12])) ^ (2.0))) + (((4.45) - (input[13])) ^ (2.0))))) * (1.0)))
}
subroutine43 <- function(input) {
    return((subroutine44(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.38735) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((25.65) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.581) - (input[5])) ^ (2.0))) + (((5.613) - (input[6])) ^ (2.0))) + (((95.6) - (input[7])) ^ (2.0))) + (((1.7572) - (input[8])) ^ (2.0))) + (((2.0) - (input[9])) ^ (2.0))) + (((188.0) - (input[10])) ^ (2.0))) + (((19.1) - (input[11])) ^ (2.0))) + (((359.29) - (input[12])) ^ (2.0))) + (((27.26) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine44 <- function(input) {
    return((subroutine45(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((41.5292) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((5.531) - (input[6])) ^ (2.0))) + (((85.4) - (input[7])) ^ (2.0))) + (((1.6074) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((329.46) - (input[12])) ^ (2.0))) + (((27.38) - (input[13])) ^ (2.0))))) * (-0.3490103966325617)))
}
subroutine45 <- function(input) {
    return((subroutine46(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((24.8017) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((5.349) - (input[6])) ^ (2.0))) + (((96.0) - (input[7])) ^ (2.0))) + (((1.7028) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((19.77) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine46 <- function(input) {
    return((subroutine47(input)) + ((exp((-0.0000036459736698188483) * (((((((((((((((1.15172) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((5.701) - (input[6])) ^ (2.0))) + (((95.0) - (input[7])) ^ (2.0))) + (((3.7872) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((358.77) - (input[12])) ^ (2.0))) + (((18.35) - (input[13])) ^ (2.0))))) * (-1.0)))
}
subroutine47 <- function(input) {
    return((((25.346480984077544) + ((exp((-0.0000036459736698188483) * (((((((((((((((16.8118) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.7) - (input[5])) ^ (2.0))) + (((5.277) - (input[6])) ^ (2.0))) + (((98.1) - (input[7])) ^ (2.0))) + (((1.4261) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((30.81) - (input[13])) ^ (2.0))))) * (-1.0))) + ((exp((-0.0000036459736698188483) * (((((((((((((((38.3518) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((18.1) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.693) - (input[5])) ^ (2.0))) + (((5.453) - (input[6])) ^ (2.0))) + (((100.0) - (input[7])) ^ (2.0))) + (((1.4896) - (input[8])) ^ (2.0))) + (((24.0) - (input[9])) ^ (2.0))) + (((666.0) - (input[10])) ^ (2.0))) + (((20.2) - (input[11])) ^ (2.0))) + (((396.9) - (input[12])) ^ (2.0))) + (((30.59) - (input[13])) ^ (2.0))))) * (-1.0))) + ((exp((-0.0000036459736698188483) * (((((((((((((((0.84054) - (input[1])) ^ (2.0)) + (((0.0) - (input[2])) ^ (2.0))) + (((8.14) - (input[3])) ^ (2.0))) + (((0.0) - (input[4])) ^ (2.0))) + (((0.538) - (input[5])) ^ (2.0))) + (((5.599) - (input[6])) ^ (2.0))) + (((85.7) - (input[7])) ^ (2.0))) + (((4.4546) - (input[8])) ^ (2.0))) + (((4.0) - (input[9])) ^ (2.0))) + (((307.0) - (input[10])) ^ (2.0))) + (((21.0) - (input[11])) ^ (2.0))) + (((303.42) - (input[12])) ^ (2.0))) + (((16.51) - (input[13])) ^ (2.0))))) * (-1.0)))
}


# R code
# Luis P. F. Garcia 2018
# Export the best model based on the accuracy

extract <- function(data, result, wtype, ftype, size) {

  result = do.call("rbind", lapply(result, "[", "acc",))
  clf = names(which.max(colMeans(result)))
  user = which.max(result[,clf])

  data = window(data$tran[[user]], wtype, ftype, size)
  model = eval(call(clf, data, data))
  return(model$model)
}


## Plot simulations for Mincerian Wage equation
## Load libraries
library(tidyverse)
library(texreg)
library(cowplot)
library(ggsci)
library(ggpubr)
library(vtable)

## Make descriptipve table
df <- read.csv("data/edit/analysis_df.csv") %>%
  dplyr::select(-X.1)

labs <- data.frame(
  age = "Age",
  S = "Schooling (years)",
  X = "Work experience (years)",
  ln_y_I = "Log wages (linear-I)",
  ln_y_II = "Log wages (linear-II)",
  ln_y_III = "Log wages (linear-III)",
  ln_y_IV = "Log wages (linear-IV)",
  gender = "Sex (1 = female, 0 = male)"
)

df %>%
  select(age, S, X, gender, ln_y_I, ln_y_II, ln_y_III, ln_y_IV) %>%
  mutate(gender = ifelse(gender == 1, "Female", "Male")) %>%
  vtable::sumtable(
    labels = labs, out = "latex",
    file = "tex/tables/desc_mincerian.tex"
  )

## Plot OOS performance
source("mincerian/functions.R")
data <- readRDS("data/final/simul_4models_100.rds")

df <- data %>%
  mutate(
    lm_1_1 = 1 - (lm_1_1 / lm_1_bench),
    lm_1_2 = 1 - (lm_1_2 / lm_1_bench),
    lm_1_3 = 1 - (lm_1_3 / lm_1_bench),
    lm_1_4 = 1 - (lm_1_4 / lm_1_bench),
    lm_2_1 = 1 - (lm_2_1 / lm_2_bench),
    lm_2_2 = 1 - (lm_2_2 / lm_2_bench),
    lm_2_3 = 1 - (lm_2_3 / lm_2_bench),
    lm_2_4 = 1 - (lm_2_4 / lm_2_bench),
    lm_3_1 = 1 - (lm_3_1 / lm_3_bench),
    lm_3_2 = 1 - (lm_3_2 / lm_3_bench),
    lm_3_3 = 1 - (lm_3_3 / lm_3_bench),
    lm_3_4 = 1 - (lm_3_4 / lm_3_bench),
    lm_4_1 = 1 - (lm_4_1 / lm_4_bench),
    lm_4_2 = 1 - (lm_4_2 / lm_4_bench),
    lm_4_3 = 1 - (lm_4_3 / lm_4_bench),
    lm_4_4 = 1 - (lm_4_4 / lm_4_bench),
    gb_1 = 1 - (gb_1 / lm_1_bench),
    gb_2 = 1 - (gb_2 / lm_2_bench),
    gb_3 = 1 - (gb_3 / lm_3_bench),
    gb_4 = 1 - (gb_4 / lm_4_bench)
  ) %>%
  dplyr::select(-lm_1_bench, -lm_2_bench, -lm_3_bench, -lm_4_bench)

df_melt <- df %>%
  reshape2::melt() %>%
  mutate(
    dataset = ifelse(grepl("lm_1|gb_1", variable), "Dataset I",
      ifelse(grepl("lm_2|gb_2", variable), "Dataset II",
        ifelse(grepl("lm_3|gb_3", variable), "Dataset III",
          ifelse(grepl("lm_4|gb_4", variable), "Dataset IV",
            "Else"
          )
        )
      )
    ),
    model = ifelse(grepl("\\d{1}_1", variable), "Linear I",
      ifelse(grepl("\\d{1}_2", variable), "Linear II",
        ifelse(grepl("\\d{1}_3", variable), "Linear III",
          ifelse(grepl("\\d{1}_4", variable), "Linear IV",
            ifelse(grepl("gb", variable), "XGBoost",
              "Other"
            )
          )
        )
      )
    )
  )

df_summ <- df_melt %>%
  group_by(variable) %>%
  summarise(
    mean = mean(value),
    sd = sd(value),
    model = unique(model),
    dataset = unique(dataset)
  )

df_plot <- df_summ %>%
  filter(!grepl("rf", variable))

custom_pal <- c(
  ggsci::pal_aaas()(6)[6],
  RColorBrewer::brewer.pal(4, "Blues")
)

df_plot$model <- factor(df_plot$model, levels = c(
  "XGBoost", "Linear I", "Linear II",
  "Linear III", "Linear IV"
))
text_size <- 20

ggplot(df_plot, aes(y = mean, x = model, group = dataset, fill = model)) +
  geom_bar(stat = "identity", color = "black") +
  geom_text(aes(label = paste0(as.character(round(mean, 2) * 100), "%")),
    vjust = -0.5
  ) +
  geom_hline(yintercept = 0.9, linetype = "dashed") +
  scale_fill_manual(values = custom_pal, name = "") +
  ylim(0, 1) +
  scale_y_continuous(
    limits = c(0.5, 1.05), oob = scales::rescale_none,
    labels = scales::percent
  ) +
  geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = 0.5) +
  facet_wrap(~dataset, nrow = 1) +
  cowplot::theme_cowplot() +
  xlab("Model") +
  ylab("Out-of-sample R-squared") +
  theme(
    panel.grid.minor.x = element_line(size = 0.25), # linetype = 'dotted'),
    strip.text.y = element_text(face = "bold", hjust = 0.5, vjust = 0.5),
    strip.background = element_rect(fill = NA, color = "black", size = 1.5),
    legend.position = "top",
    panel.border = element_rect(color = "lightgrey", fill = NA, size = 0.5),
    text = element_text(size = 20)
  ) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1, size = (text_size - 1)),
    axis.text.y = element_text(size = (text_size - 1)),
    axis.title.y = element_text(size = 16.3)
  ) +
  scale_y_continuous(labels = scales::percent, limits = c(0, 1))

ggsave("tex/figs/fig1_mincerian.pdf", last_plot(), width = 12, height = 6)

## Plot in-sample regression results

analysis_df <- read.csv("data/edit/analysis_df.csv")

form_0 <- as.formula("ln_y ~ 1")
form_1 <- as.formula("ln_y ~ 1 + S + X")
form_2 <- as.formula("ln_y ~ 1 + S + X + X_sq")
form_3 <- as.formula(
  "ln_y ~ 1 + S_0_8 + S_9_10 + S_11_12 + S_13_14 + S_15p + X + X_sq"
)
form_4 <- as.formula(
  "ln_y ~ 1 + S_0_8 + S_9_10 + S_11_12 + S_13_14 + S_15p + X + X_sq + gender"
)

formulas <- list(form_0, form_1, form_2, form_3, form_4)

vars <- list("ln_y_I", "ln_y_II", "ln_y_III", "ln_y_IV")

coef_dfs <- lapply(vars, FUN = function(x) {
  make_coef_df(formulas, analysis_df, var = x)
})

total_df <- data.frame()

for (i in coef_dfs) {
  total_df <- rbind(total_df, i)
}

total_df <- total_df[total_df$model_no != "Null", ]
plot_df <- total_df[total_df$coefficient != "(Intercept)", ]
plot_df$dataset <- as.factor(plot_df$dataset)

plot_df <- plot_df %>%
  mutate(var_type = ifelse(grepl("X", coefficient), "Years Work Experience",
    ifelse(grepl("S", coefficient), "Years Schooling", "Sex")
  )) %>%
  mutate(coefficient = gsub("gender", "Female", coefficient)) %>%
  mutate(
    coefficient = gsub("S_|S", "School years: ", coefficient),
    coefficient = gsub("_", " to ", coefficient),
    coefficient = gsub("p$", "+", coefficient),
    coefficient = gsub("X to sq", "Work years (squared)", coefficient),
    coefficient = gsub("X", "Work years", coefficient),
    dataset = gsub("ln_y_", "Dataset ", dataset)
  ) %>%
  mutate(
    sig = ifelse(`p-value` < 0.01, "*", ""),
    sig_pos = estimate + 0.05
  )

ggplot(
  plot_df,
  aes(x = estimate, y = coefficient, fill = model_no)
) +
  geom_point(
    size = 2.5, position = position_dodge(width = 0.5),
    color = "black", pch = 21
  ) +
  facet_wrap(~dataset, nrow = 1) +
  geom_vline(xintercept = 0, linetype = "dashed") +
  theme_cowplot() +
  scale_fill_manual(
    values = custom_pal[2:5],
    name = "Model type"
  ) +
  theme(legend.position = "top") +
  xlab("Coefficient Estimate") +
  ylab("Coefficient") +
  geom_text(
    data = plot_df, aes(x = sig_pos, y = coefficient, label = sig),
    color = "black",
    position = position_dodge(width = 0.5),
    vjust = 0.7
  ) +
  theme(
    panel.grid.major.x = element_line(
      size = 0.5, linetype = "dotted",
      colour = "lightgrey"
    ),
    panel.grid.minor.x = element_line(
      size = 0.25, linetype = "dotted",
      colour = "lightgrey"
    ),
    strip.placement = "outside",
    strip.text.y = element_text(face = "bold", hjust = 0.5, vjust = 0.5),
    strip.background = element_rect(fill = NA, color = "black", size = 1.2),
    legend.position = "top",
    panel.spacing.x = unit(1, "lines"),
    panel.spacing.y = unit(0.1, "lines"),
    panel.border = element_rect(color = "lightgrey", fill = NA, size = 0.5),
    plot.margin = grid::unit(c(0.5, 0.5, 0.1, 0.1), "mm")
  )

ggsave("tex/figs/fig2_mincerian.pdf", last_plot(), width = 12, height = 8)

## -- Shapley plots

df <- read.csv("data/edit/mincerian_shap.csv") %>%
  rowwise() %>%
  mutate(
    S1 = as.numeric(S1),
    S_0_8 = min(S1, 8),
    S_9_10 = min(max(S1 - 8, 0), 2),
    S_11_12 = min(max(S1 - 10, 0), 2),
    S_13_14 = min(max(S1 - 12, 0), 2),
    S_15p = max(S1 - 14, 0),
  ) %>%
  ungroup()

df$X1_1_predict <- predict_XSQ(df, total_df, "Linear I", "ln_y_I")
df$X1_2_predict <- predict_XSQ(df, total_df, "Linear II", "ln_y_I")
df$X1_3_predict <- predict_XSQ(df, total_df, "Linear III", "ln_y_I")
df$X1_4_predict <- predict_XSQ(df, total_df, "Linear IV", "ln_y_I")

df$X2_1_predict <- predict_XSQ(df, total_df, "Linear I", "ln_y_II")
df$X2_2_predict <- predict_XSQ(df, total_df, "Linear II", "ln_y_II")
df$X2_3_predict <- predict_XSQ(df, total_df, "Linear III", "ln_y_II")
df$X2_4_predict <- predict_XSQ(df, total_df, "Linear IV", "ln_y_II")

df$X3_1_predict <- predict_XSQ(df, total_df, "Linear I", "ln_y_III")
df$X3_2_predict <- predict_XSQ(df, total_df, "Linear II", "ln_y_III")
df$X3_3_predict <- predict_XSQ(df, total_df, "Linear III", "ln_y_III")
df$X3_4_predict <- predict_XSQ(df, total_df, "Linear IV", "ln_y_III")

df$X4_1_predict <- predict_XSQ(df, total_df, "Linear I", "ln_y_IV")
df$X4_2_predict <- predict_XSQ(df, total_df, "Linear II", "ln_y_IV")
df$X4_3_predict <- predict_XSQ(df, total_df, "Linear III", "ln_y_IV")
df$X4_4_predict <- predict_XSQ(df, total_df, "Linear IV", "ln_y_IV")

df$S1_1_predict <- predict_S(df, total_df, "Linear I", "ln_y_I")
df$S1_2_predict <- predict_S(df, total_df, "Linear II", "ln_y_I")
df$S1_3_predict <- predict_S(df, total_df, "Linear III", "ln_y_I")
df$S1_4_predict <- predict_S(df, total_df, "Linear IV", "ln_y_I")

df$S2_1_predict <- predict_S(df, total_df, "Linear I", "ln_y_II")
df$S2_2_predict <- predict_S(df, total_df, "Linear II", "ln_y_II")
df$S2_3_predict <- predict_S(df, total_df, "Linear III", "ln_y_II")
df$S2_4_predict <- predict_S(df, total_df, "Linear IV", "ln_y_II")

df$S3_1_predict <- predict_S(df, total_df, "Linear I", "ln_y_III")
df$S3_2_predict <- predict_S(df, total_df, "Linear II", "ln_y_III")
df$S3_3_predict <- predict_S(df, total_df, "Linear III", "ln_y_III")
df$S3_4_predict <- predict_S(df, total_df, "Linear IV", "ln_y_III")

df$S4_1_predict <- predict_S(df, total_df, "Linear I", "ln_y_IV")
df$S4_2_predict <- predict_S(df, total_df, "Linear II", "ln_y_IV")
df$S4_3_predict <- predict_S(df, total_df, "Linear III", "ln_y_IV")
df$S4_4_predict <- predict_S(df, total_df, "Linear IV", "ln_y_IV")

df_melt_X <- df %>%
  sample_n(250) %>%
  dplyr::select(
    X1, X1_shap, X2_shap, X3_shap, X4_shap,
    contains("_predict"),
    -starts_with("S"), sex
  ) %>%
  reshape2::melt(id.vars = c("X1", "sex")) %>%
  mutate(
    model = ifelse(grepl("shap", variable), "Shapley Value",
      ifelse(grepl("_1", variable), "Linear I",
        ifelse(grepl("_2", variable), "Linear II",
          ifelse(grepl("_3", variable), "Linear III",
            ifelse(grepl("_4", variable), "Linear IV", "None")
          )
        )
      )
    ),
    dataset = gsub("_.*", "", variable),
    dataset = gsub("X", "Dataset ", dataset),
    sex = as.factor(ifelse(sex == 1, "Female", "Male"))
  ) %>%
  rename(Sex = sex) %>%
  group_by(variable) %>%
  mutate(value = scale(value)) %>%
  ungroup()

df_melt_S <- df %>%
  sample_n(250) %>%
  dplyr::select(
    S1, S1_shap, S2_shap, S3_shap, S4_shap,
    contains("_predict"), sex
  ) %>%
  dplyr::select(-contains("X"), sex) %>%
  reshape2::melt(id.vars = c("S1", "sex")) %>%
  mutate(
    model = ifelse(grepl("shap", variable), "Shapley Value",
      ifelse(grepl("_1", variable), "Linear I",
        ifelse(grepl("_2", variable), "Linear II",
          ifelse(grepl("_3", variable), "Linear III",
            ifelse(grepl("_4", variable), "Linear IV", "None")
          )
        )
      )
    ),
    dataset = gsub("_.*", "", variable),
    dataset = gsub("S", "Dataset ", dataset),
    S1 = as.numeric(S1),
    sex = as.factor(ifelse(sex == 1, "Female", "Male"))
  ) %>%
  rename(Sex = sex) %>%
  group_by(variable) %>%
  mutate(value = scale(value)) %>%
  ungroup()

X_shap_plot <- ggplot(
  df_melt_X %>% filter(!grepl("shap", variable)),
  aes(y = value, x = X1, color = Sex)
) +
  geom_point(
    data = df_melt_X %>% filter(grepl("shap", variable)),
    alpha = 0.5, size = 3.5
  ) +
  geom_line(aes(linetype = model), color = "black", size = 0.8) +
  ggsci::scale_color_aaas() +
  xlab("Work experience (years)") +
  ylab("Implied effect on log wages") +
  scale_linetype_manual(values = c("solid", "dashed", "twodash", "dotted")) +
  theme_cowplot() +
  guides(color = guide_legend(override.aes = list(fill = NA))) +
  facet_wrap(~dataset, nrow = 1) +
  theme(
    panel.grid.minor.y = element_line(size = 0.25, linetype = "dotted"),
    panel.grid.major.y = element_line(size = 0.25, linetype = "dotted"),
    strip.text.y = element_text(face = "bold", hjust = 0.5, vjust = 0.5),
    strip.background = element_rect(fill = NA, color = "black", size = 1.5),
    legend.position = "top",
    panel.border = element_rect(color = "lightgrey", fill = NA, size = 0.5),
    text = element_text(size = 20),
    legend.title = element_blank()
  )

S_shap_plot <- ggplot(
  df_melt_S %>% filter(!grepl("shap", variable)),
  aes(y = value, x = S1, color = Sex)
) +
  geom_point(
    data = df_melt_S %>% filter(grepl("shap", variable)),
    size = 3.5, alpha = 0.5
    #  color = ggsci::pal_aaas("default")(4)[1], size = 3.5
  ) +
  ggsci::scale_color_aaas() +
  geom_line(aes(linetype = model), color = "black", size = 0.8) +
  xlab("Schooling (years)") +
  ylab("Implied effect on log wages") +
  scale_linetype_manual(values = c("solid", "dashed", "twodash", "dotted")) +
  theme_cowplot() +
  theme(
    panel.grid.minor.y = element_line(size = 0.25, linetype = "dotted"),
    panel.grid.major.y = element_line(size = 0.25, linetype = "dotted"),
    strip.text.y = element_text(face = "bold", hjust = 0.5, vjust = 0.5),
    strip.background = element_rect(fill = NA, color = "black", size = 1.5),
    legend.position = "top",
    panel.border = element_rect(color = "lightgrey", fill = NA, size = 0.5),
    text = element_text(size = 20),
    legend.title = element_blank()
  ) +
  guides(color = guide_legend(override.aes = list(fill = NA))) +
  facet_wrap(~dataset, nrow = 1)

ggarrange(X_shap_plot + theme(legend.position = "none"),
  S_shap_plot + theme(legend.position = "none"),
  nrow = 2, common.legend = TRUE, legend = "top"
)

ggsave("tex/figs/fig3_mincerian.pdf", last_plot(), width = 12, height = 8)


test_that("define_level_factor",{
    dat_new <- data.frame(
      factor1=c("var1","var2"),
      factor2=c("2var1","2var2")
    )
    result <- define_level_factor(dat_new, "pop")
    expect_equal(result, 'pop_level =~ 1*factor1 + 1*factor2')
})


############ simulate.KB.data.r
## Simulate data for Michael for the training input/output.
##
## Input:
## pre_mod - indicator for n[43] up front
## name - one hot encoding for 25 letters (25 rows), across 50 positions (50 cols)
## charge - integer 1-6
## precursor mz: 300-2000 real
##
## Output:
## column of mz: 300-2000 real
## intensity: 0-1 scale
## ion: indicator for two letters
## position: integer for number, 1-L (30)
## chem_loss: one hot for 17, 44, 43, etc (say 5)
## charge: integer 1-6
## delta: -1 to 1

datDir <- "D:\\hackathon\\"

## functions to return a string, a list of lists [[0,1,0,...,0],[1,0,0,...,0]]  # each list 25 long
## one-hot encoded variable of length L
oh_l <- function(L){
  tmp <- rep(0, L)
  tmp[sample(c(1:L), 1)] <- 1
  tmp
}

## return a string that is a list of lists
## num_aa is the number of possible amino acids (plus other residues)
## seq_length is the length of the peptide sequence
seq_string <- function(num_aa, seq_length){
  st <- '['
  for (i in 1:seq_length){
    oh <- oh_l(num_aa)
    oh_string <- paste(oh, collapse=',')
    st <- paste0(st, '[', oh_string, ']')
    if (i < seq_length) { st <- paste0(st, ',')}
  }
  st <- paste0(st, ']')
  st
}

## function to turn a vector into a list string
list_string <- function(vec){
  st <- paste(vec, collapse=',')
  st <- paste0('[', st, ']')
  st
}

## set up simulated training input for 100 peptide sequences
set.seed(29387429)

sim.in <- data.frame(seq_id=1:100,
                     acetyl=sample(c(0,1), 100, replace=T),
                     name=seq_string(25, 50),
                     charge=sample(c(1:6), 100, replace=T),
                     precursor=runif(100, 300, 2000))

sim.out <- NA

## simulating 300 mz values per sequence
for (i in 1:100){
  tmp.out <- data.frame(mz=list_string(round(runif(300, 300, 2000),digits=3)),
                      intensity=list_string(round(runif(300, 0, 1),digits=3)),
                      ion=list_string(sample(c(0,1), 300, replace=T)),
                      position=list_string(sample(c(1:49), 300, replace=T)),
                      neutral_loss=list_string(sample(c(0:3), 300, replace=T)),
                      charge=list_string(sample(c(1:6), 300, replace=T)),
                      delta=list_string(round(runif(300, -.99, .99),digits=3)))
  #tmp.out <- tmp.out[order(tmp.out$mz),]
  sim.out <- rbind(sim.out, tmp.out)
}
sim.out <- sim.out[-1,]

#write.table(sim.in[which(sim.in$seq_id <= 100),], paste0(datDir, "sim.input.csv"), sep=',', row.names=F, col.names=T)
#write.table(sim.out[which(sim.out$seq_id <= 100),], paste0(datDir, "sim.output.csv"), sep=',', row.names=F, col.names=T)

sim.data <- cbind(sim.in, sim.out)
write.table(sim.data, paste0(datDir, "sim.data.csv"), sep=',', row.names=F, col.names=T)


# From neurips 2021 docker
install.packages(c("IRkernel", "tidyverse", "anndata", "lmds", "FNN"), repos = "https://cran.rstudio.com")
# For Linux: download libv8 during installation
Sys.setenv(DOWNLOAD_STATIC_LIBV8=1)
install.packages(c("V8","sfsmisc","clue","randomForest","lattice","devtools","MASS"),repos="https://cran.rstudio.com")
if (!require("BiocManager", quietly = TRUE))
    install.packages("BiocManager",repos="https://cran.rstudio.com")
BiocManager::install(version = "3.14")
BiocManager::install(c("SID", "bnlearn", "pcalg"))
#BiocManager::install(c("CAM", "SID", "bnlearn", "pcalg", "kpcalg", "D2C"))
library(devtools)
install_github("cran/momentchi2")
install_github("Diviyan-Kalainathan/RCIT")
install.packages(c("sparsebn"), repos="https://cran.rstudio.com")


library(FLCore)
library(FLXSA)
library(FLash) # from the MSE directory

data(ple4)

## Check Retro
# MV retro.ple4<-retro(ple4,ple4.indices,FLXSA.control(),retro=10)
# MV xyplot(data~year,groups=qname,data=lapply(retro.ple4,fbar), type="l")
# MV xyplot(data~year,groups=qname,data=lapply(retro.ple4,"ssb"),type="l")

## Stock recruitment relationship
ple4.sr       <-as.FLSR(ple4)
ple4.sr       <-transform(ple4.sr,ssb=ssb/1000,rec=rec/1000)
model(ple4.sr)<-ricker()
ple4.sr       <-mle(ple4.sr)
plot(ple4.sr)
sr.params      <- c(params(ple4.sr))[1:2]*c(1,1/1000)
sr.model      <-"ricker"

## set up objects
nits                   <-100
ple4                   <-propagate(stf(ple4,nyrs=21),iter=nits)
biol                   <-as(ple4,"FLBiol")
fleet                  <-as(ple4,"FLFleet")
fleet@capacity[]       <-0.75

## years
now        <-2001
future.yr  <-now+19
history.yr <-dims(ple4)$minyear
plusgroup  <-ple4@range["plusgroup"]

## HCR options
Fpa          <-.60
Bpa          <-200000
Fmin         <-.10
TAC.bound    <-0.15
GodOnlyKnows <-FALSE

plusgrp      <-ple4@range["plusgroup"]

# Monte Carlo
#sr.deviates   <-FLQuant(sample(c(exp(residuals(ple4.sr))),replace=TRUE,size=nits*20*nits),dimnames=dmns)
sr.deviates       <-FLQuant(exp(rnorm(nits*dims(ple4)$year, mean=0.0, sd=.3)),dimnames=list(age=1,year=now:future.yr,iter=1:nits))/exp(.3^2/2.0)
index.deviates    <-FLQuant(exp(rnorm(dims(biol@m)$age*dims(biol@m)$year*nits, mean=0, sd=.30)), dimnames=list(age=ple4@range["min"]:plusgrp,year=history.yr:future.yr,iter=1:nits))
catch.q(fleet,1,1)<-FLQuant(1*exp(rnorm(length(c(catch.q(fleet,1)[[1]])),0,.2)),dimnames=dimnames(catch.q(fleet,1)[[1]]))

################
# MV Here you have to remove the FLash package and substitute it by another FLAsh

# remove.packages("FLash")

## MP ########################################################################
## set up CPUE index

OEMCPUE<-function(biol,deviates,start,end="missing",plusgroup="missing")
     {
     if (missing(end)) end<-start
     yrs<-start:end

     if (!missing(plusgroup))
        index<-setPlusGroup(trim(biol,year=yrs),plusgroup)@n
     else
        index<-trim(biol,year=yrs)@n

     ## unbiased population estimates
     return(index*deviates[,ac(yrs)])
     }

index                               <-as(trim(biol, age=biol@range["min"]:plusgroup),"FLIndex")
index@range[c("startf","endf")]     <-c(0,0.1)
index@index[,ac(history.yr:(now-1))]<-OEMCPUE(biol,index.deviates,start=history.yr,end=now-1,plusgroup=plusgroup)

## set up stock
stk               <-as(biol,"FLStock")
stk               <-setPlusGroup(stk,plusgrp)
stk@stock.n[]     <-NA
stk@harvest[]     <-NA
units(stk@harvest)<-"f"
 ## Observation Error Model

OEMStock<-function(biol,fleet,start,end="missing",plusgroup="missing")
    {
    if (missing(end)) end<-start
    yrs<-as.character(end:start)

    stk <-as(window(fleet@metiers[[1]]@catches[[1]], start=start, end=end),"FLStock")

    ## biological parameters
    stock.wt(    stk)[,yrs] <-wt(  biol)[dimnames(stk@m)$age,yrs]
    m(           stk)[,yrs] <-m(   biol)[dimnames(stk@m)$age,yrs]
    mat(         stk)[,yrs] <-fec( biol)[dimnames(stk@m)$age,yrs]
    harvest.spwn(stk)[,yrs] <-spwn(biol)[dimnames(stk@m)$age,yrs]
    m.spwn(      stk)[,yrs] <-spwn(biol)[dimnames(stk@m)$age,yrs]

    if (!missing(plusgroup))
       stk<-setPlusGroup(stk,plusgroup)

    return(stk)
    }

## set up stock
yrs.assess<-ac(-30:(now-1))
stk       <-OEMStock(biol,fleet,start=history.yr,end=now-1)
TAC       <-catch(fleet,1,1)[,ac(now)]

  cat(sprintf("\n===========================================\n"))
  for (iyr in now:future.yr)
     {
     stk@range["maxyear"] <-iyr-1
     yrs.assess           <-as.character((history.yr):stk@range["maxyear"])
     cat(sprintf("Year =%.0f\n",iyr))

     ## Observation Error Model
     index@index[,ac(iyr-1)]<-OEMCPUE( biol,index.deviates,iyr-1,plusgroup=plusgroup)
     stk[        ,ac(iyr-1)]<-OEMStock(biol,fleet,         iyr-1,plusgroup=plusgroup)

     cat("=============","Assess!"," =============\n")
     # MV if (TRUE) {
        t.<-system.time(stk<-stk[,yrs.assess]+FLXSA(stk[,yrs.assess],trim(index,year=((history.yr):(iyr-1))),diag.flag=FALSE))
     # MV }
     # MV else {
     # MV    t.<-system.time(stk<-perfectAssess(stk,biol,fleet,yrs.assess))
     # MV }

     cat("system.time",t.,"\n")

     ## HCR
     cat("=============","HCR"," =================\n")
     ## years for projection etc.
     yr.now     <-as.character(stk@range["maxyear"]+1)
     yr.TAC     <-as.character(stk@range["maxyear"]+2)
     yr.recruits<-as.character((stk@range["minyear"]+1):(stk@range["maxyear"]+2))

     ## set up future years
     stk   <-stf(window(stk,end=stk@range["maxyear"]),nyrs=2)

     ## F status quo
     Fsq   <-c(fbar(stk)[,yr.now])

     ## target options
     target<-fwdTarget(year    =c(stk@range["maxyear"]-1,rep(stk@range["maxyear"],4)),
                       quantity=c(rep(      "f",2),"catch","ssb","f"),
                       value   =c(mean(Fsq),mean(pmin(Fsq,Fpa)),   NA,    NA, NA),
                       min     =c(NA,NA,mean(TAC*(1.0-TAC.bound)),mean(Bpa),     Fmin),
                       max     =c(NA,NA,mean(TAC*(1.0+TAC.bound)),       NA,mean(Fpa)))

      cat("\n===================","Target"," ====================\n")
      print(target[,1:5])
      cat("================================================\n")

      ## targets by iter
      value    <-array(NA,c(dim(target)[1], dims(stk)$iter))

      min      <-value
      max      <-value

      value[1,]<-c(Fsq)
      value[2,]<-c(pmin(Fsq,Fpa))
      value[2,]<-c(pmin(Fsq,Fpa))

      min[3,]<-c(TAC*(1.0-TAC.bound))
      min[4,]<-c(Bpa)
      min[5,]<-Fmin

      max[3,]<-c(TAC*(1.0-TAC.bound))
      max[5,]<-c(Fpa)

      ## run
      t.<-system.time(stk<-fwd(stk,target[1:2,],value=value[1:2,], min=min[1:2,], max=max[1:2,], sr.model="mean",sr.params=exp(mean(log(stk@stock.n[1,yr.recruits]),na.rm=TRUE))))

      ## get Quota
      TAC<-computeCatch(stk)[,yr.TAC]
      cat("system.time",t.,"\n")

      ## go fish!!
      cat("=============","Go Fish!"," ============\n")
      OMcontrol <-fwdControl(year=iyr+1, fleet=1, metier=1, value=NA, min=.01, max=.75)
      OMtarget  <-fwdTarget( year=iyr+1, value=mean(c(TAC)), quantity="catch", fleet=1, metier=1, spp=1)

      t.<-system.time(res<-fwd(biol, fleet, OMtarget, OMcontrol, target.value=t(matrix(TAC)),sr.model=sr.model, sr.params=sr.params, sr.residuals=sr.deviates[,as.character(iyr+1)]))

      landings.n(fleet,1,1)[,as.character(iyr+1)]<-res$landings.n[,as.character(iyr+1)]
      discards.n(fleet,1,1)[,as.character(iyr+1)]<-res$discards.n[,as.character(iyr+1)]
      effort(fleet)[        ,as.character(iyr+1)]<-res$effort[    ,as.character(iyr+1)]
      n(biol)[              ,as.character(iyr+1)]<-res$n[         ,as.character(iyr+1)]
      cat("system.time",t.,"\n")

      SmryPlots(fleet,biol,stk,stk@range[c("minfbar","maxfbar")],(history.yr):(iyr-1))
      }


library(DBI)
library(odbc)
library(tidyverse)

rm(list=ls())

#Load and prepare gene expression matrix
myinf1 <- "/projects/varnf/GLASS-III/GLASS-III/results/kallisto/kallisto/final/gene_tpm_matrix_all_samples.tsv"

genes <- read.delim(myinf1,row.names=1)
colnames(genes) <- gsub("\\.","-",colnames(genes))

#Load clinical data
con <- DBI::dbConnect(odbc::odbc(), "GLASSv3")

q <- "SELECT al.aliquot_barcode, sa.sample_type, su.idh_codel_subtype, aliquot_batch, ROUND(nd.rneo,2) AS rneo
FROM biospecimen.aliquots al
LEFT JOIN clinical.surgeries su ON su.sample_barcode = al.sample_barcode
LEFT JOIN biospecimen.samples sa ON al.sample_barcode = sa.sample_barcode
JOIN analysis.analyte_sets an ON an.rna_barcode = al.aliquot_barcode
LEFT JOIN analysis.neoantigen_depletion nd ON nd.aliquot_barcode = an.dna_barcode
INNER JOIN analysis.gold_set gs ON an.dna_barcode = gs.tumor_barcode_a OR an.dna_barcode = gs.tumor_barcode_b
WHERE aliquot_analyte_type = 'R'"

clin <- dbGetQuery(con,q)

sub_genes <- genes[,clin[,"aliquot_barcode"]]
gene_sums <- apply(sub_genes,1,sum)
sub_genes <- sub_genes[which(gene_sums>0),]
sub_genes <- log10(sub_genes + 1)

#Create model comparing neoantigen depletion to expression when adjusting for subtype and batch
pval <- eff <- rep(0,nrow(sub_genes))
for(i in 1:nrow(sub_genes))
{
	cat("\r", i)
	mygene = as.numeric(sub_genes[i,])
	xx = cbind(mygene, clin)
	formula_vec = paste("rneo ~ mygene +", paste(colnames(clin)[3:4],collapse=" + ",sep=" "))
	mylm <- lm(formula_vec, data = xx)
	mylm = summary(mylm)
	pval[i] =  mylm[["coefficients"]][2, 4]
	eff[i] =  mylm[["coefficients"]][2, 1]
}

#Multiple testing correction
fdr <- p.adjust(pval,"BH")

#Create results
res <- data.frame(rownames(sub_genes),pval,fdr,eff)
colnames(res)[1] <- "gene_symbol"
res <- res[order(res[,"pval"]),]

#Get the genes negatively associated with the ratio
res_neg <- res[which(res[,"eff"] < 0 & res[,"pval"] < 0.05),]


#' @export
Association.test <- function (data, hydro, strata.group, species, nreps = 0, method = c("KS-Test", "CVM-Test")[1], subset,stat.plot=F) {
  #amc additions for characterizing the distribution of catch weighted effort and effort
    method.int <- charmatch(method, c("KS-Test", "CVM-Test"))

    if (is.na(method.int))
        stop("Invalid test method specified")
    if (method.int == 0)
        stop("Ambiguous test method")
    if (!inherits(data, "strata.data"))
        stop("Not a legitimate strata data object")
    attach(data)
    if (!missing(subset)) {
        data <- data[subset, ]
    }
    detach("data")
    strata.use <- is.element(data$Strata, strata.group$Strata)
    hydro <- (data[hydro])[strata.use, ]
    species <- (data[species])[strata.use, ]
    Strata <- data$Strata[strata.use]
    if (is.null(species))
        species <- rep.int(1, length(hydro))
    nreps <- nreps - 1
    tempy <- cbind(hydro, species, Strata)
    if (any(is.na(hydro)))
        tempy <- (na.omit(as.data.frame(tempy)))
    hydro <- as.numeric(as.vector(tempy[, 1]))
    species <- as.numeric(as.vector(tempy[, 2]))
    Strata <- as.vector(tempy[, 3])
    WH <- strata.group$NH
    na.strata <- match(strata.group$Strata, unique(Strata))
    WH[is.na(na.strata)] <- NA
    IWH <- cbind(strata.group$Strata, WH)
    IWH <- (na.omit(as.data.frame(IWH)))
    WH <- as.numeric(IWH$WH)
    IWH <- IWH[[1]]

    WH <- (WH/sum(WH))
    yhi <- split(species, Strata)
    nh <- as.vector(sapply(yhi, length))

    yst <- sum(WH * as.vector(sapply(yhi, mean)))
    wh <- WH/nh
    Whi <- rep(0, length(species))
    for (i in seq(along = wh)) Whi[c(Strata == IWH[i])] <- wh[i]
    gt <- cumsum(sapply(split((Whi * (species - yst))/yst, hydro),
        sum))
#AMC addition
            max.values<-max(abs(gt))
            #to get 1st and 3rd quartile of catch
                    wh1 <- WH/(nh * yst)
                    Whi1 <- rep(0, length(species))
                    for (i in seq(along = wh)) Whi1[c(Strata == IWH[i])] <- wh1[i]
                    Whi1 <- Whi1 * species
                    gt1 <- cumsum(sapply(split(Whi1, hydro), sum))

                    abc <-  data.frame(x=rbind(as.numeric(names(gt1[length(gt1[gt1<=0.25])])), as.numeric(names(gt1[gt1>0.25][1]))),y=rbind(gt1[length(gt1[gt1<=0.25])], gt1[gt1>0.25][1]))
                    if(nrow(abc)<2) min.50 <- as.numeric(names(gt1)[1])
                    if(nrow(abc)==2) {
                    abcd <-  coefficients(lm(abc[,2]~abc[,1]))
                    min.50 <- (0.25-abcd[1])/abcd[2]
                    }
                    abc<-data.frame(x=rbind(as.numeric(names(gt1[length(gt1[gt1<=0.5])])), as.numeric(names(gt1[gt1>0.5][1]))),y=rbind(gt1[length(gt1[gt1<=0.5])], gt1[gt1>0.5][1]))
                    if(nrow(abc)<2) med.50 <- as.numeric(names(gt1)[1])
                    if(nrow(abc)==2) {
                    abcd <-  coefficients(lm(abc[,2]~abc[,1]))
                    med.50 <- (0.5-abcd[1])/abcd[2]
                    }

                    abc<-data.frame(x=rbind(as.numeric(names(gt1[length(gt1[gt1<=0.75])])), as.numeric(names(gt1[gt1>0.75][1]))),y=rbind(gt1[length(gt1[gt1<=0.75])], gt1[gt1>0.75][1]))
                    abcd <-  coefficients(lm(abc[,2]~abc[,1]))
                    max.50 <- (0.75-abcd[1])/abcd[2]
            #to get 95% intervals of hydro variable
                    hv<-cumsum(sapply(split(Whi, hydro), sum))
                    abc <-  data.frame(x=rbind(as.numeric(names(hv[length(hv[hv<=0.5])])), as.numeric(names(hv[hv>0.5][1]))),y=rbind(hv[length(hv[hv<=0.5])], hv[hv>0.5][1]))
                    if(nrow(abc)<2) med.hv.50 <- as.numeric(names(hv)[1])
                    if(nrow(abc)==2) {
                    abcd <-  coefficients(lm(abc[,2]~abc[,1]))
                    med.hv.50 <- (0.5-abcd[1])/abcd[2]
                    }

                    abc <-  data.frame(x=rbind(as.numeric(names(hv[length(hv[hv<=0.025])])), as.numeric(names(hv[hv>0.025][1]))),y=rbind(hv[length(hv[hv<=0.025])], hv[hv>0.025][1]))
                    if(nrow(abc)<2) min.95.hv <- as.numeric(names(hv)[1])
                    if(nrow(abc)==2) {
                    abcd <-  coefficients(lm(abc[,2]~abc[,1]))
                    min.95.hv <- (0.025-abcd[1])/abcd[2]
                    }

                    abc<-data.frame(x=rbind(as.numeric(names(hv[length(hv[hv<=0.975])])), as.numeric(names(hv[hv>0.975][1]))),y=rbind(hv[length(hv[hv<=0.975])], hv[hv>0.975][1]))
                    abcd <-  coefficients(lm(abc[,2]~abc[,1]))
                    max.95.hv <- (0.975-abcd[1])/abcd[2]
if(min.95.hv>max.95.hv) browser()

    test.stat.rep <- vector(mode = "numeric", length = nreps)
    if (method.int == 1) {
        test.stat <- max(abs(gt))
        prefer.lab <- c("Kolmorogorov-Smirnov Type test")
        if (nreps != 0) {
            for (i in 1:nreps) {
                Ixh <- sample(hydro, replace = TRUE, prob = Whi)
                temp.stat <- cumsum(sapply(split((Whi * (species -
                  yst))/yst, Ixh), sum))
                test.stat.rep[i] <- max(abs(temp.stat))
            }
        }
    }
    if (method.int == 2) {
        test.stat <- sum(gt^2)
        prefer.lab <- c("Cramer-Von Mises Type test")
        if (nreps != 0) {
            for (i in 1:nreps) {
                Ixh <- sample(hydro, replace = TRUE, prob = Whi)
                temp.stat <- cumsum(sapply(split((Whi * (species -
                  yst))/yst, Ixh), sum))
                test.stat.rep[i] <- sum(temp.stat^2)
            }
        }
    }
     if(stat.plot==T) {
     x <- sort(c(test.stat.rep,test.stat))
    c.freq<-cumsum(tabulate(match(x,unique(x))))/length(x) #cumulative frequency of unique test stats
    plot(unique(x),c.freq,xlab='Test Statistic', ylab='Cumulative Frequency',type='l',xlim=c(min(x)-min(x)*0.02,max(x)+max(x)*0.02)) #cdf plot of test stats
        #adding in the specifics of the test statistic and p-value
        ddd<-data.frame(x=unique(x),y=c.freq)
        probs<-ddd[match(max.values,ddd[,1]),2]
        arrows(x0=max.values,x1=max.values,y0=probs,y1=0.01,length=0.1)
        arrows(x0=max.values,x1=min(x)-min(x)*0.01,y0=probs,y1=probs,length=0.1)
        text(max.values+max.values*0.05,y=0.01,paste("s",round(max.values,4),sep="="),cex=0.7)
        text(min(x)+min(x)*0.05,probs+0.02,paste("p=1-",round(1-sum(test.stat <= test.stat.rep)/length(test.stat.rep),4),sep=""),cex=0.7)
    }

    locs<-names(which(abs(gt)==max.values))#finding the row and column of the gt matrix where the test statistic was located (max value of gt-ft)

    res <- list(test.stat = test.stat, test.stat.rep = c(test.stat,
        test.stat.rep), prefer.lab = prefer.lab, prefer2.lab = c("Randomization Test"),
        prefer3.lab = c("P-level"), location.of.max.gt=locs,p=round(sum(test.stat <= test.stat.rep)/length(test.stat.rep),4),yst1=yst,min.med.max.gt = c(min.50,med.50,max.50),min.med.max.hydro = c(min.95.hv,med.hv.50,max.95.hv), descrip = "Association Analysis")
    class(res) <- "assoc"
    res
}


#' @title
#' Plot standard maps
#'
#' @description
#' \code{plot_maps} plots a standard set of diagnostic maps for stream network models
#'
#' @param plot_set integer-vector defining plots to create
#' \describe{
#'   \item{plot_set=1}{Probability of encounter/no-encounter}
#'   \item{plot_set=2}{Log-expected positive catch rate}
#'   \item{plot_set=3}{Log-predicted density (product of encounter probability and positive catch rates)}
#'   \item{plot_set=4}{Log-positive catch rates (rescaled)}
#'   \item{plot_set=5}{Log-predicted density (rescaled)}
#'   \item{plot_set=6}{Spatio-temporal variation in encounter probability}
#'   \item{plot_set=7}{Spatio-temporal variation in log-positive catch rates}
#'   \item{plot_set=8}{Linear predictor for encounter probability}
#'   \item{plot_set=9}{Linear predictor for positive catch rates}
#'   \item{plot_set=10}{Coefficient of variation for predicted density (available only if \code{Data_Fn(...,Options=c('SD_site_logdensity'=1,...))}}
#'   \item{plot_set=11}{Covariates that are included in the model}
#'   \item{plot_set=12}{Total biomass across all categories (only useful in a multivariate model)}
#'   \item{plot_set=13}{Covariate effects on encounter probability}
#'   \item{plot_set=14}{Covariate effects on positive catch rates}
#'   \item{plot_set=15}{Covariate effect on encounter probability by covariate}
#' }
#' @param Report tagged list of outputs from TMB model via \code{Obj$report()}
#' @param Sdreport Standard deviation outputs from TMB model via \code{sdreport(Obj)}
#' @param Year_Set total years
#' @param Years2Include years with data
#' @param savedir Directory (absolute path) and base for filenames of plots
#' @param category_names character vector specifying names for different categories (only used for R package \code{VAST})
#' @param covar_names character vector specifying names for different covariates
#' @param cex_network point size for network
#' @inheritParams plot_network
#' \describe{
#'   \item{use}{Boolean whether to plot insert colorbar or not}
#'   \item{x}{Left and right-hand limits for legend in percentage of panel}
#'   \item{y}{bottom and top limits for legend in percentage of panel}
#' }
#' @param ... arguments passed to \code{PlotMap_Fn}
#' @importFrom ggplot2 ggplot geom_point scale_color_distiller aes facet_wrap xlab ylab ggsave ggtitle
#' @importFrom RuddR mytheme
#'
#' @return Mat_xt a matrix (rows: modeled knots; column: modeled year) for plotted output of last element of \code{plot_set}
#'

#' @export
plot_maps <-
function(plot_set=3, Report, Sdreport=NULL,
         TmbData=NULL,
         savedir=paste0(getwd(),"/"),
         category_names=NULL,
         covar_names=NULL,
         cex_network=1,
         X_xtp, ...){

  # avoid attaching maps and mapdata to use worldHires plotting
  if( !(all(c("package:maps","package:mapdata") %in% search())) ){
    require(maps)
    require(mapdata)
    on.exit( if("package:mapdata"%in% search()){detach("package:mapdata")} )
    on.exit( if("package:maps"%in% search()){detach("package:maps")}, add=TRUE )
  }

  # local functions
  logsum = function(vec){ max(vec) + log(sum(exp(vec-max(vec)))) }

  # Fill in missing inputs
  if( "D_xt" %in% names(Report)){
    # SpatialDeltaGLMM
    if( is.null(Year_Set) ) Year_Set = 1:ncol(Report$D_xt)
    if( is.null(Years2Include) ) Years2Include = 1:ncol(Report$D_xt)
    category_names = "singlespecies"
    Ncategories = length(category_names)
    Nyears = dim(Report$D_xt)[2]
  }
  if( "D_xct" %in% names(Report)){
    # VAST Version < 2.0.0
    if( is.null(Year_Set) ) Year_Set = 1:dim(Report$D_xct)[3]
    if( is.null(Years2Include) ) Years2Include = 1:dim(Report$D_xct)[3]
    if( is.null(category_names) ) category_names = 1:dim(Report$D_xct)[2]
    Ncategories = dim(Report$D_xct)[2]
    Nyears = dim(Report$D_xct)[3]
  }
  if( "D_xcy" %in% names(Report)){
    # VAST Version >= 2.0.0
    if( is.null(Year_Set) ) Year_Set = 1:dim(Report$D_xcy)[3]
    if( is.null(Years2Include) ) Years2Include = 1:dim(Report$D_xcy)[3]
    if( is.null(category_names) ) category_names = 1:dim(Report$D_xcy)[2]
    Ncategories = dim(Report$D_xcy)[2]
    Nyears = dim(Report$D_xcy)[3]
  }
  if("dhat_ktp" %in% names(Report)){
    # MIST Version <= 14
    if( is.null(Year_Set) ) Year_Set = 1:dim(Report$dhat_ktp)[2]
    if( is.null(Years2Include) ) Years2Include = 1:dim(Report$dhat_ktp)[2]
    if( is.null(category_names) ) category_names = 1:dim(Report$dhat_ktp)[3]
    Ncategories = dim(Report$dhat_ktp)[3]
    Nyears = dim(Report$dhat_ktp)[2]
  }
  if("dpred_ktp" %in% names(Report)){
    # MIST Version >= 15
    if( is.null(Year_Set) ) Year_Set = 1:dim(Report$dpred_ktp)[2]
    if( is.null(Years2Include) ) Years2Include = 1:dim(Report$dpred_ktp)[2]
    if( is.null(category_names) ) category_names = 1:dim(Report$dpred_ktp)[3]
    Ncategories = dim(Report$dpred_ktp)[3]
    Nyears = dim(Report$dpred_ktp)[2]
  }

  # Errors
  if( Nyears != length(Year_Set) ){
    stop("Problem with `Year_Set`")
  }
  if( Ncategories != length(category_names) ){
    stop("Problem with `category_names`")
  }

  # Extract elements
  plot_codes <- c("Pres", "Pos", "Dens", "Pos_Rescaled", "Dens_Rescaled", "Eps_Pres", "Eps_Pos", "LinPred_Pres", "LinPred_Pos", "Dens_CV", "Covariates", "Total_dens", "Cov_effects_Pres", "Cov_effects_Pos", "Individual_cov_effects_Pres")
  plot_names <- c("presence_absence", "log-positive catch rates", "log-density", "positive catch rates", "density", "epsilon for presence_absence", "epsilon for positive catch rates", "encounter probability linear predictor", "positive catch rates linear predictor", "density CV", "covariates", "total density", "encounter probability covariate effects", "catch rates covariate effects", "encounter probability covariate effects")

  # Loop through plots
  for(plot_num in plot_set){

    # Extract matrix to plot
    if(plot_num==1){
      # Presence/absence ("Pres")
      if("D_xt"%in%names(Report)) Array_xct = Report$R1_xt
      if("D_xct"%in%names(Report)) Array_xct = Report$R1_xct
      if("D_xcy"%in%names(Report)) Array_xct = Report$R1_xcy
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report))) stop("Not implemented for SpatialVAM")
      message( "plot_num=1 doesn't work well when using ObsModel[2]==1" )
    }
    if(plot_num==2){
      # Positive values ("Pos")
      if("D_xt"%in%names(Report)) Array_xct = log(Report$R2_xt)
      if("D_xct"%in%names(Report)) Array_xct = log(Report$R2_xct)
      if("D_xcy"%in%names(Report)) Array_xct = log(Report$R2_xcy)
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report)))  stop("Not implemented for SpatialVAM")
    }
    if(plot_num==3){
      # Density ("Dens")
      if("D_xt"%in%names(Report)) Array_xct = log(Report$D_xt)
      if("D_xct"%in%names(Report)) Array_xct = log(Report$D_xct)
      if("D_xcy"%in%names(Report)) Array_xct = log(Report$D_xcy)
      if("dhat_ktp" %in% names(Report)) Array_xct = aperm(Report$dhat_ktp[,,cI],c(1,3,2))
      if("dpred_ktp" %in% names(Report)) Array_xct = aperm(Report$dpred_ktp[,,cI],c(1,3,2))
    }
    if(plot_num==4){
      # Positive values rescaled ("Pos_Rescaled")
      if("D_xt"%in%names(Report)) Array_xct = log(Report$R2_xt+quantile(Report$R2_xt,0.25))
      if("D_xct"%in%names(Report)) Array_xct = log(Report$R2_xct+quantile(Report$R2_xct,0.25))
      if("D_xcy"%in%names(Report)) Array_xct = log(Report$R2_xcy+quantile(Report$R2_xcy,0.25))
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report)))  stop("Not implemented for SpatialVAM")
    }
    if(plot_num==5){
      # Density rescaled ("Dens_Rescaled")
      if("D_xt"%in%names(Report)) Array_xct = log(Report$D_xt+quantile(Report$D_xt,0.25))
      if("D_xct"%in%names(Report)) Array_xct = log(Report$D_xct+quantile(Report$D_xct,0.25))
      if("D_xcy"%in%names(Report)) Array_xct = log(Report$D_xcy+quantile(Report$D_xcy,0.25))
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report)))  stop("Not implemented for SpatialVAM")
    }
    if(plot_num==6){
      # Epsilon for presence/absence ("Eps_Pres")
      if("D_xt"%in%names(Report)) Array_xct = Report$Epsilon1_st
      if("D_xct"%in%names(Report)) Array_xct = Report$Epsilon1_sct
      if("D_xcy"%in%names(Report)) Array_xct = Report$Epsilon1_sct
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report)))  stop("Not implemented for SpatialVAM")
    }
    if(plot_num==7){
      # Epsilon for positive values ("Eps_Pos")
      if("D_xt"%in%names(Report)) Array_xct = Report$Epsilon2_st
      if("D_xct"%in%names(Report)) Array_xct = Report$Epsilon2_sct
      if("D_xcy"%in%names(Report)) Array_xct = Report$Epsilon2_sct
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report)))  stop("Not implemented for SpatialVAM")
    }
    if(plot_num==8){
      # Linear predictor for probability of encounter
      if("D_xt"%in%names(Report)) Array_xct = Report$P1_xt
      if("D_xct"%in%names(Report)) Array_xct = Report$P1_xct
      if("D_xcy"%in%names(Report)) Array_xct = Report$P1_xcy
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report)))  stop("Not implemented for SpatialVAM")
    }
    if(plot_num==9){
      # Linear predictor for positive catch rates
      if("D_xt"%in%names(Report)) Array_xct = Report$P2_xt
      if("D_xct"%in%names(Report)) Array_xct = Report$P2_xct
      if("D_xcy"%in%names(Report)) Array_xct = Report$P2_xcy
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report)))  stop("Not implemented for SpatialVAM")
    }
    if(plot_num==10){
      # Density ("Dens") CV             # Index_xtl
      if( is.null(Sdreport) ) stop("Must supply 'Sdreport' if 'plot_num=10'")
      if("D_xt"%in%names(Report)){
        if( !("log(Index_xtl)" %in% rownames(TMB::summary.sdreport(Sdreport))) ) stop("Please re-run with Options('SD_site_logdensity'=1,...) to use 'plot_num=10' in 'SpatialDeltaGLMM'")
        Array_xct = array( TMB::summary.sdreport(Sdreport)[which(rownames(TMB::summary.sdreport(Sdreport))=="log(Index_xtl)"),], dim=c(dim(Report$D_xt),ncol(Report$Index_tl),2), dimnames=list(NULL,NULL,NULL,c('Estimate','Std. Error')) )[,,1,'Std. Error']
      }
      if("D_xct"%in%names(Report)){
        if( !("log(Index_xctl)" %in% rownames(TMB::summary.sdreport(Sdreport))) ) stop("Please re-run with Options('SD_site_logdensity'=1,...) to use 'plot_num=10' in 'VAST'")
        Array_xct = array( TMB::summary.sdreport(Sdreport)[which(rownames(TMB::summary.sdreport(Sdreport))=="log(Index_xctl)"),], dim=c(dim(Report$D_xct),dim(Report$Index_ctl)[3],2), dimnames=list(NULL,NULL,NULL,NULL,c('Estimate','Std. Error')) )[,,,1,'Std. Error']
      }
      if("D_xcy"%in%names(Report)){
        if( !("log(Index_xcyl)" %in% rownames(TMB::summary.sdreport(Sdreport))) ) stop("Please re-run with Options('SD_site_logdensity'=1,...) to use 'plot_num=10' in 'VAST'")
        Array_xct = array( TMB::summary.sdreport(Sdreport)[which(rownames(TMB::summary.sdreport(Sdreport))=="log(Index_xcyl)"),], dim=c(dim(Report$D_xcy),dim(Report$Index_cyl)[3],2), dimnames=list(NULL,NULL,NULL,NULL,c('Estimate','Std. Error')) )[,,,1,'Std. Error']
      }
      if(any(c("dhat_ktp","dpred_ktp")%in%names(Report))) stop("'plot_num=10' not implemented for 'SpatialVAM'")
      # Convert to CV
      Array_xct = sqrt( exp(Array_xct^2) - 1 )
    }
    if(plot_num==11){
      if(is.null(TmbData)) stop( "Must provide `TmbData` to plot covariates" )
      if(!("X_xtp" %in% names(TmbData))) stop( "Can only plot covariates for VAST version >= 2.0.0" )
      Array_xct = aperm( TmbData$X_xtp, perm=c(1,3,2) )
      # category_names = 1:dim(Array_xct)[2]
    }
    if(plot_num==12){
      # Total density ("Dens")
      if("D_xt"%in%names(Report)) Array_xct = log(Report$D_xt)
      if("D_xct"%in%names(Report)) Array_xct = log(apply(Report$D_xct,FUN=sum,MARGIN=c(1,3)))
      if("D_xcy"%in%names(Report)) Array_xct = log(apply(Report$D_xcy,FUN=sum,MARGIN=c(1,3)))
      if("dhat_ktp" %in% names(Report)) Array_xct = apply(aperm(Report$dhat_ktp,c(1,3,2)),FUN=logsum,MARGIN=c(1,3))
      if("dpred_ktp" %in% names(Report)) Array_xct = apply(aperm(Report$dpred_ktp,c(1,3,2)),FUN=logsum,MARGIN=c(1,3))
    }
    if(plot_num==13){
      # Covariate effects for probability of encounter
      if("D_xt"%in%names(Report)) stop()
      if("D_xct"%in%names(Report)) stop()
      if("D_xcy"%in%names(Report)) Array_xct = Report$eta1_xct
      if("dhat_ktp" %in% names(Report)) stop()
      if("dpred_ktp" %in% names(Report)) stop()
    }
    if(plot_num==14){
      # Covariate effects for positive catch rates
      if("D_xt"%in%names(Report)) stop()
      if("D_xct"%in%names(Report)) stop()
      if("D_xcy"%in%names(Report)) Array_xct = Report$eta2_xct
      if("dhat_ktp" %in% names(Report)) stop()
      if("dpred_ktp" %in% names(Report)) stop()
    }
    if(plot_num==15){
      if(is.null(TmbData)) stop( "Must provide `TmbData` to plot covariates" )
      if(!("X_xtp" %in% names(TmbData))) stop( "Can only plot covariates for VAST version >= 2.0.0" )

      X_xtp <- TmbData$X_xtp
      gamma1_ctp <- summary(Sdreport)[which(grepl("gamma1", rownames(summary(Sdreport)))),"Estimate"]

      n_p <- dim(X_xtp)[3]
      category_names <- covar_names
      Array_xct <- array(NA, dim=c(dim(X_xtp)[1],n_p,dim(X_xtp)[2]))
      for(i in 1:n_p){
        eta <- gamma1_ctp[i] * X_xtp[,,i]
        Array_xct[,i,] <- eta
      }
    }
    years <- min(Data_Geostat$Year):max(Data_Geostat$Year)
    # xct <- lapply(1:n_t, function(x){
    #   mat <- matrix(Array_xct[,,x], ncol=n_c)
    #   if(ncol(mat)==1){
    #     out <- data.frame('value'=mat[,1], 'category'=1, 'year'=years[x], Spatial_List$loc_x)
    #   }
    #   if(ncol(mat)>1){
    #     out <- data.frame('value'=mat[,1], 'category'=mat[,2], 'year'=years[x], Spatial_List$loc_x)
    #   }
    #   return(out)
    # })
    # xct <- do.call(rbind, xct)

    # Col = colorRampPalette(colors=c("darkblue","blue","lightblue","lightgreen","yellow","orange","red"))

    # if( tolower(Panel)=="category" ){
      if(length(dim(Array_xct))==2) Nplot = 1
      if(length(dim(Array_xct))==3) Nplot = dim(Array_xct)[2]
      for( cI in 1:Nplot){
        if(length(dim(Array_xct))==2) Mat_xt = Array_xct
        if(length(dim(Array_xct))==3) Mat_xt = Array_xct[,cI,]
          ## matrix is number of nodes by number of years
          if(is.null(dim(Mat_xt)))  n_t = 1 else n_t <- dim(Mat_xt)[2]
          if(n_t != length(years)) stop("number of years in density array does not match Data_Geostat years")
          if(n_t > 1) {
            xct <- lapply(1:n_t, function(x){
              out <- data.frame('value'=Mat_xt[,x], 'year'=years[x], Spatial_List$loc_x)
              return(out)
            })
            xct <- do.call(rbind, xct)
          } else xct <- data.frame('value'=Mat_xt, 'year'=years, Spatial_List$loc_x)

          p <- ggplot(xct) +
              geom_point(aes(x = E_km, y = N_km, color = value), cex=cex_network) +#, ...) +
              scale_color_distiller(palette = "Spectral") +
              scale_x_continuous(breaks=quantile(xct$E_km, prob=c(0.1,0.5,0.9)), labels=round(quantile(xct$E_km, prob=c(0.1,0.5,0.9)),0)) +
              # guides(color=guide_legend(title=plot_codes[plot_num])) +
              facet_wrap(~year) +
              mytheme() +
              xlab("Eastings") + ylab("Northings")
          if(Nplot!=1) p <- p + ggtitle(paste(category_names[cI], plot_names[plot_num]))
          if(Nplot==1) p <- p + ggtitle(paste(plot_names[plot_num]))

          if(!is.null(savedir)){
            if(Nplot!=1) ggsave(file.path(savedir, paste0(plot_names[plot_num], "_", cI, ".png")), p)
            if(Nplot==1) ggsave(file.path(savedir, paste0(plot_names[plot_num], ".png")), p)
          }
          dev.new()
          print(p)
        # Do plot
        # if( is.null(mfrow)) mfrow = c(ceiling(sqrt(length(Years2Include))), ceiling(length(Years2Include)/ceiling(sqrt(length(Years2Include)))))
        # if(add==FALSE) par( mfrow=mfrow )
        # PlotMap_Fn( MappingDetails=MappingDetails, Mat=Mat_xt[,Years2Include,drop=FALSE], PlotDF=PlotDF, MapSizeRatio=MapSizeRatio, Xlim=Xlim, Ylim=Ylim, FileName=paste0(FileName,plot_codes[plot_num],ifelse(Nplot>1,paste0("--",category_names[cI]),"")), Year_Set=Year_Set[Years2Include], Rescale=Rescale, Rotate=Rotate, Format=Format, Res=Res, zone=zone, Cex=Cex, textmargin=textmargin[plot_num], add=add, pch=pch, Legend=Legend, mfrow=mfrow, plot_legend_fig=plot_legend_fig, ...)
      }
    # }
    # # Plot for each year
    # if( tolower(Panel)=="year" ){
    #   Nplot = length(Years2Include)
    #   for( tI in 1:Nplot){
    #     if(length(dim(Array_xct))==2) Mat_xc = Array_xct[,Years2Include[tI],drop=TRUE]
    #     if(length(dim(Array_xct))==3) Mat_xc = Array_xct[,,Years2Include[tI],drop=TRUE]
    #     Return = Mat_xc = array( as.vector(Mat_xc), dim=c(dim(Array_xct)[1],Ncategories)) # Reformat to make sure it has same format for everything

    #     # Do plot
    #     if( is.null(mfrow)) mfrow = c(ceiling(sqrt(length(category_names))), ceiling(length(category_names)/ceiling(sqrt(length(category_names)))))
    #     if(add==FALSE) par( mfrow=mfrow )
    #     PlotMap_Fn( MappingDetails=MappingDetails, Mat=Mat_xc, PlotDF=PlotDF, MapSizeRatio=MapSizeRatio, Xlim=Xlim, Ylim=Ylim, FileName=paste0(FileName,plot_codes[plot_num],ifelse(Nplot>1,paste0("--",Year_Set[Years2Include][tI]),"")), Year_Set=category_names, Rescale=Rescale, Rotate=Rotate, Format=Format, Res=Res, zone=zone, Cex=Cex, textmargin=textmargin[plot_num], add=add, pch=pch, Legend=Legend, mfrow=mfrow, plot_legend_fig=plot_legend_fig, ...)
    #   }
    # }
  }

  # return( invisible(xct) )
}


from_txt_to_epsg = function(chr_zn){
  chr_zn = 32600+as.integer(substr(chr_zn, 1, nchar(chr_zn)-1))
  return(chr_zn)
}

l2_norm =  function(brick, ndvi = 0.5, nir = 0.2){
  # filter for no data
  brick = brick %>% ungroup %>% dplyr::select(contains("band"))
  mask1 = apply(brick, 1, function(x)all(x>=0))
  mask2 = apply(brick, 1, function(x)all(x<1))
  brick[!as.logical(mask2), ] = NA
  brick[!as.logical(mask1), ] = NA
  brick[brick<0]=0
  brick[,30:40][brick[,30:40]==0] = NA

  #filter for greennes and shadows
  ndvi <- (brick[,"band_90"]- brick[,"band_58"])/(brick[,"band_58"] + brick[,"band_90"]) <ndvi
  nir860 <- (brick[,"band_96"] + brick[,"band_97"])/2 < nir
  mask = as.logical(ndvi * nir860)
  mask[is.na(mask)] = T
  brick[mask,] = NA
  rm(mask, ndvi, nir860)
  brick = brick %>% dplyr::select(one_of(paste("band", 15:360, sep="_")))
  normMat <- sqrt(apply(brick^2,FUN=sum,MAR=1, na.rm=TRUE))
  normMat <- matrix(data=rep(normMat,ncol(brick)),ncol=ncol(brick))
  brick=brick/normMat

  # rm(cnd,idx)

  return(brick)
}

clean_typos_taxonID <- function(species_classification_data){
  #make it a function but for testing ok replicating upper loop
  species_classification_data$taxonID[species_classification_data$taxonID == "2PLANT"] = "NA"
  species_classification_data$taxonID[species_classification_data$taxonID == "2PLANT"] = "NA"
  species_classification_data$taxonID[species_classification_data$taxonID == "FRAM2/FRPE"] = "FRAM2"
  species_classification_data$taxonID[species_classification_data$taxonID == "JUVIV"] = "JUVI"
  species_classification_data$taxonID[species_classification_data$taxonID == "PIGL"] = "PIGL2"
  species_classification_data$taxonID[species_classification_data$taxonID == "PRSES"] = "PRSE2"
  species_classification_data$taxonID[species_classification_data$taxonID == "BEPAP"] = "BEPA"
  species_classification_data$taxonID[species_classification_data$taxonID == "CECAC"] = "CECA4"
  species_classification_data$taxonID[species_classification_data$taxonID == "ACSAS"] = "ACSA3"
  species_classification_data$taxonID[species_classification_data$taxonID == "ACNEN"] = "ACNE2"
  species_classification_data$taxonID[species_classification_data$taxonID == "ACRUR"] = "ACRU"
  species_classification_data$taxonID[species_classification_data$taxonID == "PICOL"] = "PICO"
  species_classification_data$taxonID[species_classification_data$taxonID == "PSMEM"] = "PSME"
  return(species_classification_data)
}

remove_too_close_stems <- function(species_classification_data, stem_dist = 3){
  field_vst = list()
  for (jj in unique(species_classification_data$siteID)){
    new_data = species_classification_data %>% filter(siteID == jj)
    ids = new_data %>% select(individualID, taxonID) %>% data.frame
    #identify tree stems that are closer than 3m apart
    xdist = dist(new_data$itcEasting) %>% as.matrix
    ydist = dist(new_data$itcNorthing) %>% as.matrix
    rownames(xdist) = rownames(ydist) = colnames(xdist) = colnames(ydist) = new_data$individualID
    final_dist = sqrt(xdist^2 + ydist^2)
    index <- which(final_dist < stem_dist, arr.ind=TRUE)
    is_other = index[,1] != index[,2]
    index = index[is_other,]
    #identify if they are diffeernt species
    is_different_species = cbind(rownames(final_dist)[index[,1]], colnames(final_dist)[index[,2]]) %>% data.frame %>% unique
    is_different_species = left_join(is_different_species, ids, by = c("X1"="individualID"))# by = c("X1",  "individualID"))
    is_different_species = left_join(is_different_species, ids, by = c("X2"="individualID"))
    index = is_different_species %>% filter(taxonID.x != taxonID.y) %>% select(X1) %>% unique
    #get only ids with no different species within 3m
    no_too_close = new_data %>% filter(!individualID %in% index$X1)
    field_vst[[jj]] = no_too_close
    #new_data = sf::st_as_sf(no_too_close, coords=c("itcEasting", "itcNorthing"), crs = from_txt_to_epsg(unique(new_data$utmZone)))
    #sf::write_sf(new_data, paste("~/Documents/Data/shp_vst/", jj, ".shp", sep=""))
  }
  species_classification_data = do.call(rbind, field_vst)
  return(species_classification_data)
}

apply_corrections = function(brick){
  brdf_corrections = readr::read_csv("./data/brdf_corrections.csv")
  refl=list()
  for( ii in 1:367){
    y = brick[,ii+1]/10000
    refl[[ii]] = y * bdrf_cor[ii] * topo_cor[ii]
  }
  refl = do.call(cbind.data.frame, refl)
  return(refl)
}
calculate_lat_lon <- function(df){
  latlon = list()
  for(zones in unique(df$utmZone)){
    tmp = df %>% filter(utmZone == zones)
    epsg = 32600+ as.integer(substr(zones, 1, nchar(zones)-1))
    tmp = sf::st_as_sf(tmp, coords = c("itcEasting", "itcNorthing"), crs = epsg)
    tmp = sf::st_transform(tmp, crs=4326)
    latlon[[zones]] = tmp
  }
  latlon = do.call(rbind.data.frame, latlon)
}
clean_reflectance = function(brdf_data, soil_th = NA){
  #filter shaded and NAs
  ancillary = brdf_data %>% select(!contains("band"))
  ids = brdf_data[["individualID"]]
  brdf_data = brdf_data %>% ungroup %>% select(contains("band"))
  if(is.integer(brdf_data[[1]])){
    brdf_data=brdf_data/10000
  }
  if (!is.na(soil_th)){
  }
  #brdf_data[brdf_data < -9000]=NA
  #brdf_data[brdf_data > 12000]=NA

  #brdf_data[["individualID"]] = ids
  brdf_data = brdf_data[complete.cases(brdf_data),]
  ancillary = ancillary[complete.cases(brdf_data),]

  brick = l2_norm(brdf_data, ndvi = 0.4, nir = 0.2)
  brick = cbind.data.frame(ancillary, brick)
  #remove NA bands using a random band as a target
  brick = brick %>% filter(!is.na(band_58))
  #brick = brick[complete.cases(brick),]
  # #apply corrections
  # brick = apply_corrections(brick)
  return(brick)
}

filter_too_rare_out = function(vst, id_in_library, min_id = 5){
  vst = vst %>% data.frame %>% filter(individualID %in% id_in_library)
  vst_ =vst %>% ungroup %>% group_by(individualID) %>% slice(1)
  goodIDS = vst_$taxonID %>% table() %>% data.frame
  goodIDS = goodIDS %>% filter(Freq > min_id) %>% select(".")
  vst = vst %>%
    filter(taxonID %in% as.character(goodIDS[[1]]))
  return(vst)

}

#df = readr::read_csv("./data/brdf_df_2021_NEON.csv")

plot_spectra <- function(df){
  df = df %>% select(contains("band"))
  df = reshape2::melt(df)
  ggplot(df, aes(x = variable, y = value)) +
    geom_boxplot(size = 0.1, alpha=0.3)+ theme_bw()
}

# df = df %>% group_by(individualID) %>% summarize_all(mean)
# df = df %>% ungroup %>% select(contains("band"))
# df = data.frame(t(df), colnames(df))
# colnames(df) = c("reflectance", "band")
# ggplot(df, aes(x = band, y = reflectance)) +
#   geom_path(size = 2, color="black") + theme_classic() + theme(text = element_text(size=20),
#          axis.text.x = element_text(angle=45, hjust=1))
# ggsave("~/Documents/spectra_sample.png")


###
#Runs deseq2 on our data.
#TODOS:
##We can only normalize against a single sample
##We have chosen a fittype that may not make sense for real data
#args
#1: data directory
#2: control sample
#3: output filename
#source("http://bioconductor.org/biocLite.R")
#biocLite("DESeq2")
###
library("DESeq2")
args <- commandArgs(trailingOnly = TRUE)
#get output from htseq
sampleFiles <- grep("hts.txt",list.files(args[1]),value=TRUE)
#condition is currently based on file name.  We may eventually want to take in a list for the condition
sampleCondition <- sub("(.*).hts.txt","\\1",sampleFiles)
sampleTable <- data.frame(sampleName = sampleFiles, fileName = sampleFiles, condition = sampleCondition)
dds <- DESeqDataSetFromHTSeqCount(sampleTable = sampleTable, directory = args[1], design= ~ condition)

dds <- dds[ rowSums(counts(dds)) > 1, ] # filter to genes with at least 2 reads
dds <- DESeq(dds, fitType="mean")
dds$condition <- relevel(dds$condition, ref=args[2]) # define the control sample.
res <- results(dds)
write.csv(as.data.frame(res), file=paste(args[3], "deseq.csv", sep="/"))


library(shiny)
library(dplyr)
library(plotly)
library(readxl)
library(lubridate)
#library(shinyalert)
library(shinyWidgets)
library("httr")
library("jsonlite")
library(rgdal)
library(leaflet)
library(lubridate)
knitr::opts_chunk$set(echo = TRUE)
#library('BBmisc')
#library(viridis)  # paletas de colores
set.seed(19990)

###### Desactivar notacion cientifica
#options(scipen=999,enconding = 'UTF-8')

#### CONSTANTES ####

FONT = list(family = 'Arial Rounded MT Bold')

GRIS = 'rgb(127, 127, 127)'
AZUL = 'rgb(0, 32, 96)'
AMARILLO = 'rgb(255, 192, 0)'

COLORES = c(GRIS,AZUL,AMARILLO)

mapa_barrios <- function(){

  dir<-paste("./mapas/mapa_barrios_usado", sep = "", collapse = NULL)
  print(dir)

  barriosShape <- readOGR(
    dsn= dir,
    layer="Barrio_Vereda",
    verbose=TRUE
  )

  geoData<-read.csv("mapas/geoDataframe_definitivo.csv",sep =';')

  barriosShape@data<-geoData

  barriosShape$numerica <- as.numeric(barriosShape@data$CLUSTER)

  palnumeric <- colorNumeric("viridis", barriosShape$numerica)

  #palnumeric <- colorNumeric(c("aliceblue","brown4"), 0:2)
  palfac <- colorFactor("RdBu",barriosShape$numerica)

  # Variable categorica
  barriosShape$categorica <- case_when(barriosShape$numerica == 3 ~ "no agrupado", barriosShape$numerica == 1 ~ "peligro bajo", barriosShape$numerica == 0 ~ "peligro medio", barriosShape$numerica == 2 ~ "peligro alto")
  sdaojdosjadoa<-barriosShape$categorica

  popup <- paste0("",
                  "","Nombre del barrio: ", "", as.character(barriosShape$NOMBRE),
                  "
Grupo al que pertenece: ", "", as.character(barriosShape$categorica), "
",
                  "
", "
",
                  "","TIPO","	",
                  "","ATROPELLO","	",
                  "","CAIDA OCUPANTE","	",
                  "","CHOQUE","	",
                  "","OTRO","	",
                  "","VOLCAMIENTO","	",
                  "
",
                  "","PROMEDIO/DIA","	",
                  "",round(as.numeric(barriosShape$atropello),2),"	",
                  "",round(as.numeric(barriosShape$caidaocupante),2),"	",
                  "",round(as.numeric(barriosShape$choque),2),"	",
                  "",round(as.numeric(barriosShape$otro),2),"	",
                  "",round(as.numeric(barriosShape$volcamiento),2),"	",
                  "
",
                  "
",
                  "
",
                  "
", "
",
                  "","ACCIDENTES","	",
                  "","MUERTOS","	",
                  "","HERIDOS","	",
                  "","SOLO_DANOS","	",

                  "
",
                  "","PROMEDIO/MES","	",
                  "",round(as.numeric(barriosShape$ACCIDENTES),2),"	",
                  "",round(as.numeric(barriosShape$MUERTO),2),"	",
                  "",round(as.numeric(barriosShape$HERIDO),2),"	",
                  "",round(as.numeric(barriosShape$SOLO_DANOS),2),"	",

                  "
",
                  "
"

  )

  leaflet(barriosShape) %>%
    # Opcion para anadir imagenes o mapas de fondo (tiles)
    setView(-75.60272578, 6.21901553, 12) %>%
    # Funcion para agregar poligonos
    addPolygons(color = "#444444" ,
                weight = 1,
                smoothFactor = 0.5,
                opacity = 1.0,
                fillOpacity = 0.5,
                fillColor = ~palnumeric(barriosShape$numerica),    # Color de llenado
                highlightOptions = highlightOptions(color = "white", weight = 2,
                                                    bringToFront = TRUE), #highlight cuando pasas el cursor
                label = ~barriosShape$NOMBRE ,                                  # etiqueta cuando pasas el cursor
                labelOptions = labelOptions(direction = "auto"),
                popup = popup)%>%addTiles(attribution = "overlay data mapsnigeriainitiative 2016")%>%
    addLegend(position = "bottomleft", pal = palfac, values = ~barriosShape$categorica,
              title = "Clasificacion de barrio")

}

prediccion <- function(fecha_inicio,fecha_fin,ventana){

  get_request <- GET("https://jor45458.pythonanywhere.com/Predictor/predecir/")
  datos <- list(
    fecha_inicial = fecha_inicio,
    fecha_final = fecha_fin,
    #d -> dia; m -> mes; s -> semana
    resoluciontemporal = ventana,

    #variable constante
    Modelo = "RF"
  )
  res <- POST("https://jor45458.pythonanywhere.com/Predictor/predecir/", body = datos, encode = "json")
  res <- content(res)
  data = data.frame(res)
  #print(head(data))
  data

}

####### SERVER #######
shinyServer(function(input, output, session){

  ####### BASES DE DATOS #######

  #Datos Procesados
  datos_procesados <- reactive({
    data <- read.csv("./data/datos_procesados.csv",sep = ",")
    data <- select(data,FECHA,BARRIO,CLASE,GRAVEDAD,LONGITUD,LATITUD)
    data <- filter(data,FECHA >= input$fecha_inicio_datos)
    data <- filter(data,FECHA<= input$fecha_fin_datos)
    data
  })
  #Clustering
  clustering <- read.csv("./data/clustering.csv",sep=";")

  data_prediccion <- reactive({
    prediccion(input$fecha_inicio,input$fecha_fin,input$ventana)

  })

  ######## SALIDA ##########

  #### INICIO ####

  #### DATOS ####

  output$torta_datos <- renderPlotly({plot_ly(
    datos_procesados(),labels=as.character(datos_procesados()$CLASE),type="pie"

  )%>%
    layout(title='Proporcion de Accidentes'
    )})

  output$tabla <- renderUI({
      box(width=12,renderDataTable(datos_procesados()))
  })

  # Downloadable csv of selected dataset ----
  output$downloadData <- downloadHandler(
    filename = 'Descarga.csv',
    content = function(file) {
      write.csv(datos_procesados(), file, row.names = FALSE)
    }
  )

  #### DESCRIPTIVO ####

  #### CLUSTERING ####

  output$map_cluster <- renderLeaflet({mapa_barrios()})

  #### PREDICTIVO ####

  #
  # output$atropello = renderValueBox({
  #   data <- prediccion(input$fecha_inicio,input$fecha_fin,input$ventana)
  #   print(head(data))
  #   valueBox('Atropello',data$Resultado.Atropello,icon = icon("gavel"),color = "blue")
  #
  #
  #   })

  atropello <- reactive({

    valueBox('Atropellos',data_prediccion()$Resultado.Atropello,icon = icon("gavel"),color = "red")

  })

  output$atropello <- renderValueBox({atropello()})

  output$caida = renderValueBox({

    valueBox('Caidas Ocupante',data_prediccion()$Resultado.CaidaOcupante,icon = icon("gavel"),color = "blue")

  })
  output$choque = renderValueBox({

    valueBox('Choques',data_prediccion()$Resultado.Choque,icon = icon("gavel"),color = "yellow")

  })
  output$otro = renderValueBox({

    valueBox('Otros',data_prediccion()$Resultado.Otro,icon = icon("gavel"),color = "aqua")

  })
  output$volcamiento = renderValueBox({

    valueBox('Volcamientos',data_prediccion()$Resultado.volcamiento,icon = icon("gavel"),color = "green")

  })

})


#!/usr/local/bin/R
args = commandArgs(trailingOnly=TRUE)

file_in=args[1]
splits_remained=args[2]
splits_ignored=args[3]

library(ape)
library(igraph)

file_out=paste(file_in,"_plot_consensus_tree.pdf",sep="")
pdf(file_out,5,5)
	par(mar=c(0.5,0.5,0.5,0.5),oma=c(0,0,0,0))

	tree<-read.tree(file_in)
	graph=ape::as.igraph.phylo(tree,directed = FALSE,use.labels = FALSE)

	V(graph)$size=ifelse(strength(graph, vids = V(graph), mode = "all")>3,5,0.5)
	V(graph)$color=ifelse(strength(graph, vids = V(graph), mode = "all")>3,"#D93951","#00B7A1")

	ids=which(strength(graph, vids = V(graph), mode = "all")>3)
	multi_v=length(ids)
	int_ids=list()
	ext_ids=list()
	int_NUM=0
	ext_NUM=0
	for(v in ids){
		nei_ids=neighbors(graph, V(graph)[v], mode ="all")
                check=length(which(strength(graph, vids = nei_ids, mode = "all")!=1))
                if(check<2){
			ext_NUM=ext_NUM+1
			ext_ids[[ext_NUM]]=v
                }else{
                        int_NUM=int_NUM+1
			int_ids[[int_NUM]]=v
                }
	}

	ext_ids=array(as.numeric(ext_ids))
	int_ids=array(as.numeric(int_ids))

	max_ext_degree=0
	if(length(ext_ids)>0){
		f_cols=colorRampPalette(c("#b4bfe0","royalblue"))
		ext_degrees=degree(graph,v=ext_ids,mode="all")
		ext_cols=f_cols(max(ext_degrees))
		V(graph)[ext_ids]$color=ext_cols[ext_degrees]
		max_ext_degree=max(ext_degrees)
	}

	max_int_degree=0
	if(length(int_ids)>0){
        	f_cols=colorRampPalette(c("#bf8f8f","firebrick"))
                int_degrees=degree(graph,v=int_ids,mode="all")
                int_cols=f_cols(max(int_degrees))
                V(graph)[int_ids]$color=int_cols[int_degrees]
		max_int_degree=max(int_degrees)
	}

        plot.igraph(graph,vertex.label=NA,xlim=c(-1.5,1.5),ylim=c(-1.5,1.5))
	x=-1.4
	y=1.4
	e=0.1
	sz=0.8
	text(x,y,paste("No.int.branches: ",splits_remained,sep=""),cex=sz,adj=0)
	text(x,y-e,paste("No.mult.nodes: ",multi_v,sep=""),cex=sz,adj=0)

	x=-0.4
	col_nd=ifelse(ext_NUM>0,"royalblue","lightgrey")
	text(x,y,paste("No.mult.ext.nodes: ",ext_NUM,sep=""),cex=sz,adj=0,col=col_nd)
	text(x,y-e,paste("max degree: ",max_ext_degree,sep=""),cex=sz,adj=0,col=col_nd)
	x=0.7
	col_nd=ifelse(int_NUM>0,"firebrick","lightgrey")
	text(x,y,paste("No.mult.int.nodes: ",int_NUM,sep=""),cex=sz,adj=0,col=col_nd)
        text(x,y-e,paste("max degree: ",max_int_degree,sep=""),cex=sz,adj=0,col=col_nd)

	#text_info=paste(r[i,1],"REMAINED",r[i,2]+n,"REMAINED_INT",r[i,2],"DISCARDED",r[i,3],"T_SIZE",9,"NUM_MULTI_NODES",multi_v,"EXTERNAL_MULTI",ext_NUM,"INTERNAL_MULTI",int_NUM,"MULTI_MAX",max(ext_max_degree,int_max_degree),"EXT_MAX",ext_max_degree,"EXT_AVE",ext_ave_degree,"INT_MAX",int_max_degree,"INT_AVE",int_ave_degree,"| EXT_DISTR",paste(ext_distr,collapse=" "),"INT_DISTR",paste(int_distr,collapse=" "),"|",sep=" ")

	#write(text_info,file="output.txt",append=TRUE)
dev.off()


#petsc_invert <- function(dim, ldim, Data, row_ptr, col_ind)
#{
#  storage.mode(dim) <- "integer"
#  storage.mode(ldim) <- "integer"
#  storage.mode(Data) <- "double"
#  storage.mode(row_ptr) <- "integer"
#  storage.mode(col_ind) <- "integer"
#
#  out <- .Call(sbase_petsc_matinvert, dim, ldim, Data, row_ptr, col_ind)
#
#  return( out )
#}