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


#calculates autofit(p,q)order all value in string/arma model for stationary models----> for LINUX

rm(list=ls())
library(itsmr)  #adding itsmr package

pandit <-read.table("C:\\Users\\msc2\\Desktop\\Halwa\\BADMASHI\\Model\\ARMA\\Autofit_arma_stationary.txt",skip=1)
madhur<-as.character(pandit$V1)     #have all ids stat

naringi_firangi<-NULL #complete row information for Stationary model
bunty_bubly<-NULL  #for taking zero p & q

for (sangeet in madhur){
compendium<- read.table(paste("C:\\kindle_patrika\\PDB\\pdb_clf_potentials\\pdb_clf_stationary_pot\\",sangeet,".txt",sep=""))
print(paste("Reading-------------------------------->",sangeet))

#autofit(arma)model  & checking for non stationarity
red_money<-autofit(ts(compendium$V1))  #autofit(arma)model (max likelihood method)

#checking p & q (both)zero
if(red_money$phi[1]==0 && red_money$theta[1]==0 ){
  bunty_bubly<-append(bunty_bubly,sangeet)  #p,q not zero else
   }
else{

p_tunar<-paste(red_money$phi,collapse=" ")        #to decode jk<-strsplit(tunar," ")  & pal<-jk[[1]][1]
q_funar<-paste(red_money$theta,collapse=" ")

autofit_ar_p<-length(red_money$phi)  #autoregressive p value
autofit_ma_q<-length(red_money$theta)  #moving average q value
autofit_aicc<-red_money$aicc   #aicc
autofit_sigma2<-red_money$sigma2  # sigma2

 #joining single line
 bumro<-cbind(sangeet,autofit_ar_p,p_tunar,autofit_ma_q,q_funar,autofit_sigma2,autofit_aicc,deparse.level=0)
 naringi_firangi<-rbind(naringi_firangi,bumro)

} #else

}  #last for  4 file iterating

#writnig only stationary model
write.table(naringi_firangi,"C:\\Users\\msc2\\Desktop\\Halwa\\BADMASHI\\Model\\ARMA\\Autofit_arma_stationary_rectified_linux.txt",col.names=c("PDB_file","Autof_p_order","Autof_ar_p_value","Autof_q_order","AutoF_ma_q_value","Autof_sigma2","AutoF_aicc"),row.names=F)

#zero p & q models
write.table(bunty_bubly,"C:\\Users\\msc2\\Desktop\\Halwa\\BADMASHI\\Model\\ARMA\\Autofit_arma_stat_p_q_zero.txt",col.names="zero p & q models",row.names=F)


genomewide_Genomewide_distribution_of_expressed_small_RNA_loci<- function(fprefix='input',wdir=".") {

start_time <- proc.time()
cat("Genomewide scatter (Philadelphia) plot (M3.13) start", date(), "\n")

# Plots for Module 3 Analysis and visualization of SPAR output
# Session: Genomewide characteristics

# Module_3_Figure_13(Figure 3.13)
# Description: Genomewide scatter plot on RPM values (log10) for all loci
# input: input_annot.with_conservation.xls, input.unannot.final.with_conservation.xls
# output: Genomewide_distribution_of_expressed_small_RNA_loci.png / Genomewide_distribution_of_expressed_small_RNA_loci.pdf

# parameters for the plot
datafile1=paste(wdir, "/", fprefix, "_annot.with_conservation.xls", sep="")
datafile2=paste(wdir, "/", fprefix, "_unannot.with_conservation.xls", sep="")
BASENAME="Genomewide_distribution_of_expressed_small_RNA_loci"
PLOTTITLE="Genome wide scatter plot \nof RPM of all loci"
XTITLE="Chromosome Number"
YTITLE="Log10(RPM)"

# libraries needed
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(RColorBrewer))
suppressPackageStartupMessages(library(plyr))
suppressPackageStartupMessages(library(scales))

#args<-commandArgs(TRUE)
#datafile1=args[1] # input file 1
#datafile2=args[2] # input file 2
#wdir=args[3] # output / working directory
#if (length(args)<1) { stop("ERROR: No input! USAGE: script inputfile <output-dir>")}
#if (length(args)<2) { stop("ERROR: No input! USAGE: script inputfile <output-dir>")}
#if (length(args)<3) { wdir="." }
#use current dir if no
#working dir has been specified

# output image file
pngfile= paste(wdir, "/../figures/", paste(BASENAME,".png",sep=""), sep="")
#pdffile= paste(wdir, "/", paste(BASENAME,".pdf",sep=""), sep="")

# Read in data
D = read.table(datafile1,sep='\t',header=T,comment.ch="")
E = read.table(datafile2,sep='\t',header=T,comment.ch="")
E$annotRNAclass = "unannot"
#DE = rbind(D[,c(1:20,25,29:31)],E)
DE = rbind(D,E)
DE$annotRNAclass2 = DE$annotRNAclass
DE$annotRNAclass2 = revalue(DE$annotRNAclass2, c("mir-3p"="miRNA", "mir-5p"="miRNA", "mir-5p3pno"="miRNA", "miRNAprimary"="miRNA", "snoRNAnar"="snoRNA", "tRF3"="tRF","tRF5"="tRF"))

DE$plotchr = DE$X.peakChr
DE$plotchr = revalue(DE$plotchr,c("chr1"=1,"chr2"=2,"chr3"=3,"chr4"=4,"chr5"=5,"chr6"=6,"chr7"=7,"chr8"=8,"chr9"=9,"chr10"=10,"chr11"=11,"chr12"=12,"chr13"=13,"chr14"=14,"chr15"=15,"chr16"=16,"chr17"=17,"chr18"=18,"chr19"=19,"chr20"=20,"chr21"=21,"chr22"=22,"chrX"="X","chrY"="Y","chrM"="M"))
DE = DE[nchar(as.character(DE$plotchr))<=2,]

DE$plotchr = droplevels(DE$plotchr)

DE$plotpos = ifelse(DE$plotchr==1, DE$peakChrStart,
ifelse(DE$plotchr==2, 249250621 +DE$peakChrStart,
ifelse(DE$plotchr==3, 492449994 +DE$peakChrStart,
ifelse(DE$plotchr==4, 690472424 +DE$peakChrStart,
ifelse(DE$plotchr==5, 881626700 +DE$peakChrStart,
ifelse(DE$plotchr==6, 1062541960 +DE$peakChrStart,
ifelse(DE$plotchr==7, 1233657027 +DE$peakChrStart,
ifelse(DE$plotchr==8, 1392795690 +DE$peakChrStart,
ifelse(DE$plotchr==9, 1548066250 +DE$peakChrStart,
ifelse(DE$plotchr==10, 1694430272 +DE$peakChrStart,
ifelse(DE$plotchr==11, 1835643703 +DE$peakChrStart,
ifelse(DE$plotchr==12, 1971178450 +DE$peakChrStart,
ifelse(DE$plotchr==13, 2106184966 +DE$peakChrStart,
ifelse(DE$plotchr==14, 2240036861 +DE$peakChrStart,
ifelse(DE$plotchr==15, 2355206739 +DE$peakChrStart,
ifelse(DE$plotchr==16, 2462556279 +DE$peakChrStart,
ifelse(DE$plotchr==17, 2565087671 +DE$peakChrStart,
ifelse(DE$plotchr==18, 2655442424 +DE$peakChrStart,
ifelse(DE$plotchr==19, 2736637634 +DE$peakChrStart,
ifelse(DE$plotchr==20, 2814714882 +DE$peakChrStart,
ifelse(DE$plotchr==21, 2877740402 +DE$peakChrStart,
ifelse(DE$plotchr==22, 2937113968 +DE$peakChrStart,
ifelse(DE$plotchr=="X", 2996242951 +DE$peakChrStart,
ifelse(DE$plotchr=="Y", 3047547517 +DE$peakChrStart,
ifelse(DE$plotchr=="M", 3095677412 +DE$peakChrStart,
DE$plotchr)))))))))))))))))))))))))

DE$plotchr[DE$plotchr=="23"]<-"X"
DE$plotchr[DE$plotchr=="24"]<-"Y"
DE$plotchr[DE$plotchr=="25"]<-"M"

ChrLoc = c(1,249250621,492449994,690472424,881626700,1062541960,1233657027,1392795690,1548066250,1694430272,1835643703,1971178450,2106184966,2240036861,2355206739,2462556279,2565087671,2655442424,2736637634,2814714882,2877740402,2937113968,2996242951,3047547517,3095677412)
DE2=DE[order(DE$plotpos),]

# DE$plotpos = revalue(DE$plotchr,c("2"=249250622,"3"=492449995,"4"=690472425,"5"=881626701,"6"=1062541961,"7"=1233657028,"8"=1392795691,"9"=1548066251,"10"=1694430273,"11"=1835643704,"12"=1971178451,"13"=2106184967,"14"=2240036862,"15"=2355206740,"16"=2462556280,"17"=2565087672,"18"=2655442425,"19"=2736637635,"20"=2814714883,"21"=2877740403,"22"=2937113969,"X"=2996242952,"Y"=3047547518,"M"=3095677413))

png(pngfile,width = 14, height = 7, units = 'in', res = 300, type="cairo")

print(ggplot(data = DE2, aes(x = plotpos, y = log10(peakRPM))) +
		geom_point(aes(colour=annotRNAclass2)) + facet_wrap( ~ annotRNAclass2, shrink=FALSE)+
		scale_x_continuous(breaks=ChrLoc, labels=c("1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","X","Y","M"), expand=c(0.02,0))+
		ggtitle(PLOTTITLE) + xlab(XTITLE)+ylab(YTITLE)+theme_classic()+
		scale_color_discrete(name = "sncRNA classes")+
		theme(legend.position="bottom",legend.text=element_text(size=10),
                      axis.text = element_text(size = 7),
                      axis.text.x = element_text(size=6, angle = 90, hjust=1, vjust=0.5),
                      axis.title = element_text(size =14),plot.title = element_text(size = 14)))
dev.off()

cat("Total time for RPM scatter/Phliadelphia plot (M3.13) analysis:", (proc.time() - start_time)[['elapsed']], "seconds (", date(), ")\n")

}
# genomewide_Genomewide_distribution_of_expressed_small_RNA_loci(fprefix=fprefix,wdir=wdir)


\name{reverse.circlize}
\alias{reverse.circlize}
\title{
Convert to data coordinate system
}
\description{
Convert to data coordinate system
}
\usage{
reverse.circlize(x, y, sector.index = get.current.sector.index(),
    track.index = get.current.track.index())
}
\arguments{

  \item{x}{degree values. The value can also be a two-column matrix/data frame if you put x and y data points into one variable.}
  \item{y}{distance to the circle center (the radius)}
  \item{sector.index}{Index for the sector where the data coordinate is used}
  \item{track.index}{Index for the track where the data coordinate is used}

}
\details{
This is the reverse function of \code{\link{circlize}}. It transform data points from polar coordinate system to a specified data coordinate system.
}
\value{
A matrix with two columns (\code{x} and \code{y})
}
\examples{
pdf(NULL)
factors = letters[1:4]
circos.initialize(factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
reverse.circlize(c(30, 60), c(0.9, 0.8))
reverse.circlize(c(30, 60), c(0.9, 0.8), sector.index = "d", track.index = 1)
reverse.circlize(c(30, 60), c(0.9, 0.8), sector.index = "a", track.index = 1)
circos.clear()
dev.off()

}


## Anatomía de las funciones

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

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

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

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

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

formals(f)

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

f(2, 4)

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

f(2)

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

body(f)

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

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

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

environment(f)

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

environment(mean)

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

rm (w)
f(2, 4)

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

w <- 24

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

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

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

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

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

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


# What is tidy data

# A. Tidy data structure
# 1. Multiple variables per column
netflix_df %>%
  # Split the duration column into value and unit columns. Using convert parameter creates the appropriate column data type conversion
  separate(duration, into = c("value", "unit"), sep = " ", convert = TRUE)

# B. Columns with multiple values
# 1. International phone numbers
phone_nr_df %>%
  # Unite the country_code and national_number columns
  unite("international_number", country_code, national_number, sep = " ")

# 2. Extracting observations from values
tvshow_df %>%
  # Separate the actors in the cast column over multiple rows
  separate_rows(cast, sep = ", ") %>%
  rename(actor = cast) %>%
  count(actor, sort = TRUE) %>%
  head()

# 3. Separating into columns and rows
drink_df %>%
  # Separate the ingredients over rows
  separate_rows(ingredients, sep = "; ") %>%
  # Separate ingredients into three columns
  separate(
    ingredients,
    into = c("ingredient", "quantity", "unit"),
    sep = " ",
    convert = TRUE
  ) %>%
  # Group by ingredient and unit
  group_by(ingredient, unit) %>%
  # Calculate the total quantity of each ingredient
  summarize(quantity = sum(quantity))

# C. Missing values
# 1. Drop na values
director_df %>%
  # Drop rows with NA values in the director column
  drop_na() %>%
  # Spread the director column over separate rows
  separate_rows(director, sep = ", ") %>%
  # Count the number of movies per director
  count(director, sort = TRUE)

# 2. Imputing sales data
# fill(): can be used to back and forward fill missing values for variables
sales_df %>%
  # Impute the year column
  fill(year, .direction = "up") %>%
  # Create a line plot with sales per quarter colored by year.
  ggplot(aes(x = quarter, y = sales, color = year, group = year)) +
  geom_line()

# 3. Working with replace_na
# Method allows for missing values to be filled in for the DataFrame
country_to_continent_df %>%
  left_join(nuke_df, by = "country_code") %>%
  # Impute the missing values in the n_bombs column with 0L
  replace_na(list(n_bombs = 0L)) %>%
  # Group the dataset by continent
  group_by(continent) %>%
  # Sum the number of bombs per continent
  summarize(n_bombs_continent = sum(n_bombs)) %>%
  # Plot the number of bombs per continent
  ggplot(aes(x = continent, y = n_bombs_continent)) +
  geom_col()


for(i in 10:0) {print(i)}


fuzzy_join <- function(df1,df2,col1,col2,mode,max_dist,method, q, p){
# df1 the dataframe of the first concept
# df2 the dataframe of the first concept
# col1 column name from df1 to join
# col2 column name from df12 to join
# mode of the join: inner, left, right, full, semi, anti
# max_dist maximum distance(lv,dl,qgram,osa,lcs,soundex) or minimum similarity(jw,cosine,jaccard) required to join the concept records
# method for fuzzy matching
# q the size of grams for q-gram matching
# p - penalty for some methods for fuzzy matching
#
library(fuzzyjoin)
#write.csv(df1,"C:\\Users\\rramirezjimenez\\workspace\\Semoss\\R\\FuzzyJoinTest\\Temp\\sourceDataFrame.csv")
#write.csv(df2,"C:\\Users\\rramirezjimenez\\workspace\\Semoss\\R\\FuzzyJoinTest\\Temp\\targetDataFrame.csv")
a<-paste(col1,"=","\"",col2,"\")",sep="")
b<-paste(",mode=\"",mode,"\",max_dist=",max_dist,",method=\"",method,"\",q=",q,",p=",p,")",sep="")
c<-paste("r<-","stringdist_join(df1,df2,by=c(",a,b,sep="")
eval(parse(text=c))
r<-as.data.frame(r)
if(ncol(df1) == 1){
r<-as.data.frame(r)
names(r)[1]<-col1
}
#write.csv(r,"C:\\Users\\rramirezjimenez\\workspace\\Semoss\\R\\FuzzyJoinTest\\Temp\\final.csv")
return(r)
}

#df1<-read.csv("C:/fuzzy1.csv")
#df2<-read.csv("C:/fuzzy2.csv")

# Jaro - Winkler
#df<-fuzzy_join(df1,df2,"t1c1","t2c1","inner",0.1,method="jw",q=1,p=0.1)
# Damirau - Levenshtein
#df<-fuzzy_join(df1,df2,"t1c1","t2c1","inner",1,method="dl",q=1,p=0)
# qgram
#df<-fuzzy_join(df1,df2,"t1c1","t2c1","inner",2,method="qgram",q=2,p=0)
# cosine
#df<-fuzzy_join(df1,df2,"t1c1","t2c1","inner",0.1,method="cosine",q=2,p=0)
# osa
#df<-fuzzy_join(df1,df2,"t1c1","t2c1","inner",2,method="osa",q=1,p=0)


library(ggplot2)
library(ggwordcloud)

einstein <- scan( "http://www.gutenberg.org/files/5001/5001-h/5001-h.htm" , what = character() )
galilei <- scan( "http://www.gutenberg.org/cache/epub/37729/pg37729.txt" , what = character() )
huygens <- scan( "http://www.gutenberg.org/cache/epub/14725/pg14725.txt" , what = character() )
tesla <- scan( "http://www.gutenberg.org/cache/epub/13476/pg13476.txt" , what = character() )

remove_punct <- function( str ) {
  tmp <- gsub( "[[:punct:][:blank:]]+" , "" , str )
  tmp <- unlist( apply( as.matrix( tmp ) , c(1,2) , strsplit , split = "\n" ) )
  tmp <- tmp[ tmp != "" ]
  res <- tolower( tmp )
  return( res )
}

tmp_einstein <- remove_punct( einstein )
tmp_galilei <- remove_punct( galilei )
tmp_huygens <- remove_punct( huygens )
tmp_tesla <- remove_punct( tesla )

length( tmp_einstein ); head( tmp_einstein , 20 )
length( tmp_galilei ); head( tmp_galilei , 20 )
length( tmp_huygens ); head( tmp_huygens , 20 )
length( tmp_tesla ); head( tmp_tesla , 20 )

tab_einstein <- table( tmp_einstein ) ; tab_einstein <- sort( tab_einstein , decreasing = TRUE )
tab_galilei <- table( tmp_galilei ) ; tab_galileo <- sort( tab_galilei , decreasing = TRUE )
tab_huygens <- table( tmp_huygens ) ; tab_huygens <- sort( tab_huygens , decreasing = TRUE )
tab_tesla <- table( tmp_tesla ) ; tab_tesla <- sort( tab_tesla , decreasing = TRUE )

author <- rep( c( "Einstein" , "Galilei" , "Huygens" , "Tesla" ) , c( length( tab_einstein ) , length( tab_galilei ) , length( tab_huygens ) , length( tab_tesla ) ) )
word <- c( names( tab_einstein ) , names( tab_galilei ) , names( tab_huygens ) , names( tab_tesla ) )
count <- c( tab_einstein , tab_galilei , tab_huygens , tab_tesla )

tf_einstein <- tab_einstein / sum( tab_einstein )
tf_galilei <- tab_galilei / sum( tab_galilei )
tf_huygens <- tab_huygens / sum( tab_huygens )
tf_tesla <- tab_tesla / sum( tab_tesla )
tf <- c( tf_einstein , tf_galilei , tf_huygens , tf_tesla )

physics <- data.frame( author = author , word = word , count = count , tf = tf , stringsAsFactors = FALSE )

idf_fun <- function( word ) {
  idx <- physics$word %in% word
  idf <- log( 4 / sum(idx) )
  return( idf )
} #tf_idf 가중치 함수 설정

idf <- sapply( physics$word , FUN = idf_fun )

physics$idf <- idf
physics$tf_idf <- physics$tf * physics$idf

idx <- tapply( physics$tf_idf , physics$author , FUN = order , decreasing = TRUE )

tf_idf_einstein <- physics[ physics$author == "Einstein" , ][ idx$Einstein[1:10] ,]
tf_idf_galilei <- physics[ physics$author == "Galilei" , ][ idx$Galilei[1:10] ,]
tf_idf_huygens <- physics[ physics$author == "Huygens" , ][ idx$Huygens[1:10] ,]
tf_idf_tesla <- physics[ physics$author == "Tesla" , ][ idx$Tesla[1:10] ,]

physics <- rbind( tf_idf_einstein , tf_idf_galilei , tf_idf_huygens , tf_idf_tesla )

p <- ggplot( physics , aes( x = factor(word , levels = word ) , y = tf_idf , fill = author ) ) + geom_col( show.legend = FALSE )
p + facet_wrap( ~ author , scales = "free" ) + coord_flip() + theme( axis.title.y = element_blank() )


library(tidyverse)
library(RCurl)
library(xml2)

url_root = "ftp://ftp-reg.cloud.bom.gov.au/fwo/IDV60920.xml"
dat=getURLContent(url_root,userpwd="bom893:bmaT94jN",binary=FALSE)
dat=read_xml(dat)
dl = xml_find_all(dat,".//observations")
dl = xml_find_all(dl,".//station")

st_id = xml_attr(dl,"wmo-id")
st_name = xml_attr(dl,"stn-name")
st_lat = xml_attr(dl,"lat")
st_lon = xml_attr(dl,"lon")

get_var = function(dl,varname){
  x=map(dl,xml_find_all,xpath=sprintf("period/level/element[@type='%s']",varname))
  x=map(x,xml_text)
  x[sapply(x, is_empty)] <- NA
  as.numeric(unlist(x))
}

df = tibble(id = st_id,
            name = st_name,
            lat=as.numeric(st_lat),
            lon=as.numeric(st_lon),
            apparent_temp = get_var(dl,"apparent_temp"),
            air_temperature = get_var(dl,"air_temperature"),
            dew_point = get_var(dl,"dew_point"),
            pres = get_var(dl,"pres"),
            rel_humidity = get_var(dl,"rel-humidity"),
            wind_dir_deg = get_var(dl,"wind_dir_deg"),
            wind_spd_kmh = get_var(dl,"wind_spd_kmh"),
            rainfall_24hr = get_var(dl,"rainfall_24hr")
            )

library(tmap)
library(sf)
dat = st_as_sf(df,coords=c("lon","lat"),crs=4326)

m = tm_shape(dat) + tm_text("air_temperature")


library(ggplot2)
theme_set(theme_bw(18))
setwd("~/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/sinking-marbles/results/")
source("rscripts/summarySE.r")
source("rscripts/helpers.r")
load("data/priors.RData")
r = read.table("data/sinking-marbles.tsv", sep="\t", header=T)
r$trial = r$slide_number_in_experiment - 2
r = r[,c("workerid", "rt", "effect", "cause","language","gender.1","age","gender","other_gender","quantifier", "object_level", "response", "object","slider_id","num_objects","trial")]
row.names(priors) = paste(priors$effect, priors$object)
r$Prior = priors[paste(r$effect, r$object),]$response
r$object_level = factor(r$object_level, levels=c("object_high", "object_mid", "object_low"))
r$Proportion = factor(ifelse(r$slider_id == "all","100",ifelse(r$slider_id == "lower_half","1-50",ifelse(r$slider_id == "upper_half","51-99","0"))),levels=c("0","1-50","51-99","100"))
r$Half = as.factor(ifelse(r$trial < 16, 1, 2))
r$Quarter = as.factor(ifelse(r$trial < 8, 1, ifelse(r$trial < 16, 2, ifelse(r$trial < 24, 3, 4))))
summary(r)
r$Combination = as.factor(paste(r$cause,r$object,r$effect))
table(r$Combination)

# compute normalized probabilities
nr = ddply(r, .(workerid,trial), summarize, normresponse=response/(sum(response)),workerid=workerid,Proportion=Proportion)
row.names(nr) = paste(nr$workerid,nr$trial,nr$Proportion)
r$normresponse = nr[paste(r$workerid,r$trial,r$Proportion),]$normresponse
# test: sums should add to 1
sums = ddply(r, .(workerid,trial), summarize, sum(normresponse))
colnames(sums) = c("workerid","trial","sum")
sums

save(r, file="data/r.RData")

##################

s = summarySE(r, measurevar="response", groupvars=c("effect", "object_level", "object","Proportion","Prior","quantifier"))
head(s[s$quantifier == "Some" & s$Proportion == "100",],20)

ggplot(s, aes(x=Prior, y=response))+#, colour=object_level)) +
  geom_point() +
  geom_smooth() +
#  geom_errorbar(aes(ymin=response-ci, ymax=response+ci, colour=factor(object_level)), width=.3) +
  facet_grid(quantifier~Proportion) +
  scale_y_continuous(limits=c(0,1)) +
  ylab("") +
  xlab("") +
  theme_bw(18) +
  theme(
    axis.text.x = element_text(size=10, angle=-45, hjust=0)
    ,plot.background = element_blank()
    ,panel.grid.minor = element_blank()
  )

s = summarySE(r, measurevar="response", groupvars=c("effect", "object_level", "object","Proportion","Prior","quantifier","Quarter"))

ggplot(s, aes(x=Prior, y=response,color=Quarter))+#, colour=object_level)) +
  geom_point() +
  geom_smooth() +
  #  geom_errorbar(aes(ymin=response-ci, ymax=response+ci, colour=factor(object_level)), width=.3) +
  facet_grid(quantifier~Proportion) +
  scale_y_continuous(limits=c(0,1)) +
  ylab("") +
  xlab("") +
  theme_bw(18) +
  theme(
    axis.text.x = element_text(size=10, angle=-45, hjust=0)
    ,plot.background = element_blank()
    ,panel.grid.minor = element_blank()
  )

# see if first half different
firsthalf = subset(r, trial < 16)
s = summarySE(r, measurevar="response", groupvars=c("effect", "object_level", "object","Proportion","Prior","quantifier"))

ggplot(s, aes(x=Prior, y=response))+#, colour=object_level)) +
  geom_point() +
  geom_smooth() +
  #  geom_errorbar(aes(ymin=response-ci, ymax=response+ci, colour=factor(object_level)), width=.3) +
  facet_grid(quantifier~Proportion) +
  scale_y_continuous(limits=c(0,1)) +
  ylab("") +
  xlab("") +
  theme_bw(18) +
  theme(
    axis.text.x = element_text(size=10, angle=-45, hjust=0)
    ,plot.background = element_blank()
    ,panel.grid.minor = element_blank()
  )

ggsave(file=paste(c("graphs/",graph_title, ".png"), collapse=""), width=15, height=6, title=graph_title)

graph_title = "sinking-marbles-prior-with-labels"
ggplot(s, aes(x=effect, y=response)) +
  geom_point(aes(colour=factor(object_level)), stat="identity") +
  geom_errorbar(aes(ymin=response-ci, ymax=response+ci, colour=factor(object_level)), width=.3) +
  geom_text(aes(label=object), size=3) +
  ylab("") +
  xlab("") +
  theme_bw(18) +
  theme(
    axis.text.x = element_text(size=10, angle=-45, hjust=0)
    ,plot.background = element_blank()
    ,panel.grid.minor = element_blank()
  )
ggsave(file=paste(c("graphs/",graph_title, ".png"), collapse=""), width=15, height=6, title=graph_title)

s$y = 0
s$yobject = as.numeric(ifelse(s$object_level == "object_high",0.25,ifelse(s$object_level =="object_mid",0,-0.25)))
ggplot(s, aes(x=response, y=yobject)) +
  geom_point(aes(colour=factor(object_level)))  +
  geom_text(aes(label=effect,y=yobject-0.05),angle=45) +
  theme_bw(18) +
  theme(
    axis.text.x = element_text(size=10, angle=-45, hjust=0)
    ,plot.background = element_blank()
    ,panel.grid.minor = element_blank()
  )
graph_title = "sinking-marbles-prior-distribution"
ggsave(file=paste(c("graphs/",graph_title, ".png"), collapse=""), width=15, height=6, title=graph_title)

ggplot(s, aes(x=response, fill=factor(object_level))) +
  geom_histogram(position="dodge")  +
  theme_bw(18) +
  theme(
    axis.text.x = element_text(size=10, angle=-45, hjust=0)
    ,plot.background = element_blank()
    ,panel.grid.minor = element_blank()
  )
graph_title = "sinking-marbles-prior-histogram"
ggsave(file=paste(c("graphs/",graph_title, ".png"), collapse=""), width=15, height=6, title=graph_title)

# ggplot(s, aes(x=sentence, y=response)) +
#   geom_bar(aes(fill=factor(sentence)), position=position_dodge(0.9), stat="identity") +
#   geom_errorbar(aes(ymin=response-ci, ymax=response+ci, group=factor(sentence)), position=position_dodge(0.9), width=.3) +
#   ggtitle(graph_title) +
#
# graph_title = "3a-dots"
# ggplot(r, aes(x=sentence, y=response)) +
#   geom_point(colour="black", size=3, alpha=1/3, stat="identity") +
#   geom_line(aes(group=workerid, colour=factor(workerid)), alpha=1) +
#   ggtitle(graph_title) +
#   ylab("") +
#   xlab("") +
#   theme_bw(18) +
#   theme(
#     axis.text.x = element_text(size=10, angle=-45, hjust=0)
#     ,legend.position="none"
#     ,plot.background = element_blank()
#     ,panel.grid.minor = element_blank()
#   )
# ggsave(file=paste(c(graph_title, ".png"), collapse=""), width=10, height=6, title=graph_title)
#
# r.z = ddply(r, .(workerid), transform, z.response = scale(response))
# z = summarySE(r.z, measurevar="z.response", groupvars=c("sentence"))
# graph_title = "3a-z"
# ggplot(z, aes(x=sentence, y=z.response)) +
#   geom_bar(aes(fill=factor(sentence)), position=position_dodge(0.9), stat="identity") +
#   geom_errorbar(aes(ymin=z.response-ci, ymax=z.response+ci, group=factor(sentence)), position=position_dodge(0.9), width=.3) +
#   ggtitle(graph_title) +
#   ylab("") +
#   xlab("") +
#   theme_bw(18) +
#   theme(
#     axis.text.x = element_text(size=10, angle=-45, hjust=0)
#     ,plot.background = element_blank()
#     ,panel.grid.minor = element_blank()
#   )
# ggsave(file=paste(c(graph_title, ".png"), collapse=""), width=10, height=6, title=graph_title)
#
# r.z = ddply(r, .(workerid), transform, z.response = scale(response))
# z = summarySE(r.z, measurevar="z.response", groupvars=c("sentence", "workerid"))
# graph_title = "3a-z-facet"
# ggplot(z, aes(x=sentence, y=z.response)) +
#   geom_bar(aes(fill=factor(sentence)), position=position_dodge(0.9), stat="identity") +
#   geom_errorbar(aes(ymin=z.response-ci, ymax=z.response+ci, group=factor(sentence)), position=position_dodge(0.9), width=.3) +
#   ggtitle(graph_title) +
#   facet_wrap(~ workerid) +
#   ylab("") +
#   xlab("") +
#   theme_bw(18) +
#   theme(
#     axis.text.x = element_text(size=10, angle=-45, hjust=0)
#     ,plot.background = element_blank()
#     ,panel.grid.minor = element_blank()
#   )
# ggsave(file=paste(c(graph_title, ".png"), collapse=""), width=10, height=6, title=graph_title)


my_lottery_number <- c(37, 20, 48, 1, 13, 5)
days_count <- 0

while (TRUE) {
  days_count <- days_count + 1
  lottery_number <- sample(1:49, 6)
  if (sum(sort(lottery_number) == sort(my_lottery_number)) == 6) {
    cat('Lottery number: ')
    cat(lottery_number)
    cat('\n')
    break
  }
}

cat(sprintf('Took %s days to win the lottery\n', days_count))
cat(sprintf('Spent %s dollars to win the lottery\n', days_count * 2))


InvertPreference <- function(data) {
  # This function takes some input data containing all the six preferences at
  # single level (no PCA) and it multiplies the ones with an opposite trend by
  # a -1

  # Define the original value of the gender to preserve the direction of the
  # change
  data[, genderOrig := gender]
  # Invert the sign for the known preferences
  data[preference %in% c("risktaking", "negrecip", "patience"),
       gender := -1 * genderOrig]

  return(data)
}


# install.packages("plotly")

library(plotly)

data <- read.csv("./example-fingerprints/fingerprints.csv")
colors <- c('#4AC6B7', '#1972A4', '#965F8A', '#FF7070', '#C61951', '#FAEF44', '#DEAF69')

p <- plot_ly(data, x = ~total_number_packets, y = ~no_incoming_packets, z = ~no_outgoing_packets, color = ~domain, size = ~total_incoming_sizes, colors = colors,
             marker = list(symbol = 'circle', sizemode = 'diameter'), sizes = c(5, 150),
             text = ~paste('Domain:', domain, '<br># of packets:', total_number_packets)) %>%
  layout(title = 'Website Fingerprinting',
         scene = list(xaxis = list(title = 'Total Number of packets',
                      gridcolor = 'rgb(255, 255, 255)',
                      type = 'log',
                      zerolinewidth = 1,
                      ticklen = 5,
                      gridwidth = 2),
               yaxis = list(title = 'Number of Incoming Packets',
                      gridcolor = 'rgb(255, 255, 255)',
                      zerolinewidth = 1,
                      ticklen = 5,
                      gridwith = 2),
               zaxis = list(title = 'Number of Outgoing Packets',
                            gridcolor = 'rgb(255, 255, 255)',
                            type = 'log',
                            zerolinewidth = 1,
                            ticklen = 5,
                            gridwith = 2)),
         paper_bgcolor = 'rgb(243, 243, 243)',
         plot_bgcolor = 'rgb(243, 243, 243)')

p


#!/usr/bin/env Rscript

# Command line argument processing
args <- commandArgs(trailingOnly=TRUE)

if (!require("stringr")){
    install.packages("stringr", dependencies=TRUE, repos='http://cloud.r-project.org/')
    library("stringr")
}

if (!require("dplyr")){
    install.packages("dplyr", dependencies=TRUE, repos='http://cloud.r-project.org/')
    library("dplyr")
}

### function

calc_Tcenter <- function(bed.row){

  if (bed.row[10]==1){
    new_position = as.integer(bed.row[2] + (bed.row[3]-bed.row[2])/2)
    return(new_position)
  }

  t_Length_set = as.integer(unlist(str_split(bed.row[11], ",")))
  t_Length_set = t_Length_set[!is.na(t_Length_set)]
  t_length = as.integer(sum(t_Length_set)/2)

  t_Position_set = as.integer(unlist(str_split(bed.row[12], ",")))
  t_Position_set = t_Position_set[!is.na(t_Position_set)]

  for(i in 1:length(t_Length_set)){
    S_i = sum(t_Length_set[1:i])

    if(S_i >= t_length){
      k = i
      s = sum(t_Length_set[1:(i-1)])
      new_position = as.integer(bed.row[2] + t_Position_set[k] + (t_length-s))
      return(new_position)
    }
  }
}

inputfile <- args[1]
bed.raw = read.table(inputfile, sep="\t", header=F, check.names=FALSE, stringsAsFactors=F)

bed.adjusted = bed.raw
for(i in 1:nrow(bed.raw)){
  if(bed.raw[i,7] == bed.raw[i,8]){
    bed.adjusted[i,7] = calc_Tcenter(bed.raw[i,])
    bed.adjusted[i,8] = bed.adjusted[i,7]
  }
}

write.table(bed.adjusted, 'adjusted.bed', sep="\t", col.names=F, row.names=F, quote=F)

# Printing sessioninfo to standard out
print("adjusted bed script info:")
sessionInfo()


#' knots2kmh
#'
#' Conversion from knot per second to kilometers per hour.
#'
#' @param knots numeric  Speed in knots per second.
#' @return kilometers per hour
#'
#'
#' @author    Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @keywords  knots2kmh
#'
#' @export
#'
#'
#'
#'

knots2kmh=function(knots) {
                         ct$assign("knots", as.array(knots))
                         ct$eval("var res=[]; for(var i=0, len=knots.length; i < len; i++){ res[i]=knots2kmh(knots[i])};")
                          res=ct$get("res")
                         return(ifelse(res==9999,NA,res))
}


#!/usr/bin/env Rscript
#autor:      Joao Sollari Lopes
#local:      University of Reading, Reading, UK
#Rversion:   3.2.3
#criado:     01.03.2010
#modificado: 20.11.2017

# @arg rej_file  - file with rejection step results (.dat)
plot_sstats <- function(data_file){

    #info on summstats
	lsstats <- c("pi1","S1","k_S1","sH_S1","avMFS1","sdMFS1")
	nsstats <- length(lsstats)

	#import the .dat file
    npoints <- 1000
	abc.data <- data.matrix(read.table(data_file))[1:npoints,]

    #normalize summstats
	sstats <- abc.data[,7:12]
	sstats.s <- sstats
	for(i in 1:nsstats){
		sstats.s[,i] <- (sstats[,i] - mean(sstats[,i]))/sd(sstats[,i])
	}

	#plotting summstats
    fname <- "../results/plot_sstats.eps"
    postscript(file=fname,width=7,height=7,colormodel="rgb",horizontal=FALSE,onefile=FALSE,paper="special")
	oldpar <- par(mfrow=c(2,3),xaxt="n",yaxt="n",mar=c(2,2,2,2))
	for(i in 1:nsstats){
		plot(sstats[,i],log(abc.data[,6]),pch='.',main=lsstats[i])
		abline(lm(log(abc.data[,6])~sstats[,i]),lty=2,col="red")
	}
	par(oldpar)
	dev.off()
	print("done plot sstats")

}

args = commandArgs(trailingOnly=TRUE)
plot_sstats(args[1])


######################################################################################################
# Triple plot
#
# Version 1.00, 28/08/2007 10:59:53
#
# Author: Mark Payne
# DIFRES, Charlottenlund, DK
#
# Plots SSB, F.bar and Recruitment on a single stacked plot.
# Functions here are called from elsewhere
#
# Changes:
# V 1.00  - First release
####################################################################################################

plot.triple.panel<-function(x,label,xlimits,show.x.lbl=FALSE,legend.pos=NULL,legend.ncol=1) {
      yr  <-  as.numeric(dimnames(x)[[2]])
      n.runs  <-  dim(x)[3]
      plot(yr,x[sp,,1],ann=FALSE,type='b',ylim=c(0,max(x[sp,,],na.rm=T)),xlim=xlimits,
          lwd=3,pch=1,xaxt=if(show.x.lbl){"s"} else {"n"})
      mtext(label,las=0,side=2,padj=-6)
      grid()
      if (n.runs>1) for (yy in (2:n.runs)) {
        lines(yr,x[sp,,yy],type='b',pch=yy,col=1,lwd=1)
      }
      if(!is.null(legend.pos)) {
          run.names <-  dimnames(x)[[3]]
          legend(x=legend.pos,legend=as.character(run.names),lwd=c(2,rep(1,n.runs-1)),
              pch=seq(1,n.runs),col=1,bg="white",pt.bg="white",ncol=legend.ncol)
      }
    }

plot.triple<-function(legend.pos=NULL,legend.ncol=1) {
    layout(matrix(c(1,2,3),3,1,byrow=TRUE), height=c(1,1,1), width=1)
    oldpar  <-  par(oma=c(2.5,0.5,1.5,0.5),cex=1,las=1,mar=c(0,6,0,0))
    xlims   <-  range(pretty(as.numeric(c(dimnames(SSB)[[2]],dimnames(FI)[[2]],dimnames(REC)[[2]]))))
    for (sp in (1:nsp)) {
        #Not sure if this works in multispecies mode or not - needs to be checked. MRP 20070827
        if(nsp>1) {stop("Unsure whether this works in mulitspecies mode. Check it properly!! - MRP 20070827")}
        plot.triple.panel(SSB,"SSB (kt)",xlims,legend.pos=legend.pos,legend.ncol=legend.ncol)
        plot.triple.panel(FI,"F bar",xlims)
        plot.triple.panel(REC,"Recruits (10^6)",xlims,show.x.lbl=TRUE)
    }
    par(oldpar)
}


# Clear workspace
rm(list=ls())

# load libraries
library(ggplot2)
library(dplyr)
library(treemap)
library(RColorBrewer)
library(scales)
library(doBy)

# Install trebuchet font to be used
#library(devtools)
#install_github("extrafont", "wch")
#font_import(pattern = "trebuc")

# Define lab colors (TODO: Source this)
# Lab RGB colors
redL    <- c("#B71234")
dredL 	<- c("#822443")
dgrayL 	<- c("#565A5C")
lblueL 	<- c("#7090B7")
dblueL 	<- c("#003359")
lgrayL	<- c("#CECFCB")

#setwd("U:/FoodForPeace/R/")
setwd("C:/Users/t/Box Sync/FoodForPeace/R/")
d <- read.csv("FFPdata0912.csv", sep = ",", header = TRUE)
names(d)

d$Food.Aid <- round(d$decTotal/1000000, 0)
d$Food.AidNom <- round(d$decTotalNom/1000000, 0)

# d$Food.Aid <- format(d$tot.thous, big.mark=",", scientific=F)

# Subset data into years; where x[1] = 1959, x[2] = 1953 etc...
# Apply vector of names to new subset data
x.split <- split(d, d$year)
new_names <- c("dfif", "dsix", "dsev", "degt", "dnin", "dzer", "dsub")
for (i in 1:length(x.split)) {
  assign(new_names[i], x.split[[i]])
}

# Create a function to keep top X records; z controls graphic title -- linked to x input.
myBar <- function(x, y, z, a) {

  # Filter the data to select top N countries of NOMINAL FOOD Aid expenditures
  dplot <- head(arrange(x, desc(Food.AidNom)), n = y)

  # Initialize a ggplot bar chart using the dollars as stat
  c <- ggplot(dplot, aes(x = reorder(factor(country), Food.AidNom),
         y =Food.AidNom, fill = "country")) + geom_bar(stat = "identity") + scale_fill_manual(values = redL )

  # Touch up plot to remove formatting and add USAID lab colours
  pp <- c + coord_flip()+labs(x ="", title = z, y = "($ Nominal US Millions)") +
          theme(legend.position = "none", panel.background=element_rect(fill="white"),
          axis.ticks.y=element_blank(),
          axis.text.y  = element_text(hjust=1, size=10, colour = dblueL),
          axis.ticks.x=element_blank(),
          axis.text.x  = element_text(hjust=1, size=10, colour = dblueL),
          axis.title.x = element_text(colour=dblueL, size=8),
          plot.title = element_text(lineheight=.8, colour = dblueL))  +
          scale_y_continuous(labels = dollar )

  print(pp)

  # Save the plot in the working directory using the values in a (new_names)
  ggsave(pp, filename = paste(a, ".png"), width=7.5, height=5.5)
}

# Define top N list and names for top of each graph
topList <- c(10)
graph.title <- c("Top 10 Receipients of Food Aid: 1954-1959",
                 "Top 10 Receipients of Food Aid: 1960-1969",
                 "Top 10 Receipients of Food Aid: 1970-1979",
                 "Top 10 Receipients of Food Aid: 1980-1989",
                 "Top 10 Receipients of Food Aid: 1990-1999",
                 "Top 10 Receipients of Food Aid: 2000-2009",
                 "Top 10 Receipients of Food Aid: 2010-2013")

for (i in 1:length(new_names)) {
  myBar(get(new_names[i]), topList, graph.title[i], new_names[i])
}

### Bring in regional data

dd <- read.csv("FFPdata0912_RegionTotals.csv", sep = ",", header = TRUE)
dd$Food.Aid.R <- round(dd$decTotal/1000000, 0)  # For real numbers
dd$Food.Aid.RNom <- round(dd$decTotalNom/1000000, 0) # For nomimal numbers (default)

x.splitreg <- split(dd, dd$year)
new_namesreg <- c("dfifreg", "dsixreg", "dsevreg", "degtreg", "dninreg", "dzerreg", "dsubreg")
for (i in 1:length(x.split)) {
  assign(new_namesreg[i], x.splitreg[[i]])
}

# Create a function for regions
myReg <- function(x, z, a) {

  # Initialize a ggplot bar graph for showing regional totals by decade
  p <- ggplot(x , aes(x = reorder(factor(region), Food.Aid.RNom),
                      y = Food.Aid.RNom, fill = "region")) + geom_bar(stat = "identity") + scale_fill_manual(values = dblueL )

  # Touch up plot to remove formatting and add USAID lab colours
  pp <- p + coord_flip()+labs(x ="", title = z, y = "($ Nominal US Millions)") +
       theme(legend.position = "none", panel.background=element_rect(fill="white"),
          axis.ticks.y=element_blank(),
          axis.text.y  = element_text(hjust=1, size=10, colour = dblueL),
          axis.ticks.x=element_blank(),
          axis.text.x  = element_text(hjust=1, size=10, colour = dblueL),
          axis.title.x = element_text(colour=dblueL, size=8),
          plot.title = element_text(lineheight=.8, colour = dblueL))  +
          scale_y_continuous(labels = dollar )
  print(pp)

  # Save plot using names in vector a (new_namesreg)
  ggsave(pp, filename = paste(a, ".png"), width=7.5, height=5.5)
}

graph.titlereg <- c("Regional Totals: 1954-1959",
                 "Regional Totals: 1960-1969",
                 "Regional Totals: 1970-1979",
                 "Regional Totals: 1980-1989",
                 "Regional Totals: 1990-1999",
                 "Regional Totals: 2000-2009",
                 "Regional Totals: 2010-2013")

for (i in 1:length(new_namesreg)) {
  myReg(get(new_namesreg[i]), graph.titlereg[i], new_namesreg[i])
}

# Calculate totals Aggregates for decades
summaryBy(decTotalNom ~ year, data = d, FUN = sum)

grandT <- summaryBy(decTotalNom ~ region, data = d, FUN = sum)
grandD <- as.data.frame(grandT)
grandD$decTotalNom.sumR <- round(grandD$decTotalNom.sum/1000000, 0)

# Plot grand totals
p <- ggplot(grandD , aes(x = reorder(factor(region), decTotalNom.sumR),
                         y = decTotalNom.sumR, fill = "region")) + geom_bar(stat = "identity") + scale_fill_manual(values = dblueL )
pp <- p + coord_flip()+labs(x ="", title = "Regional Totals: 1954-2013", y = "($ Nominal US Millions)") +
  theme(legend.position = "none", panel.background=element_rect(fill="white"), axis.ticks.y=element_blank(),
        axis.text.y  = element_text(hjust=1, size=10, colour = dblueL), axis.ticks.x=element_blank(),
        axis.text.x  = element_text(hjust=1, size=10, colour = dblueL),
        axis.title.x = element_text(colour=dblueL, size=8),
        plot.title = element_text(lineheight=.8, colour = dblueL))  +
  scale_y_continuous(labels = dollar )
print(pp)
ggsave(pp, filename = paste("GrandTotNom", ".png"), width=7.5, height=5.5)

# Calculate total Aggregates for countries
summaryBy(decTotal ~ country, data = d, FUN = sum)
countryTot <- as.data.frame(summaryBy(decTotal ~ country, data = d, FUN = sum))
countryTot$decTotal.sumD <- round(countryTot$decTotal.sum/1000000, 0)

# Plot top 25 receipients of Food Aid
dplot <- head(arrange(countryTot, desc(decTotal.sum)), n = 25)
c <- ggplot(dplot, aes(x = reorder(factor(country), decTotal.sumD),
                       y =decTotal.sumD, fill = "country")) + geom_bar(stat = "identity")+ scale_fill_manual(values = redL )
p <- c + coord_flip()+labs(x ="", title = "Top 25 Recipients of Food Aid: 1954-2013", y = "($ 2013 US Millions)") +
  theme(legend.position = "none", panel.background=element_rect(fill="white"), axis.ticks.y=element_blank(),
        axis.text.y  = element_text(hjust=1, size=10, colour = dblueL), axis.ticks.x=element_blank(),
        axis.text.x  = element_text(hjust=1, size=10, colour = dblueL),
        axis.title.x = element_text(colour=dblueL, size=8),
        plot.title = element_text(lineheight=.8, colour = dblueL))  +
  scale_y_continuous(labels = dollar )
print(p)
ggsave(p, filename = paste("CountryTot", ".png"), width=7.5, height=5.5)

# Calculate total Aggregates for countries
summaryBy(decTotalNom ~ country, data = d, FUN = sum)
countryTot <- as.data.frame(summaryBy(decTotalNom ~ country, data = d, FUN = sum))
countryTot$decTotalNom.sumD <- round(countryTot$decTotalNom.sum/1000000, 0)

# Plot top 25 receipients of Food Aid in nominal terms
dplot <- head(arrange(countryTot, desc(decTotalNom.sum)), n = 25)
c <- ggplot(dplot, aes(x = reorder(factor(country), decTotalNom.sumD),
                       y =decTotalNom.sumD, fill = "country")) + geom_bar(stat = "identity")+ scale_fill_manual(values = redL )
p <- c + coord_flip()+labs(x ="", title = "Top 25 Recipients of Food Aid: 1954-2013", y = "($ Nominal US Millions)") +
  theme(legend.position = "none", panel.background=element_rect(fill="white"), axis.ticks.y=element_blank(),
        axis.text.y  = element_text(hjust=1, size=10, colour = dblueL), axis.ticks.x=element_blank(),
        axis.text.x  = element_text(hjust=1, size=10, colour = dblueL),
        axis.title.x = element_text(colour=dblueL, size=8),
        plot.title = element_text(lineheight=.8, colour = dblueL))  +
  scale_y_continuous(labels = dollar )
print(p)
ggsave(p, filename = paste("CountryTot", ".png"), width=7.5, height=5.5)

# Basic treemap function to call with subsetted data above
myTree <- function(x) {
  tm <- treemap(x, index=c("region", "country"),
                vSize = "Food.Aid",
                vColor ="Food.Aid",
                type = "value",
                palette="RdYlGn",
                fontsize.labels=c(40,10),
                align.labels=list(c("center", "center"),
                                  c("left", "top")),
                lowerbound.cex.labels=.66,
                position.legend = "bottom",
                #inflate.labels = TRUE,
                title = "Food Aid Decadal Totals",
                #subtitle = "US Dollars (000s)",
                fontsize.title = 24,
                fontsize.legend = 16,
                bg.labels = 0,
                algorithm = "pivotSize",
                #sortID = "size"
  )
}
myTree(d)


c.activity_martin <- function(traj, min_pause_length=0.2) {

	activities <- c()
	distances <- c()
	timestart <- c()
	timestop <- c()
	Xstart <- c()
	Ystart <- c()
	Xend <- c()
	Yend <- c()
	speedmax_all<- c()

	for (oo in c(1:length(traj))) {

		data = traj[[oo]]
		dt <- data$dt

		xx <- data$x
		yy <- data$y
		ddist <- data$dist
		if (length(ddist)<12) next

		date <- data$date

		#moving <- data$dist
		#moving[is.na(moving)] <- 0
		dt[is.na(dt)] <- 0

		activity <- c()
		Distance <- c()
		datesstart <- c()
		datesend <- c()
		dataXstart <- c()
		dataYstart <- c()
		dataXend <- c()
		dataYend <- c()
		speedmax_burst <- c()

		pause_length <- 0
		active_length <- 0
		Distance_traveled <- 0
		movprec <- FALSE

		speedmax_temp <- 0
		dtempP <- date [1]
		dtempA <-date [1]
		xP<-xx [1]
		yP<-yy [1]
		xA<-xx [1]
		yA<-yy [1]
		active <- FALSE
    DDD=c()
    DD=c()
		# TODO: use rapply here!
		for (i in c(6:(length(dt)-6))) {

		disttrav1s = (ddist[i-5] +ddist[i-4] +ddist[i-3] +ddist[i-2] +ddist[i-1] +ddist[i] +ddist[i+1] +ddist[i+2] +ddist[i-+3] +ddist[i+4] +ddist[i+5])
		DD=c(DD,disttrav1s)
		movprec =ifelse (disttrav1s <1.15, FALSE,movprec)
		moving =ifelse (disttrav1s >2.5, TRUE,movprec)
		#moving is true if >4, false if <2 and the same as in the last loop otherwise
		movprec = moving

			if (!moving) {

				pause_length <- pause_length + dt[i]
				dtempP= ifelse(pause_length > dt [i],dtempP,date [i])## end of bout temporary
				xP = ifelse(pause_length > dt[i],xP,xx [i])
				yP = ifelse(pause_length > dt[i],yP,yy [i])
				if (active_length>0 && pause_length>=min_pause_length) {
					activity <- c(activity,active_length)
					Distance <- c(Distance,Distance_traveled)
					speedmax_burst <- c(speedmax_burst,speedmax_temp)
					datesstart <- c(datesstart,dtempA)
					datesend <- c(datesend,dtempP)
					dataXstart <- c(dataXstart,xA)
					dataYstart <- c(dataYstart,yA)
					dataXend <- c(dataXend,xP)
					dataYend <- c(dataYend,yP)
					active_length <- 0
					Distance_traveled <- 0
					speedmax_temp <-0
				}

			} else {
				active_length <- active_length + dt[i]
				Distance_traveled <- ifelse(active_length > dt[i],Distance_traveled + dt[i+5], disttrav1s)
				speedmax_temp <- ifelse (ddist[i]/dt[i] >speedmax_temp,ddist [i]/dt[i] ,speedmax_temp)
				if (pause_length>0) {
					dtempA= ifelse( active_length > dt [i],dtempA,date [i]) #start of bout temporary, change if active_length was 0(bout def depend on what happen next)
					xA = ifelse(active_length > dt [i],xA,xx [i])
					yA = ifelse(active_length > dt [i],yA,yy [i])
					if (pause_length<min_pause_length){
						active_length <- active_length + pause_length
						pause_length <- 0
					} else {
						activity <- c(activity,-pause_length)
						Distance <- c(Distance,0)
						speedmax_burst <- c(speedmax_burst,speedmax_temp)
						datesstart <- c(datesstart,dtempP)
						datesend <- c(datesend,date [i])
						dataXstart <- c(dataXstart,xP)
						dataYstart <- c(dataYstart,yP)
						dataXend <- c(dataXend,xx[i])
						dataYend <- c(dataYend,yy[i])
						pause_length <- 0
						speedmax_temp <-0
					}
				}

			}
		}
		# add activitity for the last bout
		i=length(dt)
		dataXend <- c(dataXend,xx[i])
		dataYend <- c(dataYend,yy[i])
		datesend <- c(datesend,date [i])
		speedmax_burst <- c(speedmax_burst,speedmax_temp)
		if (!pause_length<min_pause_length){
			activity <- c(activity,-pause_length)
			Distance <- c(Distance,0)
			datesstart <- c(datesstart,dtempP)
			dataXstart <- c(dataXstart,xP)
			dataYstart <- c(dataYstart,yP)
		}else{
			active_length <- active_length + pause_length
			activity <- c(activity,active_length)
			Distance <- c(Distance,Distance_traveled)
			datesstart <- c(datesstart,dtempA)
			dataXstart <- c(dataXstart,xA)
			dataYstart <- c(dataYstart,yA)
			}

		#write activities for this burst

		activities <- c(activities,activity)
		distances <- c(distances, Distance)
		speedmax_all<- c(speedmax_all,speedmax_burst)
		timestart <- c(timestart, datesstart)
		timestop <- c(timestop, datesend)
		Xstart <- c(Xstart, dataXstart)
		Ystart <- c(Ystart, dataYstart)
		Xend <- c(Xend, dataXend)
		Yend <- c(Yend, dataYend)
	}

	erg <- data.frame(datestart=timestart, datesend=timestop,Xs=Xstart,Xe= Xend,Ys=Ystart, Ye=Yend,dist_traveled = distances,speedmax_inbout = speedmax_all,act=activities)
	class(erg$datestart) <- "POSIXct"
	class(erg$datesend) <- "POSIXct"

	return(erg)
}

# takes g_inputdir,g_filetable and g_outputdir
##and g_duration_slider, g_bin_size
# return activity plots

message("starting activity_martin.r corrected for experimental length")
### compute the activities

act_table = data.frame()

#compute activities for each individum
for (i in c(1:nrow(id_table))) {
	act = c.activity_martin(traj[id(traj)==id_table$id[i]])
	act_id = rep(id_table$id[i],nrow(act))
	act_group = rep(id_table$group[i],nrow(act))
	act_table = rbind(act_table,data.frame(act,id=act_id,group=act_group))

}

# filter activities which are smaller than the act slider
act_table_martin = act_table
act_table_ori = act_table
pause_table = act_table[act_table$act<0,]
pause_table$pause = - pause_table$act
act_table = act_table[act_table$act>0,]
########act_table = act_table[act_table$act>g_duration_slider/10*4,]
#

#calculation of linearity of curve for each bout
#########################
#act_table$lin = sqrt( (act_table$Xe-act_table$Xs)^2+(act_table$Ye-act_table$Ys)^2)/act_table$dist_traveled

#calculate total activity time for each individual
sum_act = c()
median_act = c()
median_pause = c()
number_pause = c()
#median_lin = c()
#mean_lin = c()
for (i in c(1:nrow(id_table))) {
	act = act_table[act_table$id==id_table$id[i],]$act
	pause = pause_table[pause_table$id==id_table$id[i],]$pause
	#lin = act_table[act_table$id==id_table$id[i],]$lin
	sum_act = c(sum_act,sum(act))
	median_act = c(median_act,median(act))
	median_pause = c(median_pause, median(abs(pause)))
	number_pause = c(number_pause,length(pause))
	#median_lin = c(median_lin, quantile(lin, probs =0.5, na.rm=TRUE))

}
#act_table_m2 = data.frame(sum_act,median_act,median_pause,number_pause,id=id_table$id,group=id_table$group)
number_pause=number_pause/f_table$length_experiment
sum_act=sum_act/f_table$length_experiment

f_table = data.frame (f_table,activitytime_permin_ST=sum_act,act_bouts_ST=median_act,
pause_duration_ST=median_pause,numb_pause_permin_ST=number_pause)

f_table_positive= data.frame (f_table_positive,activitytime_permin_ST=sum_act,act_bouts_ST=median_act,
pause_duration_ST=median_pause,numb_pause_permin_ST=number_pause)
message("starting writing activities log.txt")

setwd(rgghome)

#if (g_bin_size==0)
#	{g_bin_size = 0.5}
#
#v = act_table$act
#bins = seq(min(v[!is.na(v)])-g_bin_size,max(v[!is.na(v)])+g_bin_size,g_bin_size)

#create mean and sd table
#mean_table = create.mean.table(act_table_m2,group_ids,data_cols=1:4)

# # message("starting plots activity")
# ### create plots
# mybarplot(mean_table$means$sum_act,mean_table$ses$sum_act,rownames(mean_table$means),
	# main="Total activity time Martin 27-10",ylab="Total activity time [s]", ylim= c(0,ylim_acttime))
# mybarplot(mean_table$means$median_act,mean_table$ses$median_act,rownames(mean_table$means),
	# main="Mean of medians of bouts duration Martin 27-10",ylab="median of bouts length [s]",ylim = c(0,ylim_pausetime))

# mybarplot(mean_table$means$number_pause,mean_table$ses$number_pause,rownames(mean_table$means),
	# main="Number of pauses Martin 27-10",ylab="Number of pauses", ylim = c(0,ylim_pauses))

# mybarplot(mean_table$means$median_pause,mean_table$ses$median_pause,rownames(mean_table$means),
	# main="Mean of medians of pause duration Martin 27-10",ylab="Median pause time [s]", ylim =c(0, ylim_pausetime))

# ##mybarplot(mean_table$means$median_lin,mean_table$ses$median_lin,rownames(mean_table$means),
# ##	main="Mean of medians of linearity score Martin 2_1",ylab="Lin score [0 to 1]", ylim =c(0, 1))

# #
# #print(plot(hplot1, xlim=c(0,1),freq = FALSE))
# #
# #bins = 0.11
# #
# #hplot4 = hist(act_table$act,breaks= c(seq(0,max(act_table$act)+bins*5, bins*5)), plot=FALSE)
# #print(plot(hplot4, freq = FALSE, xlim=c(0,100)))
# #
# #
# #
# #plot (act_table$lin, act_table$dist_traveled, ylim =c(0,1000))
# #
# #plot (act_table$lin, act_table$dist_traveled, ylim =c(0,35))
# #
# #plot (act_table_ori$speedmax_inbout, act_table_ori$dist_traveled)
# #hist(act_table_ori$speedmax_inbout)
# #
# #hplot2 = hist(pause_table$pause,breaks= c(seq(0,200, 0.05),  seq(220,1000,20)), plot=FALSE)
# #print(plot(hplot2, xlim=c(0,100)))


library(plotly)

x = Model_SDP_Mean$Débit_CV004
y = Model_SDP_Mean$Pression_PK16
z = Model_SDP_Mean$X250µm

fig <- plot_ly(x = ~x, y = ~y, z = ~z,intensity = ~z, type = 'mesh3d')
fig %>% layout(
  scene = list(
    color ="green",
    xaxis = list(title = "Débit"),
    yaxis = list(title = "Pression_PK16"),
    zaxis = list(title = "Gros")
    )
  )


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

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

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

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

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